[BACK]Return to slof.bin CVS log [TXT] [DIR] Up to [Qemu by Fabrice Bellard] / qemu / pc-bios

Annotation of qemu/pc-bios/slof.bin, revision 1.1

1.1     ! root        1: ��(headermagic123�HEADqemu0 #U11J]���������È�X&(stage1H?ޭ��@<|C�|  �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C���|     �8�N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C���|     �8�N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C���|     �8�N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��        `|      �8    N� B|C�|  �|C�|�|C��
        !             2: `|     �8
        !             3: N� B|C�| �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��
`|     �8
N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C��`|     �8N� B|C�|     �|C�|�|C�� `|     �8 N� B|C�|     �|C�|�|C��!`|     �8!N� B|C�|     �|C�|�|C��"`|     �8"N� B|C�|     �|C�|�|C��#`|     �8#N� B|C�|     �|C�|�|C��$`|     �8$N� B|C�|     �|C�|�|C��%`|     �8%N� B|C�|     �|C�|�|C��&`|     �8&N� B|C�|     �|C�|�|C��'`|     �8'N� B|C�|     �|C�|�|C��(`|     �8(N� B|C�|     �|C�|�|C��)`|     �8)N� B|C�|     �|C�|�|C��*`|     �8*N� B|C�|     �|C�|�|C��+`|     �8+N� B|C�|     �|C�|�|C��,`|     �8,N� B|C�|     �|C�|�|C��-`|     �8-N� B|C�|     �|C�|�|C��.`|     �8.N� B|C�|     �|C�|�|C��/`|     �8/N� B|x}`�9��y���}kcx}`&dL&,8`
        !             4: H&8`
H�8`
        !             5: H�8`SH�8`LH�8`OH�8`FH�H�[?25l **********************************************************************
        !             6: QEMU Starting
        !             7:  Build Date = Mar 23 2011 15:55:48
        !             8:  FW Version = dgibson@(private build)
        !             9: |h�H�8`I|i�N�!xf��8`X8�8�&D"N� dgibson@(private build)�b��#�A@�aH�P�X��`��h�&p�!x�A��a������������&��!��A��a������������&��!��A&�a&�&�&��& ��&(��&8}����&@}����&H}�� �/�|   ��&0�!8N� |)�< �!���A@�aH��P��X��`��h�&p�!x�A��a��������������&��!��A��a��������������&��!��A&�a&��&��&��& ��&(�&0}����8}����&8}����&@}�&��&H}����&PH��b��#|xH
        !            10: 1��&8}����&@}����&H}�� ��&P}���A@�aH�P�X��`��h�&p�!x�A��a������������&��!��A��a������������&��!��A&�a&�&�&��& ��&(�!8|B�|     �|B�|�|B�L$���`N� 
        !            11: 
        !            12: 
E1001 - Boot ROM CRC failure
        !            13: 

        !            14: 
        !            15: 
E1002 - Memory could not be initialized
        !            16: 

        !            17: 
        !            18: 
E1003 - Firmware image incomplete
        !            19: 
       internal FLS1-FFS-0.
        !            20: 
        !            21: 
E1004 - Unspecified Internal Firmware Error
        !            22: 
       internal FLSX-SE-0.|x|�#x|�+x|�3x9@&s�
        !            23: @�(��x|�J�|c#xH&���x;�|#�A�H�H}��|�#x8�|#8A�H�}B�,A�4Hx��}B�8�|'0A�8��|' 8`&A�P|�#x|qB���8�|' A�|����������|���(8� �� 8`~�x}��N� }��|�+x|�+xH9,&@�}��N� |��:��8����E&�P&B��~%�x}��N� }(�|�#x|jx|�#x8� |�+xHE,&@� �,|�*@���8`&}(�N� 8`�����|�B}(�N� 9J��9k���        ��     |-p9�&A�N� q��@���9�N� �!��|��&0��8��@��H|�+xK��Y�&0|����������H��@��88!PN� }�|ix�i,A�H     9)&K���}�N� }�|ixy#' pc,
        !            24: A�8c8c0H&�y#F pc,
        !            25: A�8c8c0H&�y#e pc,
        !            26: A�8c8c0H&�y#� pc,
        !            27: A�8c8c0H&�y#� pc,
        !            28: A�8c8c0H&ey#� pc,
        !            29: A�8c8c0H&Iy#� pc,
        !            30: A�8c8c0H&-y#"pc,
        !            31: A�8c8c0H&y#'pc,
        !            32: A�8c8c0H�y#Fpc,
        !            33: A�8c8c0H�y#epc,
        !            34: A�8c8c0H�y#�pc,
        !            35: A�8c8c0H�y#�pc,
        !            36: A�8c8c0H�y#�pc,
        !            37: A�8c8c0Hiy#�pc,
        !            38: A�8c8c0HMy#pc,
        !            39: A�8c8c0H1}�N� }�|ixK��}�|ixK��t}�|ixK���xf��8`X8�8�&D"N� |jx8`T8�D"|�#yA�x�F �jN� <``cxc�dc`cf�<�`�x��d�`�]T���A�8�|����    B��< `!x!�d!`!�8a�|��H58`��xH�< `!x!�d!`!�8!��a|h�N� <@`BxB�dB`BØ8B@8B@N� |fx8`&8�&<�`�DTK���|`>p�"�|�x$|�&*N� ```8``cޭxc��`c��N� N� 8`N� ```|���������<�@||x�&����<`�|�#x�����!�!8�H�`�"��b� 8;���       He`�b�(<����xK���`|dy@�&T�!�뢀8<��8����x��K���`/�A���b�@��xH`�b�H<����xK��]`|dyA��b�0H�`�a�;�p��xH�`�b�P肀X袀`H�`�&p�&xL&,|��A(�&p��x<��8�8��a�8�| ��_N�!�A(L&,|�8!��&����������|�����N� �����8`&H
        !            40: E`9 &�a�}kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L&,9)�B��K���``�b�0H
        !            41: �`K���&�`|�9 /��&�!���     /�@�|�"�p�b�h�H
        !            42: �`|���b�x|�#xx�"H
        !            43: �`|���b��|�#xx�"H
        !            44: y`|�B��b��|�#xx�"H
        !            45: a`|�B��b��|�#xx�"H
        !            46: I`HK��`K���&�`|��"��b�p�&�!��x`��x$�k})*/�A�8�     �A(| ��i�IN�!�A(8!p�&|�N� ``8!p�&|�K���&�|��&�����!��|?x|`x����x |xK��E`8?��&|�����N� &�&&|��&�����!�q|?x|ix���|�+x�?������p��/�&A���/�A�8Hx8�xHT�p| x�     x /�
        !            47: @�8`
K��9�p|      x�     x �?p9)&�?p|xK���x0&�x�?x���@A����xx |x8?��&|�����N� &�&&|��&�����!�q|?x|`x��K���`|`xx     �����| x��pH<�px |xK��A`K��`|`x|�/�@����0������/�@���8?��&|�����N� &�&&|����p���x|�#x�&�&��|`x�!���A���!�&|x}CxK��y`8!&�&���p���x�&��|��!���A��N� &�8���8���|�*��8��|�*��<�`�x��d�ib`�m,|�(P|�*�<�CP`�U0x��d�lo`�g|�(P|�*��8���|�*��8�|�*+�A�8�&|ex|�#x|�+xN� }�|dx8`8�/�A�8�|�#xH��&�0A�`�&/�@�`�&|�#xK��-/�A�`�|�;x}�N� }(�K���}(�/�|�#x@�|8`N� }(�8� �|�28�Q8�����8�@8�����8�&<�ib`�m,����<�CP`�U1x��d�lo`�g��|�3xH&]�f&}(�N� }�|gxHm8�Q8� ����8�@8�����8�&<�ib`�m,����<�CP`�U0x��d�lo`�g��H��g&K��1|�;x8`&}�N� <�`�x��d�&`�x���|��8�<�`�x��d�`�|�)*8�B��N� <�`�x��d�`� ��x�&�8����0A�8�8�&��8���|�*�f@N� 8� �|�"<�`�x��d�`���x�&�8����0A�8�8�&��8���|�*�f@N� |fx�f<�`�x��d�`�|�0�8�&|�x� �@+$@�8�&x� |�+xA���|�3xN� |�= E�a������|�#x�&����a)LF|x��������;����!�a��HA�,8!���x�&�a��������|���������N� �;���/�@��̠;���/�@����;���0��T>+�&A�����/�&A�&(/�@����� ;���H,```�8;�&�����6A����/�&@������$�~|�"Hy`� �(8��~|�(P|`x� H&�`�~(/�A����>}kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L&,9)�B��8;�&�����6@��X```8!����x��&�a��������|���������N� ��;���H �,;�&�����*A����/�&@��܀����~|�"H&i`���8��~|�(P|`x� H�`�~/�A����>}kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L&,9)�B��,;�&�����*@��X```8!����x��&�a��������|���������N� &�,%M� 8���x� x� |ix8�&|����9)&B��N� ,%M� 8���|ixx� 8�&|��`�8�&�     9)&B��N� �@@�\|*�@A�P/�M� 9%��8���y) |�*9)&|�*})�9 `|H�|I�9)��B��N� ```/�M� 8���|ixx� 8�&|��`�8�&� 9)&B��N� |��&�!��|`x�b��������|x�������&��!��A�8��H)`8!p�&|�N� &�|���������|�+x|~x�&����|�#x8�&@�!�1;�p��xH�`��x|}x�~{� K��`8!&���x�&�����������|�N� &�|��"������|�#x�&����8��|�+x��������T>|x�!�a+�
�I�)8�!p�AxA�X� @@�|�"���     /�A���c8-�8�c9k&�c� ��8&�=p�+�?9)&�?8!�|x�&����������|�����N� ``�+������x��PK��!���?8!�8&|x�}p�i�&�?������|�9)&�����?����N� ``�cK��T&�```|��a������}Cx|�;x�&����|�3x��������|~x|�+x�!�a|�#x8�
        !            48: 8�H�`/�9 8&|c�A� `��9)&/�})�@���y  |�|��@�@|P|�/�@�0x �>|  �```���>9)&�>B��8!�8`�&�a��������|���������N� &�``|����p���x9�x9�0�&�&��:&��������:� �����&��|�#x|xx�!���A��; �a�������!���A���a�������������������!��;a&P;Ap:���{1�%/�A�8|P��@�,/�%A���#8�&�a&�8c&�a&��%/�@���8��a&�8!&P|xP�&���p|c����x�&��|��!���A���a�����������������&���!���A���a����������������N� `K�x|�+x8%�;�&|�P|
        !            49: ��/�dA��/�iA��/�uA��/�xA��/�XA��/�pA��/�cA��/�sA��/�%A�/�OA��/�o9k&@���9 o9j&}AR}k�}aZ�*p�+p�/�%@� 9#&��!&�8�&�a&�K���`�&q��:&/�0A�/�.:` ;�qA��</�A�P|�:��&�;�8        ��T>+�)@�D8 ��T>+�       A�}z�;�&{� �+�<&/�@���~&�xK��p```�b��x�|�}`Z}i�N� X������������������������������������������������������������������������&������������������������X��������X&h������������������������8�8�
        !            50: ~��x�?H�`x ��xH-`�@@�D|c�Pxc!A�8/��!&�|i�A��A��```���!&�9)&�!&�B��;�H(`�!&�|��;�&{� �  �!&�8 &�&&���xH�`��@A���K��l``}:�~��x��x8�8� 9�)c�xK����!&�c�x��x8����!&�8     &�&&���&�!&�8 &�&&�K��]�<&K��}:�c�x~��x8�&8�
        !            51: 8� �)9K����!&����a&��<&8c&�a&�K���}:��b��z�$8�~g�x}k9�)~��xc�x�KҐ8~E�xK��-c�x~D�x8�K��͍<&K��x}:��b��z�$8�~g�x}k9�)~��xc�x�KҐ8~E�xK���c�x~D�x8�K��}�<&K��(�<&:�/�h@���<&:�&K��`V�88      ��}:�~6��x�)�9A�4�a&��"��z�$})8-��I�!&��a�8 &}r�8�&&�~E�x8�
        !            52: ~g�x9~��xc�xK��9c�x~D�x8�
        !            53: K��ٍ<&K���```�<&:�/�l@��hK��````:`0;�rK���`9 dK���``9 iK��|``9 uK��l9 xK��d9 XK��\9 pK��T9 cK��L9 sK��D9 OK��<8&|  �K�� &�|ix9`8`� /�M� ``�     &9k&}k�/�@���yc N� ,$|ixA�&@+�$�$@�H&`9)&�$�i/� /       ,�
        !            54: A���/�
A���A���A���/�@��/�0A��8�
        !            55: /�A��8``8��9K��T>UJ>+�    +
        !            56: 9)&9K��|4@�$8��T>+�}@4@�M� 9k��}`4�(L� �$|c)҉i/�|`@���N� `/�@��|/�08�@��p�        &9I&/�x@��h9*&�$�j&K��P```8`N� �     &9I&/�x@��(9*&�$�j&K���8���K���&�P&&�PP Press "s" to enter Open Firmware.
        !            57: 
        !            58: bootinfo  !!! roomfs lookup(bootinfo) = %d
        !            59: xvectCannot find romfs file %s
        !            60: ofw_main%s%s[?25h
        !            61:  exception %llx 
        !            62: SRR0 = %08llx%08llx  SRR1 = %08llx%08llx 
        !            63: SPRG2 = %08llx%08llx  SPRG3 = %08llx%08llx 
        !            64: 0123456789ABCDEF������������������������������������AT&C�I�&C�J&C�J0&C�J@&C�J`&C�L@&C�L�&C�Ml&C�M�&C�N�&C�OP&C�R�&C�U�&C�V&C�V`&C�W&C�Wp&C�W�&C�Y@&C�Z@&C�`�&C�a &C�&C�������b�ccc@cHchcxc�c�c�Ðc�c�c�c� ě��S��b�d��\���������?0?(xvect�`/�|i�8&N� |C�|  �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8�N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8�N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8�N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8    N� |C�|  �|C�|�|C��/�|     �8
        !            65: N� |C�| �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8
N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8N� |C�|     �|C�|�|C��/�|     �8 N� |C�|     �|C�|�|C��/�|     �8!N� |C�|     �|C�|�|C��/�|     �8"N� |C�|     �|C�|�|C��/�|     �8#N� |C�|     �|C�|�|C��/�|     �8$N� |C�|     �|C�|�|C��/�|     �8%N� |C�|     �|C�|�|C��/�|     �8&N� |C�|     �|C�|�|C��/�|     �8'N� |C�|     �|C�|�|C��/�|     �8(N� |C�|     �|C�|�|C��/�|     �8)N� |C�|     �|C�|�|C��/�|     �8*N� |C�|     �|C�|�|C��/�|     �8+N� |C�|     �|C�|�|C��/�|     �8,N� |C�|     �|C�|�|C��/�|     �8-N� |C�|     �|C�|�|C��/�|     �8.N� |C�|     �|C�|�|C��/�|     �8/N� 6��������d�dh0ofw_mainELF&&&@a�@8&@
        !            66:       &a��49&?��c��?��c���?�c����|�|�<``c�c�`/�H&�|1C�B�|(��!���A�a�� ��(��0��8�&@�!H�AP�aX��`��h��p��x�&��!��A��a��������������&��!��A��a�������������8`|x|B��&|B��&,      @�|��<�|�|&�&&|&��&&|B��&&|B��&&|��&& |��&&(|��&&0|��&&8B�
�.�|H��"|!8�&���!�&<@�b|��Bb L$|�B���}�|��}B��(|&x��H|x��h|x� �� |x�(��(|x�0��0|x�8��8|x�h��h|
x�p��p|x�x��x|x����|x���(�|x���H�|x���h�|x�����|x�����|x�����|x�����|x����|x���(�|x���H�|x���h�|x�����|x�����|x�����|x�����|x�&} &|� �(&�&(} �|&d|�L&,�(&(N� |��K��u|��8`N� |��|i�K��]N�!K��U|��8`��N� ``|������&|�3x��|      �N�!�������&|�N� &&`|��"�����|wx�&���p���x�&���!���A���a���������������&���!���A���a�������������������!��� /�@�<�B���(}+Kx9
        !            67: 8�
        !            68: 0�  ���B� ����*8&�       �iz���A��B��j8�
        !            69: ��z��A��B��j8�
        !            70: ��z���@�\z���@�"�ꂀ;�&��:�&�:�p:&t:�u;&v;`: &;�����;A�;�&w:@;!x>`&`}��N� z���8`A��"��i8���k�    8!P�&���p���x�&��|��!���A���a�����������������&���!���A���a����������������N� �b���       ��0�+��9I�K�   }��N� �b���       ��8�+��9I�K�   }��N� �b���       ��@�+��9I�K�   }��N� �b���       ��H�+��9I�K�   }��N� �b���       ��P�+��9I�K�   }��N� �b���       ��X�+��9I�K�   }��N� �b��B�`��   �+�
        !            71: ��9I�K�        }��N� �b��B�`��   �+�
        !            72: ��9I�K�        }��N� �b��B�h��   �+�
        !            73: ��9I�K�        }��N� �b��B�p��   �+�
        !            74: ��9I�K�        }��N� �b��B�x��   �+�
        !            75: ��9I�K�        }��N� �b� �+8     ���;�����}��N� �B� �b�8�*9 �
        !            76: ���+��9I�K�        ����}��N� ����}��N� ����}��N� �b���+9I�K� ��   ��}��N� �b���+9I�K�       ��   ��}��N� �"���)�i|�       ��   ��}��N� �b�;��+8       �����   ��}��N� �b�;��+8       �����   ��}��N� �9>});�����}��N� ���9>�o�K/�@�})9k��;��o����}��N� �b� �+8       ���~��x����}��N� �B��9>;��j9�
        !            77: �����}��N� �B��9>;��j9�
        !            78: �����}��N� �b���  �+��9I�   �K� }��N� �b���       �+��9I�   ���K� }��N� �"���       �)���       |�x$|     *�     }��N� �"���       �       ��0���     }��N� �"���       �)���i���   �     ���i}��N� �"��B� ��       �       �j��8��8������ }��N� �"� �B���   �       �j��8��8������ }��N� �"� �b���   �       �+��9I��K� }��N� �b���       �B���+��8   }JP�}Jt�I}��N� �"���       �b���I���
        !            79: 0��x$|�        }��N� �"� �b������       �I�+��|PP9I|t0&�K�       }��N� �"���       �B� ����i��8������0��x$|�
        !            80: }��N� �"��b� ��  �)�k���   x$|�|*� }��N� �"���       �i���K���|
        !            81: ����        0��� }��N� �"���       �i���K���|PP����       0��� }��N� �"���       �i���K���|
        !            82: &�����        0��� }��N� �"���       �i���K���}@6����       0��� }��N� �"���       �i���K���}@6����       0��� }��N� �"���       �i���K���}@4����       0��� }��N� �"���       �i���K���}@8����       0��� }��N� �"���       �i���K���}@x����       0��� }��N� �"���       �i���K���}@x����       0��� }��N� �"���       �)���i��       }��N� �b���       �+��9       ���I� ����
        !            83: }��N� �"���      �)���i��       }��N� �b���       �+��9       ���I� ����
        !            84: }��N� �"���      �)���i��       }��N� �b���       �+��9       ���I� ����
        !            85: }��N� �"���      �)���i��       }��N� �b���       �+��9       ���I� ����
        !            86: }��N� �"���      �)���i��       }��N� �b���       �+��9       ���I� ����
        !            87: }��N� �"���      �)���i���&�&�&p�       }��N� �B���       �j��}i[x�k�       ���&p9)��x��*��&�&}��N� �"���   �i���+9I&�       �� &��
        !            88: &��
        !            89: �&�&t�}��N� �B���  �*��}+Kx�)����&t9k��TF>�j�   9i&��     &��&�&�}��N� �"���       �i���K����|&T��|�|�����       0��� }��N� �"���       �i���K���|P|&����   0��� }��N� �"���       �)���       |�v� }��N� �"���       �i���K���}@x0��|&����       0��� }��N� �"���       �)���       0��|&�     }��N� ���B� ��   �h����9'����8�8�����k�i�}��N� �b�9>�K8���8����
        !            90: ���
        !            91: ���@�~A���B� �j8�������;���}��N� �"� �;��i�K9J&�K�i��K���PA�����;���}��N� ���"� ��;��H�i8�����J��/��}HR�KA�P�I}KSx�J���}@PP9��|@P�P@@��9k���i��;���}��N� �b� �9>});��0�������}��N� �"��;��i9K���k�I/�A��"� ��        0��� ��;���}��N� �b� �+8 ���)�;�����}��N� ����   �h��9K��8����+�H8���k�����J���}@[x|Kxx`/�A��/�A�d/�@���P@A�0|�J|�J�8@9A�H|@*9)��|A*/�9��@���K���B��*9i��8����   �j8���yE�|Cxx��|�x�)�����k����}*[xyJ`/�A��/�A��/�A�l/�}+J}+HP})�@��9k&B����   ��}��N� ���O9j��9���
        !            92: �o9(��/��J����k���/@�T����@@A�A��4���}�@�,H�```��&|�B|�P��8@A��A��4��@���8    ��i��   ��}��N� ���h9K��8����+�H8����k����}`Kx�J����|Sxx`/�A��/�A��/�@���P@A�H|�J|�J�8@9A�H0|@*9)��|A*/�9��@����� ��}��N� �b� �+8   ���)�;�����}��N� �"��i8����� ��}��N� ����   �O�9j��9+���
        !            93: �o8����J���/�A��������@�I��A��i��|x}��N� ����      �o��9+����//�A�����       ��9)���/}��N� ����       �/���iH=Q`�/8       ��i}��N� ��   �b��8�8�`����H> `}�{x}��N� �b��� ����+��9I�K�   }��N� ����       �/�8       �����/��)��A�����8```�ix��&��!��a�H>
`���&��!�4����a�|x9)&���|rx@����B���/xh|
        !            94: �    }n[x}��N� �"���   �i��8���k�       H �`}��N� �"���       ����8�   H y`�o}��N� �"���   ����8�   H }`�o}��N� �"���   8`��i��9���8����������       ����H�`�o��}��N� �"���       8`&�i��8�����   H�`}��N� �"���       ����8����       �o��H )`�o��}��N� �"���       �i��8���k�       |c4H%`}��N� �"���   �I��9j��}�{x9����i8�������   �k��� H�`}��N� �"���       �i��9K��8
        !            95: ����I�k���        HE`}��N� �"���       �I��9j��}�{x9����i8�������   �k��� H`}��N� �"���       �i��9K��8
        !            96: �����I�k���        H%`}��N� �"���       ����8�����       �o��H�`1��||����}��N� ��       ��H�`}��N� �"���     �����oH�`�o}��N� �"��� �����oH�`�o}��N� �"��� �����oH`�o}��N� �"��� �����oH=`�o}��N� ���� �/�������iHQ`�0���}��N� ����     �/�������iHm`�0���}��N� ����     �/�������iH�`�0���}��N� ����     �/������iH�`�0���}��N� ����     C�x8��/����H$m`�z�9+&+�&@��/�   �/8 ��i�/8 ��i}��N� ����       ��x�/�9I��9j�����Oy� ����o�&�H8�` ��8�x� |}rH8U`8���C�xx� ��xH#�`�z�Z�&�9+&+�&@�D�/|x8   ��I�/8 ��i�/8 ��i}��N� ����       8���x|��8����9H��9j�����O8���8������o�J��������H }}HP|P��   8�&9)&|��B@�8A����IK�������       �o��9+��9I���k�/8
        !            97: ������O����H$�`�//�8    �@����}��N� ��       ��H*�`}��N� �� ��HE`}��N� �� ��H�`}��N� �� ����x���/���9i��8�����oy� ����H6�` ��8�x� |}rH6q`�/��x9i��8����o�i���H,�`|`yA�D�/9i�o�   �/�!�8     �H5)`�!�����i�/8 ���}��N� ����       #�x�/��9I��9j���   �Ox ����o�&�H5�`�&�8� ��|yx� H5�`�/��x9I��9j���     �Ox ����o�&�H5�`�&�8� ��|}x� H5Q`�/��x&�x9i��8����o�i���H-5`,#A�
�/8     ���}��N� ����       #�x�/�9I��9j�����Oy� ����o�&�H5 ` ��8�x� |yrH4�`�/%�x9I��9j����O�i���oH1�`�&�,#A�4�/|x8       ���}��N� ����       �/��9i��8����o�i���H�`,#A���/8   ���}��N� ����       ��x�/��9I��9j���   �Ox ����o�&�H4`�&�8� ��|}x� H3�`�/#�x9I��9j���     �Ox ����o�&�H3�`�&�8� ��|yx� H3m`�/%�x��x9i��8����o�i���H-�`,#A�
        !            98: ��/8 ���}��N� ����       �/��9i��8����o�i���H#A`,#A�
        !            99: \�/8 ���}��N� �b���       �+��8       ��i}��N� �b���       �+��8       �|��     }��N� �b���       �+��8       �|B��     }��N� �b���       �+��8       �|���     }��N� �b���       �+��8       �|B��     }��N� �b���       �+��8       �|
B��     }��N� �"���       �)���       |���b�9)���+}��N� �b���       �+��8       �|���     }��N� �"���       �)���       |K��b�9)���+}��N� �b���       �+��8       �|J��     }��N� �"���       �i���|C�9k���i}��N� �b��� �+��8       �|B��     }��N� �"���       �i���|C�9k���i}��N� �b��� �+��8       �|B��     }��N� �"���       �i���|C�9k���i}��N� �b��� �+��8       �|B��     }��N� �"���       �i���|C�9k���i}��N� �b��� �+��8       �|B��     }��N� �"���       �i���|K�9k���i}��N� �b��� �+��8       �|J��     }��N� �"���       �i���|K�9k���i}��N� �b��� �+��8       �|J��     }��N� �"���       �)���       |�|æL&,�b�9)���+}��N� �b���       �+��8       �|�|¦� }��N� �"���       �)���       |l|�|�|�L&,�b�9)���+}��N� �"���       �����oK��`�o}��N� H�"���     8��i��9���8��������o���       K��&�o��}��N� �"���       �I��9j��9���8�����������o���   K����o��}��N� �B���       �*��9       ��8���i�
        !           100: �)���
        !           101: }kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L&,9)�B��}��N� �"���      �i���|�9k���i}��N� �b��� �+��8       �|��     }��N� �B� ꂀ9);���j8�
        !           102: �+K���b���      �+��9       ���I� ����
        !           103: }��N� �"���      �)���i��       }��N� �b���       �+��9       ���I� ����
        !           104: }��N� �"���      �)���i��       }��N� �b���       �+��9       ���I� ����
        !           105: }��N� �"���      �i���|�|��|��|��|��|��|��|��9k���i}��N� �b���     �+��8       �|���     }��N� �"���       �)���       |��|��L&,�b�9)���+}��N� �b���       �+��8       �|���     }��N� �"���       �)���       |�|��L&,�b�9)���+}��N� �b���       �+��8       �|���     }��N� �"���       �)���       |���b�9)���+}��N� �b���       �+��8       �|���     }��N� �"���       �)���       |&d�b�9)���+}��N� �b���       �+��8       �|��     }��N� �"���       �)���       |��b�9)���+}��N� �b���       �+��8       ��i}��N� �"���       �)���i��       }��N� �b���       �+��9       ���I� ����
        !           106: }��N� �"���      �)���i��       }��N� �b���       �+��8       ��i}��N� �b���       �+��8       ��i}��N� �b���       �+��8       ��i}��N� |��|��C�x��xHm`��z/�@�&��/8 ���}��N� 9I��x�/���y*��|Cx9J&}h[x@�9@&H�95J��9)��@���9I��}h[x/���y*��9J&@�9@&H�95J��9)��@���9I��y)�B/���9)&@�H&��9k5)��@���K�� })ZK���/8     ��i}��N� �i}��N� �:K��$�/8     ��i}��N� �/|x8     ��i}��N� �/8 ��i}��N� �/8 ��i}��N� �P@A�8}
        !           107: J�@@@�,}kJ9)&})�9 H|H�|I�9)��B��K��9)&|
        !           108: �})�B@�t}*�
        !           109: 9J&}        Y�K����P@A�x}
        !           110: J�@@@�l}kJ9)&})�9 H|H�|I�9)��B��K��p�/9I�O�i�/9i�o�        �/8 ��i}��N� 9 &K���9)&})�9 B@� |     �9)��}
        !           111: �}&�K����/���9i�o�    }��N� �/|x8     ���}��N� �/��}��N� |     x���K��l����9 H`}i�9)��|jX��&��!��A��a�H'=`�a���|hx|dX��&�H'!`�&��&��!��A��@@�@9���/�@���|x}��N� 9H|P*9)��|Y*9/�@���K����/|x�i}��N� �P@A�|�J|�J�8@9A�49H|P.9)��|Y.9/�@���K��x|@.9)��|A./�9��@���K��\�P@A�|�J|�J�8@9A�49H|R.9)��|[.9/�@���K��|B.9)��|C./�9��@���K��8&K��L8 �����   ��}��N� 8   ��)��   ��}��N� 9H|
        !           112: @*9)��|A*9/�@���K����P@A�|�J|�J�8@9A�49H|
        !           113: @.9)��|A.9/�@���K�Ԩ|@.9)��|A./�9��@���K�Ԍ�P@A�|�J|�J�8@9A�49H|
        !           114: B.9)��|C.9/�@���K��L|B.9)��|C./�9��@���K��0�i|
        !           115: x�K��9k���iK��L&�`|�/��&�!��A�xc H!`8!p�&|�N� &�`|�8c����������|�+x+�&�&�����!�q@�,8!�8`�&�����������|�N� ``/�@���|�#x;�H,```;�&H�`;�&����@�H�/�
        !           116: @���8`
;�&HY`���;�&HE`��A���```8!���x�&�����������|�N� &�`|��&�!��H&�`8!p�&|�N� &�}��|�#x8�|#8A�H�}B�,A�4Hx��}B�8�|'0A�8��|' 8`&A�P|�#x|qB���8�|' A�|����������|���(8� �� 8`~�x}��N� }��|�+x|�+xH9,&@�}��N� |��:��8����E&�P&B��~%�x}��N� }(�|�#x|jx|�#x8� |�+xHE,&@� �,|�*@���8`&}(�N� 8`�����|�B}(�N� 9J��9k���        ��     |-p9�&A�N� q��@���9�N� �!��|��&0��8��@��H|�+xK��Y�&0|����������H��@��88!PN� N� xf��8`X8�8�&D"N� |jx8`T8�D"|�#yA�x�F �jN� }�|ix�i,A�K���9)&K���}�N� }�|ixy#' pc,
        !           117: A�8c8c0K��}y#F pc,
        !           118: A�8c8c0K��ay#e pc,
        !           119: A�8c8c0K��Ey#� pc,
        !           120: A�8c8c0K��)y#� pc,
        !           121: A�8c8c0K��
y#� pc,
        !           122: A�8c8c0K���y#� pc,
        !           123: A�8c8c0K���y#"pc,
        !           124: A�8c8c0K���y#'pc,
        !           125: A�8c8c0K���y#Fpc,
        !           126: A�8c8c0K���y#epc,
        !           127: A�8c8c0K��ey#�pc,
        !           128: A�8c8c0K��Iy#�pc,
        !           129: A�8c8c0K��-y#�pc,
        !           130: A�8c8c0K��y#�pc,
        !           131: A�8c8c0K���y#pc,
        !           132: A�8c8c0K���}�N� }�|ixK��}�|ixK��t}�|ixK���|��H|��|��8��xxg�j|�8�|8N� }h�|ix8`CK���}#KxK��18`K���8`K���8`K���8`K���8`K���}h�N� }h�|ix|�#x|�+x8`
        !           133: K���8`
K���}�cxK���}#KxK���8` K���}CSxK���8`
        !           134: K��y8`
K��q}h�N� 8�EK���}h�K��1}h�8�W@���N� }h�8� K��}h�8�D@��tN� }h�|�#[email protected]���8`A�8`&}h�N� |��H|��8��Tpc|�2��|��N� N� `D"N� xf��8`X8�8�&D"N� }H�H-}H�,M� = �a)2��|dH�8�&��N� 8`��= �a)2����|0@L� 8`T8�D"= �a)2��8`�i(M� 8`������N� ���|dx8`&D"N� 9`}*Kx}  Cx|�;x|�3x|�+x|�#x|dx8`& D"N� ``+���8A��"��|     �|xN� ``+���M� �"��|��N� +���8A��"��| .|xN� ``+���M� �"��|�.N� +���8A��"��| .|xN� ``+���M� �"��|�.N� +���8A��"��| *|xN� ``+���M� �"��|�*N� <&�@�8`N� ```�b��<c&�/�@���8���8cN� �"��8=)&�     N� 8����8``���<�&```8&8�x �(A�|��x` 8�x� |�;x}h�8|     �```+���9I&8A�|H�}`ZyI yk B��U`�>}`ZUk>�XL� +���M� |:./�M� T 6|`|c�� @��dN� ||��L� 9#&9`�}#Py) })�A�<= ��HA�0``x` 8c&+���A��"��}i&�|c�B��N� 8&| �K���`<&�B��9 |     �9````y  9)&})�}j&�B��N� ```8c��8�/�|��|i�A�8�|�J|��� @�Xxc 9@8&|c Pxc � |i�A�@<��A�4``y  9)&+���A��b��}K&�})�B��8`N� 8&| �K���|`y8`M� | �|�J|��� @�Tx 9@8&}k Pyk � }i�A�<<��A�0`y  9)&+���A��b��}K&�})�B��8`&N� 8&| �K���N� |��!���A��|zx�&�a��8|�+x��������T6|�#x�����&��|������!�Q|�3xK���|yxK���<&|P��A�&�{8 +���@�&4;�{� +���@�&;�;�{� H$9=&8&}{�A��B��}j�y= x c�xHm`+����@A���9&+���y 9 @��8|     �```+���9~&8A��B��|
        !           135: �} Jy~ y) B��+���@��8!�;9��9��:C�x�&�&���!���A��|��a����������������N� ```�"��})��K��d`�"���&p�&���.K���```�"�����;�{� +���A���K���`�b��U �>} J}+A�K��P```8!�8��C�x�A���&�&���!��|��a����������������N� &�`|��&�!��K���8�袀�8�`���|�0P8ap|��K����ap8!�0��|`�&|�N� &�``}�&|���������.$|�+x�&���!��; |xx�A���a��|�#xc9����������?`&-%��������;�-����&���!�A�‘?�:�;�8&8�x ��A�|��{� 98y |        �}8�} Cx``+���9I&8A�|H�}`ZyI yk B��U`�>}`ZUk>�X@��+���;�A��B.A��/�A�t@�|A��|�P9>| �y) ��x+���9I&8A�|H��yI 9k&B����x~�x8�H�`/�A�4W� 6������@��89 ��H(|8���@���K��|9=��8U) 6|�})�8!���8�x�&���&������|������!��}�& �A���a��}�& ������}�� ��������N� �
        !           136: ```|�� ��������|}x�����&|�#x|�+x�!�a@�(8!�8`�&�����������|�N� `8�8ap8�K����&x�p/���A���}>�P�A���{� {� 9d��}>�}k�})��HA��|� P9x� |��`y` 9k&+���A��B��}
        !           137: &�}k�B��{� �8P|J|��@�L9i&9@�}iPyk }i�A�&�=`��XA�&�y  9)&+���A��b��}K&�})�B��;���{� +���A��"����.K��I8!�8`&�&�����������|�N� `|iXP<&|c��A���袀�=�&�/�@���8    &9L�X|     XPx }HSx|     �}'KxA��<��A��``x� 8�&+���|��8A�|0��9&B��|� P9x� |��``y` 9k&+���A�}&�}k�B��{� }g�yk |cZ}k�|c��@�<|kPxc |i�``y` 9k&�
        !           138: +���}k�A�}&�9J&B��8�K��H8&|    �K��88&|     �K��l&�```|��&�!��8&+�&8@�&px� `��}$y) }+��A�h}jX�}$HP=J&9)��8
        !           139: &y) x |    �``y` 9k&+��9I&+���}k�9A����}�A��‘}I�yI B��89 `��a)��|�P|���H@�H89d&`���H|P9`x |     �A��x� 8�&+���A��"��}i&�|��B��8ap8�8�K��%�ap�!|9k��8     }i�|J|��@�Pyk 9K&}kP�yk }i�9@A�X=`��XA�Ly  9)&+���A��b��}K&�})�B��K��Q8&8!�|x�&|�N� 8&|     �K��<8&|     �K���&�|��a������|�#x|�+x�&����8�8���������|x|�3x�!�Q;�p��xK��1�!x�ap8 &+�&@�<9+��9@})�}iXPyk }i�y  9)&+���A��b��}K&�})�B����xd�x��x��xK��A�&x�p�A�;�;�K��U8!�������x�����&�a�����|��������N� &�`|��������������&�!�q��&���&�|dx��&���&��&&��!&��A&�;�p8�&���xH
�`/�|}x@�0��x`�~8�;�&8�&K��`|�P��A���8!&���x�&�����������|�N� &�|��A���a��9 9`�&����<&��������|     ������!�A�‘��x`y  9)&})�}&�B��;�p;�����<�&?�ib�&tc�m,`�����x8�Q��p��xK����a������x��x8�Q8�O�p�&t{{ K���!�+���A�8@|�.8x +���A�9`}.8x +���A�9`&}&.y) +���A�8@|K.8 x +���A�9`}.8 x +���A�9 &}?&.�b��K��袀���x8�p8��K���K��
8!��&�A���a�����|������������N� &�`|��a������|�#x��������x~ |x�&������x{��!�a{���K���`��||x@�d;�H``}>�||x@�H;�&{� {� K��`/�|�9>&�@���/�A�}>�||xA���``;���8!���x�&�a��������|���������N� &�``|�,#��������|�+x�&�A���a�����������!�aA��낀�|~�;�;@��x```{� ;�&K���`��/��|`y��xA�@A�<|��9?&{� }?�;�&��K��`/��|`y��x@���``\��H`d�x|ex��xHY`/?/�A�HA�;�K��l``8!�8`�&�A���a�����|������������N� `�/�=A��A��{� /�;{&9 | �@�t<��@�Hd``;{&B@�9)&})�/�=@���8i&||8!��&�A���a�����|������������N� 8`&||K���9`&}i�K���&�|��A���a��|�#x�&����|�3x��������|~x�����!�a|�+x��K��       |}x��xH�`��P|zx��xH�`C�8`��;Z��;�@�$H�`|��|�;�&K���`{� ��xHe`{� 8&��@}#KxA���8�=|�;�K��`H|���;�&��{� K��`��xH`{� ;�&��@|xA���8`8!��&�A���a�����|������������N� &�|��a������8���������|�+x|~������&8�&;��!�a�b��;�&��xHq```{� ;�&K��`��/��|`y��xA�@};�A�8�       &{� ;�&��;�&��K��}`/��|`y��x@���`H`��x|ex��xHM`/?/�A� A�;�K��p```;���8!���x�&�a��������|���������N� &�``}�&|���������|y|�3x��������|�+x|�#x�&�!���A���a�ؑ��!�Q@�@8!�8`���&���!���A��|��a�����}�� �����������N� `K��A|{yA�&���xH&`��x8�&c�xx� H9`/�@�<8`8!��&���!���A��|��a�����}�� �����������N� ��x��xK�����x��x|{x��xK�����P|x����xK��&`|zyA��.@�@Y�x;�|}�;�&xc ��K��`���y;9&A���H`|�{� K��i`8��/�=@���;�&����xH`��|�;�&K��e`��xH�`|�P{� �8&}#KxA���8�|�K��1`@�H_�x��x```��{� ;�&;�&K��&`|�P����A�������C�xK��=`��@��x��x``{� ;�&8���K��`��A���8`K��H``8!���x��x��x��x�&���!���A��|��a�����}�� �����������K����|���������|y�&����8��|�#x�!���A���a�������!�A@�<8!�|x�&�!���A���a��|���������������N� ``��pK����p��x|~x��xK��y;���|yx��H`|�{� K��i`8��/�@���y�P{�c�xK��`/�|zx@��||x;�```|�;�&xc ��K��`���|;�&A���;�&_�x{� ```����x;�&;�&K��&`|�P{� ��A���;{&C�x��K��=`��x��K��`8!�8|x�&�!���A���a��|���������������N� &�`|ix9`8`� /�M� ``�     &9k&}k�/�@���yc N� ``,%|ix8`M� �I/�A�p�}KSx/�A�T8���x�!A�H�@@�@|��H$``�/�@A� B@@��i&8�&/�@��܈}`XP}c�N� �9`K���,%M� 8���x� x� |ix8�&|����9)&B��N� `,%M� 8���|ixx� 8�&|��`�8�&� 9)&B��N� ```8��+�M� 8c |c�N� ```8��+�M� 8c��|c�N� ```|�|�+x�&�!��|�#x8���|xx�`H�`8!p�&|�N� &�```|��"������|�#x�&����8��|�+x��������T>|x�!�a+�
�I�)8�!p�AxA�X� @@�|�"�؈     /�A���c8-�8�c9k&�c� ��8&�=p�+�?9)&�?8!�|x�&����������|�����N� ``�+������x��PK��!���?8!�8&|x�}p�i�&�?������|�9)&�����?����N� ``�cK��T&�```|��a������}Cx|�;x�&����|�3x��������|~x|�+x�!�a|�#x8�
        !           140: 8�HQ`/�9 8&|c�A� `��9)&/�})�@���y  |�|��@�@|P|�/�@�0x �>|  �```���>9)&�>B��8!�8`�&�a��������|���������N� &�``|����p���x9�x9�0�&�&��:&��������:� �����&��|�#x|xx�!���A��; �a�������!���A���a�������������������!��;a&P;Ap:���{1�%/�A�8|P��@�,/�%A���#8�&�a&�8c&�a&��%/�@���8��a&�8!&P|xP�&���p|c����x�&��|��!���A���a�����������������&���!���A���a����������������N� `K�x|�+x8%�;�&|�P|
        !           141: ��/�dA��/�iA��/�uA��/�xA��/�XA��/�pA��/�cA��/�sA��/�%A�/�OA��/�o9k&@���9 o9j&}AR}k�}aZ�*p�+p�/�%@� 9#&��!&�8�&�a&�K���`�&q��:&/�0A�/�.:` ;�qA��</�A�P|�:��&�;�8        ��T>+�)@�D8 ��T>+�       A�}z�;�&{� �+�<&/�@���~&�xK��p```�b��x�|�}`Z}i�N� X������������������������������������������������������������������������&������������������������X��������X&h������������������������8�8�
        !           142: ~��x�?H=`x ��xK��`�@@�D|c�Pxc!A�8/��!&�|i�A��A��```���!&�9)&�!&�B��;�H(`�!&�|��;�&{� �  �!&�8 &�&&���xK���`��@A���K��l``}:�~��x��x8�8� 9�)c�xK����!&�c�x��x8����!&�8     &�&&���&�!&�8 &�&&�K��]�<&K��}:�c�x~��x8�&8�
        !           143: 8� �)9K����!&����a&��<&8c&�a&�K���}:��b��z�$8�~g�x}k9�)~��xc�x�KҐ8~E�xK��-c�x~D�x8�K��͍<&K��x}:��b��z�$8�~g�x}k9�)~��xc�x�KҐ8~E�xK���c�x~D�x8�K��}�<&K��(�<&:�/�h@���<&:�&K��`V�88      ��}:�~6��x�)�9A�4�a&��"��z�$})8-��I�!&��a�8 &}r�8�&&�~E�x8�
        !           144: ~g�x9~��xc�xK��9c�x~D�x8�
        !           145: K��ٍ<&K���```�<&:�/�l@��hK��````:`0;�rK���`9 dK���``9 iK��|``9 uK��l9 xK��d9 XK��\9 pK��T9 cK��L9 sK��D9 OK��<8&|  �K�� &�,$|ixA�&@+�$�$@�H&`9)&�$�i/� /   ,�
        !           146: A���/�
A���A���A���/�@��/�0A��8�
        !           147: /�A��8``8��9K��T>UJ>+�    +
        !           148: 9)&9K��|4@�$8��T>+�}@4@�M� 9k��}`4�(L� �$|c)҉i/�|`@���N� `/�@��|/�08�@��p�        &9I&/�x@��h9*&�$�j&K��P```8`N� �     &9I&/�x@��(9*&�$�j&K���8���K����@�2p�2��3������:��:��;�;@�;`�;��;��;��<�<P�<p�=@�=��>�>��?@�?P�A��A��C��F��Hp�Ip�J �K��L��Np�O��P��S��Up�U��V`�V��V��W �WP�W��X��Y��`��ph���x�&�������������2ghCPU0logCPU1loggxg��20g��48\�free spaceCreating common NVRAM partition
        !           149: common0123456789ABCDEF������������������������������������q�FORTH-WORDLIST�q��LASTWORD�i�m8EVALUATE�nn�n�o jHo@o`oxo`n�o�o�mPo�ppqi�jj0jHj`&jxj�(j�j���j�8jHj`8jxj�kk0lpj�BP  $s�      SEMICOLON4n�&0    Ds�RDEPTH!�o�DUP
        !           150: �s�LIT
        !           151: �s�&=tj�0BRANCH
        !           152: ,j�SWAP�s�DROPltBRANCH
        !           153: t CLIENTINTERFACE        $t@PRINT-STATUS�u0jHu`j�(u�o�u�j�8jHn�jxj�0o�vvvXj�PjHj`��������jxj�8v�v�vvXj�j�t`v�i�wQUIT�jj0wpw�xx0j`>ru0xhj�Pu0o�mPo�jHk0j��������xj��������Hi�y       INTERPRET�jy�o`z jHj�PzXv�j�z�j�y8j���������si�{hSAVE-SOURCE�{�o�|o@v�|o |oxv�|y�v�||i��-1    D��������|DOTO�{�|@jH|v�|@o`i�o0      SOURCE-ID    lo�#IB �v�&!X|XSPAN �|xIB ljPDOTICK
        !           154: �v�CATCH�x||�v�|s�|�o`|�{�|�o`{�j�ji�m�RESTORE-SOURCE�{�{�y�o`{�oxo`{�n�o {�o@o`{�n�o�|i�o�THROW�|�j�`|�v�j0{�|�o`{�j�|}0j�{�i�}8NOOP�i�}�BOOT-EXCEPTION-HANDLER        $}�EMIT $r�((FIND))�jHj�x|~ ~P~p~�~�j�s{�s�{�v�j��������p~�(i�~�(FIND) $82DROP�j�j�i�x(REVEAL) $j8OVER�&-
��EXIT�} RDEPTH�i�
        !           155: BREAKPOINT
        !           156: h�0<PsPPICK@�EPAPR-MAGIC���JUMP-CLIENT'�uhPRINT-EXCEPTION�jHj`��������jxj�8o�� vvXv�j�s�jHj`&jxj�j�s��Pi��`SPACE���ri�jh0=���PRINT-STACK��j�(||�8{�{�i�pXOK-STRoku�ABORTED-STRAborted��COUNT�jH�8j��`i�v�TYPE��x��(���`r���������i�|�
        !           157: ABORT"-STR   ��&@4q�CR $�(&'�z �`u`o��@��j�i�zH&&[�zX�@i�y�TERMINAL��xn�o�|�v�o@o`jn�o i���DEPTHT��&.���vXu0i��8REFILL�o u`j�8���Hjy�o`��s�o n�jxj�(s�j`eqi�zhINTERPRET-WORD�~ �`j�(j�����|�s�~ �j� vXj`��������q|s{�i��p>IN ���
        !           158: PARSE-WORD�������i���STATE   �kCOMPILE-WORD�~ �`j�P�j� ����|�s��Hss�~ �j� vXj`��������qo�j`�H�Hsi��`&?LEAVE���o���H�@v���@o`�Hi�{�R>�j�>R��pCELLS+���i��(CELL+���i���ACCEPT $�#TIB �&�HCATCHER �i�EXECUTE\��?DUP�jHj�jHi�xDEPTH!���STRING,��s`������i��@DUMBER��Pv��pj`&�P��i���LINEFEED D
        !           159: ��2DUP�s`s`i�{�R@$�      LINK>NAME�|@i��8NAME>STRING��8vi��h STRING=CI|r�3DROP�j�j�j�i���FALSE    D��2OVER��0s��0s�i�~�LATEST �j&+
`�@DO?LEAVEh�`U<�x
        !           160: ROMFS-BASEd��UNKNOWN-STRUndefined word�HW-EXCEPTION-HANDLER   $vHLL-CR���r~ri�w�BL D ��NOSHOWSTACK�jn��i��0SHOW-STACK? l�.S�xjHs�j�j�s�j��@x��sx��s�x0���������i�u SPACES�j��u0���������i���CHAR+���i�oPC@���BOUNDS�s`�j�i��DO?DO� &I�{�~Pj�|i���DOLOOPt�xXOR��
UNDEFINED-STRundefined word��$FIND���jHj�0~pjH��j��`��i��(DOABORT"�j�j�(v�o`j`��������qj�i��POFF�(j�o`i�TIB�~@RPICK
,�h(U.)�����xi��@(.)���jH|��j��{��@�Pi�ohEXPECT�|hoxo`i�oSOURCE�o�o@v�i���TRUE D��������~�NIP�j�j�i���$NUMBER�jHu`j� j�j���s�|jH|�`j`-jxjHj�x{��8{���jHu`j�(j�j�j���s�||jj{�{�����u`j�8j�j�j��(s�j�j�j���i���SKIPWS�o�oxv�jHy�v��8j�ps`y�v���`���hj�(��y���j��������`j�j�i���PARSE�|o�y�v��oxv�y�v�sx~ {���j�0��jH���j�jHy���i���&&\�y�v���y�o`~��si��
        !           161: IMMEDIATE?�� �@�Xi���COMPILE,���i���&LEAVE���o��X�H�@v���@o`�Hi��?COMP�zXv�j�s�j`�������zqi��HLEAVES   ���
        !           162: HASH-TABLEl��CHARS+���i���NA+��8�i��XNA1+����i���KEY?   $qABORT�n�qi���ERASE�j`�i�n�SLITERAL�{�|@jHjH�`�j`���������@|i��PLACE�~ �p�8j����x��HjH�`���p�8��������������j�i���1+����i���CHARS��i���ALLOT���n��i��0DAAR ���PC!��H+!���v��j�o`i���CARRET D
|�TUCK�j�s`i���CONTEXT l����LINK>�~p��i��PREVEAL��v�~p~�s@�v���o`i�~3DUP��s��s��s�i���&3 D��DOLEAVE8�&<��8      FDT-START8�XICBI'lu�
EXCEPTION-STRException #� SHOWSTACK�n�n��i��p.H���v�j���x0��o`i���1-���sxi���CA1+��0�i��@EVEN���n��@i�uPDODO��pALIGNED����������@i��0OR���&ABORT"���o����Hi�r(FIND-ORDER)��(jH|���xj��~ ~Pv�|@v�r�|�j�(����{�j�s�{���j��������@{�~�ji�~XNAME>��8jH�`�����8i�h`EVAL�hxi��xCOMP���U#>�j���jHv���sxi���<#���jHo`i��8U#S��HjHj�j���������i���#>�s��jHv���sxi���ABS�jHs�j��i���#S���~ ��j�j���������i���SIGN�s�j�j`-��i��8NOT��Hi��h>NUMBER�jHu`j�s�s`�`��v��xj��j�|j�||��v���j���v������{�j�0{��8{���j���������j�i��`NEGATE�jj�sxi�&>�j��pi���<=��8u`i�i�&1    D&��FINDCHAR�j�j���s`����`s`jH��jxj��hj�jxj�0���X������s���������@j�j�(i��h&&(�j`)��si��P
        !           163: 'IMMEDIATE   D&��AND���0<>�j��i��&,��o`���i��&+LOOP���o����H���@i�w`&]�j`&zXo`i���&REPEAT�����hi���
        !           164: CLEAN-HASH@��CELLS��8i��(CA+���i���XA+����i���/N*����i�� XA1+��`�i��P/N   D�pKEY $�BLANK�j` �i���FILLp�hALIGN�������@j� j��j���������i���DO+LOOP���U*��i��8CELL-���sxi��h/C*��0�i���CRASH'���UNLOOP�{�{�{�s|i��BS D��SEARCH-ORDER �h(s(HEADER��(���v����o`j��}P�(i��8LAST��P|@i���&2 D�`UNALIGNED-L!���HEAP-END��PMC1@'@��.D���v�j��`x0��o`i�xXBASE ��HHEX�����o`i���/C D&��2-��sxi���XBFLIP��X��j�����i��&C"���j`"��o����HjH���x��(���`������������(i��hU>=��u`i���PAD��j`&�i���MU/MOD�jH|�h{�j�|��{�i���U#���v��hj�����i��0&#���v���������i���HOLD���jHv�����j�o`�pi���INVERT�n�� i�� DIGIT�s`�`jHj`Aj`Z��j�j`sxj`0sxjH��jj��j� ����j�j�(i���UM*�j�(j`@j������������j�i��XROT�|j�{�j�i���D+�|��{��i��D2/�|�x~Pj`?����{���i��(U>�j��i���      IMMEDIATE���v�|@jH�`� ��j��pi���CHAR�z j��`i���ASHIFTd��0<=�j�hi��X<>�jxu`i���&LOOP���o���H���@i��0RESOLVE-LOOP��@v�|�j�PjHv�j��s`sxj�o`j����������sx�H�@o`i��h-COMP�n�zX��zXv�j�s�� s��pv�n����|�i���&WHILE����j�i��H&AGAIN���o�j��H���@i���&THEN������@i��HASH��@LA+����i��p/X*��`�i�sh&*
���LA1+����i���/X    D�PLCC�jHj`Aj`Z��j�j` �i���XLFLIPS��x��@�����������`����������i���X,�����`�i��xC,���p�0�i��MIN�~ �8j�j�j�i�|0CHAR-��0sxi���CELL D�h
        !           165: FLUSHCACHE(P��&J�{�{�{�~Pj�|j�|j�|i���BELL   DhCURRENT lh(��UNALIGNED-L@8��
        !           166: HEAP-START���MMCR0!'��U.R�j�����~ �pj�(s`sx��j�j�vXi���DECIMAL�����o`i��PH#10   D�pD#10 D
        !           167: �p2+���i���BXJOIN���|��{���i��(XLSPLIT�jH���@j�����i���LBFLIP���j��j���i��0LXJOIN�������i��h&&;���o�i��H�xwpi���U<=���u`i���OCTAL��`��o`i���TODIGIT�jHj`        �8j�j`'�j`0�i���U/MOD�jj���i���UM/MOD�j`@j������������j�j�i��p>>A���i��(&?�v�x0i�˜UPC�jHj`aj`z��j�j` sxi��BETWEEN�����i��hWITHIN���jH����j�s(s��8j�(s���i���*'�|jHs�|� {�j�~P��{�i���-ROT�j�|j�{�i���CLEAR�j}0i��hM+�j�|jH|�jH{��{�j�sxi��UD2/�|�x~Pj`?����{��xi�ðU2/�����i��LSHIFT
��h2/�����i���WORD���|��jH~P�p�x{�jH���8�8���`s`�p���������j�i���RSHIFT0��>=��pu`i�Ĩ&?DO��x�@v�o����H���@o`j�Hi��`+COMP�zXv���zX��j�s���po`��n��� �i��COMPILE�{�|@jHv��H|i��THERE  ��XCOMP-BUFFER��&UNTIL���o�j��H���@i��x&IF��xo�j��H�j�Hi��x&BEGIN��x�i���RESOLVE-DEST��|@sx�Hi��0RESOLVE-ORIG��s`|@sxj�o`i��      HASH-SIZE    D��WA+��8�i��(/L*����i���WA1+��h�i��X/L D�xXWFLIPS��x��@�����������`����������i���X@t��XLFLIP��Xj���i��pX!��L,������i���MAX�~ �pj�j�j�i��P
        !           168: START-RTAS'��hUNALIGNED-W!�LjDEC!(�Ǡ.R�j�����~ �pj�(s`sx��j�j�vXi���&8   D��
        !           169: H#FFFFFFFF   D�����XWFLIP��xj��j��(i�ȰBLJOIN���|��{���i�� LWSPLIT�jH��@j�����i���H#20 D �@LBSPLIT��@|�8{��8i��2SWAP�|�({��(i��xLWFLIP��@j���i�ɰ:NONAME��(�o���H�i��0>=�j��i��0FM/MOD�jH|~ � s�|�@s`�X{��@j�0��j�{��j�s�{�j�i���/'�|jHs�|� {�s`~P�x��j�0|����{�~Psx{�i��x>>���i�vPACK�jH|j�˰{�i�� D-����0i���D2*���s`s�sx|��{�i�˸DABS�jHs�j���i�� 2*�����i��8POCKET��x�Pv�j`&���Pv����jHj`jxj�j�j�Po`i��h&DO��x�@v��o���Hj�@o`i�̀&.(�j`)��vXi��CISTACK���&AHEAD��xo�j��H�j�Hi�� &ENDOF���|��{�i��ZCOUNT�/W*��h�i�� /W D�0XBFLIPS��x��@�����������`����������i�ΰL!H��W,�����h�i���CALL-C(��UNALIGNED-W@�� DEC@(��@U.���vXu0i�� &4 D�hH#FFFF D����WXJOIN���|��{���i���XWSPLIT��X|�@{��@i���WLJOIN�������i�ψBWJOIN��`����i���WBSPLIT�jH�x�@j��`��i���WBFLIP��8j���i��0&:�z �`o���H�i��H0>�j�8i���SM/REM�s`||�x~P����{�s�j��{�s�j� �j��j�i��pM*�~ � ||��{�����{�s�j���i���<<���i�|�MOVE��DNEGATE��H|�jHu`{�j�sxi��8?PICK�zWHICHPOCKET ��hPOCKETSИ&."�zXv�j�(�o�vX�Hs�j`"��vXi�ѸCIREGSh��&OF�����|o�s`�Ho�jx�H�o�j��H{�i��X&ELSE���o�j��H�j�Hj���i�ˠRMOVE��`LBFLIPS��x��@���������������������i���L@$��W!���WRITE-LOG-BYTE-ENTRY���v�i���HSPRG1!&�x S.�x0i���H#FF D��`XBSPLIT��X|��{���i��*/��(��i��hS>D�jHs�i��X2R@�{�{�~Ps`|��|j�i���&Z"��~ �jj��pj�i���&S"�zXv�j�(��o�v�Hs�j`"��jH|��jH|j�˰{�{�i��`EREGS@Ө&ENDCASE���o�j��H|�j�(��j��hj����������@i���LWFLIPS��x��@�����@���������������i��`W@��XHSPRG1@&��x*/MOD�|�{��i�Ԩ2R>�{�{�{���|j�i�Ͱ&CASE��xji���WBFLIPS��x��@����Ɉ�����h����������i��HHSPRG0!&l�hMOD�ըj�i���2>R�{���|j�||i�֨2!�jH|o`{�|@o`i���HSPRG0@&�՘&/�ը��i��X/MOD�|�{��i��-ROLL�jH|�j�H|��{�j�|��sxj���������|�j�0{�j���sxj���������i���2@�jH|@v�j�v�i��0SPRG3!&�HROLL�jH|�j�0��|��sxj���������|�j�0{��(��sxj���������i�ؘ<W@���jHj`���j�j`&sxi���SPRG3@&D��2ROT�||�{�{��i��0ON���j�o`i���SPRG2!%��SPRG2@%��SPRG1!%|�0SPRG1@%��HSPRG0!%,�`SPRG0@%T�xHIOR!$�ِHIOR@%٨DABR!$���DABR@$���TBU@$\��TBL@$4�PIR@$� PVR@#��8SDR1!+��PSDR1@#��hMSR!+pڀMSR@+�ژHID5@+HڰHID5!+��HID4@*���HID4!*���HID1@*��HID1!*d�(HID0@*<�@HID0!)��XRX!)��pRX@)�ۈRL!)|۠RL@)X۸RW!),��RW@,d��RB!,8�RB@,� get-mbx-base+��@get-flash-size,��`get-flash-base,�܀get-nvram-size,�ܠget-nvram-base#���internal-set-env"X��internal-del-env!d�internal-add-env t�@internal-get-env��hdelete-nvram-partition#Hݐerase-nvram-partition"��increase-nvram-partition��new-nvram-partition��get-named-nvram-partition��@get-nvram-partitionX�`
        !           170: wipe-nvramtހnvram-debug�ިinternal-reset-nvram\��nvram-x!$��nvram-x@`�nvram-l!��(nvram-l@8�Hnvram-w!��hnvram-w@߈nvram-c!�ߨnvram-c@���bootmsg-checklevel���bootmsg-nvupdate�� bootmsg-setlevelX�Hbootmsg-debugcp�h
bootmsg-error���bootmsg-warning��
        !           171: bootmsg-cp`��hv-send-crq,��hv-free-crq��
        !           172: hv-reg-crq��0
        !           173: hv-haschar��P
        !           174: hv-getchar`�p
        !           175: hv-putchar4��&o#�z ��v�|��hx{���o`i��@&h#�z ��v�|��hx{���o`i��&d#�z ��v�|�`hx{���o`i���&RECURSE��v��H�Hi�� &        RECURSIVE��xi��XBODY>����sxi��>BODY�����i���BEHAVIOR�|@v�i��H&TO�wzXv�j�(o�n��H�Hs�|@o`i���FIND�jHv�`j�H��j���j��j��s�(s�i��0&[']�wo�o��H�Hi��`&[CHAR]��x�(i��X&POSTPONE�z �`u`o��@���u`j�0o�o��H�Ho��H�Hi��&LITERAL�o�j`�H�Hi��& [COMPILE]�w�Hi���FIELD�z �`o�    ��Hs`����xi��(
        !           176: END-STRUCT�j�i��PSTRUCT�ji��ALIAS�z �`o�   4�Hw�H�xi��DEFER�z �`o� $�Ho��(�H�xi��xBUFFER:�z �`o� ��H��xi���VARIABLE�z �`o� ��Hj�H�xi��8VALUE�z �`o� l�H�H�xi��CONSTANT�z �`o� D�H�H�xi���&DOES>�o����Hi��0DODOES>�{�|@�v��H|@o`i��`CREATE�z �xi���$CREATE��`o���Ho�q�|@�H�xi��INCLUDE�z � i��(INCLUDED��h~ ||�x���{�~Pj�|~Psx~Pj�~ ~��j���jH|hx{������������X{�{��i��x
        !           177: WRITE-FILE   $l`MAP-FILE $�P
        !           178: UNMAP-FILE   $�q�NICEINIT�o�j�n�ro�r(n�r�o�sn�s@j`�8j`a\s`sxo�hxo�q�i��PHERE l�@��CLIENT-ENTRY-POINT Dbx�.WRITE-LOG-BYTE-ENTRY Db`j�ROMFS-LOOKUP-ENTRY D5Xhex
        !           179: ' ll-cr to cr
        !           180: get-flash-base VALUE flash-addr
        !           181: get-nvram-base CONSTANT nvram-base
        !           182: get-nvram-size CONSTANT nvram-size
        !           183: ff8f9000 CONSTANT sec-nvram-base  \ save area from phype.... not really known
        !           184: 2000 CONSTANT sec-nvram-size
        !           185: nvram-base 20000 + CONSTANT nvram-log-be1-base
        !           186: : hvterm-emit  hv-putchar ;
        !           187: : hvterm-key?  hv-haschar ;
        !           188: : hvterm-key   BEGIN hvterm-key? UNTIL hv-getchar ;
        !           189: ' hvterm-emit to emit
        !           190: ' hvterm-key  to key
        !           191: ' hvterm-key? to key?
        !           192: : serial-emit hvterm-emit ;
        !           193: : serial-key? hvterm-key? ;
        !           194: : serial-key  hvterm-key  ;
        !           195: clean-hash
        !           196: : hash-find ( str len head -- 0 | link )
        !           197: >r 2dup 2dup hash                  ( str len str len hash          R: head )
        !           198: dup >r @ dup                       ( str len str len *hash *hash   R: head hash )
        !           199: IF                                 ( str len str len *hash         R: head hash )
        !           200: link>name name>string string=ci ( str len true|false            R: head hash )
        !           201: dup 0=
        !           202: IF
        !           203: THEN
        !           204: ELSE
        !           205: nip nip                         ( str len 0                     R: head hash )
        !           206: THEN
        !           207: IF                                 \ hash found
        !           208: 2drop r> @ r> drop              (  *hash                        R: )
        !           209: exit
        !           210: THEN                               \ hash not found
        !           211: r> r> swap >r ((find))             ( str len head                  R: hash=0 )
        !           212: dup
        !           213: IF
        !           214: dup r> !                        ( link                          R: )
        !           215: ELSE
        !           216: r> drop                         ( 0                             R: )
        !           217: THEN
        !           218: ;
        !           219: : hash-reveal  hash off ;
        !           220: ' hash-reveal to (reveal)
        !           221: ' hash-find to (find)
        !           222: : >name ( xt -- nfa ) \ note: still has the "immediate" field!
        !           223: BEGIN char- dup c@ UNTIL ( @lastchar )
        !           224: dup dup aligned - cell+ char- ( @lastchar lenmodcell )
        !           225: dup >r -
        !           226: BEGIN dup c@ r@ <> WHILE
        !           227: cell- r> cell+ >r
        !           228: REPEAT
        !           229: r> drop char-
        !           230: ;
        !           231: VARIABLE mask -1 mask !
        !           232: VARIABLE huge-tftp-load 1 huge-tftp-load !
        !           233: : sms-get-tftp-blocksize 598 ;
        !           234: : default-hw-exception s" Exception #" type . ;
        !           235: ' default-hw-exception to hw-exception-handler
        !           236: : diagnostic-mode? false ;     \ 2B DOTICK'D later in envvar.fs
        !           237: : memory-test-suite ( addr len -- fail? )
        !           238: diagnostic-mode? IF
        !           239: ." Memory test mask value: " mask @ . cr
        !           240: ." No memory test suite currently implemented! " cr
        !           241: THEN
        !           242: false
        !           243: ;
        !           244: : 0.r  0 swap <# 0 ?DO # LOOP #> type ;
        !           245: : cnt-bits  ( 64-bit-value -- #bits=1 )
        !           246: dup IF
        !           247: 41 1 DO dup 1- and dup 0= IF drop i LEAVE THEN LOOP
        !           248: THEN
        !           249: ;
        !           250: : bcd-to-bin  ( bcd -- bin )
        !           251: dup f and swap 4 rshift a * +
        !           252: ;
        !           253: : 2log ( n -- lb{n} )
        !           254: 8 cells 0 DO 1 rshift dup 0= IF drop i LEAVE THEN LOOP
        !           255: ;
        !           256: : log2  ( n -- log2-n )
        !           257: 1- 2log 1+
        !           258: ;
        !           259: : $find ( str len -- xt true | str len false )
        !           260: 2dup $find
        !           261: IF
        !           262: drop nip nip TRUE
        !           263: ELSE
        !           264: FALSE
        !           265: THEN
        !           266: ;
        !           267: CREATE $catpad 100 allot
        !           268: : $cat ( str1 len1 str2 len2 -- str3 len3 )
        !           269: >r >r dup >r $catpad swap move
        !           270: r> dup $catpad + r> swap r@ move
        !           271: r> + $catpad swap ;
        !           272: : $cat-comma ( str2 len2 str1 len1 -- "str1, str2" len1+len2+2 )
        !           273: 2dup + s" , " rot swap move 2+ 2swap $cat
        !           274: ;
        !           275: : $cat-space ( str2 len2 str1 len1 -- "str1 str2" len1+len2+1 )
        !           276: 2dup + bl swap c! 1+ 2swap $cat
        !           277: ;
        !           278: : $cathex ( str len val -- str len' )
        !           279: (u.) $cat
        !           280: ;
        !           281: : 2CONSTANT    CREATE , , DOES> 2@ ;
        !           282: : $2CONSTANT  $CREATE , , DOES> 2@ ;
        !           283: : 2VARIABLE    CREATE 0 , 0 ,  DOES> ;
        !           284: : (is-user-word) ( name-str name-len xt -- ) -rot $CREATE , DOES> @ execute ;
        !           285: : zplace ( str len buf -- )  2dup + 0 swap c! swap move ;
        !           286: : rzplace ( str len buf -- )  2dup + 0 swap rb! swap rmove ;
        !           287: : strdup ( str len -- dupstr len ) here over allot swap 2dup 2>r move 2r> ;
        !           288: : str= ( str1 len1 str2 len2 -- equal? )
        !           289: rot over <> IF 3drop false ELSE comp 0= THEN ;
        !           290: : #aligned ( adr alignment -- adr' ) negate swap negate and negate ;
        !           291: : #join  ( lo hi #bits -- x )  lshift or ;
        !           292: : #split ( x #bits -- lo hi )  2dup rshift dup >r swap lshift xor r> ;
        !           293: : /string ( str len u -- str' len' )
        !           294: >r swap r@ chars + swap r> - ;
        !           295: : skip ( str len c -- str' len' )
        !           296: >r BEGIN dup WHILE over c@ r@ = WHILE 1 /string REPEAT THEN r> drop ;
        !           297: : scan ( str len c -- str' len' )
        !           298: >r BEGIN dup WHILE over c@ r@ <> WHILE 1 /string REPEAT THEN r> drop ;
        !           299: : split ( str len char -- left len right len )
        !           300: >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
        !           301: : rfindchar ( str len char -- offs true | false )
        !           302: swap 1 - 0 swap do
        !           303: over i + c@
        !           304: over dup bl = if <= else = then if
        !           305: 2drop i dup dup leave
        !           306: then
        !           307: -1 +loop =
        !           308: ;
        !           309: : rsplit ( str len char -- left len right len )
        !           310: >r 2dup r> rfindchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
        !           311: : left-parse-string ( str len char -- R-str R-len L-str L-len )
        !           312: split 2swap ;
        !           313: : replace-char ( str len chout chin -- )
        !           314: >r -rot BEGIN 2dup 4 pick findchar WHILE tuck - -rot + r@ over c! swap REPEAT
        !           315: r> 2drop 2drop
        !           316: ;
        !           317: : \-to-/ ( str len -- str' len ) strdup 2dup [char] \ [char] / replace-char ;
        !           318: : //  dup >r 1- + r> / ; \ division, round up
        !           319: : c@+ ( adr -- c adr' )  dup c@ swap char+ ;
        !           320: : 2c@ ( adr -- c1 c2 )  c@+ c@ ;
        !           321: : 4c@ ( adr -- c1 c2 c3 c4 )  c@+ c@+ c@+ c@ ;
        !           322: : 8c@ ( adr -- c1 c2 c3 c4 c5 c6 c7 c8 )  c@+ c@+ c@+ c@+ c@+ c@+ c@+ c@ ;
        !           323: : 4dup  ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 n3 n4 )  2over 2over ;
        !           324: : 4drop  ( n1 n2 n3 n4 -- )  2drop 2drop ;
        !           325: : 6dup  ( 1 2 3 4 5 6 -- 1 2 3 4 5 6 1 2 3 4 5 6 )
        !           326: 5 pick 5 pick 5 pick 5 pick 5 pick 5 pick
        !           327: ;
        !           328: : signed ( n1 -- n2 ) dup 80000000 and IF FFFFFFFF00000000 or THEN ;
        !           329: : <l@ ( addr -- x ) l@ signed ;
        !           330: : -leading  BEGIN dup WHILE over c@ bl <= WHILE 1 /string REPEAT THEN ;
        !           331: : (parse-line)  skipws 0 parse ;
        !           332: : hex-byte ( char0 char1 -- value true|false )
        !           333: 10 digit IF
        !           334: swap 10 digit IF
        !           335: 4 lshift or true EXIT
        !           336: ELSE
        !           337: 2drop 0
        !           338: THEN
        !           339: ELSE
        !           340: drop
        !           341: THEN
        !           342: false EXIT
        !           343: ;
        !           344: : parse-hexstring ( dst-adr -- dst-adr' )
        !           345: [char] ) parse cr                 ( dst-adr str len )
        !           346: bounds ?DO                        ( dst-adr )
        !           347: i c@ i 1+ c@ hex-byte IF       ( dst-adr hex-byte )
        !           348: >r dup r> swap c! 1+ 2      ( dst-adr+1 2 )
        !           349: ELSE
        !           350: drop 1                      ( dst-adr 1 )
        !           351: THEN
        !           352: +LOOP
        !           353: ;
        !           354: : add-specialchar ( dst-adr special -- dst-adr' )
        !           355: over c! 1+                        ( dst-adr' )
        !           356: 1 >in +!                          \ advance input-index
        !           357: ;
        !           358: : parse-" ( dst-adr -- dst-adr' )
        !           359: [char] " parse dup 3 pick + >r    ( dst-adr str len R: dst-adr' )
        !           360: >r swap r> move r>                ( dst-adr' )
        !           361: ;
        !           362: : (") ( dst-adr -- dst-adr' )
        !           363: begin                             ( dst-adr )
        !           364: parse-"                        ( dst-adr' )
        !           365: >in @ dup span @ >= IF         ( dst-adr' >in-@ )
        !           366: drop
        !           367: EXIT
        !           368: THEN
        !           369: ib + c@
        !           370: CASE
        !           371: [char] ( OF parse-hexstring ENDOF
        !           372: [char] " OF [char] " add-specialchar ENDOF
        !           373: dup      OF EXIT ENDOF
        !           374: ENDCASE
        !           375: again
        !           376: ;
        !           377: CREATE "pad 100 allot
        !           378: : " ( [text<">< >] -- text-str text-len )
        !           379: state @ IF                        \ compile sliteral, pstr into dict
        !           380: "pad dup (") over -            ( str len )
        !           381: ['] sliteral compile, dup c,   ( str len )
        !           382: bounds ?DO i c@ c, LOOP
        !           383: align ['] count compile,
        !           384: ELSE
        !           385: pocket dup (") over -          \ Interpretation, put string
        !           386: THEN                              \ in temp buffer
        !           387: ; immediate
        !           388: : $forget ( str len -- )
        !           389: 2dup last @            ( str len str len last-bc )
        !           390: BEGIN
        !           391: dup >r             ( str len str len last-bc R: last-bc )
        !           392: cell+ char+ count  ( str len str len found-str found-len R: last-bc )
        !           393: string=ci IF       ( str len R: last-bc )
        !           394: r> @ last ! 2drop clean-hash EXIT ( -- )
        !           395: THEN
        !           396: 2dup r> @ dup 0=   ( str len str len next-bc next-bc )
        !           397: UNTIL
        !           398: drop 2drop 2drop            \ clean hash table
        !           399: ;
        !           400: : forget ( "old-name<>" -- )
        !           401: parse-word $forget
        !           402: ;
        !           403: : linked ( var -- )  here over @ , swap ! ;
        !           404: HEX
        !           405: VARIABLE wordlists  forth-wordlist wordlists !
        !           406: : wordlist ( -- wid )  here wordlists linked 0 , ;
        !           407: 10 CONSTANT max-in-search-order        \ should define elsewhere
        !           408: : also ( -- )  clean-hash  context dup cell+ dup to context  >r @ r> ! ;
        !           409: : previous ( -- )  clean-hash  context cell- to context ;
        !           410: : only ( -- )  clean-hash  search-order to context  ( minimal-wordlist search-order ! ) ;
        !           411: : seal ( -- )  clean-hash  context @  search-order dup to context  ! ;
        !           412: : get-order ( -- wid_n .. wid_1 n )
        !           413: context >r search-order BEGIN dup r@ u<= WHILE
        !           414: dup @ swap cell+ REPEAT r> drop
        !           415: search-order - cell / ;
        !           416: : set-order ( wid_n .. wid_1 n -- )    \ XXX: special cases for 0, -1
        !           417: clean-hash  1- cells search-order + dup to context
        !           418: BEGIN dup search-order u>= WHILE
        !           419: dup >r ! r> cell- REPEAT drop ;
        !           420: : get-current ( -- wid )  current ;
        !           421: : set-current ( wid -- )  to current ;
        !           422: : definitions ( -- )  context @ set-current ;
        !           423: : VOCABULARY ( C: "name" -- ) ( -- )  CREATE wordlist drop  DOES> clean-hash  context ! ;
        !           424: : FORTH ( -- )  clean-hash  forth-wordlist context ! ;
        !           425: : .voc ( wid -- ) \ display name for wid \ needs work ( body> or something like that )
        !           426: dup cell- @ ['] vocabulary ['] forth within IF
        !           427: 2 cells - >name name>string type ELSE u. THEN  space ;
        !           428: : vocs ( -- ) \ display all wordlist names
        !           429: cr wordlists BEGIN @ dup WHILE dup .voc REPEAT drop ;
        !           430: : order ( -- )
        !           431: cr ." context:  " get-order 0 ?DO .voc LOOP
        !           432: cr ." current:  " get-current .voc ;
        !           433: : voc-find ( wid -- 0 | link )
        !           434: clean-hash  cell+ @ (find)  clean-hash ;
        !           435: : (function) ;
        !           436: defer (defer)
        !           437: 0 value (value)
        !           438: 0 constant (constant)
        !           439: variable (variable)
        !           440: create (create)
        !           441: alias (alias) (function)
        !           442: cell buffer: (buffer:)
        !           443: ' (function) @        \ ( <colon> )
        !           444: ' (function) cell + @ \ ( ... <semicolon> )
        !           445: ' (defer) @           \ ( ... <defer> )
        !           446: ' (value) @           \ ( ... <value> )
        !           447: ' (constant) @       \ ( ... <constant> )
        !           448: ' (variable) @        \ ( ... <variable> )
        !           449: ' (create) @          \ ( ... <create> )
        !           450: ' (alias) @           \ ( ... <alias> )
        !           451: ' (buffer:) @         \ ( ... <buffer:> )
        !           452: forget (function)
        !           453: constant <buffer:>
        !           454: constant <alias>
        !           455: constant <create>
        !           456: constant <variable>
        !           457: constant <constant>
        !           458: constant <value>
        !           459: constant <defer>
        !           460: constant <semicolon>
        !           461: constant <colon>
        !           462: ' lit      constant <lit>
        !           463: ' sliteral constant <sliteral>
        !           464: ' 0branch  constant <0branch>
        !           465: ' branch   constant <branch>
        !           466: ' doloop   constant <doloop>
        !           467: ' dotick   constant <dotick>
        !           468: ' doto     constant <doto>
        !           469: ' do?do    constant <do?do>
        !           470: ' do+loop  constant <do+loop>
        !           471: ' do       constant <do>
        !           472: ' exit     constant <exit>
        !           473: ' doleave  constant <doleave>
        !           474: ' do?leave  constant <do?leave>
        !           475: 500 CONSTANT AVAILABLE-SIZE
        !           476: 10000000 CONSTANT MIN-RAM-SIZE \ assumed minimal memory size
        !           477: 4000 CONSTANT MIN-RAM-RESERVE \ prevent from using first pages
        !           478: STRUCT
        !           479: cell field available>address
        !           480: cell field available>size
        !           481: CONSTANT /available
        !           482: CREATE available AVAILABLE-SIZE /available * allot available AVAILABLE-SIZE /available * erase
        !           483: VARIABLE mem-pre-released 0 mem-pre-released !
        !           484: : available>size@      available>size @ ;
        !           485: : available>address@   available>address @ ;
        !           486: : available>size!      available>size ! ;
        !           487: : available>address!   available>address ! ;
        !           488: : available! ( addr size available-ptr -- )
        !           489: dup -rot available>size! available>address!
        !           490: ;
        !           491: : available@ ( available-ptr -- addr size )
        !           492: dup available>address@ swap available>size@
        !           493: ;
        !           494: : (?available-segment<) ( start1 end1 start2 end2 -- true/false ) drop < nip ;
        !           495: : (?available-segment>) ( start1 end1 start2 end2 -- true/false ) -rot 2drop > ;
        !           496: : (?available-segment-#) ( start1 end1 start2 end2 -- true/false )
        !           497: 2dup 5 roll -rot                ( e1 s2 e2 s1 s2 e2 )
        !           498: between >r between r> and not
        !           499: ;
        !           500: : (find-available) ( addr addr+size-1 a-ptr a-size -- a-ptr' found )
        !           501: ?dup 0= IF -rot 2drop false EXIT THEN  \ Not Found
        !           502: 2dup 2/ dup >r /available * +
        !           503: dup available>size@ 0= IF 2drop r> RECURSE EXIT THEN
        !           504: dup >r available@
        !           505: over + 1- 2>r 2swap
        !           506: 2dup 2r@ (?available-segment>) IF
        !           507: 2swap 2r> 2drop r>
        !           508: /available + -rot r> - 1- nip RECURSE EXIT     \ Look Right
        !           509: THEN
        !           510: 2dup 2r@ (?available-segment<) IF
        !           511: 2swap 2r> 2drop r>
        !           512: 2drop r> RECURSE EXIT  \ Look Left
        !           513: THEN
        !           514: 2dup 2r@ (?available-segment-#) IF     \ Conflict - segments overlap
        !           515: 2r> 2r> 3drop 3drop 2drop
        !           516: 1212 throw
        !           517: THEN
        !           518: 2r> 3drop 3drop r> r> drop     ( a-ptr' -- )
        !           519: dup available>size@ 0<>                ( a-ptr' found -- )
        !           520: ;
        !           521: : (find-available) ( addr size -- seg-ptr found )
        !           522: over + 1- available AVAILABLE-SIZE ['] (find-available) catch IF
        !           523: 2drop 2drop 0 false
        !           524: THEN
        !           525: ;
        !           526: : dump-available ( available-ptr -- )
        !           527: cr
        !           528: dup available - /available / AVAILABLE-SIZE swap - 0 ?DO
        !           529: dup available@ ?dup 0= IF
        !           530: 2drop UNLOOP EXIT
        !           531: THEN
        !           532: swap . . cr
        !           533: /available +
        !           534: LOOP
        !           535: dup
        !           536: ;
        !           537: : .available available dump-available ;
        !           538: : (drop-available) ( available-ptr -- )
        !           539: dup available - /available /   \ current element index
        !           540: AVAILABLE-SIZE swap -          \ # of remaining elements
        !           541: ( first nelements ) 1- 0 ?DO
        !           542: dup /available + dup available@
        !           543: ( current next next>address next>size ) ?dup 0= IF
        !           544: 2drop LEAVE \ NULL element - goto last copy
        !           545: THEN
        !           546: 3 roll available!              ( next )
        !           547: LOOP
        !           548: 0 0 rot available!
        !           549: ;
        !           550: : (stick-to-previous-available) ( addr size available-ptr -- naddr nsize nptr success )
        !           551: dup available = IF
        !           552: false EXIT             \ This was the first available segment
        !           553: THEN
        !           554: dup /available - dup available@
        !           555: + 4 pick = IF
        !           556: nip    \ Drop available-ptr since we are going to previous one
        !           557: rot drop       \ Drop start addr, we take the previous one
        !           558: dup available@ 3 roll + rot true
        !           559: ELSE
        !           560: drop false
        !           561: THEN
        !           562: ;
        !           563: : (insert-available) ( available-ptr -- available-ptr )
        !           564: dup                            \ current element
        !           565: dup available - /available /   \ current element index
        !           566: AVAILABLE-SIZE swap -          \ # of remaining elements
        !           567: dup 0<= 3 pick available>size@ 0= or IF
        !           568: drop drop EXIT
        !           569: THEN
        !           570: over available@ rot
        !           571: ( first        first/=current/ first>address first>size nelements ) 1- 0 ?DO
        !           572: 2>r
        !           573: /available + dup available@
        !           574: 2r> 4 pick available! dup 0= IF
        !           575: rot /available + available!
        !           576: UNLOOP EXIT
        !           577: THEN
        !           578: LOOP
        !           579: ( first next/=last/ last[0]>address last[0]>size ) ?dup 0<> IF
        !           580: cr ." release error: available map overflow"
        !           581: cr ." Dumping available property"
        !           582: .available
        !           583: cr ." No space for one before last entry:" cr swap . .
        !           584: cr ." Dying ..." cr 123 throw
        !           585: THEN
        !           586: 2drop
        !           587: ;
        !           588: : insert-available ( addr size available-ptr -- addr size available-ptr )
        !           589: dup available>address@ 0<> IF
        !           590: dup available>address@ rot dup -rot -
        !           591: 3 pick = IF    \ if (available>address@ - size == addr)
        !           592: over available>size@ + swap
        !           593: (stick-to-previous-available) IF
        !           594: dup /available + (drop-available)
        !           595: THEN
        !           596: ELSE
        !           597: swap (stick-to-previous-available)
        !           598: not IF (insert-available) THEN
        !           599: THEN
        !           600: ELSE
        !           601: (stick-to-previous-available) drop
        !           602: THEN
        !           603: ;
        !           604: defer release
        !           605: : drop-available ( addr size available-ptr -- addr )
        !           606: dup >r available@
        !           607: over 4 pick swap - ?dup 0<> IF
        !           608: dup 3 roll swap r> available! -
        !           609: over - ?dup 0= IF
        !           610: drop
        !           611: ELSE
        !           612: swap 2 pick + swap release
        !           613: THEN
        !           614: ELSE
        !           615: nip ( req_addr req_size segment_size )
        !           616: over - ?dup 0= IF
        !           617: drop r> (drop-available)
        !           618: ELSE
        !           619: -rot over + rot r> available!
        !           620: THEN
        !           621: THEN
        !           622: ;
        !           623: : pwr2roundup ( value -- pwr2value )
        !           624: dup CASE
        !           625: 0 OF EXIT ENDOF
        !           626: 1 OF EXIT ENDOF
        !           627: ENDCASE
        !           628: dup 1 DO drop i dup +LOOP
        !           629: dup +
        !           630: ;
        !           631: : (claim-best-fit) ( len align -- len base )
        !           632: pwr2roundup 1- -1 -1
        !           633: available AVAILABLE-SIZE /available * + available DO
        !           634: i              \ Must be saved now, before we use Return stack
        !           635: -rot >r >r swap >r
        !           636: available@ ?dup 0= IF drop r> r> r> LEAVE THEN         \ EOL
        !           637: 2 pick - dup 0< IF
        !           638: 2drop                  \ Can't Fit: Too Small
        !           639: ELSE
        !           640: dup 2 pick r@ and - 0< IF
        !           641: 2drop          \ Can't Fit When Aligned
        !           642: ELSE
        !           643: r> -rot dup r@ U< IF
        !           644: 2r> 2drop
        !           645: swap 2 pick + 2 pick invert and >r >r >r
        !           646: ELSE
        !           647: 2drop >r
        !           648: THEN
        !           649: THEN
        !           650: THEN
        !           651: r> r> r>
        !           652: /available +LOOP
        !           653: -rot 2drop     ( len best-fit-base/or -1 if none found/ )
        !           654: ;
        !           655: : (adjust-release0) ( 0 size -- addr' size' )
        !           656: 2dup MIN-RAM-SIZE dup 3 roll + -rot -
        !           657: dup 0< IF 2drop ELSE
        !           658: 2swap 2drop 0 mem-pre-released !
        !           659: THEN
        !           660: ;
        !           661: : claim ( [ addr ] len align -- base )
        !           662: ?dup 0<> IF
        !           663: (claim-best-fit) dup -1 = IF
        !           664: 2drop cr ." claim error : aligned allocation failed" cr
        !           665: ." available:" cr .available
        !           666: 321 throw EXIT
        !           667: THEN
        !           668: swap
        !           669: THEN
        !           670: 2dup (find-available) not IF
        !           671: drop
        !           672: 2drop
        !           673: 321 throw EXIT
        !           674: THEN
        !           675: ( req_addr req_size available-ptr ) drop-available
        !           676: ;
        !           677: : .release ( addr len -- )
        !           678: over 0= mem-pre-released @ and IF (adjust-release0) THEN
        !           679: 2dup (find-available) IF
        !           680: drop swap
        !           681: cr ." release error: region " . ." , " . ." already released" cr
        !           682: ELSE
        !           683: ?dup 0= IF
        !           684: swap 
        !           685: cr ." release error: Bad/conflicting region " . ." , " .
        !           686: ." or available list full " cr
        !           687: ELSE
        !           688: ( addr size available-ptr ) insert-available
        !           689: ( addr size available-ptr ) available!
        !           690: THEN
        !           691: THEN
        !           692: ;
        !           693: ' .release to release
        !           694: 0 MIN-RAM-SIZE release 1 mem-pre-released !
        !           695: 0 MIN-RAM-RESERVE 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop
        !           696: E000000 2000000 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop
        !           697: heap-end heap-start - log2 1+ CONSTANT (max-heads#)
        !           698: CREATE heads (max-heads#) cells allot
        !           699: heads (max-heads#) cells erase
        !           700: : size>head  ( size -- headptr )  log2 3 max cells heads + ;
        !           701: : alloc-mem  ( len -- a-addr )
        !           702: dup 0= IF EXIT THEN
        !           703: 1 over log2 3 max                   ( len 1 log_len )
        !           704: dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN
        !           705: lshift >r                           ( len  R: 1<<log_len )
        !           706: size>head dup @ IF
        !           707: dup @ dup >r @ swap ! r> r> drop EXIT
        !           708: THEN                                ( headptr  R: 1<<log_len)
        !           709: r@ 2* recurse dup                   ( headptr a-addr2 a-addr2  R: 1<<log_len)
        !           710: dup 0= IF r> 2drop 2drop 0 EXIT THEN
        !           711: r> + >r 0 over ! swap ! r>
        !           712: ;
        !           713: : free-mem  ( a-addr len -- )
        !           714: dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! !
        !           715: ;
        !           716: : #links  ( a -- n )
        !           717: @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip
        !           718: ;
        !           719: : .free  ( -- )
        !           720: 0 (max-heads#) 0 DO
        !           721: heads i cells + #links dup IF
        !           722: cr dup . ." * " 1 i lshift dup . ." = " * dup .
        !           723: THEN
        !           724: +
        !           725: LOOP
        !           726: cr ." Total " .
        !           727: ;
        !           728: heap-start heap-end heap-start - free-mem
        !           729: VARIABLE device-tree
        !           730: VARIABLE current-node
        !           731: : get-node  current-node @ dup 0= ABORT" No active device tree node" ;
        !           732: STRUCT
        !           733: cell FIELD node>peer
        !           734: cell FIELD node>parent
        !           735: cell FIELD node>child
        !           736: cell FIELD node>properties
        !           737: cell FIELD node>words
        !           738: cell FIELD node>instance
        !           739: cell FIELD node>instance-size
        !           740: cell FIELD node>space?
        !           741: cell FIELD node>space
        !           742: cell FIELD node>addr1
        !           743: cell FIELD node>addr2
        !           744: cell FIELD node>addr3
        !           745: END-STRUCT
        !           746: : find-method ( str len phandle -- false | xt true )
        !           747: node>words @ voc-find dup IF link> true THEN ;
        !           748: 0 VALUE my-self
        !           749: : >instance
        !           750: my-self 0= ABORT" No instance!"
        !           751: my-self +
        !           752: ;
        !           753: : (create-instance-var) ( initial-value -- )
        !           754: get-node ?dup 0= ABORT" Instance word outside device context!"
        !           755: dup node>instance @      ( iv phandle tmp-ihandle )
        !           756: swap node>instance-size dup @     ( iv tmp-ih *instance-size instance-size )
        !           757: dup ,                             \ compile current instance ptr
        !           758: swap 1 cells swap +!              ( iv tmp-ih instance-size )
        !           759: + !
        !           760: ;
        !           761: : create-instance-var ( "name" initial-value -- )
        !           762: CREATE (create-instance-var) PREVIOUS ;
        !           763: VOCABULARY instance-words  ALSO instance-words DEFINITIONS
        !           764: : VARIABLE  0 create-instance-var DOES> @ >instance ;
        !           765: : VALUE       create-instance-var DOES> @ >instance @ ;
        !           766: : DEFER     0 create-instance-var DOES> @ >instance @ execute ;
        !           767: PREVIOUS DEFINITIONS
        !           768: : (instance?) ( xt -- xt true|false )
        !           769: dup @ <create> = IF
        !           770: dup cell+ @ cell+ @ ['] >instance =
        !           771: ELSE
        !           772: false
        !           773: THEN
        !           774: ;
        !           775: : (doito) ( value R:*CFA -- )
        !           776: r> cell+ dup >r
        !           777: @ cell+ cell+ @ >instance !
        !           778: ;
        !           779: : to ( value wordname<> -- )
        !           780: ' (instance?)
        !           781: state @ IF
        !           782: IF ['] (doito) ELSE ['] DOTO THEN
        !           783: , , EXIT
        !           784: THEN
        !           785: IF
        !           786: cell+ cell+ @ >instance ! \ interp mode instance value
        !           787: ELSE
        !           788: cell+ !                   \ interp mode normal value
        !           789: THEN
        !           790: ; IMMEDIATE
        !           791: : INSTANCE  ALSO instance-words ;
        !           792: STRUCT
        !           793: /n FIELD instance>node
        !           794: /n FIELD instance>parent
        !           795: /n FIELD instance>args
        !           796: /n FIELD instance>args-len
        !           797: CONSTANT /instance-header
        !           798: : my-parent  my-self instance>parent @ ;
        !           799: : my-args    my-self instance>args 2@ ;
        !           800: : set-my-args   ( old-addr len -- )
        !           801: dup IF                             \ IF len > 0                    ( old-addr len )
        !           802: dup alloc-mem                   \ | allocate space for new args ( old-addr len new-addr )
        !           803: swap 2dup                       \ | write the new address       ( old-addr new-addr len new-addr len )
        !           804: my-self instance>args 2!        \ | into the instance table     ( old-addr new-addr len )
        !           805: move                            \ | and copy the args           ( -- )
        !           806: ELSE                               \ ELSE                          ( old-addr len )
        !           807: my-self instance>args 2!        \ | set new args to zero, too   ( )
        !           808: THEN                               \ FI
        !           809: ;
        !           810: : create-instance-data ( -- instance )
        !           811: get-node dup node>instance @ swap node>instance-size @  ( instance instance-size )
        !           812: dup alloc-mem dup >r swap move r>
        !           813: ;
        !           814: : create-instance ( -- )
        !           815: my-self create-instance-data
        !           816: dup to my-self instance>parent !
        !           817: get-node my-self instance>node !
        !           818: ;
        !           819: : destroy-instance ( instance -- )
        !           820: dup @ node>instance-size @ free-mem
        !           821: ;
        !           822: : ihandle>phandle ( ihandle -- phandle )
        !           823: dup 0= ABORT" no current instance" instance>node @
        !           824: ;
        !           825: : push-my-self ( ihandle -- )  r> my-self >r >r to my-self ;
        !           826: : pop-my-self ( -- )  r> r> to my-self >r ;
        !           827: : call-package  push-my-self execute pop-my-self ;
        !           828: : $call-static ( ... str len node -- ??? )
        !           829: find-method IF execute ELSE -1 throw THEN
        !           830: ;
        !           831: : $call-my-method  ( str len -- ) my-self ihandle>phandle $call-static ;
        !           832: : $call-method  push-my-self $call-my-method pop-my-self ;
        !           833: : $call-parent  my-parent $call-method ;
        !           834: 1000 CONSTANT max-instance-size
        !           835: 3000000 CONSTANT space-code-mask
        !           836: : create-node ( parent -- new )
        !           837: max-instance-size alloc-mem dup max-instance-size erase >r
        !           838: align wordlist >r wordlist >r
        !           839: here 0 , swap , 0 , r> , r> , r> , /instance-header , 0 , 0 , 0 , 0 , ;
        !           840: : peer    node>peer   @ ;
        !           841: : parent  node>parent @ ;
        !           842: : child   node>child  @ ;
        !           843: : peer  dup IF peer ELSE drop device-tree @ THEN ;
        !           844: : link ( new head -- ) \ link a new node at the end of a linked list
        !           845: BEGIN dup @ WHILE @ REPEAT ! ;
        !           846: : link-node ( parent child -- )
        !           847: swap dup IF node>child link ELSE drop device-tree ! THEN ;
        !           848: : set-node ( phandle -- )
        !           849: current-node @ IF previous THEN
        !           850: dup current-node !
        !           851: ?dup IF node>words @ also context ! THEN
        !           852: definitions ;
        !           853: : get-parent  get-node parent ;
        !           854: : new-node ( -- phandle ) \ active node becomes new node's parent;
        !           855: current-node @ dup create-node
        !           856: tuck link-node dup set-node ;
        !           857: : finish-node ( -- )
        !           858: get-node parent set-node ;
        !           859: : device-end ( -- )  0 set-node ;
        !           860: CREATE $indent 100 allot  VARIABLE indent 0 indent !
        !           861: true value encode-first?
        !           862: : decode-int  over >r 4 /string r> 4c@ swap 2swap swap bljoin ;
        !           863: : decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ;
        !           864: : decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len )
        !           865: dup 0= IF 2dup EXIT THEN \ string properties with zero lenght
        !           866: over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1-
        !           867: EXIT THEN 1+ AGAIN ;
        !           868: : (prune) ( name len head -- )
        !           869: dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF
        !           870: >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ;
        !           871: : prune ( name len -- )  last (prune) ;
        !           872: : set-property ( data dlen name nlen phandle -- )
        !           873: true to encode-first?
        !           874: get-current >r  node>properties @ set-current
        !           875: 2dup prune  $2CONSTANT  r> set-current ;
        !           876: : delete-property ( name nlen -- )
        !           877: get-node get-current >r  node>properties @ set-current
        !           878: prune r> set-current ;
        !           879: : property ( data dlen name nlen -- )  get-node set-property ;
        !           880: : get-property ( str len phandle -- true | data dlen false )
        !           881: ?dup 0= IF cr cr cr ." get-property for " type ."  on zero phandle"
        !           882: cr cr true EXIT THEN
        !           883: node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ;
        !           884: : get-package-property ( str len phandle -- true | data dlen false )
        !           885: get-property ;
        !           886: : get-my-property ( str len -- true | data dlen false )
        !           887: my-self ihandle>phandle get-property ;
        !           888: : get-parent-property ( str len -- true | data dlen false )
        !           889: my-parent ihandle>phandle get-property ;
        !           890: : get-inherited-property ( str len -- true | data dlen false )
        !           891: my-self ihandle>phandle
        !           892: BEGIN 3dup get-property 0=
        !           893: IF  \ Property found
        !           894: rot drop rot drop rot drop false EXIT
        !           895: THEN
        !           896: parent 0=
        !           897: IF
        !           898: nip nip true EXIT
        !           899: THEN
        !           900: AGAIN ;
        !           901: 20 CONSTANT indent-prop
        !           902: : .prop-int ( str len -- )
        !           903: space
        !           904: 400 min 0
        !           905: ?DO
        !           906: i over + dup                                 ( str act-addr act-addr )
        !           907: c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str )
        !           908: i c and c = IF                           \ check for multipleof 16 bytes
        !           909: cr indent @ indent-prop + 1+ 0        \ linefeed + indent
        !           910: DO
        !           911: space                              \ print spaces
        !           912: LOOP
        !           913: ELSE
        !           914: space space                           \ print two spaces
        !           915: THEN
        !           916: 4 +LOOP
        !           917: drop
        !           918: ;
        !           919: : .prop-bytes ( str len -- )
        !           920: 2dup -4 and .prop-int                       ( str len )
        !           921: dup 3 and dup IF                            ( str len len%4 )
        !           922: >r -4 and + r>                           ( str' len%4 )
        !           923: bounds                                   ( str' str'+len%4 )
        !           924: DO
        !           925: i c@ 2 0.r                            \ Print last 3 bytes
        !           926: LOOP
        !           927: ELSE
        !           928: 3drop
        !           929: THEN
        !           930: ;
        !           931: : .prop-string ( str len )
        !           932: 2dup space type
        !           933: cr indent @ indent-prop + 0 DO space LOOP   \ Linefeed
        !           934: .prop-bytes
        !           935: ;
        !           936: : .propbytes ( xt -- )
        !           937: execute dup
        !           938: IF
        !           939: over cell- @ execute
        !           940: ELSE
        !           941: 2drop
        !           942: THEN
        !           943: ;
        !           944: : .property ( lfa -- )
        !           945: cr indent @ 0
        !           946: ?DO
        !           947: space
        !           948: LOOP
        !           949: link> dup >name name>string 2dup type nip ( len )
        !           950: indent-prop swap -                        ( xt 20-len )
        !           951: dup 0< IF drop 0 THEN 0                   ( xt number-of-space 0 )
        !           952: ?DO
        !           953: space
        !           954: LOOP
        !           955: .propbytes
        !           956: ;
        !           957: : (.properties) ( phandle -- )
        !           958: node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ;
        !           959: : .properties ( -- )
        !           960: get-node (.properties) ;
        !           961: : next-property ( str len phandle -- false | str' len' true )
        !           962: ?dup 0= IF device-tree @ THEN  \ XXX: is this line required?
        !           963: node>properties @
        !           964: >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN
        !           965: @ dup IF link>name name>string true THEN ;
        !           966: : encode-start ( -- prop 0 )
        !           967: ['] .prop-int compile,
        !           968: false to encode-first?
        !           969: here 0
        !           970: ;
        !           971: : encode-int ( val -- prop prop-len )
        !           972: encode-first? IF
        !           973: ['] .prop-int compile,             \ Execution token for print
        !           974: false to encode-first?
        !           975: THEN
        !           976: here swap lbsplit c, c, c, c, /l
        !           977: ;
        !           978: : encode-bytes ( str len -- prop-addr prop-len )
        !           979: encode-first? IF
        !           980: ['] .prop-bytes compile,           \ Execution token for print
        !           981: false to encode-first?
        !           982: THEN
        !           983: here over 2dup 2>r allot swap move 2r>
        !           984: ;
        !           985: : encode-string ( str len -- prop-addr prop-len )
        !           986: encode-first? IF
        !           987: ['] .prop-string compile,          \ Execution token for print
        !           988: false to encode-first?
        !           989: THEN
        !           990: encode-bytes 0 c, char+
        !           991: ;
        !           992: : encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len )
        !           993: nip + ;
        !           994: : encode-int+  encode-int encode+ ;
        !           995: : encode-64    xlsplit encode-int rot encode-int+ ;
        !           996: : encode-64+   encode-64 encode+ ;
        !           997: : device-name  encode-string s" name"        property ;
        !           998: : device-type  encode-string s" device_type" property ;
        !           999: : model        encode-string s" model"       property ;
        !          1000: : compatible   encode-string s" compatible"  property ;
        !          1001: : #address-cells  s" #address-cells" rot parent get-property
        !          1002: ABORT" parent doesn't have a #address-cells property!"
        !          1003: decode-int nip nip
        !          1004: ;
        !          1005: : my-#address-cells  ( -- #address-cells )
        !          1006: get-node #address-cells
        !          1007: ;
        !          1008: : child-#address-cells  ( -- #address-cells )
        !          1009: s" #address-cells" get-node get-property
        !          1010: ABORT" node doesn't have a #address-cells property!"
        !          1011: decode-int nip nip
        !          1012: ;
        !          1013: : child-#size-cells  ( -- #address-cells )
        !          1014: s" #size-cells" get-node get-property
        !          1015: ABORT" node doesn't have a #size-cells property!"
        !          1016: decode-int nip nip
        !          1017: ;
        !          1018: : encode-phys  ( phys.hi ... phys.low -- prop len )
        !          1019: encode-first?  IF  encode-start  ELSE  here 0  THEN
        !          1020: my-#address-cells 0 ?DO rot encode-int+ LOOP
        !          1021: ;
        !          1022: : encode-child-phys  ( phys.hi ... phys.low -- prop len )
        !          1023: encode-first?  IF  encode-start  ELSE  here 0  THEN
        !          1024: child-#address-cells 0 ?DO rot encode-int+ LOOP
        !          1025: ;
        !          1026: : encode-child-size  ( size.hi ... size.low -- prop len )
        !          1027: encode-first? IF  encode-start  ELSE  here 0  THEN
        !          1028: child-#size-cells 0 ?DO rot encode-int+ LOOP
        !          1029: ;
        !          1030: : decode-phys
        !          1031: my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT drop
        !          1032: my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ;
        !          1033: : decode-phys-and-drop
        !          1034: my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT 3drop
        !          1035: my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ;
        !          1036: : reg  >r encode-phys r> encode-int+ s" reg" property ;
        !          1037: : >space    node>space @ ;
        !          1038: : >space?   node>space? @ ;
        !          1039: : >address  dup >r #address-cells dup 3 > IF r@ node>addr3 @ swap THEN
        !          1040: dup 2 > IF r@ node>addr2 @ swap THEN
        !          1041: 1 > IF r@ node>addr1 @ THEN r> drop ;
        !          1042: : >unit     dup >r >address r> >space ;
        !          1043: : my-space ( -- phys.hi )
        !          1044: my-self ihandle>phandle >space ;
        !          1045: : my-address  my-self ihandle>phandle >address ;
        !          1046: : my-unit     my-self ihandle>phandle >unit ;
        !          1047: : my-unit-64 ( -- phys.lo+1|phys.lo )
        !          1048: my-unit                                ( phys.lo ... phys.hi )
        !          1049: my-self ihandle>phandle #address-cells ( phys.lo ... phys.hi #ad-cells )
        !          1050: CASE
        !          1051: 1   OF EXIT ENDOF
        !          1052: 2   OF lxjoin EXIT ENDOF
        !          1053: 3   OF drop lxjoin EXIT ENDOF
        !          1054: dup OF 2drop lxjoin EXIT ENDOF
        !          1055: ENDCASE
        !          1056: ;
        !          1057: : set-space    get-node dup >r node>space ! true r> node>space? ! ;
        !          1058: : set-address  my-#address-cells 1 ?DO
        !          1059: get-node node>space i cells + ! LOOP ;
        !          1060: : set-unit     set-space set-address ;
        !          1061: : set-unit-64 ( phys.lo|phys.hi -- )
        !          1062: my-#address-cells 2 <> IF
        !          1063: ." set-unit-64: #address-cells <> 2 " abort
        !          1064: THEN
        !          1065: xlsplit set-unit
        !          1066: ;
        !          1067: : set-args ( arg-str len unit-str len -- )
        !          1068: s" decode-unit" get-parent $call-static set-unit set-my-args ;
        !          1069: : $cat-unit  dup parent 0= IF drop EXIT THEN
        !          1070: dup >space? not IF drop EXIT THEN
        !          1071: dup >r >unit s" encode-unit" r> parent $call-static dup IF
        !          1072: dup >r here swap move s" @" $cat here r> $cat
        !          1073: ELSE 2drop THEN ;
        !          1074: : node>name  dup >r s" name" rot get-property IF r> (u.) ELSE 1- r> drop THEN ;
        !          1075: : node>qname dup node>name rot ['] $cat-unit CATCH IF drop THEN ;
        !          1076: : node>path  here 0 rot  BEGIN dup WHILE dup parent REPEAT 2drop
        !          1077: dup 0= IF [char] / c, THEN
        !          1078: BEGIN dup WHILE [char] / c, node>qname here over allot swap move
        !          1079: REPEAT drop here 2dup - allot over - ;
        !          1080: : interposed? ( ihandle -- flag )
        !          1081: dup instance>parent @ dup 0= IF 2drop false EXIT THEN
        !          1082: ihandle>phandle swap ihandle>phandle parent <> ;
        !          1083: : instance>qname  dup >r interposed? IF s" %" ELSE 0 0 THEN
        !          1084: r@ ihandle>phandle node>qname $cat  r> instance>args 2@
        !          1085: dup IF 2>r s" :" $cat 2r> $cat ELSE 2drop THEN ;
        !          1086: : instance>qpath \ With interposed nodes.
        !          1087: here 0 rot BEGIN dup WHILE dup instance>parent @ REPEAT 2drop
        !          1088: dup 0= IF [char] / c, THEN
        !          1089: BEGIN dup WHILE [char] / c, instance>qname here over allot swap move
        !          1090: REPEAT drop here 2dup - allot over - ;
        !          1091: : instance>path \ Without interposed nodes.
        !          1092: here 0 rot BEGIN dup WHILE
        !          1093: dup interposed? 0= IF dup THEN instance>parent @ REPEAT 2drop
        !          1094: dup 0= IF [char] / c, THEN
        !          1095: BEGIN dup WHILE [char] / c, instance>qname here over allot swap move
        !          1096: REPEAT drop here 2dup - allot over - ;
        !          1097: : .node  node>path type ;
        !          1098: : pwd  get-node .node ;
        !          1099: : .instance instance>qpath type ;
        !          1100: : .chain    dup instance>parent @ ?dup IF recurse THEN
        !          1101: cr dup . instance>qname type ;
        !          1102: defer find-node
        !          1103: : set-alias ( alias-name len device-name len -- )
        !          1104: encode-string
        !          1105: 2swap s" /aliases" find-node ?dup IF
        !          1106: set-property
        !          1107: ELSE
        !          1108: 4drop
        !          1109: THEN
        !          1110: ;
        !          1111: : find-alias ( alias-name len -- false | dev-path len )
        !          1112: s" /aliases" find-node dup IF
        !          1113: get-property 0= IF 1- dup 0= IF nip THEN ELSE false THEN
        !          1114: THEN ;
        !          1115: : .alias ( alias-name len -- )
        !          1116: find-alias dup IF type ELSE ." no alias available" THEN ;
        !          1117: : (.print-alias) ( lfa -- )
        !          1118: link> dup >name name>string
        !          1119: 2dup s" name" string=ci IF 2drop drop
        !          1120: ELSE cr type space ." : " execute type
        !          1121: THEN ;
        !          1122: : (.list-alias) ( phandle -- )
        !          1123: node>properties @ cell+ @ BEGIN dup WHILE dup (.print-alias) @ REPEAT drop ;
        !          1124: : list-alias ( -- )
        !          1125: s" /aliases" find-node dup IF (.list-alias) THEN ;
        !          1126: : devalias ( "{alias-name}<>{device-specifier}<cr>" -- )
        !          1127: parse-word parse-word dup IF set-alias
        !          1128: ELSE 2drop dup IF .alias
        !          1129: ELSE 2drop list-alias THEN THEN ;
        !          1130: : sub-alias ( arg-str arg-len -- arg' len' | false )
        !          1131: 2dup
        !          1132: 2dup [char] / findchar ?dup IF ELSE 2dup [char] : findchar THEN
        !          1133: ( a l a l [p] -1|0 ) IF nip dup ELSE 2drop 0 THEN >r
        !          1134: find-alias ?dup IF ( a l a' p' -- R:p | a' l' -- R:0 )
        !          1135: r@ IF 2swap r@ - swap r> + swap $cat strdup ( a" l-p+p' -- )
        !          1136: ELSE ( a' l' -- R:0 ) r> drop ( a' l' -- ) THEN
        !          1137: ELSE ( a l -- R:p | -- R:0 ) r> IF 2drop THEN false ( 0 -- ) THEN
        !          1138: ;
        !          1139: : de-alias ( arg-str arg-len -- arg' len' )
        !          1140: BEGIN over c@ [char] / <> dup IF drop 2dup sub-alias ?dup THEN
        !          1141: WHILE 2swap 2drop REPEAT
        !          1142: ;
        !          1143: : +indent ( not-last? -- )
        !          1144: IF s" |   " ELSE s"     " THEN $indent indent @ + swap move 4 indent +! ;
        !          1145: : -indent ( -- )  -4 indent +! ;
        !          1146: : ls-node ( node -- )
        !          1147: cr $indent indent @ type
        !          1148: dup peer IF ." |-- " ELSE ." +-- " THEN node>qname type ;
        !          1149: : (ls) ( node -- )
        !          1150: child BEGIN dup WHILE dup ls-node dup child IF
        !          1151: dup peer +indent dup recurse -indent THEN peer REPEAT drop ;
        !          1152: : ls ( -- )  get-node dup cr node>path type (ls) 0 indent ! ;
        !          1153: : show-devs ( {device-specifier}<eol> -- )
        !          1154: skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN   ( str len )
        !          1155: find-node dup 0= ABORT" No such device path" (ls)
        !          1156: ;
        !          1157: VARIABLE interpose-node
        !          1158: 2VARIABLE interpose-args
        !          1159: : interpose ( arg len phandle -- )  interpose-node ! interpose-args 2! ;
        !          1160: : open-node ( arg len phandle -- ihandle | 0 )
        !          1161: current-node @ >r set-node create-instance set-my-args
        !          1162: s" open" ['] $call-my-method CATCH IF 2drop true THEN
        !          1163: 0= IF my-self destroy-instance 0 to my-self THEN
        !          1164: my-self my-parent to my-self r> set-node
        !          1165: interpose-node @ IF my-self >r to my-self
        !          1166: interpose-args 2@ interpose-node @
        !          1167: interpose-node off recurse  r> to my-self THEN ;
        !          1168: : close-node ( ihandle -- )
        !          1169: my-self >r to my-self
        !          1170: s" close" ['] $call-my-method CATCH IF 2drop THEN
        !          1171: my-self destroy-instance r> to my-self ;
        !          1172: : close-dev ( ihandle -- )
        !          1173: my-self >r to my-self
        !          1174: BEGIN my-self WHILE my-parent my-self close-node to my-self REPEAT
        !          1175: r> to my-self ;
        !          1176: : new-device ( -- )
        !          1177: my-self new-node node>instance @ dup to my-self instance>parent !
        !          1178: get-node my-self instance>node ! ;
        !          1179: : finish-device ( -- )
        !          1180: finish-node my-parent my-self max-instance-size free-mem to my-self ;
        !          1181: : split ( str len char -- left len right len )
        !          1182: >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ;
        !          1183: : generic-decode-unit ( str len ncells -- addr.lo ... addr.hi )
        !          1184: dup >r -rot BEGIN r@ WHILE r> 1- >r [char] , split 2swap
        !          1185: $number IF 0 THEN r> swap >r >r REPEAT r> 3drop
        !          1186: BEGIN dup WHILE 1- r> swap REPEAT drop ;
        !          1187: : generic-encode-unit ( addr.lo ... addr.hi ncells -- str len )
        !          1188: 0 0 rot ?dup IF 0 ?DO rot (u.) $cat s" ," $cat LOOP 1- THEN ;
        !          1189: : hex-decode-unit ( str len ncells -- addr.lo ... addr.hi )
        !          1190: base @ >r hex generic-decode-unit r> base ! ;
        !          1191: : hex-encode-unit ( addr.lo ... addr.hi ncells -- str len )
        !          1192: base @ >r hex generic-encode-unit r> base ! ;
        !          1193: : handle-leading-/ ( path len -- path' len' )
        !          1194: dup IF over c@ [char] / = IF 1 /string device-tree @ set-node THEN THEN ;
        !          1195: : match-name ( name len node -- match? )
        !          1196: over 0= IF 3drop true EXIT THEN
        !          1197: s" name" rot get-property IF 2drop false EXIT THEN
        !          1198: 1- string=ci ; \ XXX should use decode-string
        !          1199: 0 VALUE #search-unit   CREATE search-unit 4 cells allot
        !          1200: : match-unit ( node -- match? )
        !          1201: node>space search-unit #search-unit 0 ?DO 2dup @ swap @ <> IF
        !          1202: 2drop false UNLOOP EXIT THEN cell+ swap cell+ swap LOOP 2drop true ;
        !          1203: : match-node ( name len node -- match? )
        !          1204: dup >r match-name r> match-unit and ; \ XXX e3d
        !          1205: : find-kid ( name len -- node|0 )
        !          1206: dup -1 = IF \ are we supposed to stay in the same node? -> resolve-relatives
        !          1207: 2drop get-node
        !          1208: ELSE
        !          1209: get-node child >r BEGIN r@ WHILE 2dup r@ match-node
        !          1210: IF 2drop r> EXIT THEN r> peer >r REPEAT
        !          1211: r> 3drop false
        !          1212: THEN ;
        !          1213: : set-search-unit ( unit len -- )
        !          1214: dup 0= IF to #search-unit drop EXIT THEN
        !          1215: s" #address-cells" get-node get-property THROW
        !          1216: decode-int to #search-unit 2drop
        !          1217: s" decode-unit" get-node $call-static
        !          1218: #search-unit 0 ?DO search-unit i cells + ! LOOP ;
        !          1219: : resolve-relatives ( path len -- path' len' )
        !          1220: 2dup 2 = swap s" .." comp 0= and IF
        !          1221: get-node parent ?dup IF
        !          1222: set-node drop -1
        !          1223: ELSE
        !          1224: s" Already in root node." type
        !          1225: THEN
        !          1226: THEN
        !          1227: 2dup 1 = swap c@ [CHAR] . = and IF
        !          1228: drop -1
        !          1229: THEN
        !          1230: ;
        !          1231: : find-component ( path len -- path' len' args len node|0 )
        !          1232: [char] / split 2swap ( path'. component. )
        !          1233: [char] : split 2swap ( path'. args. node-addr. )
        !          1234: [char] @ split ['] set-search-unit CATCH IF 2drop 2drop 0 EXIT THEN
        !          1235: resolve-relatives find-kid ;
        !          1236: : .find-node ( path len -- phandle|0 )
        !          1237: current-node @ >r
        !          1238: handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN
        !          1239: BEGIN dup WHILE \ handle one component:
        !          1240: find-component ( path len args len node ) dup 0= IF
        !          1241: 3drop 2drop r> set-node 0 EXIT THEN
        !          1242: set-node 2drop REPEAT 2drop
        !          1243: get-node r> set-node ;
        !          1244: ' .find-node to find-node
        !          1245: : find-node ( path len -- phandle|0 ) de-alias find-node ;
        !          1246: : delete-node ( phandle -- )
        !          1247: dup node>parent @ node>child @ ( phandle 1st peer )
        !          1248: 2dup = IF
        !          1249: node>peer @ swap node>parent @ node>child !
        !          1250: EXIT
        !          1251: THEN
        !          1252: dup node>peer @
        !          1253: BEGIN 2 pick 2dup <> WHILE
        !          1254: drop
        !          1255: nip dup node>peer @
        !          1256: dup 0= IF 2drop drop unloop EXIT THEN
        !          1257: REPEAT
        !          1258: drop
        !          1259: node>peer @    swap node>peer !
        !          1260: drop
        !          1261: ;
        !          1262: : open-dev ( path len -- ihandle|0 )
        !          1263: de-alias current-node @ >r
        !          1264: handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN
        !          1265: my-self >r 0 to my-self
        !          1266: 0 0 >r >r BEGIN dup WHILE \ handle one component:
        !          1267: ( arg len ) r> r> get-node open-node to my-self
        !          1268: find-component ( path len args len node ) dup 0= IF
        !          1269: 3drop 2drop my-self close-dev r> to my-self r> set-node 0 EXIT THEN
        !          1270: set-node >r >r REPEAT 2drop
        !          1271: r> r> get-node open-node to my-self
        !          1272: my-self r> to my-self r> set-node ;
        !          1273: : select-dev  open-dev dup to my-self ihandle>phandle set-node ;
        !          1274: : find-device ( str len -- ) \ set as active node
        !          1275: find-node dup 0= ABORT" No such device path" set-node ;
        !          1276: : dev  skipws 0 parse find-device ;
        !          1277: : (lsprop) ( node --)
        !          1278: dup cr $indent indent @ type ."     node: " node>qname type
        !          1279: false +indent (.properties) cr -indent ;
        !          1280: : (show-children) ( node -- )
        !          1281: child BEGIN dup WHILE
        !          1282: dup (lsprop) dup child IF false +indent dup recurse -indent THEN peer
        !          1283: REPEAT drop
        !          1284: ;
        !          1285: : lsprop ( {device-specifier}<eol> -- )
        !          1286: skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN
        !          1287: find-device get-node dup dup
        !          1288: cr ." node: " node>path type (.properties) cr (show-children) 0 indent ! ;
        !          1289: : (node>path) node>path ;
        !          1290: : node>path ( phandle -- str len )
        !          1291: node>path dup allot
        !          1292: ;
        !          1293: 0 VALUE packages
        !          1294: : find-package  ( name len -- false | phandle true )
        !          1295: 0 >r packages child BEGIN dup WHILE dup >r node>name 2over string=ci r> swap
        !          1296: IF r> drop dup >r THEN peer REPEAT 3drop r> dup IF true THEN ;
        !          1297: : open-package ( arg len phandle -- ihandle | 0 )  open-node ;
        !          1298: : close-package ( ihandle -- )  close-node ;
        !          1299: : $open-package ( arg len name len -- ihandle | 0 )
        !          1300: find-package IF open-package ELSE 2drop false THEN ;
        !          1301: : pci-address-type  ( node address prop_type -- type )
        !          1302: -rot 2 pick ( prop_type node address prop_type )
        !          1303: 0= IF
        !          1304: swap s" reg" rot get-property  ( prop_type address data dlen false )
        !          1305: ELSE
        !          1306: swap s" assigned-addresses" rot get-property  ( prop_type address data dlen false )
        !          1307: THEN
        !          1308: IF  2drop -1  EXIT  THEN  4 / 5 /
        !          1309: 0 DO
        !          1310: dup l@ FF AND 0<> ( prop_type address data cfgspace_offset? )
        !          1311: 3 pick 0= ( prop_type address data cfgspace_offset? reg_prop? )
        !          1312: AND NOT IF 
        !          1313: 2dup 8 + ( prop_type address data address data' )
        !          1314: 2dup l@ 2 pick 8 + l@ + <= -rot l@  >= and  IF
        !          1315: l@ 03000000 and 18 rshift nip
        !          1316: dup 3 = IF  1-  THEN
        !          1317: swap drop ( type )
        !          1318: UNLOOP EXIT
        !          1319: THEN
        !          1320: THEN
        !          1321: 4 5 * +
        !          1322: LOOP
        !          1323: 3drop -1
        !          1324: ;
        !          1325: : (range-read-cells)  ( range-addr #cells -- range-value )
        !          1326: 1 =  IF  l@  ELSE  @  THEN
        !          1327: ;
        !          1328: : (map-one-range)  ( type range pnac nsc nac address -- address true | address false )
        !          1329: over 3 = 5 pick l@ 3000000 and 18 rshift 7 pick <> and  IF
        !          1330: >r 2drop 3drop r> false EXIT
        !          1331: THEN
        !          1332: 4 pick 4 pick 3 pick + 4 * +
        !          1333: 3 pick
        !          1334: (range-read-cells)
        !          1335: 5 pick 3 pick 3 =  IF
        !          1336: 4 +
        !          1337: THEN
        !          1338: 3 pick
        !          1339: (range-read-cells)
        !          1340: dup >r dup 3 pick > >r + over <= r> or  IF
        !          1341: >r 2drop 3drop r> r> drop false EXIT
        !          1342: THEN
        !          1343: dup r> -
        !          1344: 5 pick 5 pick 3 =  IF
        !          1345: 4 +
        !          1346: THEN
        !          1347: 3 pick 4 * +
        !          1348: 5 pick
        !          1349: (range-read-cells)
        !          1350: + >r 3drop 3drop r> true
        !          1351: ;
        !          1352: : translate-address  ( node address -- address )
        !          1353: 2dup 1 pci-address-type  ( node address type )
        !          1354: dup -1 = IF
        !          1355: drop 2dup 0 pci-address-type ( node address type )
        !          1356: THEN
        !          1357: rot parent BEGIN
        !          1358: dup parent 0=  IF  2drop EXIT  THEN
        !          1359: s" #address-cells" 2 pick get-property 2drop l@ >r        \ nac
        !          1360: s" #size-cells" 2 pick get-property 2drop l@ >r           \ nsc
        !          1361: s" #address-cells" 2 pick parent get-property 2drop l@ >r \ pnac
        !          1362: -rot ( node address type )
        !          1363: s" ranges" 4 pick get-property  IF
        !          1364: 3drop
        !          1365: ABORT" no ranges property; not translatable"
        !          1366: THEN
        !          1367: r> r> r> 3 roll
        !          1368: 4 / >r 3dup + + >r 5 roll r> r> swap / 0 ?DO
        !          1369: 6dup (map-one-range) IF
        !          1370: nip leave
        !          1371: THEN
        !          1372: nip
        !          1373: 4 roll
        !          1374: 4 pick 4 pick 4 pick + + 4 * + 4 -roll
        !          1375: LOOP
        !          1376: >r 2drop 2drop r> ( node type address )
        !          1377: swap rot parent ( address type node )
        !          1378: dup 0=
        !          1379: UNTIL
        !          1380: ;
        !          1381: : translate-my-address  ( address -- address' )
        !          1382: get-node swap translate-address
        !          1383: ;
        !          1384: : find-substr ( basestr-ptr basestr-len substr-ptr substr-len -- pos )
        !          1385: dup 0 = IF
        !          1386: 2drop 2drop 0 exit THEN
        !          1387: dup 3 pick <= IF
        !          1388: 2 pick over - 1+ 0 DO dup 0 DO
        !          1389: over i + c@ 4 pick j + i + c@ = IF
        !          1390: dup i 1+ = IF
        !          1391: 2drop 2drop j unloop unloop exit THEN
        !          1392: ELSE leave THEN
        !          1393: LOOP LOOP
        !          1394: THEN
        !          1395: 2drop nip
        !          1396: ;
        !          1397: : find-isubstr ( basestr-ptr basestr-len substr-ptr substr-len -- pos )
        !          1398: dup 0 = IF
        !          1399: 2drop 2drop 0 exit THEN
        !          1400: dup 3 pick <= IF
        !          1401: 2 pick over - 1+ 0 DO dup 0 DO
        !          1402: over i + c@ lcc 4 pick j + i + c@ lcc = IF
        !          1403: dup i 1+ = IF
        !          1404: 2drop 2drop j unloop unloop exit THEN
        !          1405: ELSE leave THEN
        !          1406: LOOP LOOP
        !          1407: THEN
        !          1408: 2drop nip
        !          1409: ;
        !          1410: : find-nextline ( str-ptr str-len -- pos )
        !          1411: dup 0 ?DO over i + c@ CASE
        !          1412: 0a OF
        !          1413: dup 1- i = IF
        !          1414: 2drop i 1+ unloop exit THEN
        !          1415: over i 1+ + c@ 0d = IF
        !          1416: 2drop i 2+ ELSE
        !          1417: 2drop i 1+ THEN
        !          1418: unloop exit
        !          1419: ENDOF
        !          1420: 0d OF
        !          1421: dup 1- i = IF
        !          1422: 2drop i 1+ unloop exit THEN
        !          1423: over i 1+ + c@ 0a = IF
        !          1424: 2drop i 2+ ELSE
        !          1425: 2drop i 1+ THEN
        !          1426: unloop exit
        !          1427: ENDOF
        !          1428: ENDCASE LOOP nip
        !          1429: ;
        !          1430: : string-at ( str1-ptr str1-len pos -- str2-ptr str2-len )
        !          1431: -rot 2 pick - -rot swap chars + swap
        !          1432: ;
        !          1433: : string-cat ( addr1 len1 addr2 len2 -- addr1 len1+len2 )
        !          1434: rot dup >r over + -rot
        !          1435: 3 pick r> chars + -rot
        !          1436: 0 ?DO
        !          1437: 2dup c@ swap c!
        !          1438: char+ swap char+ swap
        !          1439: LOOP 2drop
        !          1440: ;
        !          1441: : char-cat ( addr len character -- addr len+1 )
        !          1442: -rot 2dup >r >r 1+ rot r> r> chars + c!
        !          1443: ;
        !          1444: : overlap ( src dest size -- true|false )
        !          1445: 3dup over + within IF 3drop true ELSE rot tuck + within THEN
        !          1446: ;
        !          1447: : parse-2int ( str len -- val.lo val.hi )
        !          1448: [char] , split ?dup IF eval ELSE drop 0 THEN
        !          1449: -rot ?dup IF eval ELSE drop 0 THEN
        !          1450: ;
        !          1451: : cpeek ( addr -- false | byte true ) c@ true ;
        !          1452: : cpoke ( byte addr -- success? ) c! true ;
        !          1453: : wpeek ( addr -- false | word true ) w@ true ;
        !          1454: : wpoke ( word addr -- success? ) w! true ;
        !          1455: : lpeek ( addr -- false | lword true ) l@ true ;
        !          1456: : lpoke ( lword addr -- success? ) l! true ;
        !          1457: defer reboot ( -- )
        !          1458: defer halt ( -- )
        !          1459: defer disable-watchdog ( -- )
        !          1460: defer reset-watchdog ( -- )
        !          1461: defer set-watchdog ( +n -- )
        !          1462: defer set-led ( type instance state -- status )
        !          1463: defer get-flashside ( -- side )
        !          1464: defer set-flashside ( side -- status )
        !          1465: defer read-bootlist ( -- )
        !          1466: defer furnish-boot-file ( -- adr len )
        !          1467: defer set-boot-file ( adr len -- )
        !          1468: defer mfg-mode? ( -- flag )
        !          1469: defer of-prompt? ( -- flag )
        !          1470: defer debug-boot? ( -- flag )
        !          1471: defer bmc-version ( -- adr len )
        !          1472: defer cursor-on ( -- )
        !          1473: defer cursor-off ( -- )
        !          1474: : nop-reboot ( -- ) ." reboot not available" abort ;
        !          1475: : nop-halt ( -- ) ." halt not available" abort ;
        !          1476: : nop-disable-watchdog ( -- )  ;
        !          1477: : nop-reset-watchdog ( -- )  ;
        !          1478: : nop-set-watchdog ( +n -- ) drop ;
        !          1479: : nop-set-led ( type instance state -- status ) drop drop drop ;
        !          1480: : nop-get-flashside ( -- side ) ." Cannot get flashside" cr ABORT ;
        !          1481: : nop-set-flashside ( side -- status ) ." Cannot set flashside" cr ABORT ;
        !          1482: : nop-read-bootlist ( -- ) ;
        !          1483: : nop-furnish-bootfile ( -- adr len ) s" net:" ;
        !          1484: : nop-set-boot-file ( adr len -- ) 2drop ;
        !          1485: : nop-mfg-mode? ( -- flag ) false ;
        !          1486: : nop-of-prompt? ( -- flag ) false ;
        !          1487: : nop-debug-boot? ( -- flag ) false ;
        !          1488: : nop-bmc-version ( -- adr len ) s" XXXXX" ;
        !          1489: : nop-cursor-on ( -- ) ;
        !          1490: : nop-cursor-off ( -- ) ;
        !          1491: ' nop-reboot to reboot
        !          1492: ' nop-halt to halt
        !          1493: ' nop-disable-watchdog to disable-watchdog
        !          1494: ' nop-reset-watchdog   to reset-watchdog
        !          1495: ' nop-set-watchdog     to set-watchdog
        !          1496: ' nop-set-led          to set-led
        !          1497: ' nop-get-flashside    to get-flashside
        !          1498: ' nop-set-flashside    to set-flashside
        !          1499: ' nop-read-bootlist    to read-bootlist
        !          1500: ' nop-furnish-bootfile to furnish-boot-file
        !          1501: ' nop-set-boot-file    to set-boot-file
        !          1502: ' nop-mfg-mode?        to mfg-mode?
        !          1503: ' nop-of-prompt?       to of-prompt?
        !          1504: ' nop-debug-boot?      to debug-boot?
        !          1505: ' nop-bmc-version      to bmc-version
        !          1506: ' nop-cursor-on        to cursor-on
        !          1507: ' nop-cursor-off       to cursor-off
        !          1508: : reset-all reboot ;
        !          1509: 10000000 value load-base
        !          1510: 2000000 value flash-load-base
        !          1511: false constant <debug-dummy>
        !          1512: 12 34 2constant (2constant) ' (2constant) cell+ @
        !          1513: here 0
        !          1514: dup , dup , dup , dup , dup ,
        !          1515: over 7 cells + ,
        !          1516: dup , dup , dup , dup , dup ,
        !          1517: dup , drop
        !          1518: current-node ! \ FAKE!
        !          1519: 12 instance value (instancevalue) ' (instancevalue) cell+ @
        !          1520: instance variable (instancevariable) ' (instancevariable) cell+ @
        !          1521: instance defer (instancedefer) ' (instancedefer) cell+ @
        !          1522: 0 current-node !
        !          1523: forget <debug-dummy>
        !          1524: constant <instancedefer>
        !          1525: constant <instancevariable>
        !          1526: constant <instancevalue>
        !          1527: constant <2constant>
        !          1528: : xt>name ( xt -- str len )
        !          1529: BEGIN
        !          1530: cell - dup c@ 0 2 within IF
        !          1531: dup 2+ swap 1+ c@ exit
        !          1532: THEN
        !          1533: AGAIN
        !          1534: ;
        !          1535: cell -1 * CONSTANT -cell
        !          1536: : cell- ( n -- n-cell-size )
        !          1537: [ cell -1 * ] LITERAL +
        !          1538: ;
        !          1539: : find-xt-addr ( addr -- xt )
        !          1540: BEGIN
        !          1541: dup @ <colon> = IF
        !          1542: EXIT
        !          1543: THEN
        !          1544: cell-
        !          1545: AGAIN
        !          1546: ;
        !          1547: : (.immediate) ( xt -- )
        !          1548: xt>name drop 2 - c@ \ skip len and flags
        !          1549: immediate? IF
        !          1550: ."  IMMEDIATE"
        !          1551: THEN
        !          1552: ;
        !          1553: : (.xt) ( xt -- )
        !          1554: xt>name type
        !          1555: ;
        !          1556: : trace-back (  )
        !          1557: 1
        !          1558: BEGIN
        !          1559: cr dup dup . ."  : " rpick dup . ."  : "
        !          1560: ['] tib here within IF
        !          1561: dup rpick find-xt-addr (.xt)
        !          1562: THEN
        !          1563: 1+ dup rdepth 5 - >= IF cr drop EXIT THEN
        !          1564: AGAIN
        !          1565: ;
        !          1566: VARIABLE see-my-type-column
        !          1567: : (see-my-type) ( indent limit xt str len -- indent limit xt )
        !          1568: dup see-my-type-column @ + dup 50 >= IF
        !          1569: -rot over "  " comp 0= IF
        !          1570: 2drop see-my-type-column !
        !          1571: ELSE
        !          1572: rot drop                      ( indent limit xt str len )
        !          1573: 2 pick (u.) dup -rot cr type  ( indent limit xt str len xt-len )
        !          1574: " :" type 1+                  ( indent limit xt str len prefix-len )
        !          1575: 5 pick dup spaces +           ( indent limit xt str len prefix-len )
        !          1576: over + see-my-type-column !   ( indent limit xt str len )
        !          1577: type
        !          1578: THEN                          ( indent limit xt )
        !          1579: ELSE
        !          1580: see-my-type-column ! type     ( indent limit xt )
        !          1581: THEN
        !          1582: ;
        !          1583: : (see-my-type-init) ( -- )
        !          1584: ffff see-my-type-column !        \ just enforce a new line
        !          1585: ;
        !          1586: : (see-colon-body) ( indent limit xt -- indent limit xt )
        !          1587: (see-my-type-init)                              \ enforce new line
        !          1588: BEGIN                                           ( indent limit xt )
        !          1589: cell+ 2dup <>
        !          1590: over @
        !          1591: dup <semicolon> <>
        !          1592: rot and                                           ( indent limit xt @xt flag )
        !          1593: WHILE                                           ( indent limit xt @xt )
        !          1594: xt>name (see-my-type) "  " (see-my-type)
        !          1595: dup @                                        ( indent limit xt @xt)
        !          1596: CASE
        !          1597: <0branch>  OF cell+ dup @
        !          1598: over + cell+ dup >r
        !          1599: (u.) (see-my-type) r>          ( indent limit xt target)
        !          1600: 2dup < IF
        !          1601: over 4 pick 3 + -rot recurse
        !          1602: nip nip nip cell-           ( indent limit xt )
        !          1603: ELSE
        !          1604: drop                        ( indent limit xt )
        !          1605: THEN
        !          1606: (see-my-type-init) ENDOF       \ enforce new line
        !          1607: <branch>   OF cell+ dup @ over + cell+ (u.)
        !          1608: (see-my-type) "  " (see-my-type) ENDOF
        !          1609: <do?do>    OF cell+ dup @ (u.) (see-my-type)
        !          1610: "  " (see-my-type) ENDOF
        !          1611: <lit>      OF cell+ dup @ (u.) (see-my-type)
        !          1612: "  " (see-my-type) ENDOF
        !          1613: <dotick>   OF cell+ dup @ xt>name (see-my-type)
        !          1614: "  " (see-my-type) ENDOF
        !          1615: <doloop>   OF cell+ dup @ (u.) (see-my-type)
        !          1616: "  " (see-my-type) ENDOF
        !          1617: <doleave>  OF cell+ dup @ over + cell+ (u.)
        !          1618: (see-my-type) "  " (see-my-type) ENDOF
        !          1619: <do?leave> OF cell+ dup @ over + cell+ (u.)
        !          1620: (see-my-type) "  " (see-my-type) ENDOF
        !          1621: <sliteral> OF cell+ " """ (see-my-type) dup count dup >r
        !          1622: (see-my-type) " """ (see-my-type)
        !          1623: "  " (see-my-type)
        !          1624: r> -cell and + ENDOF
        !          1625: ENDCASE
        !          1626: REPEAT
        !          1627: drop
        !          1628: ;
        !          1629: : (see-colon) ( xt -- )
        !          1630: (see-my-type-init)
        !          1631: 1 swap 0 swap                                    ( indent limit xt )
        !          1632: " : " (see-my-type) dup xt>name (see-my-type)
        !          1633: rot drop 4 -rot (see-colon-body)                 ( indent limit xt )
        !          1634: rot drop 1 -rot (see-my-type-init) " ;" (see-my-type)
        !          1635: 3drop 
        !          1636: ;
        !          1637: : (see-create) ( xt -- )
        !          1638: dup cell+ @
        !          1639: CASE
        !          1640: <2constant> OF
        !          1641: dup cell+ cell+ dup @ swap cell+ @ . .  ." 2CONSTANT "
        !          1642: ENDOF
        !          1643: <instancevalue> OF
        !          1644: dup cell+ cell+ @ . ." INSTANCE VALUE "
        !          1645: ENDOF
        !          1646: <instancevariable> OF
        !          1647: ." INSTANCE VARIABLE "
        !          1648: ENDOF
        !          1649: dup OF
        !          1650: ." CREATE "
        !          1651: ENDOF
        !          1652: ENDCASE
        !          1653: (.xt)
        !          1654: ;
        !          1655: : (see) ( xt -- )
        !          1656: cr dup dup @
        !          1657: CASE
        !          1658: <variable> OF ." VARIABLE " (.xt) ENDOF
        !          1659: <value>    OF dup execute . ." VALUE " (.xt) ENDOF
        !          1660: <constant> OF dup execute . ." CONSTANT " (.xt) ENDOF
        !          1661: <defer>    OF dup cell+ @ swap ." DEFER " (.xt) ."  is " (.xt) ENDOF
        !          1662: <alias>    OF dup cell+ @ swap ." ALIAS " (.xt) ."  " (.xt) ENDOF
        !          1663: <buffer:>  OF ." BUFFER: " (.xt) ENDOF
        !          1664: <create>   OF (see-create) ENDOF
        !          1665: <colon>    OF (see-colon)  ENDOF
        !          1666: dup        OF ." ??? PRIM " (.xt) ENDOF
        !          1667: ENDCASE
        !          1668: (.immediate) cr
        !          1669: ;
        !          1670: : see ( "old-name<>" -- )
        !          1671: ' (see)
        !          1672: ;
        !          1673: 0    value forth-ip
        !          1674: true value trace>stepping?
        !          1675: true value trace>print?
        !          1676: true value trace>up?
        !          1677: 0    value trace>depth
        !          1678: 0    value trace>rdepth
        !          1679: 0    value trace>recurse
        !          1680: : trace-depth+ ( -- ) trace>depth 1+ to trace>depth ;
        !          1681: : trace-depth- ( -- ) trace>depth 1- to trace>depth ;
        !          1682: : stepping ( -- )
        !          1683: true to trace>stepping?
        !          1684: ;
        !          1685: : tracing ( -- )
        !          1686: false to trace>stepping?
        !          1687: ;
        !          1688: : trace-print-on ( -- )
        !          1689: true to trace>print?
        !          1690: ;
        !          1691: : trace-print-off ( -- )
        !          1692: false to trace>print?
        !          1693: ;
        !          1694: : fip-add ( n -- )
        !          1695: forth-ip + to forth-ip
        !          1696: ;
        !          1697: 0 value debug-last-xt
        !          1698: 0 value debug-last-xt-content
        !          1699: : trace-print ( -- )
        !          1700: forth-ip cr u. ." : "
        !          1701: forth-ip @ 
        !          1702: dup ['] breakpoint = IF drop debug-last-xt-content THEN
        !          1703: xt>name type ."  "
        !          1704: ."     ( " .s  ."  )  | "
        !          1705: ;
        !          1706: : trace-interpret ( -- )
        !          1707: rdepth 1- to trace>rdepth
        !          1708: BEGIN
        !          1709: depth . [char] > dup emit emit space
        !          1710: source expect                        ( str len )
        !          1711: ['] interpret catch print-status
        !          1712: AGAIN
        !          1713: ;
        !          1714: : trace-xt ( xt -- )
        !          1715: trace>recurse IF
        !          1716: r> drop                                \ Drop return of 'trace-xt call
        !          1717: cell+                                  \ Step over ":"
        !          1718: ELSE
        !          1719: debug-last-xt-content <colon> = IF
        !          1720: ['] breakpoint @ debug-last-xt !    \ Re-arm break point
        !          1721: r> drop                             \ Drop return of 'trace-xt call
        !          1722: cell+                               \ Step over ":"
        !          1723: ELSE
        !          1724: ['] breakpoint debug-last-xt !      \ Re-arm break point
        !          1725: 2r> 2drop
        !          1726: THEN
        !          1727: THEN
        !          1728: to forth-ip
        !          1729: true to trace>print?
        !          1730: BEGIN
        !          1731: trace>print? IF trace-print THEN
        !          1732: forth-ip                                              ( ip )
        !          1733: trace>stepping? IF
        !          1734: BEGIN
        !          1735: key
        !          1736: CASE
        !          1737: [char] d OF dup @ @ <colon> = IF             \ recurse only into colon definitions
        !          1738: trace-depth+
        !          1739: 1 to trace>recurse
        !          1740: dup >r @ recurse
        !          1741: THEN true ENDOF
        !          1742: [char] u OF trace>depth IF tracing trace-print-off true ELSE false THEN ENDOF
        !          1743: [char] f OF drop cr trace-interpret ENDOF      \ quit trace and start interpreter FIXME rstack
        !          1744: [char] c OF tracing true ENDOF
        !          1745: [char] t OF trace-back false ENDOF
        !          1746: [char] q OF drop cr quit ENDOF
        !          1747: 20       OF true ENDOF
        !          1748: dup      OF cr ." Press d:       Down into current word" cr
        !          1749: ." Press u:       Up to caller" cr
        !          1750: ." Press f:       Switch to forth interpreter, 'resume' will continue tracing" cr
        !          1751: ." Press c:       Switch to tracing" cr
        !          1752: ." Press <space>: Execute current word" cr
        !          1753: ." Press q:       Abort execution, switch to interpreter" cr
        !          1754: false ENDOF
        !          1755: ENDCASE
        !          1756: UNTIL
        !          1757: THEN                                                 ( ip' )
        !          1758: dup to forth-ip @                                      ( xt )
        !          1759: dup ['] breakpoint = IF drop debug-last-xt-content THEN
        !          1760: dup                                                    ( xt xt )
        !          1761: CASE
        !          1762: <sliteral>  OF drop forth-ip cell+ dup dup c@ + -cell and to forth-ip ENDOF
        !          1763: <dotick>    OF drop forth-ip cell+ @ cell fip-add ENDOF
        !          1764: <lit>       OF drop forth-ip cell+ @ cell fip-add ENDOF
        !          1765: <doto>      OF drop forth-ip cell+ @ cell+ ! cell fip-add ENDOF
        !          1766: <0branch>   OF drop IF
        !          1767: cell fip-add
        !          1768: ELSE
        !          1769: forth-ip cell+ @ cell+ fip-add THEN
        !          1770: ENDOF
        !          1771: <do?do>     OF drop 2dup <> IF
        !          1772: swap >r >r cell fip-add
        !          1773: ELSE
        !          1774: forth-ip cell+ @ cell+ fip-add 2drop THEN
        !          1775: ENDOF
        !          1776: <branch>    OF drop forth-ip cell+ @ cell+ fip-add ENDOF
        !          1777: <doleave>   OF drop r> r> 2drop forth-ip cell+ @ cell+ fip-add ENDOF           
        !          1778: <do?leave>  OF drop IF
        !          1779: r> r> 2drop forth-ip cell+ @ cell+ fip-add
        !          1780: ELSE
        !          1781: cell fip-add
        !          1782: THEN
        !          1783: ENDOF          
        !          1784: <doloop>    OF drop r> 1+ r> 2dup = IF
        !          1785: 2drop cell fip-add
        !          1786: ELSE >r >r
        !          1787: forth-ip cell+ @ cell+ fip-add THEN
        !          1788: ENDOF
        !          1789: <do+loop>   OF drop r> + r> 2dup >= IF
        !          1790: 2drop cell fip-add
        !          1791: ELSE >r >r
        !          1792: forth-ip cell+ @ cell+ fip-add THEN
        !          1793: ENDOF
        !          1794: <semicolon> OF trace>depth 0> IF
        !          1795: trace-depth- 1 to trace>recurse
        !          1796: stepping drop r> recurse
        !          1797: ELSE
        !          1798: drop exit THEN
        !          1799: ENDOF
        !          1800: <exit>      OF trace>depth 0> IF
        !          1801: trace-depth- stepping drop r> recurse
        !          1802: ELSE
        !          1803: drop exit THEN
        !          1804: ENDOF
        !          1805: dup         OF execute ENDOF
        !          1806: ENDCASE
        !          1807: forth-ip cell+ to forth-ip
        !          1808: AGAIN
        !          1809: ;
        !          1810: : resume ( -- )
        !          1811: trace>rdepth rdepth!
        !          1812: forth-ip cell - trace-xt
        !          1813: ;
        !          1814: : debug-off ( -- )
        !          1815: debug-last-xt IF
        !          1816: debug-last-xt-content debug-last-xt !  \ Restore overwriten token
        !          1817: 0 to debug-last-xt
        !          1818: THEN
        !          1819: ;
        !          1820: : (break-entry) ( -- )
        !          1821: debug-last-xt dup @ ['] breakpoint <> swap  ( debug-addr? debug-last-xt )
        !          1822: debug-last-xt-content swap !                \ Restore overwriten token
        !          1823: r> drop                                     \ Don't return to bp, but to caller
        !          1824: debug-last-xt-content <colon> <> and IF     \ Execute non colon definition
        !          1825: debug-last-xt cr u. ." : "
        !          1826: debug-last-xt xt>name type ."  "
        !          1827: ."     ( " .s  ."  )  | "
        !          1828: key drop
        !          1829: debug-last-xt execute
        !          1830: ELSE
        !          1831: debug-last-xt 0 to trace>depth 0 to trace>recurse trace-xt   \ Trace colon definition
        !          1832: THEN
        !          1833: ;
        !          1834: ' (break-entry) to BP
        !          1835: : debug-address ( addr --  )
        !          1836: debug-off                       ( xt )  \ Remove active breakpoint
        !          1837: dup to debug-last-xt            ( xt )  \ Save token for later debug
        !          1838: dup @ to debug-last-xt-content  ( xt )  \ Save old value
        !          1839: ['] breakpoint swap !
        !          1840: ;
        !          1841: : (debug ( xt --  )
        !          1842: debug-off                       ( xt )  \ Remove active breakpoint
        !          1843: dup to debug-last-xt            ( xt )  \ Save token for later debug
        !          1844: dup @ to debug-last-xt-content  ( xt )  \ Save old value
        !          1845: ['] breakpoint @ swap !
        !          1846: ;
        !          1847: : debug ( "old-name<>" -- )
        !          1848: parse-word $find IF                       \ Get xt for old-name
        !          1849: (debug
        !          1850: ELSE
        !          1851: ." undefined word " type cr
        !          1852: THEN
        !          1853: ;
        !          1854: : words
        !          1855: last @
        !          1856: BEGIN ?dup WHILE
        !          1857: dup cell+ char+ count type space @
        !          1858: REPEAT
        !          1859: ;
        !          1860: : .calls    ( xt -- )
        !          1861: current-node @ >r 0 set-node    \ only search commands, according too IEEE1275
        !          1862: last BEGIN @ ?dup WHILE    ( xt currxt )
        !          1863: dup cell+ char+         ( xt currxt name* )
        !          1864: dup dup c@ + 1+ aligned ( xt currxt name* CFA )
        !          1865: dup @ <colon> = IF      ( xt currxt name* CFA )
        !          1866: BEGIN
        !          1867: cell+ dup @ ['] semicolon <>
        !          1868: WHILE                ( xt currxt *name pos )
        !          1869: dup @ 4 pick = IF ( xt currxt *name pos )
        !          1870: over count type space
        !          1871: BEGIN cell+ dup @ ['] semicolon = UNTIL cell - \ eat up other occurences
        !          1872: THEN
        !          1873: REPEAT
        !          1874: THEN
        !          1875: 2drop ( xt currxt )
        !          1876: REPEAT
        !          1877: drop
        !          1878: r> set-node               \ restore node
        !          1879: ;
        !          1880: 0 value #sift-count
        !          1881: false value sift-compl-only
        !          1882: : $inner-sift ( text-addr text-len LFA -- ... word-addr word-len true | false )
        !          1883: dup cell+ char+ count           \ get word name
        !          1884: 2dup 6 pick 6 pick find-isubstr \ is there a partly match?
        !          1885: sift-compl-only IF 0= ELSE over < THEN
        !          1886: IF
        !          1887: #sift-count 1+ to #sift-count \ count completions
        !          1888: true
        !          1889: ELSE
        !          1890: 2drop false
        !          1891: THEN
        !          1892: ;
        !          1893: : $sift    ( text-addr text-len -- )
        !          1894: current-node @ >r 0 set-node   \ only search commands, according too IEEE1275
        !          1895: sift-compl-only >r false to sift-compl-only \ all substrings, not only compl.
        !          1896: last BEGIN @ ?dup WHILE        \ walk the whole dictionary
        !          1897: $inner-sift IF type space THEN
        !          1898: REPEAT
        !          1899: 2drop
        !          1900: 0 to #sift-count          \ we don't need completions here.
        !          1901: r> to sift-compl-only    \ restore previous sifting mode
        !          1902: r> set-node               \ restore node
        !          1903: ;
        !          1904: : sifting    ( "text< >" -- )
        !          1905: parse-word $sift
        !          1906: ;
        !          1907: defer '(r@)
        !          1908: defer '(r!)
        !          1909: 1 VALUE /(r)
        !          1910: : (rfill) ( addr size pattern 'r! /r -- )
        !          1911: to /(r) to '(r!) ff and
        !          1912: dup 8 lshift or dup 10 lshift or dup 20 lshift or
        !          1913: -rot bounds ?do dup i '(r!) /(r) +loop drop
        !          1914: ;
        !          1915: : (fwrmove) ( src dest size -- )
        !          1916: >r 0 -rot r> bounds ?do + dup '(r@) i '(r!) /(r) dup +loop 2drop
        !          1917: ;
        !          1918: : mrmove ( src dest size -- )
        !          1919: 3dup or or 7 AND CASE
        !          1920: 0 OF ['] x@ ['] rx! /x ENDOF
        !          1921: 4 OF ['] l@ ['] rl! /l ENDOF
        !          1922: 2 OF ['] w@ ['] rw! /w ENDOF
        !          1923: dup OF ['] c@ ['] rb! /c ENDOF
        !          1924: ENDCASE
        !          1925: to /(r) to '(r!) to '(r@) (fwrmove)
        !          1926: ;
        !          1927: : rfill ( addr size pattern -- )
        !          1928: 3dup drop or 7 AND CASE
        !          1929: 0 OF ['] rx! /x ENDOF
        !          1930: 4 OF ['] rl! /l ENDOF
        !          1931: 2 OF ['] rw! /w ENDOF
        !          1932: dup OF ['] rb! /c ENDOF
        !          1933: ENDCASE (rfill)
        !          1934: ;
        !          1935: : ([IF])
        !          1936: BEGIN
        !          1937: BEGIN parse-word dup 0= WHILE
        !          1938: 2drop refill
        !          1939: REPEAT
        !          1940: 2dup s" [IF]" str= IF 1 throw THEN
        !          1941: 2dup s" [ELSE]" str= IF 2 throw THEN
        !          1942: 2dup s" [THEN]" str= IF 3 throw THEN
        !          1943: s" \" str= IF linefeed parse 2drop THEN
        !          1944: AGAIN
        !          1945: ;
        !          1946: : [IF] ( flag -- )
        !          1947: IF exit THEN
        !          1948: 1 BEGIN
        !          1949: ['] ([IF]) catch 
        !          1950: CASE
        !          1951: 1 OF 1+ ENDOF
        !          1952: 2 OF dup 1 = if 1- then ENDOF
        !          1953: 3 OF 1- ENDOF
        !          1954: ENDCASE
        !          1955: dup 0 <=
        !          1956: UNTIL drop
        !          1957: ; immediate
        !          1958: : [ELSE] 0 [COMPILE] [IF] ; immediate
        !          1959: : [THEN] ; immediate
        !          1960: : $dnumber base @ >r decimal $number r> base ! ;
        !          1961: : (.d) base @ >r decimal (.) r> base ! ;
        !          1962: : (ipaddr) ( "a.b.c.d" -- FALSE | n1 n2 n3 n4 TRUE )
        !          1963: base @ >r decimal
        !          1964: over s" 000.000.000.000" comp 0= IF 2drop false r> base ! EXIT THEN
        !          1965: [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot
        !          1966: [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot
        !          1967: [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot
        !          1968: $number IF false r> base ! EXIT THEN
        !          1969: true r> base !
        !          1970: ;
        !          1971: : (ipformat)  ( n1 n2 n3 n4 -- str len )
        !          1972: base @ >r decimal
        !          1973: 0 <# # # # [char] . hold drop # # # [char] . hold
        !          1974: drop # # # [char] . hold drop # # #s #>
        !          1975: r> base !
        !          1976: ;
        !          1977: : ipformat  ( n1 n2 n3 n4 -- ) (ipformat) type ;
        !          1978: deadbeef here l!
        !          1979: here c@ de = CONSTANT ?bigendian
        !          1980: here c@ ef = CONSTANT ?littleendian
        !          1981: ?bigendian [IF]
        !          1982: : l!-le  >r lbflip r> l! ;
        !          1983: : l@-le  l@ lbflip ;
        !          1984: : w!-le  >r wbflip r> w! ;
        !          1985: : w@-le  w@ wbflip ;
        !          1986: : rl!-le  >r lbflip r> rl! ;
        !          1987: : rl@-le  rl@ lbflip ;
        !          1988: : rw!-le  >r wbflip r> rw! ;
        !          1989: : rw@-le  rw@ wbflip ;
        !          1990: : l!-be  l! ;
        !          1991: : l@-be  l@ ;
        !          1992: : w!-be  w! ;
        !          1993: : w@-be  w@ ;
        !          1994: : rl!-be  rl! ;
        !          1995: : rl@-be  rl@ ;
        !          1996: : rw!-be  rw! ;
        !          1997: : rw@-be  rw@ ;
        !          1998: [ELSE]
        !          1999: : l!-le  l! ;
        !          2000: : l@-le  l@ ;
        !          2001: : w!-le  w! ;
        !          2002: : w@-le  w@ ;
        !          2003: : rl!-le  rl! ;
        !          2004: : rl@-le  rl@ ;
        !          2005: : rw!-le  rw! ;
        !          2006: : rw@-le  rw@ ;
        !          2007: : l!-be  >r lbflip r> l! ;
        !          2008: : l@-be  l@ lbflip ;
        !          2009: : w!-be  >r wbflip r> w! ;
        !          2010: : w@-be  w@ wbflip ;
        !          2011: : rl!-be  >r lbflip r> rl! ;
        !          2012: : rl@-be  rl@ lbflip ;
        !          2013: : rw!-be  >r wbflip r> rw! ;
        !          2014: : rw@-be  rw@ wbflip ;
        !          2015: [THEN]
        !          2016: : #join  ( lo hi #bits -- x )  lshift or ;
        !          2017: : #split ( x #bits -- lo hi )  2dup rshift dup >r swap lshift xor r> ;
        !          2018: : blink ;
        !          2019: : reset-dual-emit ;
        !          2020: : console-clean-fifo ;
        !          2021: : bootmsg-nvupdate ;
        !          2022: : asm-cout 2drop drop ;
        !          2023: defer nvramlog-write-byte
        !          2024: : .nvramlog-write-byte ( byte -- )
        !          2025: drop
        !          2026: ;
        !          2027: ' .nvramlog-write-byte to nvramlog-write-byte
        !          2028: : nvramlog-write-string ( str len -- )
        !          2029: dup 0> IF
        !          2030: 0 DO dup c@ 
        !          2031: nvramlog-write-byte char+ LOOP
        !          2032: ELSE
        !          2033: drop
        !          2034: THEN drop ;
        !          2035: : nvramlog-write-number ( number format -- )
        !          2036: 0 swap <# 0 ?DO # LOOP #> 
        !          2037: nvramlog-write-string ;
        !          2038: : nvramlog-write-string-cr ( str len -- )
        !          2039: nvramlog-write-string
        !          2040: a nvramlog-write-byte d nvramlog-write-byte ;
        !          2041: : log-string ( str len -- ) type ;
        !          2042: : log-string 2drop ;
        !          2043: create debugstr 255 allot
        !          2044: 0 VALUE debuglen
        !          2045: : cp ( checkpoint -- )
        !          2046: bootmsg-cp ;
        !          2047: : (warning) ( id level ptr len -- )
        !          2048: dup TO debuglen
        !          2049: debugstr swap move           \ copy into buffer
        !          2050: 0 debuglen debugstr + c!     \ terminate '\0'
        !          2051: debugstr bootmsg-warning
        !          2052: ;
        !          2053: : warning" ( id level [text<">] -- )
        !          2054: postpone s" state @
        !          2055: IF
        !          2056: ['] (warning) compile,
        !          2057: ELSE
        !          2058: (warning)
        !          2059: THEN
        !          2060: ; immediate
        !          2061: : (debug-cp) ( id level ptr len -- )
        !          2062: dup TO debuglen
        !          2063: debugstr swap move           \ copy into buffer
        !          2064: 0 debuglen debugstr + c!     \ terminate '\0'
        !          2065: debugstr bootmsg-debugcp
        !          2066: ;
        !          2067: : debug-cp" ( id level [text<">] -- )
        !          2068: postpone s" state @
        !          2069: IF
        !          2070: ['] (debug-cp) compile,
        !          2071: ELSE
        !          2072: (debug-cp)
        !          2073: THEN
        !          2074: ; immediate
        !          2075: : (error) ( id ptr len -- )
        !          2076: dup TO debuglen
        !          2077: debugstr swap move           \ copy into buffer
        !          2078: 0 debuglen debugstr + c!     \ terminate '\0'
        !          2079: debugstr bootmsg-error
        !          2080: ;
        !          2081: : error" ( id level [text<">] -- )
        !          2082: postpone s" state @
        !          2083: IF
        !          2084: ['] (error) compile,
        !          2085: ELSE
        !          2086: (error)
        !          2087: THEN
        !          2088: ; immediate
        !          2089: bootmsg-nvupdate
        !          2090: 000 cp
        !          2091: STRUCT
        !          2092: cell FIELD >r0   cell FIELD >r1   cell FIELD >r2   cell FIELD >r3
        !          2093: cell FIELD >r4   cell FIELD >r5   cell FIELD >r6   cell FIELD >r7
        !          2094: cell FIELD >r8   cell FIELD >r9   cell FIELD >r10  cell FIELD >r11
        !          2095: cell FIELD >r12  cell FIELD >r13  cell FIELD >r14  cell FIELD >r15
        !          2096: cell FIELD >r16  cell FIELD >r17  cell FIELD >r18  cell FIELD >r19
        !          2097: cell FIELD >r20  cell FIELD >r21  cell FIELD >r22  cell FIELD >r23
        !          2098: cell FIELD >r24  cell FIELD >r25  cell FIELD >r26  cell FIELD >r27
        !          2099: cell FIELD >r28  cell FIELD >r29  cell FIELD >r30  cell FIELD >r31
        !          2100: cell FIELD >cr   cell FIELD >xer  cell FIELD >lr   cell FIELD >ctr
        !          2101: cell FIELD >srr0 cell FIELD >srr1 cell FIELD >dar  cell FIELD >dsisr
        !          2102: CONSTANT ciregs-size
        !          2103: : .16  10 0.r 3 spaces ;
        !          2104: : .8   8 spaces 8 0.r 3 spaces ;
        !          2105: : .4regs  cr 4 0 DO dup @ .16 8 cells+ LOOP drop ;
        !          2106: : .fixed-regs
        !          2107: cr ."     R0 .. R7           R8 .. R15         R16 .. R23         R24 .. R31"
        !          2108: dup 8 0 DO dup .4regs cell+ LOOP drop
        !          2109: ;
        !          2110: : .special-regs
        !          2111: cr ."     CR / XER           LR / CTR          SRR0 / SRR1        DAR / DSISR"
        !          2112: cr dup >cr  @ .8   dup >lr  @ .16  dup >srr0 @ .16  dup >dar @ .16
        !          2113: cr dup >xer @ .16  dup >ctr @ .16  dup >srr1 @ .16    >dsisr @ .8
        !          2114: ;
        !          2115: : .regs
        !          2116: cr .fixed-regs
        !          2117: cr .special-regs
        !          2118: cr cr
        !          2119: ;
        !          2120: : .hw-exception ( reason-code exception-nr -- )
        !          2121: ." ( " dup . ." ) "
        !          2122: CASE
        !          2123: 200 OF ." Machine Check" ENDOF
        !          2124: 300 OF ." Data Storage" ENDOF
        !          2125: 380 OF ." Data Segment" ENDOF
        !          2126: 400 OF ." Intruction Storage" ENDOF
        !          2127: 480 OF ." Instruction Segment" ENDOF
        !          2128: 500 OF ." External" ENDOF
        !          2129: 600 OF ." Alignment" ENDOF
        !          2130: 700 OF ." Program" ENDOF
        !          2131: 800 OF ." Floating-point unavailable" ENDOF
        !          2132: 900 OF ." Decrementer" ENDOF
        !          2133: 980 OF ." Hypervisor Decrementer" ENDOF
        !          2134: C00 OF ." System Call" ENDOF
        !          2135: D00 OF ." Trace" ENDOF
        !          2136: F00 OF ." Performance Monitor" ENDOF
        !          2137: F20 OF ." VMX Unavailable" ENDOF
        !          2138: 1200 OF ." System Error" ENDOF
        !          2139: 1600 OF ." Maintenance" ENDOF
        !          2140: 1800 OF ." Thermal" ENDOF
        !          2141: dup OF ." Unknown" ENDOF
        !          2142: ENDCASE
        !          2143: ."  Exception [ " . ." ]"
        !          2144: ;
        !          2145: : .sw-exception ( exception-nr -- )
        !          2146: ."  Exception [ " . ." ] triggered by boot firmware."
        !          2147: ;
        !          2148: : be-hw-exception ( [reason-code] exception-nr -- )
        !          2149: cr cr
        !          2150: dup 0> IF .hw-exception ELSE .sw-exception THEN
        !          2151: cr eregs .regs
        !          2152: ;
        !          2153: ' be-hw-exception to hw-exception-handler
        !          2154: : (boot-exception-handler) ( x1...xn exception-nr -- x1...xn)
        !          2155: dup IF
        !          2156: dup 0 > IF
        !          2157: negate cp 9 emit ." : " type
        !          2158: ELSE
        !          2159: CASE
        !          2160: -6d OF cr ." W3411: Client application returned." cr ENDOF
        !          2161: -6c OF cr ." E3400: It was not possible to boot from any device "
        !          2162: ." specified in the VPD." cr
        !          2163: ENDOF
        !          2164: -6b OF cr ." E3410: Boot list successfully read from VPD "
        !          2165: ." but no useful information received." cr
        !          2166: ENDOF
        !          2167: -6a OF cr ." E3420: Boot list could not be read from VPD." cr
        !          2168: ENDOF
        !          2169: -69 OF
        !          2170: cr ." E3406: Client application returned an error"
        !          2171: abort"-str @ count dup IF
        !          2172: ." :    " type cr
        !          2173: ELSE
        !          2174: ." ." cr
        !          2175: 2drop
        !          2176: THEN
        !          2177: ENDOF
        !          2178: -68 OF cr ." E3405: No such device" cr ENDOF
        !          2179: -67 OF cr ." E3404: Not a bootable device!" cr ENDOF
        !          2180: -66 OF cr ." E3408: Failed to claim memory for the executable" cr
        !          2181: ENDOF
        !          2182: -65 OF cr ." E3407: Load failed" cr ENDOF
        !          2183: -64 OF cr ." E3403: Bad executable:   " abort"-str @ count type cr
        !          2184: ENDOF
        !          2185: -63 OF cr ." E3409: Unknown FORTH Word" cr ENDOF
        !          2186: -2 OF cr ." E3401: Aborting boot,  " abort"-str @ count type cr
        !          2187: ENDOF
        !          2188: dup OF ." E3402: Aborting boot, internal error" cr ENDOF
        !          2189: ENDCASE
        !          2190: THEN
        !          2191: ELSE
        !          2192: drop
        !          2193: THEN
        !          2194: ;
        !          2195: ' (boot-exception-handler) to boot-exception-handler
        !          2196: : throw-error ( error-code "error-string" -- )
        !          2197: skipws 0a parse rot throw
        !          2198: ;
        !          2199: : enable-ext-int ( -- )
        !          2200: msr@ 8000 or msr!
        !          2201: ;
        !          2202: : disable-ext-int ( -- )
        !          2203: msr@ 8000 not and msr!
        !          2204: ;
        !          2205: : gen-ext-int ( -- )
        !          2206: 7fffffff dec!               \ Reset decrementer
        !          2207: enable-ext-int              \ Enable interrupt
        !          2208: FF 20000508418 rx!          \ Interrupt priority mask
        !          2209: 10 20000508410 rx!          \ Interrupt priority
        !          2210: ;
        !          2211: : mm-log-warning 2drop ;
        !          2212: : write-mm-log ( data length type -- status )
        !          2213: 3drop 0
        !          2214: ;
        !          2215: 080 cp
        !          2216: 100 cp
        !          2217: : beep  bell emit ;
        !          2218: : TABLE-EXECUTE
        !          2219: CREATE DOES> swap cells+ @ ?dup IF execute ELSE beep THEN ;
        !          2220: 0 VALUE accept-adr
        !          2221: 0 VALUE accept-max
        !          2222: 0 VALUE accept-len
        !          2223: 0 VALUE accept-cur
        !          2224: : esc  1b emit ;
        !          2225: : csi  esc 5b emit ;
        !          2226: : move-cursor ( -- )
        !          2227: esc ." 8" accept-cur IF
        !          2228: csi base @ decimal accept-cur 0 .r base ! ." C"
        !          2229: THEN
        !          2230: ;
        !          2231: : redraw-line ( -- )
        !          2232: accept-cur accept-len = IF EXIT THEN
        !          2233: move-cursor
        !          2234: accept-adr accept-len accept-cur /string type
        !          2235: csi ." K" move-cursor
        !          2236: ;
        !          2237: : full-redraw-line ( -- )
        !          2238: accept-cur 0 to accept-cur move-cursor
        !          2239: accept-adr accept-len type
        !          2240: csi ." K" to accept-cur move-cursor
        !          2241: ;
        !          2242: : redraw-prompt ( -- )
        !          2243: cr depth . [char] > emit
        !          2244: ;
        !          2245: : insert-char ( char -- )
        !          2246: accept-len accept-max = IF drop beep EXIT THEN
        !          2247: accept-cur accept-len <> IF csi ." @" dup emit
        !          2248: accept-adr accept-cur + dup 1+ accept-len accept-cur - move
        !          2249: ELSE dup emit THEN
        !          2250: accept-adr accept-cur + c!
        !          2251: accept-cur 1+ to accept-cur
        !          2252: accept-len 1+ to accept-len redraw-line
        !          2253: ;
        !          2254: : delete-char ( -- )
        !          2255: accept-cur accept-len = IF beep EXIT THEN
        !          2256: accept-len 1- to accept-len
        !          2257: accept-adr accept-cur + dup 1+ swap accept-len accept-cur - move
        !          2258: csi ." P" redraw-line
        !          2259: ;
        !          2260: STRUCT
        !          2261: cell FIELD his>next
        !          2262: cell FIELD his>prev
        !          2263: cell FIELD his>len
        !          2264: 0 FIELD his>buf
        !          2265: CONSTANT /his
        !          2266: 0 VALUE his-head
        !          2267: 0 VALUE his-tail
        !          2268: 0 VALUE his-cur
        !          2269: : add-history ( -- )
        !          2270: accept-len 0= IF EXIT THEN
        !          2271: /his accept-len + alloc-mem
        !          2272: his-tail IF dup his-tail his>next ! ELSE dup to his-head THEN
        !          2273: his-tail over his>prev !  0 over his>next !  dup to his-tail
        !          2274: accept-len over his>len !  accept-adr swap his>buf accept-len move
        !          2275: ;
        !          2276: : history  ( -- )
        !          2277: his-head BEGIN dup WHILE
        !          2278: cr dup his>buf over his>len @ type
        !          2279: his>next @ REPEAT drop
        !          2280: ;
        !          2281: : select-history ( his -- )
        !          2282: dup to his-cur dup IF
        !          2283: dup his>len @ accept-max min dup to accept-len to accept-cur
        !          2284: his>buf accept-adr accept-len move ELSE
        !          2285: drop 0 to accept-len 0 to accept-cur THEN
        !          2286: full-redraw-line
        !          2287: ;
        !          2288: 0 value ?tab-pressed
        !          2289: 0 value tab-last-adr
        !          2290: 0 value tab-last-len
        !          2291: : $same-string ( addr-1 len-1 addr-2 len-2 -- addr-1 len-1' )
        !          2292: dup 0= IF    \ The second parameter is not a string.
        !          2293: 2drop EXIT \ bail out
        !          2294: THEN
        !          2295: rot min 0 0 -rot ( addr1 addr2 0 len' 0 )
        !          2296: DO ( addr1 addr2 len-1' )
        !          2297: 2 pick i + c@ lcc
        !          2298: 2 pick i + c@ lcc
        !          2299: = IF 1 + ELSE leave THEN
        !          2300: LOOP
        !          2301: nip
        !          2302: ;
        !          2303: : $tab-sift-words    ( text-addr text-len -- sift-count )
        !          2304: sift-compl-only >r true to sift-compl-only \ save sifting mode
        !          2305: last BEGIN @ ?dup WHILE \ loop over all words
        !          2306: $inner-sift IF \ any completions possible?
        !          2307: 2dup bounds DO I c@ lcc I c! LOOP
        !          2308: ?tab-pressed IF 2dup type space THEN  \ <tab><tab> prints possibilities
        !          2309: tab-last-adr tab-last-len $same-string \ find matching substring ...
        !          2310: to tab-last-len to tab-last-adr       \ ... and save it
        !          2311: THEN
        !          2312: repeat
        !          2313: 2drop
        !          2314: #sift-count 0 to #sift-count   \ how many words were found?
        !          2315: r> to sift-compl-only          \ restore sifting completion mode
        !          2316: ;
        !          2317: 0 value current-stack
        !          2318: : new-stack ( cells <>name -- )
        !          2319: create >r here    ( here R: cells )
        !          2320: dup r@ 2 + cells  ( here here bytes R: cells )
        !          2321: dup allot erase   ( here R: cells)
        !          2322: cell+ r>          ( here+1cell cells )
        !          2323: swap !            ( )
        !          2324: DOES> to current-stack
        !          2325: ;
        !          2326: : reset-stack ( -- )
        !          2327: 0 current-stack !
        !          2328: ;
        !          2329: : stack-depth ( -- depth )
        !          2330: current-stack @
        !          2331: ;
        !          2332: : push ( value -- )
        !          2333: current-stack @
        !          2334: current-stack cell+ @ over <= ABORT" Stack overflow"
        !          2335: cells
        !          2336: 1 current-stack +!
        !          2337: current-stack 2 cells + + !
        !          2338: ;
        !          2339: : pop ( -- value )
        !          2340: current-stack @ 0= ABORT" Stack underflow"
        !          2341: current-stack @ cells
        !          2342: current-stack + cell+ @
        !          2343: -1 current-stack +!
        !          2344: ;
        !          2345: 10 new-stack device-stack
        !          2346: : (next-dev) ( node -- node' addr len )
        !          2347: device-stack
        !          2348: dup (node>path) rot
        !          2349: dup child IF dup push child -rot EXIT THEN
        !          2350: dup peer IF peer -rot EXIT THEN
        !          2351: drop
        !          2352: BEGIN
        !          2353: stack-depth
        !          2354: WHILE
        !          2355: pop peer ?dup IF -rot EXIT THEN
        !          2356: REPEAT
        !          2357: 0 -rot
        !          2358: ;
        !          2359: : $inner-sift-nodes ( text-addr text-len node -- ... path-addr path-len true | false )
        !          2360: (next-dev) ( text-addr text-len node' path-addr path-len )
        !          2361: dup 0= IF drop false EXIT THEN
        !          2362: 2dup 6 pick 6 pick find-isubstr ( text-addr text-len node' path-addr path-len pos )
        !          2363: 0= IF
        !          2364: #sift-count 1+ to #sift-count \ count completions
        !          2365: true
        !          2366: ELSE
        !          2367: 2drop false
        !          2368: THEN
        !          2369: ;
        !          2370: : .nodes ( -- )
        !          2371: s" /" find-node BEGIN dup WHILE
        !          2372: (next-dev)
        !          2373: type cr
        !          2374: REPEAT
        !          2375: drop
        !          2376: reset-stack
        !          2377: ;
        !          2378: create sift-node-buffer 1000 allot
        !          2379: 0 value sift-node-num
        !          2380: : sift-node-buffer
        !          2381: sift-node-buffer sift-node-num 100 * +
        !          2382: sift-node-num 1+ dup 10 = IF drop 0 THEN
        !          2383: to sift-node-num
        !          2384: ;
        !          2385: : $tab-sift-nodes    ( text-addr text-len -- sift-count )
        !          2386: s" /" find-node BEGIN dup WHILE
        !          2387: $inner-sift-nodes IF \ any completions possible?
        !          2388: sift-node-buffer swap 2>r 2r@ move 2r> \ make an almost permanent copy without strdup
        !          2389: ?tab-pressed IF 2dup type space THEN  \ <tab><tab> prints possibilities
        !          2390: tab-last-adr tab-last-len $same-string \ find matching substring ...
        !          2391: to tab-last-len to tab-last-adr       \ ... and save it
        !          2392: THEN
        !          2393: REPEAT
        !          2394: 2drop drop
        !          2395: #sift-count 0 to #sift-count   \ how many words were found?
        !          2396: reset-stack
        !          2397: ;
        !          2398: : $tab-sift    ( text-addr text-len -- sift-count )
        !          2399: ?tab-pressed IF beep space THEN \ cosmetical fix for <tab><tab>
        !          2400: dup IF bl rsplit dup IF 2swap THEN ELSE 0 0 THEN >r >r
        !          2401: 0 dup to tab-last-len to tab-last-adr  \ reset last possible match
        !          2402: current-node @ IF                      \ if we are in a node?
        !          2403: 2dup 2>r                               \ save text
        !          2404: $tab-sift-words to #sift-count \ search in current node first
        !          2405: 2r>                            \ fetch text to complete, again
        !          2406: THEN
        !          2407: 2dup 2>r
        !          2408: current-node @ >r 0 set-node           \ now search in global words
        !          2409: $tab-sift-words to #sift-count
        !          2410: r> set-node
        !          2411: 2r> $tab-sift-nodes
        !          2412: r> r> dup IF s"  " $cat THEN tab-last-adr tab-last-len $cat
        !          2413: to tab-last-len to tab-last-adr  \ ... and save the whole string
        !          2414: ;
        !          2415: : handle-^A
        !          2416: 0 to accept-cur move-cursor ;
        !          2417: : handle-^B
        !          2418: accept-cur ?dup IF 1- to accept-cur ( csi ." D" ) move-cursor THEN ;
        !          2419: : handle-^D
        !          2420: delete-char ( redraw-line ) ;
        !          2421: : handle-^E
        !          2422: accept-len to accept-cur move-cursor ;
        !          2423: : handle-^F
        !          2424: accept-cur accept-len <> IF accept-cur 1+ to accept-cur csi ." C" THEN ;
        !          2425: : handle-^H
        !          2426: accept-cur 0= IF beep EXIT THEN
        !          2427: handle-^B delete-char
        !          2428: ;
        !          2429: : handle-^I
        !          2430: accept-adr accept-len
        !          2431: $tab-sift 0 > IF
        !          2432: ?tab-pressed IF
        !          2433: redraw-prompt full-redraw-line
        !          2434: false to ?tab-pressed
        !          2435: ELSE
        !          2436: tab-last-adr accept-adr tab-last-len move    \ copy matching substring
        !          2437: tab-last-len dup to accept-len to accept-cur \ len and cursor position
        !          2438: full-redraw-line               \ redraw new string
        !          2439: true to ?tab-pressed   \ second tab will print possible matches
        !          2440: THEN
        !          2441: THEN
        !          2442: ;
        !          2443: : handle-^K
        !          2444: BEGIN accept-cur accept-len <> WHILE delete-char REPEAT ;
        !          2445: : handle-^L
        !          2446: history redraw-prompt full-redraw-line ;
        !          2447: : handle-^N
        !          2448: his-cur IF his-cur his>next @ ELSE his-head THEN
        !          2449: dup to his-cur select-history
        !          2450: ;
        !          2451: : handle-^P
        !          2452: his-cur IF his-cur his>prev @ ELSE his-tail THEN
        !          2453: dup to his-cur select-history
        !          2454: ;
        !          2455: : handle-^Q  \ Does not handle terminal formatting yet.
        !          2456: key insert-char ;
        !          2457: : handle-^R
        !          2458: full-redraw-line ;
        !          2459: : handle-^U
        !          2460: 0 to accept-len 0 to accept-cur full-redraw-line ;
        !          2461: : handle-fn
        !          2462: key drop beep
        !          2463: ;
        !          2464: TABLE-EXECUTE handle-CSI
        !          2465: 0 , ' handle-^P , ' handle-^N , ' handle-^F ,
        !          2466: ' handle-^B , 0 , 0 , 0 ,
        !          2467: ' handle-^A , 0 , 0 , ' handle-^E ,
        !          2468: 0 , 0 , 0 , 0 ,
        !          2469: 0 , 0 , 0 , 0 ,
        !          2470: 0 , 0 , 0 , 0 ,
        !          2471: 0 , 0 , 0 , 0 ,
        !          2472: 0 , 0 , 0 , 0 ,
        !          2473: TABLE-EXECUTE handle-meta
        !          2474: 0 , 0 , 0 , 0 ,
        !          2475: 0 , 0 , 0 , 0 ,
        !          2476: 0 , 0 , 0 , 0 ,
        !          2477: 0 , 0 , 0 , ' handle-fn ,
        !          2478: 0 , 0 , 0 , 0 ,
        !          2479: 0 , 0 , 0 , 0 ,
        !          2480: 0 , 0 , 0 , ' handle-CSI ,
        !          2481: 0 , 0 , 0 , 0 ,
        !          2482: : handle-ESC-O
        !          2483: key
        !          2484: dup 48 = IF
        !          2485: handle-^A
        !          2486: ELSE
        !          2487: dup 46 = IF
        !          2488: handle-^E
        !          2489: THEN
        !          2490: THEN drop
        !          2491: ;
        !          2492: : handle-ESC-5b
        !          2493: key
        !          2494: dup 31 = IF \ HOME
        !          2495: key drop ( drops closing 7e ) handle-^A
        !          2496: ELSE
        !          2497: dup 33 = IF \ DEL
        !          2498: key drop handle-^D
        !          2499: ELSE
        !          2500: dup 34 = IF \ END
        !          2501: key drop handle-^E
        !          2502: ELSE
        !          2503: dup 1f and handle-CSI
        !          2504: THEN
        !          2505: THEN
        !          2506: THEN drop
        !          2507: ;
        !          2508: : handle-ESC
        !          2509: key
        !          2510: dup 5b = IF
        !          2511: handle-ESC-5b
        !          2512: ELSE
        !          2513: dup 4f = IF
        !          2514: handle-ESC-O
        !          2515: ELSE
        !          2516: dup 1f and handle-meta
        !          2517: THEN
        !          2518: THEN drop
        !          2519: ;
        !          2520: TABLE-EXECUTE handle-control
        !          2521: 0 , \ ^@:
        !          2522: ' handle-^A ,
        !          2523: ' handle-^B ,
        !          2524: 0 , \ ^C:
        !          2525: ' handle-^D ,
        !          2526: ' handle-^E ,
        !          2527: ' handle-^F ,
        !          2528: 0 , \ ^G:
        !          2529: ' handle-^H ,
        !          2530: ' handle-^I , \ tab
        !          2531: 0 , \ ^J:
        !          2532: ' handle-^K ,
        !          2533: ' handle-^L ,
        !          2534: 0 , \ ^M: enter: handled in main loop
        !          2535: ' handle-^N ,
        !          2536: 0 , \ ^O:
        !          2537: ' handle-^P ,
        !          2538: ' handle-^Q ,
        !          2539: ' handle-^R ,
        !          2540: 0 , \ ^S:
        !          2541: 0 , \ ^T:
        !          2542: ' handle-^U ,
        !          2543: 0 , \ ^V:
        !          2544: 0 , \ ^W:
        !          2545: 0 , \ ^X:
        !          2546: 0 , \ ^Y: insert save buffer
        !          2547: 0 , \ ^Z:
        !          2548: ' handle-ESC ,
        !          2549: 0 , \ ^\:
        !          2550: 0 , \ ^]:
        !          2551: 0 , \ ^^:
        !          2552: 0 , \ ^_:
        !          2553: : (accept) ( adr len -- len' )
        !          2554: cursor-on
        !          2555: to accept-max to accept-adr
        !          2556: 0 to accept-len 0 to accept-cur
        !          2557: 0 to his-cur
        !          2558: 1b emit 37 emit
        !          2559: BEGIN
        !          2560: key dup 0d <>
        !          2561: WHILE
        !          2562: dup 9 <> IF 0 to ?tab-pressed THEN \ reset state machine
        !          2563: dup 7f = IF drop 8 THEN \ Handle DEL as if it was BS. ??? bogus
        !          2564: dup bl < IF handle-control ELSE
        !          2565: dup 80 and IF
        !          2566: dup a0 < IF 7f and handle-meta ELSE drop beep THEN
        !          2567: ELSE
        !          2568: insert-char
        !          2569: THEN
        !          2570: THEN
        !          2571: REPEAT
        !          2572: drop add-history
        !          2573: accept-len to accept-cur
        !          2574: move-cursor space
        !          2575: accept-len
        !          2576: cursor-off
        !          2577: ;
        !          2578: ' (accept) to accept
        !          2579: 120 cp
        !          2580: 1 VALUE /dump
        !          2581: ' c@ VALUE 'dump
        !          2582: 0 VALUE dump-first
        !          2583: 0 VALUE dump-last
        !          2584: 0 VALUE dump-cur
        !          2585: : .char ( c -- )  dup bl 7f within 0= IF drop [char] . THEN emit ;
        !          2586: : dump-line ( -- )
        !          2587: cr dump-cur dup 8 0.r [char] : emit 10 /dump / 0 DO
        !          2588: space dump-cur dump-first dump-last within IF
        !          2589: dump-cur 'dump execute /dump 2* 0.r ELSE
        !          2590: /dump 2* spaces THEN dump-cur /dump + to dump-cur LOOP
        !          2591: /dump 1 <> IF drop EXIT THEN
        !          2592: to dump-cur 2 spaces
        !          2593: 10 0 DO dump-cur dump-first dump-last within IF
        !          2594: dump-cur 'dump execute .char ELSE space THEN dump-cur 1+ to dump-cur LOOP ;
        !          2595: : (dump) ( addr len reader size -- )
        !          2596: to /dump to 'dump bounds /dump negate and to dump-first to dump-last
        !          2597: dump-first f invert and to dump-cur
        !          2598: base @ hex BEGIN dump-line dump-cur dump-last >= UNTIL base ! ;
        !          2599: : du ( -- )  dump-last 100 'dump /dump (dump) ;
        !          2600: : dump     ['] c@      1 (dump) ;
        !          2601: : wdump    ['] w@      2 (dump) ;
        !          2602: : ldump    ['] l@      4 (dump) ;
        !          2603: : xdump    ['] x@      8 (dump) ;
        !          2604: : rdump    ['] rb@     1 (dump) ;
        !          2605: cistack ciregs >r1 ! \ kernel wants a stack :-)
        !          2606: STRUCT
        !          2607: cell field romfs>file-header
        !          2608: cell field romfs>data
        !          2609: cell field romfs>data-size
        !          2610: cell field romfs>flags
        !          2611: CONSTANT /romfs-lookup-control-block
        !          2612: CREATE romfs-lookup-cb /romfs-lookup-control-block allot
        !          2613: romfs-lookup-cb /romfs-lookup-control-block erase
        !          2614: : create-filename ( string -- string\0 )
        !          2615: here >r dup 8 + allot
        !          2616: r@ over 8 + erase
        !          2617: r@ zplace r> ;
        !          2618: : romfs-lookup ( fn-str fn-len -- data size | false )
        !          2619: create-filename romfs-base
        !          2620: romfs-lookup-cb romfs-lookup-entry call-c
        !          2621: 0= IF romfs-lookup-cb dup romfs>data @ swap romfs>data-size @ ELSE
        !          2622: false THEN ;
        !          2623: : ibm,romfs-lookup ( fn-str fn-len -- data-high data-low size | 0 0 false )
        !          2624: romfs-lookup dup
        !          2625: 0= if drop 0 0 false else
        !          2626: swap dup 20 rshift swap ffffffff and then ;
        !          2627: : romfs-lookup-client ibm,romfs-lookup ;
        !          2628: STRUCT
        !          2629: cell field romfs>next-off
        !          2630: cell field romfs>size
        !          2631: cell field romfs>flags
        !          2632: cell field romfs>data-off
        !          2633: cell field romfs>name
        !          2634: CONSTANT /romfs-cb
        !          2635: : romfs-map-file ( fn-str fn-len -- file-addr file-size )
        !          2636: romfs-base >r
        !          2637: BEGIN 2dup r@ romfs>name zcount string=ci not WHILE
        !          2638: ( fn-str fn-len ) ( R: rom-cb-file-addr )
        !          2639: r> romfs>next-off dup @ dup 0= IF 1 THROW THEN + >r REPEAT
        !          2640: ( fn-str fn-len ) ( R: rom-cb-file-addr )
        !          2641: 2drop r@ romfs>data-off @ r@ + r> romfs>size @ ;
        !          2642: : flash-header ( -- address | false )
        !          2643: get-flash-base 28 +         \ prepare flash header file address
        !          2644: dup rx@                     \ fetch "magic123"
        !          2645: 6d61676963313233 <> IF      \ IF flash is not valid
        !          2646: drop                     \ | forget address
        !          2647: false                    \ | return false
        !          2648: THEN                        \ FI
        !          2649: ;
        !          2650: CREATE bdate-str 10 allot
        !          2651: : bdate2human ( -- addr len )
        !          2652: flash-header 40 + rx@ (.)
        !          2653: drop dup 0 + bdate-str 6 + 4 move
        !          2654: dup 4 + bdate-str 0 + 2 move
        !          2655: dup 6 + bdate-str 3 + 2 move
        !          2656: dup 8 + bdate-str b + 2 move
        !          2657: a + bdate-str e + 2 move
        !          2658: 2d bdate-str 2 + c!
        !          2659: 2d bdate-str 5 + c!
        !          2660: 20 bdate-str a + c!
        !          2661: 3a bdate-str d + c!
        !          2662: bdate-str 10
        !          2663: ;
        !          2664: : included  ( fn fn-len -- )
        !          2665: 2dup >r >r romfs-lookup dup IF
        !          2666: r> drop r> drop evaluate
        !          2667: ELSE
        !          2668: drop ." Cannot open file : " r> r> type cr
        !          2669: THEN
        !          2670: ;
        !          2671: : include  ( " fn " -- )
        !          2672: parse-word included
        !          2673: ;
        !          2674: : ?include  ( flag " fn " -- )
        !          2675: parse-word rot IF included ELSE 2drop THEN
        !          2676: ;
        !          2677: : include?  ( nargs flag " fn " -- )
        !          2678: parse-word rot IF
        !          2679: rot drop included
        !          2680: ELSE
        !          2681: 2drop 0 ?DO drop LOOP
        !          2682: THEN
        !          2683: ;
        !          2684: : (print-romfs-file-info)  ( file-addr -- )
        !          2685: 9 emit  dup b 0.r  2 spaces  dup 8 + @ 6 0.r  2 spaces  20 + zcount type cr
        !          2686: ;
        !          2687: : romfs-list  ( -- )
        !          2688: romfs-base 0 cr BEGIN + dup (print-romfs-file-info) dup @ dup 0= UNTIL 2drop
        !          2689: ;
        !          2690: 140 cp
        !          2691: 200 cp
        !          2692: 201 cp
        !          2693: : .slof-logo
        !          2694: cr ."         ..`. ..     .......  ..           ......      ......."
        !          2695: cr ."     ..`...`''.`'. .''``````..''.       .`''```''`.  `''``````"
        !          2696: cr ."        .`` .:' ': `''.....  .''.       ''`     .''..''......."
        !          2697: cr ."          ``.':.';. ``````''`.''.      .''.      ''``''`````'`"
        !          2698: cr ."          ``.':':`   .....`''.`'`...... `'`.....`''.`'`       "
        !          2699: cr ."         .`.`'``   .'`'`````.  ``''''''  ``''`'''`. `'`       "
        !          2700: ;
        !          2701: : banner
        !          2702: cr ."   Type 'boot'  and press return  to  continue  booting  the system."
        !          2703: s" /packages/sms" find-node IF
        !          2704: cr ."   Type 'sms-start' and press return to enter the configuration menu."
        !          2705: THEN
        !          2706: cr ."   Type 'reset-all'  and  press  return  to   reboot   the   system."
        !          2707: cr cr
        !          2708: ;
        !          2709: : .banner banner console-clean-fifo ;
        !          2710: : .banner .slof-logo .banner ;
        !          2711: 220 cp
        !          2712: DEFER find-boot-sector ( -- )
        !          2713: 240 cp
        !          2714: d# 512000000 VALUE tb-frequency   \ default value - needed for "ms" to work
        !          2715: -1 VALUE cpu-frequency
        !          2716: : slof-build-id  ( -- str len )
        !          2717: flash-header 10 + a
        !          2718: ;
        !          2719: : slof-revision s" 001" ;
        !          2720: : read-version-and-date
        !          2721: flash-header 0= IF
        !          2722: s"  " encode-string
        !          2723: ELSE
        !          2724: flash-header 10 + 10
        !          2725: here swap rmove
        !          2726: here 10
        !          2727: s" , " $cat
        !          2728: bdate2human $cat encode-string THEN
        !          2729: ;
        !          2730: : from-cstring ( addr - len )  
        !          2731: dup dup BEGIN c@ 0 <> WHILE 1 + dup REPEAT
        !          2732: swap -
        !          2733: ;
        !          2734: 260 cp
        !          2735: : tb@  ( -- tb )
        !          2736: BEGIN tbu@ tbl@ tbu@ rot over <> WHILE 2drop REPEAT
        !          2737: 20 lshift swap ffffffff and or
        !          2738: ;
        !          2739: : milliseconds ( -- ms ) tb@ d# 1000 * tb-frequency / ;
        !          2740: : microseconds ( -- us ) tb@ d# 1000000 * tb-frequency / ;
        !          2741: : ms ( ms-to-wait -- ) milliseconds + BEGIN milliseconds over >= UNTIL drop ;
        !          2742: : get-msecs ( -- n ) milliseconds ;
        !          2743: : us  ( us-to-wait -- )  microseconds +  BEGIN microseconds over >= UNTIL  drop ;
        !          2744: 280 cp
        !          2745: 2c0 cp
        !          2746: 2e0 cp
        !          2747: 10 CONSTANT quiesce-xt#
        !          2748: CREATE quiesce-xts quiesce-xt# cells allot
        !          2749: quiesce-xts quiesce-xt# cells erase
        !          2750: : add-quiesce-xt  ( xt -- )
        !          2751: quiesce-xt# 0 DO
        !          2752: quiesce-xts I cells +    ( xt arrayptr )
        !          2753: dup @ 0=                 ( xt arrayptr true|false )
        !          2754: IF
        !          2755: ! UNLOOP EXIT
        !          2756: ELSE                     ( xt arrayptr )
        !          2757: over swap             ( xt xt arrayptr )
        !          2758: @ =                   \ xt already stored ?
        !          2759: IF
        !          2760: drop UNLOOP EXIT
        !          2761: THEN                  ( xt )
        !          2762: THEN
        !          2763: LOOP
        !          2764: drop                        ( xt -- )
        !          2765: ." Warning: quiesce xt list is full." cr
        !          2766: ;
        !          2767: : quiesce  ( -- )
        !          2768: quiesce-xt# 0 DO
        !          2769: quiesce-xts I cells +    ( arrayptr )
        !          2770: @ dup IF                 ( xt )
        !          2771: EXECUTE
        !          2772: ELSE
        !          2773: drop UNLOOP EXIT
        !          2774: THEN
        !          2775: LOOP
        !          2776: ;
        !          2777: 300 cp
        !          2778: 0 VALUE usb-debug-flag
        !          2779: false VALUE scan-time?
        !          2780: VARIABLE ihandle-bulk-tran
        !          2781: 0 VALUE uDOC-present       \ device present and working?
        !          2782: : usb-debug-print  ( str len -- )
        !          2783: usb-debug-flag  IF type cr ELSE 2drop THEN
        !          2784: ;
        !          2785: : usb-debug-print-val  ( str len val -- )
        !          2786: usb-debug-flag  IF -ROT type . cr ELSE drop 2drop THEN
        !          2787: ;
        !          2788: 0 VALUE proceed-char
        !          2789: : show-proceed ( -- )
        !          2790: scan-time?              \ are we on usb-scan ?
        !          2791: IF
        !          2792: proceed-char
        !          2793: CASE
        !          2794: 0   OF 2d ENDOF   \ show '-'
        !          2795: 1   OF 5c ENDOF   \ show '\'
        !          2796: 2   OF 7c ENDOF   \ show '|'
        !          2797: dup OF 2f ENDOF   \ show '/'
        !          2798: ENDCASE
        !          2799: emit 8 emit
        !          2800: proceed-char 1 + 3 AND to proceed-char
        !          2801: THEN
        !          2802: ;
        !          2803: : wait-proceed ( nl -- )
        !          2804: show-proceed
        !          2805: BEGIN
        !          2806: dup d# 100 >         ( nl true|false )
        !          2807: WHILE
        !          2808: 100 - show-proceed
        !          2809: 100 ms               \ do it in steps of 100ms
        !          2810: REPEAT
        !          2811: ms                      \ rest delay
        !          2812: ;
        !          2813: : do-alias-setting ( num name-str name-len )
        !          2814: rot $cathex strdup            \ create alias name
        !          2815: get-node node>path            \ get path string
        !          2816: set-alias                     \ and set the alias
        !          2817: ;
        !          2818: 0 VALUE ohci-alias-num
        !          2819: : set-ohci-alias  ( -- )
        !          2820: ohci-alias-num dup 1+ TO ohci-alias-num    ( num )
        !          2821: s" ohci"
        !          2822: do-alias-setting
        !          2823: ;
        !          2824: 0 VALUE cdrom-alias-num
        !          2825: 0 VALUE disk-alias-num        \ shall start with: pci-disk-num
        !          2826: FALSE VALUE ext-disk-alias    \ first external disk: not yet assigned
        !          2827: : set-drive-alias  ( --  )
        !          2828: space 5b emit
        !          2829: s" cdrom" drop                ( name-str )
        !          2830: get-node node>name comp 0=    ( true|false )
        !          2831: IF                            \ is this a cdrom ?
        !          2832: cdrom-alias-num dup 1+ TO cdrom-alias-num    ( num )
        !          2833: s" cdrom"                  \ yes, alias = cdrom
        !          2834: ELSE
        !          2835: s" sbc-dev" drop           \ is this a scsi-block-device?
        !          2836: get-node node>name comp 0= ( true|false )
        !          2837: IF
        !          2838: disk-alias-num dup 1 + to disk-alias-num
        !          2839: s" disk"                \ all block devices will be named "disk"
        !          2840: s" usb" drop            \ parent = usb controller ? (not hub)
        !          2841: get-node node>parent @ node>name
        !          2842: comp 0=                 \ parent node starts with 'usb' ?
        !          2843: IF                      ( true|false )
        !          2844: 1 s" hdd"            \ add extra alias hdd1 for IntFlash
        !          2845: 2dup type 2 pick .
        !          2846: 8 emit 2f emit
        !          2847: do-alias-setting
        !          2848: uDOC-present 1 and
        !          2849: IF
        !          2850: uDOC-present 2 or to uDOC-present \ present and ready
        !          2851: THEN
        !          2852: ELSE
        !          2853: ext-disk-alias not   \ flag for first ext. disk already assigned
        !          2854: IF
        !          2855: TRUE to ext-disk-alias
        !          2856: 2 s" hdd"         \ add extra alias hdd2 for first USB disk
        !          2857: 2dup type 2 pick .
        !          2858: 8 emit 2f emit
        !          2859: do-alias-setting
        !          2860: THEN
        !          2861: THEN
        !          2862: ELSE
        !          2863: 0 s" ??? "              \ unknown device
        !          2864: THEN
        !          2865: THEN     ( num name-str name-len )
        !          2866: 2dup type 2 pick .
        !          2867: 8 emit 5d emit cr
        !          2868: do-alias-setting
        !          2869: ;
        !          2870: : usb-create-alias-name ( num -- str len )
        !          2871: >r s" ohciX" 2dup + 1-           ( str len last-char-ptr  R: num )
        !          2872: r> [char] 0 + swap c!            ( str len  R: )
        !          2873: ;
        !          2874: : uDOC-check   ( -- )
        !          2875: ;
        !          2876: : uDOC-failure?   ( -- )
        !          2877: uDOC-present 80 and 0<>                \ is ModFD actual beeing processed?
        !          2878: IF
        !          2879: uDOC-present 04 or to uDOC-present  \ set Warning flag
        !          2880: THEN
        !          2881: ;
        !          2882: : usb-scan
        !          2883: space ." Scan USB... " cr
        !          2884: true to scan-time?            \ show proceeding signs
        !          2885: 0 to uDOC-present             \ mark as not present
        !          2886: 0 to disk-alias-num           \ start with disk0
        !          2887: s" pci-disk-num" $find        \ previously detected disks ?
        !          2888: IF
        !          2889: execute to disk-alias-num  \ overwrite start number
        !          2890: ELSE
        !          2891: 2drop
        !          2892: THEN
        !          2893: 0 >r                             \ Counter for alias
        !          2894: BEGIN
        !          2895: r@ usb-create-alias-name
        !          2896: find-alias ?dup               ( false | str len len  R: num )
        !          2897: WHILE
        !          2898: usb-debug-flag IF
        !          2899: ." * Scanning hub " 2dup type ." ..." cr
        !          2900: THEN
        !          2901: open-dev ?dup IF              ( ihandle  R: num )
        !          2902: dup to my-self
        !          2903: dup ihandle>phandle dup set-node
        !          2904: child ?dup IF
        !          2905: delete-node s" Deleting node" usb-debug-print
        !          2906: THEN
        !          2907: >r s" enumerate" r@ $call-method   \ Scan host controller
        !          2908: r> close-dev  0 set-node 0 to my-self
        !          2909: THEN                          ( R: num )
        !          2910: r> 1+ >r                      ( R: num+1 )
        !          2911: REPEAT   r> drop
        !          2912: 0 TO ohci-alias-num
        !          2913: 0 TO cdrom-alias-num
        !          2914: s" cdrom0" find-alias            ( false | dev-path len )
        !          2915: dup IF
        !          2916: s" cdrom" 2swap              ( alias-name len' dev-path len )
        !          2917: set-alias                    ( -- )
        !          2918: ELSE 
        !          2919: drop                         ( -- )
        !          2920: THEN
        !          2921: uDOC-check  \ check if uDOC-device is present and working (ELBA only)
        !          2922: false to scan-time?                 \ suppress proceeding signs
        !          2923: ;
        !          2924: : usb-probe
        !          2925: usb-scan
        !          2926: cdrom-alias-num 0= IF
        !          2927: ." Not found CDROM! " cr
        !          2928: THEN
        !          2929: ." CDROM found " cdrom-alias-num . cr 
        !          2930: ;
        !          2931: : usb-dev-test ( -- TRUE )
        !          2932: s" USB Device Test " usb-debug-print
        !          2933: 1 usb-create-alias-name
        !          2934: find-alias ?dup IF
        !          2935: ." * open " 2dup type . cr
        !          2936: ELSE
        !          2937: s" can't found alias " usb-debug-print
        !          2938: THEN
        !          2939: open-dev ?dup IF
        !          2940: dup to my-self
        !          2941: dup ihandle>phandle dup set-node
        !          2942: s" bulk" $open-package ihandle-bulk-tran !
        !          2943: s" close all " usb-debug-print
        !          2944: close-dev 0 set-node 0 to my-self
        !          2945: ihandle-bulk-tran close-package
        !          2946: ELSE
        !          2947: s" can't open usb hub" usb-debug-print
        !          2948: THEN
        !          2949: TRUE
        !          2950: ;
        !          2951: 320 cp
        !          2952: : .ansi-attr-off 1b emit ." [0m"  ;    \ ESC Sequence: all terminal atributes off
        !          2953: : .ansi-blue     1b emit ." [34m" ;    \ ESC Sequence: foreground-color = blue
        !          2954: : .ansi-green    1b emit ." [32m" ;    \ ESC Sequence: foreground-color = green
        !          2955: : .ansi-red      1b emit ." [31m" ;    \ ESC Sequence: foreground-color = green
        !          2956: : .ansi-bold     1b emit ." [1m"  ;    \ ESC Sequence: foreground-color bold
        !          2957: false VALUE scsi-supp-present?
        !          2958: : scsi-xt-err ." SCSI-ERROR (Intern) " ;
        !          2959: ' scsi-xt-err VALUE scsi-open-xt        \ preset with an invalid token
        !          2960: : .wordlists      ( -- )
        !          2961: .ansi-red
        !          2962: get-order      ( -- wid1 .. widn n )
        !          2963: dup space 28 emit .d ." word lists : "
        !          2964: 0 DO
        !          2965: . 08 emit 2c emit
        !          2966: LOOP
        !          2967: 08 emit                 \ 'bs'
        !          2968: 29 emit                 \ ')'
        !          2969: cr space 28 emit
        !          2970: ." Context: " context dup .
        !          2971: @ 5b emit . 8 emit 5d emit
        !          2972: space
        !          2973: ." / Current: " current .
        !          2974: .ansi-attr-off
        !          2975: cr
        !          2976: ;
        !          2977: : .context  ( num -- )
        !          2978: .ansi-red
        !          2979: space
        !          2980: 5b emit
        !          2981: 23 emit . 3a emit
        !          2982: context @
        !          2983: . 8 emit 5d emit space
        !          2984: .ansi-attr-off
        !          2985: ;
        !          2986: : scsi-open  ( -- )
        !          2987: scsi-supp-present? NOT
        !          2988: IF
        !          2989: s" scsi-support.fs" included  ( xt-open )
        !          2990: to scsi-open-xt               (  )
        !          2991: true to scsi-supp-present?
        !          2992: THEN
        !          2993: scsi-open-xt execute
        !          2994: ;
        !          2995: 340 cp
        !          2996: 360 cp
        !          2997: 0 VALUE fdt-debug
        !          2998: fdt-start 0 = IF -1 throw THEN
        !          2999: struct
        !          3000: 4 field >fdth_magic
        !          3001: 4 field >fdth_tsize
        !          3002: 4 field >fdth_struct_off
        !          3003: 4 field >fdth_string_off
        !          3004: 4 field >fdth_rsvmap_off
        !          3005: 4 field >fdth_version
        !          3006: 4 field >fdth_compat_vers
        !          3007: 4 field >fdth_boot_cpu
        !          3008: 4 field >fdth_string_size
        !          3009: 4 field >fdth_struct_size
        !          3010: drop
        !          3011: h# d00dfeed constant OF_DT_HEADER
        !          3012: h#        1 constant OF_DT_BEGIN_NODE
        !          3013: h#        2 constant OF_DT_END_NODE
        !          3014: h#        3 constant OF_DT_PROP
        !          3015: h#        4 constant OF_DT_NOP
        !          3016: h#        9 constant OF_DT_END
        !          3017: fdt-start
        !          3018: dup dup >fdth_struct_off l@ + value fdt-struct
        !          3019: dup dup >fdth_string_off l@ + value fdt-strings
        !          3020: drop
        !          3021: : fdt-check-header ( -- )
        !          3022: fdt-start dup 0 = IF
        !          3023: ." No flat device tree !" cr drop -1 throw EXIT THEN
        !          3024: hex
        !          3025: fdt-debug IF
        !          3026: ." Flat device tree header at 0x" dup . s" :" type cr
        !          3027: ."  magic            : 0x" dup >fdth_magic l@ . cr
        !          3028: ."  total size       : 0x" dup >fdth_tsize l@ . cr
        !          3029: ."  offset to struct : 0x" dup >fdth_struct_off l@ . cr
        !          3030: ."  offset to strings: 0x" dup >fdth_string_off l@ . cr
        !          3031: ."  offset to rsvmap : 0x" dup >fdth_rsvmap_off l@ . cr
        !          3032: ."  version          : " dup >fdth_version l@ decimal . hex cr
        !          3033: ."  last compat vers : " dup >fdth_compat_vers l@ decimal . hex cr
        !          3034: dup >fdth_version l@ 2 >= IF
        !          3035: ."  boot CPU         : 0x" dup >fdth_boot_cpu l@ . cr
        !          3036: THEN
        !          3037: dup >fdth_version l@ 3 >= IF
        !          3038: ."  strings size     : 0x" dup >fdth_string_size l@ . cr
        !          3039: THEN
        !          3040: dup >fdth_version l@ 17 >= IF
        !          3041: ."  struct size      : 0x" dup >fdth_struct_size l@ . cr
        !          3042: THEN
        !          3043: THEN
        !          3044: dup >fdth_magic l@ OF_DT_HEADER <> IF
        !          3045: ." Flat device tree has incorrect magic value !" cr
        !          3046: drop -1 throw EXIT
        !          3047: THEN
        !          3048: dup >fdth_version l@ 10 < IF
        !          3049: ." Flat device tree has usupported version !" cr
        !          3050: drop -1 throw EXIT
        !          3051: THEN
        !          3052: drop
        !          3053: ;
        !          3054: fdt-check-header
        !          3055: : fdt-next-tag ( addr -- nextaddr tag )
        !          3056: 0                              ( dummy tag on stack for loop )
        !          3057: BEGIN
        !          3058: drop                   ( drop previous tag )
        !          3059: dup l@                 ( read new tag )
        !          3060: swap 4 + swap          ( increment addr )
        !          3061: dup OF_DT_NOP <> UNTIL         ( loop until not nop )
        !          3062: ;
        !          3063: : fdt-fetch-unit ( addr -- addr $name )
        !          3064: dup from-cstring              \  get string size
        !          3065: 2dup + 1 + 3 + fffffffc and -rot
        !          3066: ;
        !          3067: : fdt-fetch-string ( index -- $string)  
        !          3068: fdt-strings + dup from-cstring
        !          3069: ;
        !          3070: : fdt-create-dec  s" decode-unit" $CREATE , DOES> @ hex-decode-unit ;
        !          3071: : fdt-create-enc  s" encode-unit" $CREATE , DOES> @ hex-encode-unit ;
        !          3072: : fdt-unflatten-node ( start -- end )
        !          3073: recursive
        !          3074: fdt-next-tag dup OF_DT_BEGIN_NODE <> IF
        !          3075: s" Weird tag 0x" type . " at start of node" type cr
        !          3076: -1 throw
        !          3077: THEN drop
        !          3078: new-device
        !          3079: fdt-fetch-unit
        !          3080: dup 0 = IF drop drop " /" THEN
        !          3081: 40 left-parse-string
        !          3082: device-name
        !          3083: dup IF
        !          3084: " #address-cells" get-parent get-package-property IF
        !          3085: 2drop
        !          3086: ELSE
        !          3087: decode-int nip nip
        !          3088: hex-decode-unit
        !          3089: set-unit
        !          3090: THEN
        !          3091: ELSE 2drop THEN
        !          3092: BEGIN
        !          3093: fdt-next-tag dup OF_DT_END_NODE <>
        !          3094: WHILE
        !          3095: dup OF_DT_PROP = IF
        !          3096: drop dup                       ( drop tag, dup addr     : a1 a1 )
        !          3097: dup l@ dup rot 4 +     ( fetch size, stack is   : a1 s s a2)
        !          3098: dup l@ swap 4 +                ( fetch nameid, stack is : a1 s s i a3 )
        !          3099: rot                       ( we now have: a1 s i a3 s )
        !          3100: encode-bytes rot               ( a1 s pa ps i)
        !          3101: fdt-fetch-string               ( a1 s pa ps $pn )
        !          3102: property
        !          3103: + 8 + 3 + fffffffc and
        !          3104: ELSE dup OF_DT_BEGIN_NODE = IF
        !          3105: drop                   ( drop tag )
        !          3106: 4 -
        !          3107: fdt-unflatten-node
        !          3108: ELSE
        !          3109: drop -1 throw
        !          3110: THEN THEN
        !          3111: REPEAT drop \ drop tag
        !          3112: " #address-cells" get-node get-package-property IF ELSE
        !          3113: decode-int dup fdt-create-dec fdt-create-enc 2drop
        !          3114: THEN
        !          3115: finish-device  
        !          3116: ;
        !          3117: : fdt-unflatten-tree
        !          3118: fdt-debug IF
        !          3119: ." Unflattening device tree..." cr THEN
        !          3120: fdt-struct fdt-unflatten-node drop
        !          3121: fdt-debug IF
        !          3122: ." Done !" cr THEN
        !          3123: ;
        !          3124: fdt-unflatten-tree
        !          3125: : fdt-parse-memory
        !          3126: " /memory" find-device
        !          3127: " reg" get-node get-package-property IF throw -1 THEN
        !          3128: decode-phys 2drop decode-phys
        !          3129: my-#address-cells 1 > IF 20 << or THEN
        !          3130: fdt-debug IF
        !          3131: dup ." Memory size: " . cr
        !          3132: THEN
        !          3133: MIN-RAM-SIZE swap release
        !          3134: 2drop device-end
        !          3135: ;
        !          3136: fdt-parse-memory
        !          3137: : fdt-claim-reserve
        !          3138: fdt-start
        !          3139: dup dup >fdth_tsize l@ 0 claim drop
        !          3140: dup >fdth_rsvmap_off l@ +
        !          3141: BEGIN
        !          3142: dup dup x@ swap 8 + x@
        !          3143: dup 0 <>
        !          3144: WHILE
        !          3145: fdt-debug IF
        !          3146: 2dup swap ." Reserve map entry: " . ." : " . cr
        !          3147: THEN
        !          3148: 0 claim drop
        !          3149: 10 +
        !          3150: REPEAT drop drop drop
        !          3151: ;
        !          3152: fdt-claim-reserve 
        !          3153: defer (client-exec)
        !          3154: defer client-exec
        !          3155: defer callback
        !          3156: defer continue-client
        !          3157: : set-chosen ( prop len name len -- )
        !          3158: s" /chosen" find-node set-property ;
        !          3159: : get-chosen ( name len -- [ prop len ] success )
        !          3160: s" /chosen" find-node get-property 0= ;
        !          3161: " /" find-device
        !          3162: new-device
        !          3163: s" aliases" device-name
        !          3164: finish-device
        !          3165: new-device
        !          3166: s" options" device-name
        !          3167: finish-device
        !          3168: new-device
        !          3169: s" openprom" device-name
        !          3170: s" BootROM" device-type
        !          3171: finish-device
        !          3172: new-device 
        !          3173: s" packages" device-name
        !          3174: get-node to packages
        !          3175: new-device
        !          3176: s" deblocker" device-name
        !          3177: INSTANCE VARIABLE offset
        !          3178: INSTANCE VARIABLE block-size
        !          3179: INSTANCE VARIABLE max-transfer
        !          3180: INSTANCE VARIABLE my-block
        !          3181: INSTANCE VARIABLE adr
        !          3182: INSTANCE VARIABLE len
        !          3183: : open
        !          3184: s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN
        !          3185: block-size !
        !          3186: s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN
        !          3187: max-transfer !
        !          3188: block-size @ alloc-mem my-block !
        !          3189: 0 offset !
        !          3190: true ;
        !          3191: : close  my-block @ block-size @ free-mem ;
        !          3192: : seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying
        !          3193: lxjoin offset !  0 ;
        !          3194: : block+remainder ( -- block# remainder )  offset @ block-size @ u/mod swap ;
        !          3195: : read-blocks ( addr block# #blocks -- actual )  s" read-blocks" $call-parent ;
        !          3196: : read ( addr len -- actual )
        !          3197: dup >r  len ! adr !
        !          3198: block+remainder dup IF ( block# offset-in-block )
        !          3199: >r my-block @ swap 1 read-blocks drop
        !          3200: my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move
        !          3201: r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN
        !          3202: BEGIN len @ block-size @ >= WHILE
        !          3203: adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks
        !          3204: block-size @ * dup negate len +! dup adr +! offset +! REPEAT
        !          3205: len @ IF my-block @ block+remainder drop 1 read-blocks drop
        !          3206: my-block @ adr @ len @ move THEN
        !          3207: r> ;
        !          3208: finish-device
        !          3209: new-device
        !          3210: false VALUE debug-disk-label?
        !          3211: d# 16384 value max-prep-partition-blocks
        !          3212: s" disk-label" device-name
        !          3213: 0 INSTANCE VALUE partition
        !          3214: 0 INSTANCE VALUE part-offset
        !          3215: 0 INSTANCE VALUE part-start
        !          3216: 0 INSTANCE VALUE lpart-start
        !          3217: 0 INSTANCE VALUE part-size
        !          3218: 0 INSTANCE VALUE dos-logical-partitions
        !          3219: 0 INSTANCE VALUE block-size
        !          3220: 0 INSTANCE VALUE block
        !          3221: 0 INSTANCE VALUE args
        !          3222: 0 INSTANCE VALUE args-len
        !          3223: INSTANCE VARIABLE block#  \ variable to store logical sector#
        !          3224: INSTANCE VARIABLE hit#    \ partition counter
        !          3225: INSTANCE VARIABLE success-flag
        !          3226: 0ff constant END-OF-DESC
        !          3227: 3 constant  PARTITION-ID
        !          3228: 48 constant VOL-PART-LOC
        !          3229: STRUCT
        !          3230: 1b8 field mbr>boot-loader
        !          3231: /l field mbr>disk-signature
        !          3232: /w field mbr>null
        !          3233: 40 field mbr>partition-table
        !          3234: /w field mbr>magic
        !          3235: CONSTANT /mbr
        !          3236: STRUCT
        !          3237: /c field part-entry>active
        !          3238: /c field part-entry>start-head
        !          3239: /c field part-entry>start-sect
        !          3240: /c field part-entry>start-cyl
        !          3241: /c field part-entry>id
        !          3242: /c field part-entry>end-head
        !          3243: /c field part-entry>end-sect
        !          3244: /c field part-entry>end-cyl
        !          3245: /l field part-entry>sector-offset
        !          3246: /l field part-entry>sector-count
        !          3247: CONSTANT /partition-entry
        !          3248: : offset ( d.rel -- d.abs )
        !          3249: part-offset 0 d+
        !          3250: ;
        !          3251: : seek  ( pos.lo pos.hi -- status )
        !          3252: offset
        !          3253: debug-disk-label? IF 2dup ." seek-parent: pos.hi=0x" u. ." pos.lo=0x" u. THEN
        !          3254: s" seek" $call-parent
        !          3255: debug-disk-label? IF dup ." status=" . cr THEN
        !          3256: ;
        !          3257: : read ( addr len -- actual )
        !          3258: debug-disk-label? IF 2dup swap ." read-parent: addr=0x" u. ." len=" .d THEN
        !          3259: s" read" $call-parent
        !          3260: debug-disk-label? IF dup ." actual=" .d cr THEN
        !          3261: ;
        !          3262: : read-sector ( sector-number -- )
        !          3263: block-size * 0 seek drop      \ seek to sector
        !          3264: block block-size read drop    \ read sector
        !          3265: ;
        !          3266: : (.part-entry) ( part-entry )
        !          3267: cr ." part-entry>active:        " dup part-entry>active c@ .d
        !          3268: cr ." part-entry>start-head:    " dup part-entry>start-head c@ .d
        !          3269: cr ." part-entry>start-sect:    " dup part-entry>start-sect c@ .d
        !          3270: cr ." part-entry>start-cyl:     " dup part-entry>start-cyl  c@ .d
        !          3271: cr ." part-entry>id:            " dup part-entry>id c@ .d
        !          3272: cr ." part-entry>end-head:      " dup part-entry>end-head c@ .d
        !          3273: cr ." part-entry>end-sect:      " dup part-entry>end-sect c@ .d
        !          3274: cr ." part-entry>end-cyl:       " dup part-entry>end-cyl c@ .d
        !          3275: cr ." part-entry>sector-offset: " dup part-entry>sector-offset l@-le .d
        !          3276: cr ." part-entry>sector-count:  " dup part-entry>sector-count l@-le .d
        !          3277: cr
        !          3278: ;
        !          3279: : (.name) r@ begin cell - dup @ <colon> = UNTIL xt>name cr type space ;
        !          3280: : init-block ( -- )
        !          3281: s" block-size" ['] $call-parent CATCH IF ABORT" parent has no block-size." THEN
        !          3282: to block-size
        !          3283: d# 2048 alloc-mem
        !          3284: dup d# 2048 erase
        !          3285: to block
        !          3286: debug-disk-label? IF
        !          3287: ." init-block: block-size=" block-size .d ." block=0x" block u. cr
        !          3288: THEN
        !          3289: ;
        !          3290: : no-mbr? ( -- true|false )
        !          3291: 0 read-sector block mbr>magic w@-le aa55 <>
        !          3292: ;
        !          3293: : pc-extended-partition? ( part-entry-addr -- true|false )
        !          3294: part-entry>id c@      ( id )
        !          3295: dup 5 = swap          ( true|false id )
        !          3296: dup f = swap          ( true|false true|false id )
        !          3297: 85 =                  ( true|false true|false true|false )
        !          3298: or or                 ( true|false )
        !          3299: ;
        !          3300: : partition>part-entry ( partition -- part-entry )
        !          3301: 1- /partition-entry * block mbr>partition-table +
        !          3302: ;
        !          3303: : partition>start-sector ( partition -- sector-offset )
        !          3304: partition>part-entry part-entry>sector-offset l@-le
        !          3305: ;
        !          3306: : count-dos-logical-partitions ( -- #logical-partitions )
        !          3307: no-mbr? IF 0 EXIT THEN
        !          3308: 0 5 1 DO                                ( current )
        !          3309: i partition>part-entry               ( current part-entry )
        !          3310: dup pc-extended-partition? IF
        !          3311: part-entry>sector-offset l@-le    ( current sector )
        !          3312: dup to part-start to lpart-start  ( current )
        !          3313: BEGIN
        !          3314: part-start read-sector          \ read EBR
        !          3315: 1 partition>start-sector IF
        !          3316: 1+
        !          3317: THEN \ another logical partition
        !          3318: 2 partition>start-sector
        !          3319: ?dup IF lpart-start + to part-start false ELSE true THEN
        !          3320: UNTIL
        !          3321: ELSE
        !          3322: drop
        !          3323: THEN
        !          3324: LOOP
        !          3325: ;
        !          3326: : (get-dos-partition-params) ( ext-part-start part-entry -- offset count active? id )
        !          3327: dup part-entry>sector-offset l@-le rot + swap ( offset part-entry )
        !          3328: dup part-entry>sector-count l@-le swap        ( offset count part-entry )
        !          3329: dup part-entry>active c@ 80 = swap            ( offset count active? part-entry )
        !          3330: part-entry>id c@                              ( offset count active? id )
        !          3331: ;
        !          3332: : find-dos-partition ( partition# -- false | offset count active? id true )
        !          3333: to partition 0 to part-start 0 to part-offset
        !          3334: partition 0<= IF 0 to partition false EXIT THEN
        !          3335: no-mbr? IF 0 to partition false EXIT THEN
        !          3336: partition 4 <= IF \ Is this a primary partition?
        !          3337: 0 partition partition>part-entry
        !          3338: (get-dos-partition-params)
        !          3339: true EXIT
        !          3340: ELSE
        !          3341: partition 4 - 0 5 1 DO                      ( logical-partition current )
        !          3342: i partition>part-entry                   ( log-part current part-entry )
        !          3343: dup pc-extended-partition? IF
        !          3344: part-entry>sector-offset l@-le        ( log-part current sector )
        !          3345: dup to part-start to lpart-start      ( log-part current )
        !          3346: BEGIN
        !          3347: part-start read-sector             \ read EBR
        !          3348: 1 partition>start-sector IF        \ first partition entry
        !          3349: 1+ 2dup = IF                    ( log-part current )
        !          3350: 2drop
        !          3351: part-start 1 partition>part-entry
        !          3352: (get-dos-partition-params)
        !          3353: true UNLOOP EXIT
        !          3354: THEN
        !          3355: 2 partition>start-sector
        !          3356: ?dup IF lpart-start + to part-start false ELSE true THEN
        !          3357: ELSE
        !          3358: true
        !          3359: THEN
        !          3360: UNTIL
        !          3361: ELSE
        !          3362: drop
        !          3363: THEN
        !          3364: LOOP
        !          3365: 2drop false
        !          3366: THEN
        !          3367: ;
        !          3368: : try-dos-partition ( -- okay? )
        !          3369: no-mbr? IF cr ." No DOS disk-label found." cr false EXIT THEN
        !          3370: count-dos-logical-partitions TO dos-logical-partitions
        !          3371: debug-disk-label? IF
        !          3372: ." Found " dos-logical-partitions .d ." logical partitions" cr
        !          3373: ." Partition = " partition .d cr
        !          3374: THEN
        !          3375: partition 1 5 dos-logical-partitions +
        !          3376: within 0= IF
        !          3377: cr ." Partition # not 1-" 4 dos-logical-partitions + . cr false EXIT
        !          3378: THEN
        !          3379: partition find-dos-partition IF
        !          3380: 2drop drop
        !          3381: block-size * to part-offset
        !          3382: true
        !          3383: ELSE
        !          3384: false
        !          3385: THEN
        !          3386: ;
        !          3387: : has-iso9660-filesystem  ( -- TRUE|FALSE )
        !          3388: 10 800 * 0 seek drop      \ seek to sector
        !          3389: block 800 read drop       \ read sector
        !          3390: block c@ 1 =
        !          3391: block 1+ 5 s" CD001"  str=
        !          3392: and
        !          3393: dup IF 800 to block-size THEN
        !          3394: ;
        !          3395: : load-from-dos-boot-partition ( addr -- size )
        !          3396: no-mbr? IF FALSE EXIT THEN  \ read MBR and check for DOS disk-label magic
        !          3397: count-dos-logical-partitions TO dos-logical-partitions
        !          3398: debug-disk-label? IF
        !          3399: ." Found " dos-logical-partitions .d ." logical partitions" cr
        !          3400: ." Partition = " partition .d cr
        !          3401: THEN
        !          3402: 5 dos-logical-partitions + 1 DO
        !          3403: i find-dos-partition IF        ( addr offset count active? id )
        !          3404: 41 = and                    ( addr offset count prep-boot-part? )
        !          3405: IF                          ( addr offset count )
        !          3406: max-prep-partition-blocks min  \ reduce load size
        !          3407: swap                     ( addr count offset )
        !          3408: block-size * to part-offset
        !          3409: 0 0 seek drop            ( addr offset )
        !          3410: block-size * read        ( size )
        !          3411: UNLOOP EXIT
        !          3412: ELSE
        !          3413: 2drop                    ( addr )
        !          3414: THEN
        !          3415: THEN
        !          3416: LOOP
        !          3417: drop 0
        !          3418: ;
        !          3419: : load-from-boot-partition ( addr -- size )
        !          3420: load-from-dos-boot-partition
        !          3421: ;
        !          3422: : parse-bootinfo-txt  ( addr len -- str len )
        !          3423: 2dup s" <boot-script>" find-substr       ( addr len pos1 )
        !          3424: 2dup = IF
        !          3425: 3drop 0 0 EXIT
        !          3426: THEN
        !          3427: dup >r - swap r> + swap                  ( addr1 len1 )
        !          3428: 2dup [char] \ findchar drop              ( addr1 len1 pos2 )
        !          3429: dup >r - swap r> + swap                  ( addr2 len2 )
        !          3430: 2dup s" </boot-script>" find-substr nip  ( addr2 len3 )
        !          3431: ;
        !          3432: : load-chrp-boot-file ( addr -- size )
        !          3433: my-self parent ihandle>phandle node>path
        !          3434: s" :\ppc\bootinfo.txt" $cat strdup       ( addr str len )
        !          3435: open-dev dup 0= IF 2drop 0 EXIT THEN
        !          3436: >r dup                                   ( addr addr R:ihandle )
        !          3437: dup s" load" r@ $call-method             ( addr addr size R:ihandle )
        !          3438: r> close-dev                             ( addr addr size )
        !          3439: parse-bootinfo-txt                       ( addr fnstr fnlen )
        !          3440: dup 0= IF 3drop 0 EXIT THEN
        !          3441: my-self parent ihandle>phandle node>path ( addr fnstr fnlen nstr nlen )
        !          3442: s" :" $cat 2swap $cat strdup             ( addr str len )
        !          3443: 2dup encode-string s" bootpath" set-chosen
        !          3444: open-dev dup 0= IF ." failed to load CHRP boot loader." 2drop 0 EXIT THEN
        !          3445: >r s" load" r@ $call-method              ( size R:ihandle )
        !          3446: r> close-dev                             ( size )
        !          3447: ;
        !          3448: : parse-partition ( -- okay? )
        !          3449: 0 to partition
        !          3450: 0 to part-offset
        !          3451: my-args to args-len to args
        !          3452: args-len 1 = IF args c@ [char] 0 = IF 0 to args-len THEN THEN
        !          3453: my-args [char] , findchar 0= IF true EXIT THEN drop \ no comma
        !          3454: my-args [char] , split to args-len to args
        !          3455: dup 0= IF 2drop true EXIT THEN \ no first argument
        !          3456: base @ >r decimal $number r> base !
        !          3457: IF cr ." Not a partition #" false EXIT THEN
        !          3458: to partition
        !          3459: true
        !          3460: ;
        !          3461: : (interpose-filesystem) ( str len -- )
        !          3462: find-package IF args args-len rot interpose THEN
        !          3463: ;
        !          3464: : try-dos-files ( -- found? )
        !          3465: no-mbr? IF false EXIT THEN
        !          3466: block c@ e9 <> IF
        !          3467: block c@ eb <>
        !          3468: block 2+ c@ 90 <> or
        !          3469: IF false EXIT THEN
        !          3470: THEN
        !          3471: s" fat-files" (interpose-filesystem)
        !          3472: true
        !          3473: ;
        !          3474: : try-ext2-files ( -- found? )
        !          3475: 2 read-sector               \ read first superblock
        !          3476: block d# 56 + w@-le         \ fetch s_magic
        !          3477: ef53 <> IF false EXIT THEN  \ s_magic found?
        !          3478: s" ext2-files" (interpose-filesystem)
        !          3479: true
        !          3480: ;
        !          3481: : try-iso9660-files
        !          3482: has-iso9660-filesystem 0= IF false exit THEN
        !          3483: s" iso-9660" (interpose-filesystem)
        !          3484: true
        !          3485: ;
        !          3486: : try-files ( -- found? )
        !          3487: args-len 0= IF true EXIT THEN
        !          3488: try-dos-files IF true EXIT THEN
        !          3489: try-ext2-files IF true EXIT THEN
        !          3490: try-iso9660-files IF true EXIT THEN
        !          3491: false
        !          3492: ;
        !          3493: : try-partitions ( -- found? )
        !          3494: try-dos-partition IF try-files EXIT THEN
        !          3495: false
        !          3496: ;
        !          3497: : close ( -- )
        !          3498: debug-disk-label? IF ." Closing disk-label: block=0x" block u. ." block-size=" block-size .d cr THEN
        !          3499: block d# 2048 free-mem
        !          3500: ;
        !          3501: : open ( -- true|false )
        !          3502: init-block
        !          3503: parse-partition 0= IF
        !          3504: close
        !          3505: false EXIT
        !          3506: THEN
        !          3507: partition IF
        !          3508: try-partitions
        !          3509: ELSE
        !          3510: try-files
        !          3511: THEN
        !          3512: dup 0= IF debug-disk-label? IF ." not found." cr THEN close THEN \ free memory again
        !          3513: ;
        !          3514: : load ( addr -- size )
        !          3515: debug-disk-label? IF
        !          3516: ." load: " dup u. cr
        !          3517: THEN
        !          3518: args-len IF
        !          3519: TRUE ABORT" Load done w/o filesystem"
        !          3520: ELSE
        !          3521: partition IF
        !          3522: 0 0 seek drop
        !          3523: 200000 read
        !          3524: ELSE
        !          3525: has-iso9660-filesystem IF
        !          3526: dup load-chrp-boot-file ?dup 0 > IF nip EXIT THEN
        !          3527: THEN
        !          3528: load-from-boot-partition
        !          3529: dup 0= ABORT" No boot partition found"
        !          3530: THEN
        !          3531: THEN
        !          3532: ;
        !          3533: finish-device
        !          3534: new-device
        !          3535: s" fat-files" device-name
        !          3536: INSTANCE VARIABLE bytes/sector
        !          3537: INSTANCE VARIABLE sectors/cluster
        !          3538: INSTANCE VARIABLE #reserved-sectors
        !          3539: INSTANCE VARIABLE #fats
        !          3540: INSTANCE VARIABLE #root-entries
        !          3541: INSTANCE VARIABLE total-#sectors
        !          3542: INSTANCE VARIABLE media-descriptor
        !          3543: INSTANCE VARIABLE sectors/fat
        !          3544: INSTANCE VARIABLE sectors/track
        !          3545: INSTANCE VARIABLE #heads
        !          3546: INSTANCE VARIABLE #hidden-sectors
        !          3547: INSTANCE VARIABLE fat-type
        !          3548: INSTANCE VARIABLE bytes/cluster
        !          3549: INSTANCE VARIABLE fat-offset
        !          3550: INSTANCE VARIABLE root-offset
        !          3551: INSTANCE VARIABLE cluster-offset
        !          3552: INSTANCE VARIABLE #clusters
        !          3553: : seek  s" seek" $call-parent ;
        !          3554: : read  s" read" $call-parent ;
        !          3555: INSTANCE VARIABLE data
        !          3556: INSTANCE VARIABLE #data
        !          3557: : free-data
        !          3558: data @ ?dup IF #data @ free-mem  0 data ! THEN ;
        !          3559: : read-data ( offset size -- )
        !          3560: free-data  dup #data ! alloc-mem data !
        !          3561: xlsplit seek            -2 and ABORT" fat-files read-data: seek failed"
        !          3562: data @ #data @ read #data @ <> ABORT" fat-files read-data: read failed" ;
        !          3563: CREATE fat-buf 8 allot
        !          3564: : read-fat ( cluster# -- data )
        !          3565: fat-buf 8 erase
        !          3566: 1 #split fat-type @ * 2/ 2/ fat-offset @ +
        !          3567: xlsplit seek -2 and ABORT" fat-files read-fat: seek failed"
        !          3568: fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed"
        !          3569: fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split
        !          3570: rot IF swap THEN drop ;
        !          3571: INSTANCE VARIABLE next-cluster
        !          3572: : read-cluster ( cluster# -- )
        !          3573: dup bytes/cluster @ * cluster-offset @ + bytes/cluster @ read-data
        !          3574: read-fat dup #clusters @ >= IF drop 0 THEN next-cluster ! ;
        !          3575: : read-dir ( cluster# -- )
        !          3576: ?dup 0= IF root-offset @ #root-entries @ 20 * read-data 0 next-cluster !
        !          3577: ELSE read-cluster THEN ;
        !          3578: : .time ( x -- )
        !          3579: base @ >r decimal
        !          3580: b #split 2 0.r [char] : emit  5 #split 2 0.r [char] : emit  2* 2 0.r
        !          3581: r> base ! ;
        !          3582: : .date ( x -- )
        !          3583: base @ >r decimal
        !          3584: 9 #split 7bc + 4 0.r [char] - emit  5 #split 2 0.r [char] - emit  2 0.r
        !          3585: r> base ! ;
        !          3586: : .attr ( attr -- )
        !          3587: 6 0 DO dup 1 and IF s" RHSLDA" drop i + c@ ELSE bl THEN emit u2/ LOOP drop ;
        !          3588: : .dir-entry ( adr -- )
        !          3589: dup 0b + c@ 8 and IF drop EXIT THEN \ volume label, not a file
        !          3590: dup c@ e5 = IF drop EXIT THEN \ deleted file
        !          3591: cr
        !          3592: dup 1a + 2c@ bwjoin [char] # emit 4 0.r space \ starting cluster
        !          3593: dup 18 + 2c@ bwjoin .date space
        !          3594: dup 16 + 2c@ bwjoin .time space
        !          3595: dup 1c + 4c@ bljoin base @ decimal swap a .r base ! space \ size in bytes
        !          3596: dup 0b + c@ .attr space
        !          3597: dup 8 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT type
        !          3598: dup 8 + 3 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT dup IF
        !          3599: [char] . emit type ELSE 2drop THEN
        !          3600: drop ;
        !          3601: : .dir-entries ( adr n -- )
        !          3602: 0 ?DO dup i 20 * + dup c@ 0= IF drop LEAVE THEN .dir-entry LOOP drop ;
        !          3603: : .dir ( cluster# -- )
        !          3604: read-dir BEGIN data @ #data @ 20 / .dir-entries next-cluster @ WHILE
        !          3605: next-cluster @ read-cluster REPEAT ;
        !          3606: : str-upper ( str len adr -- ) \ Copy string to adr, uppercase
        !          3607: -rot bounds ?DO i c@ upc over c! char+ LOOP drop ;
        !          3608: CREATE dos-name b allot
        !          3609: : make-dos-name ( str len -- )
        !          3610: dos-name b bl fill
        !          3611: 2dup [char] . findchar IF
        !          3612: 3dup 1+ /string 3 min dos-name 8 + str-upper nip THEN
        !          3613: 8 min dos-name str-upper ;
        !          3614: : (find-file) ( -- cluster file-len is-dir? true | false )
        !          3615: data @ BEGIN dup data @ #data @ + < WHILE
        !          3616: dup dos-name b comp WHILE 20 + REPEAT
        !          3617: dup 1a + 2c@ bwjoin swap dup 1c + 4c@ bljoin swap 0b + c@ 10 and 0<> true
        !          3618: ELSE drop false THEN ;
        !          3619: : find-file ( dir-cluster name len -- cluster file-len is-dir? true | false )
        !          3620: make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE
        !          3621: next-cluster @ read-cluster REPEAT false ELSE true THEN ;
        !          3622: : find-path ( dir-cluster name len -- cluster file-len true | false )
        !          3623: dup 0= IF 3drop false ."  empty name " EXIT THEN
        !          3624: over c@ [char] \ = IF 1 /string ."  slash " RECURSE EXIT THEN
        !          3625: [char] \ split 2>r find-file 0= IF 2r> 2drop false ."  not found " EXIT THEN
        !          3626: r@ 0<> <> IF 2drop 2r> 2drop false ."  no dir<->file match " EXIT THEN
        !          3627: r@ 0<> IF drop 2r> ."  more... " RECURSE EXIT THEN
        !          3628: 2r> 2drop true ."  got it " ;
        !          3629: : do-super ( -- )
        !          3630: 0 200 read-data
        !          3631: data @ 0b + 2c@ bwjoin bytes/sector !
        !          3632: data @ 0d + c@ sectors/cluster !
        !          3633: bytes/sector @ sectors/cluster @ * bytes/cluster !
        !          3634: data @ 0e + 2c@ bwjoin #reserved-sectors !
        !          3635: data @ 10 + c@ #fats !
        !          3636: data @ 11 + 2c@ bwjoin #root-entries !
        !          3637: data @ 13 + 2c@ bwjoin total-#sectors !
        !          3638: data @ 15 + c@ media-descriptor !
        !          3639: data @ 16 + 2c@ bwjoin sectors/fat !
        !          3640: data @ 18 + 2c@ bwjoin sectors/track !
        !          3641: data @ 1a + 2c@ bwjoin #heads !
        !          3642: data @ 1c + 2c@ bwjoin #hidden-sectors !
        !          3643: total-#sectors @ 0= IF data @ 20 + 4c@ bljoin total-#sectors ! THEN
        !          3644: sectors/fat @ 0= IF data @ 24 + 4c@ bljoin sectors/fat ! THEN
        !          3645: total-#sectors @ #reserved-sectors @ - sectors/fat @ #fats @ * -
        !          3646: #root-entries @ 20 * bytes/sector @ // - sectors/cluster @ /
        !          3647: dup #clusters !
        !          3648: dup ff5 < IF drop c ELSE fff5 < IF 10 ELSE 20 THEN THEN fat-type !
        !          3649: cr ." FAT" base @ decimal fat-type @ . base !
        !          3650: #reserved-sectors @ bytes/sector @ * fat-offset !
        !          3651: #fats @ sectors/fat @ * bytes/sector @ * fat-offset @ + root-offset !
        !          3652: #root-entries @ 20 * bytes/sector @ tuck // * root-offset @ +
        !          3653: bytes/cluster @ 2* - cluster-offset ! ;
        !          3654: INSTANCE VARIABLE file-cluster
        !          3655: INSTANCE VARIABLE file-len
        !          3656: INSTANCE VARIABLE current-pos
        !          3657: INSTANCE VARIABLE pos-in-data
        !          3658: : seek ( lo hi -- status )
        !          3659: lxjoin dup current-pos ! file-cluster @ read-cluster
        !          3660: BEGIN dup #data @ >= WHILE #data @ - next-cluster @ dup 0= IF
        !          3661: 2drop true EXIT THEN read-cluster REPEAT pos-in-data ! false ;
        !          3662: : read ( adr len -- actual )
        !          3663: file-len @ current-pos @ - min \ can't go past end of file
        !          3664: #data @ pos-in-data @ - min >r \ length for this transfer
        !          3665: data @ pos-in-data @ + swap r@ move \ move the data
        !          3666: r@ pos-in-data +!  r@ current-pos +!  pos-in-data @ #data @ = IF
        !          3667: next-cluster @ ?dup IF read-cluster 0 pos-in-data ! THEN THEN r> ;
        !          3668: : read ( adr len -- actual )
        !          3669: dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" fat-files: read failed"
        !          3670: /string ( tuck - >r + r> ) REPEAT 2drop r> ;
        !          3671: : load ( adr -- len )
        !          3672: file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ;
        !          3673: : close  free-data ;
        !          3674: : open
        !          3675: do-super
        !          3676: 0 my-args find-path 0= IF close false EXIT THEN
        !          3677: file-len !  file-cluster !  0 0 seek 0= ;
        !          3678: finish-device
        !          3679: new-device
        !          3680: s" rom-files" device-name
        !          3681: INSTANCE VARIABLE length
        !          3682: INSTANCE VARIABLE next-file
        !          3683: INSTANCE VARIABLE buffer
        !          3684: INSTANCE VARIABLE buffer-size
        !          3685: INSTANCE VARIABLE file
        !          3686: INSTANCE VARIABLE file-size
        !          3687: INSTANCE VARIABLE found
        !          3688: : open  true 
        !          3689: 100 dup buffer-size ! alloc-mem buffer ! false found ! ;
        !          3690: : close buffer @ buffer-size @ free-mem ;
        !          3691: : read ( addr len -- actual ) s" read" $call-parent ;
        !          3692: : seek ( lo hi -- status ) s" seek" $call-parent ;
        !          3693: : .read-file-name ( offset -- str len )
        !          3694: 0 seek drop 
        !          3695: buffer @ buffer-size @ read drop
        !          3696: buffer-size @ 1 - buffer @ + 0 swap c!
        !          3697: buffer @ zcount ;
        !          3698: : .print-info ( offset -- )
        !          3699: dup 2 spaces 6 0.r 2 spaces dup
        !          3700: 8 + 0 seek drop length 8 read drop
        !          3701: 6 length @ swap 0.r 2 spaces
        !          3702: 20 + .read-file-name type cr ;
        !          3703: : .list-header cr
        !          3704: s" --offset---size-----file-name----" type cr ;
        !          3705: : list
        !          3706: .list-header
        !          3707: 0 0 BEGIN + dup 
        !          3708: .print-info dup 0 seek drop
        !          3709: next-file 8 read drop next-file @
        !          3710: dup 0= UNTIL 2drop ;
        !          3711: : (find-file)  ( name len -- offset | -1 )
        !          3712: 0 0 seek drop false found !
        !          3713: file-size ! file ! 0 0 BEGIN + dup
        !          3714: 20 + .read-file-name file @ file-size @
        !          3715: str= IF true found ! THEN
        !          3716: dup 0 seek drop
        !          3717: next-file 8 read drop next-file @
        !          3718: dup 0= found @ or UNTIL drop found @ 0=
        !          3719: IF drop -1 THEN ;
        !          3720: : load  ( addr -- size )
        !          3721: my-parent instance>args 2@ [char] \ left-parse-string 2drop
        !          3722: (find-file) dup -1 = IF 2drop 0 ELSE
        !          3723: 0 0 seek drop
        !          3724: dup 8 + 0 seek drop
        !          3725: here 8 read drop here @  ( dest-addr offset file-size )
        !          3726: over 18 + 0 seek drop
        !          3727: here 8 read drop here @  ( dest-addr offset file-size data-offset )
        !          3728: rot + 0 seek drop  ( dest-addr file-size )
        !          3729: read 
        !          3730: THEN
        !          3731: ;
        !          3732: finish-device
        !          3733: new-device
        !          3734: s" ext2-files" device-name
        !          3735: INSTANCE VARIABLE first-block
        !          3736: INSTANCE VARIABLE block-size
        !          3737: INSTANCE VARIABLE inodes/group
        !          3738: INSTANCE VARIABLE group-descriptors
        !          3739: : seek  s" seek" $call-parent ;
        !          3740: : read  s" read" $call-parent ;
        !          3741: INSTANCE VARIABLE data
        !          3742: INSTANCE VARIABLE #data
        !          3743: : free-data
        !          3744: data @ ?dup IF #data @ free-mem  0 data ! THEN ;
        !          3745: : read-data ( offset size -- )
        !          3746: free-data  dup #data ! alloc-mem data !
        !          3747: xlsplit seek            -2 and ABORT" ext2-files read-data: seek failed"
        !          3748: data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ;
        !          3749: : read-block ( block# -- )
        !          3750: block-size @ * block-size @ read-data ;
        !          3751: INSTANCE VARIABLE inode
        !          3752: INSTANCE VARIABLE file-len
        !          3753: INSTANCE VARIABLE blocks
        !          3754: INSTANCE VARIABLE #blocks
        !          3755: INSTANCE VARIABLE ^blocks
        !          3756: INSTANCE VARIABLE #blocks-left
        !          3757: : blocks-read ( n -- )  dup negate #blocks-left +! 4 * ^blocks +! ;
        !          3758: : read-indirect-blocks ( indirect-block# -- )
        !          3759: read-block data @ data off
        !          3760: dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move
        !          3761: r> 2 rshift blocks-read block-size @ free-mem ;
        !          3762: : read-double-indirect-blocks ( double-indirect-block# -- )
        !          3763: ;
        !          3764: : read-triple-indirect-blocks ( triple-indirect-block# -- )
        !          3765: ;
        !          3766: : read-block#s ( -- )
        !          3767: blocks @ ?dup IF #blocks @ 4 * free-mem THEN
        !          3768: inode @ 4 + l@-le file-len !
        !          3769: file-len @ block-size @ // #blocks !
        !          3770: #blocks @ 4 * alloc-mem blocks !
        !          3771: blocks @ ^blocks !  #blocks @ #blocks-left !
        !          3772: #blocks-left @ c min \ # direct blocks
        !          3773: inode @ 28 + over 4 * ^blocks @ swap move blocks-read
        !          3774: #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN
        !          3775: #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN
        !          3776: #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ;
        !          3777: : read-inode ( inode# -- )
        !          3778: 1- inodes/group @ u/mod \ # in group, group #
        !          3779: 20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table
        !          3780: swap 80 * + xlsplit seek drop  inode @ 80 read drop ;
        !          3781: : .rwx ( bits last-char-if-special special? -- )
        !          3782: rot dup 4 and IF ." r" ELSE ." -" THEN
        !          3783: dup 2 and IF ." w" ELSE ." -" THEN
        !          3784: swap IF 1 and 0= IF upc THEN emit ELSE
        !          3785: 1 and IF ." x" ELSE ." -" THEN drop THEN ;
        !          3786: CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move
        !          3787: : .mode ( mode -- )
        !          3788: dup c rshift f and mode-chars + c@ emit
        !          3789: dup 6 rshift 7 and over 800 and 73 swap .rwx
        !          3790: dup 3 rshift 7 and over 400 and 73 swap .rwx
        !          3791: dup          7 and swap 200 and 74 swap .rwx ;
        !          3792: : .inode ( -- )
        !          3793: base @ >r decimal
        !          3794: inode @      w@-le .mode \ file mode
        !          3795: inode @ 1a + w@-le 5 .r \ link count
        !          3796: inode @ 02 + w@-le 9 .r \ uid
        !          3797: inode @ 18 + w@-le 9 .r \ gid
        !          3798: inode @ 04 + l@-le 9 .r \ size
        !          3799: r> base ! ;
        !          3800: : do-super ( -- )
        !          3801: 400 400 read-data
        !          3802: data @ 14 + l@-le first-block !
        !          3803: 400 data @ 18 + l@-le lshift block-size !
        !          3804: data @ 28 + l@-le inodes/group !
        !          3805: first-block @ 1+ read-block data @ group-descriptors ! data off ;
        !          3806: INSTANCE VARIABLE current-pos
        !          3807: : read ( adr len -- actual )
        !          3808: file-len @ current-pos @ - min \ can't go past end of file
        !          3809: current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block
        !          3810: block-size @ over - rot min >r ( adr off r: len )
        !          3811: data @ + swap r@ move r> dup current-pos +! ;
        !          3812: : read ( adr len -- actual )
        !          3813: dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed"
        !          3814: /string REPEAT 2drop r> ;
        !          3815: : seek ( lo hi -- status )
        !          3816: lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ;
        !          3817: : load ( adr -- len )
        !          3818: file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ;
        !          3819: : .name ( adr -- )  dup 8 + swap 6 + c@ type ;
        !          3820: : read-dir ( inode# -- adr )
        !          3821: read-inode read-block#s file-len @ alloc-mem
        !          3822: 0 0 seek ABORT" ext2-files read-dir: seek failed"
        !          3823: dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ;
        !          3824: : .dir ( inode# -- )
        !          3825: read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE
        !          3826: cr dup 8 0.r space read-inode .inode space space dup .name
        !          3827: dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ;
        !          3828: : (find-file) ( adr name len -- inode#|0 )
        !          3829: 2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE
        !          3830: dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN
        !          3831: dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ;
        !          3832: : find-file ( inode# name len -- inode#|0 )
        !          3833: 2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ;
        !          3834: : find-path ( inode# name len -- inode#|0 )
        !          3835: dup 0= IF 3drop 0 ."  empty name " EXIT THEN
        !          3836: over c@ [char] \ = IF 1 /string ."  slash " RECURSE EXIT THEN
        !          3837: [char] \ split 2>r find-file ?dup 0= IF
        !          3838: 2r> 2drop false ."  not found " EXIT THEN
        !          3839: r@ 0<> IF 2r> ."  more... " RECURSE EXIT THEN
        !          3840: 2r> 2drop ."  got it " ;
        !          3841: : close ;
        !          3842: : open
        !          3843: do-super
        !          3844: 80 alloc-mem inode !
        !          3845: my-args nip 0= IF 0 0 ELSE
        !          3846: 2 my-args find-path ?dup 0= IF close false EXIT THEN THEN
        !          3847: read-inode read-block#s 0 0 seek 0= ;
        !          3848: finish-device
        !          3849: new-device
        !          3850: s" obp-tftp" device-name
        !          3851: INSTANCE VARIABLE ciregs-buffer
        !          3852: : open ( -- okay? ) 
        !          3853: ciregs-size alloc-mem ciregs-buffer ! 
        !          3854: true
        !          3855: ;
        !          3856: : load ( addr -- size )
        !          3857: ciregs ciregs-buffer @ ciregs-size move
        !          3858: s" bootargs" get-chosen 0= IF 0 0 THEN >r >r
        !          3859: s" bootpath" get-chosen 0= IF 0 0 THEN >r >r
        !          3860: my-parent ihandle>phandle node>path encode-string
        !          3861: s" bootpath" set-chosen
        !          3862: (u.) s" netboot " 2swap $cat s"  60000000 " $cat
        !          3863: 6B8 alloc-mem dup >r (u.) $cat s"  " $cat
        !          3864: huge-tftp-load @ IF s"  1 " ELSE s"  0 " THEN $cat
        !          3865: s" 1432 " $cat
        !          3866: my-args $cat
        !          3867: (client-exec) dup 0< IF drop 0 THEN
        !          3868: ciregs-buffer @ ciregs ciregs-size move
        !          3869: r>
        !          3870: r> r> over IF s" bootpath" set-chosen ELSE 2drop THEN
        !          3871: r> r> over IF s" bootargs" set-chosen ELSE 2drop THEN
        !          3872: s" /chosen" select-dev
        !          3873: dup 6B8 encode-bytes s" bootp-response" property
        !          3874: device-end
        !          3875: 6B8 free-mem
        !          3876: ;
        !          3877: : close ( -- )
        !          3878: ciregs-buffer @ ciregs-size free-mem 
        !          3879: ;
        !          3880: : ping  ( -- )
        !          3881: s" ping " my-args $cat (client-exec)
        !          3882: ;
        !          3883: finish-device
        !          3884: new-device
        !          3885: s" iso-9660" device-name
        !          3886: 0 VALUE iso-debug-flag
        !          3887: : iso-debug-print ( str len -- )  iso-debug-flag IF type cr ELSE 2drop THEN  ;
        !          3888: 0 VALUE  path-tbl-size
        !          3889: 0 VALUE  path-tbl-addr
        !          3890: 0 VALUE  root-dir-size
        !          3891: 0 VALUE  vol-size
        !          3892: 0 VALUE  logical-blk-size
        !          3893: 0 VALUE  path-table
        !          3894: 0 VALUE  count
        !          3895: INSTANCE VARIABLE dir-addr
        !          3896: INSTANCE VARIABLE data-buff
        !          3897: INSTANCE VARIABLE #data
        !          3898: INSTANCE VARIABLE ptable
        !          3899: INSTANCE VARIABLE file-loc
        !          3900: INSTANCE VARIABLE file-size
        !          3901: INSTANCE VARIABLE cur-file-offset
        !          3902: INSTANCE VARIABLE self
        !          3903: INSTANCE VARIABLE index
        !          3904: : seek  ( pos.lo pos.hi -- status )  s" seek" $call-parent  ;
        !          3905: : read  ( addr len -- actual )  s" read" $call-parent  ;
        !          3906: : free-data ( -- )
        !          3907: data-buff @                              ( data-buff )
        !          3908: ?DUP  IF  #data @  free-mem  0 data-buff ! THEN
        !          3909: ;
        !          3910: : read-data ( offset size -- )
        !          3911: free-data  DUP                     ( offset size size )
        !          3912: #data !  alloc-mem   data-buff !   (  offset )
        !          3913: xlsplit                            ( pos.lo pos.hi )
        !          3914: seek   -2 and ABORT" seek failed."
        !          3915: data-buff  @  #data @  read        ( actual )
        !          3916: #data @  <> ABORT" read failed."
        !          3917: ;
        !          3918: : extract-vol-info  (  --  )
        !          3919: 10  800 * 800 read-data
        !          3920: data-buff @  88  + l@-be  to path-tbl-size   \ read path table size
        !          3921: data-buff @  94  + l@-be  to path-tbl-addr   \ read big-endian  path table
        !          3922: data-buff @  a2  + l@-be   dir-addr !        \ gather of root directory info
        !          3923: data-buff @  0aa + l@-be  to root-dir-size   \ get volume info
        !          3924: data-buff @  54  + l@-be  to vol-size        \ size in blocks
        !          3925: data-buff @  82  + l@-be  to logical-blk-size
        !          3926: path-tbl-size alloc-mem dup  TO path-table path-tbl-size erase
        !          3927: path-tbl-addr 800 *  xlsplit seek  drop
        !          3928: path-table  path-tbl-size  read  drop     \ pathtable in-system-memory copy
        !          3929: ;
        !          3930: : file-name  ( str len --  str' len' )
        !          3931: 2dup  [char] ; findchar  IF
        !          3932: nip                 \ Omit the trailing ";1" revision of ISO9660 file name
        !          3933: 2dup + 1-           ( str newlen endptr )
        !          3934: c@ [CHAR] . = IF
        !          3935: 1-               ( str len' )    \ Remove trailing dot
        !          3936: THEN
        !          3937: THEN
        !          3938: ;
        !          3939: : dup3  ( num  -- num num num ) dup dup dup  ;
        !          3940: : get-next-record  ( rec-addr -- next-rec-offset )
        !          3941: dup3               ( rec-addr rec-addr rec-addr rec-addr )
        !          3942: self @ 1 +  self ! ( rec-addr rec-addr rec-addr rec-addr )
        !          3943: c@  1 AND  IF      ( rec-addr rec-addr rec-addr )
        !          3944: c@ +  9         ( rec-addr rec-addr' rec-len )
        !          3945: ELSE
        !          3946: c@ +  8         ( rec-addr rec-addr' rec-len )
        !          3947: THEN
        !          3948: + swap  -          ( next-rec-offset )
        !          3949: ;
        !          3950: : path-table-search ( str len -- TRUE | FALSE )
        !          3951: path-table path-tbl-size +  path-table ptable @ +  DO ( str len )
        !          3952: 2dup  I 6 + w@-be index @ =                        ( str len str len )
        !          3953: -rot  I 8 +  I c@  string=ci and  IF               ( str len )
        !          3954: s" Directory Matched!!  "   iso-debug-print     ( str len )
        !          3955: self @   index !                                ( str len )
        !          3956: I 2 + l@-be   dir-addr ! I  dup                 ( str len rec-addr )
        !          3957: get-next-record + path-table -   ptable !       ( str len )
        !          3958: 2drop  TRUE UNLOOP EXIT                         ( TRUE )
        !          3959: THEN
        !          3960: I get-next-record                           ( str len next-rec-offset )
        !          3961: +LOOP
        !          3962: 2drop
        !          3963: FALSE                                          ( FALSE )
        !          3964: s" Invalid path / directory "  iso-debug-print
        !          3965: ;
        !          3966: : search-file-dir ( str len  -- TRUE | FALSE )
        !          3967: dir-addr @  800 *  dir-addr !             ( str len )
        !          3968: dir-addr @ 100 read-data                  ( str len )
        !          3969: data-buff @  0e + l@-be  dup >r           ( str len rec-len )
        !          3970: 100 >  IF                                 ( str len )
        !          3971: s" size dir record"  iso-debug-print   ( str len )
        !          3972: dir-addr @ r@  read-data               ( str len )
        !          3973: THEN
        !          3974: r> data-buff @  + data-buff @  DO         ( str len )
        !          3975: I 19 + c@  2 and 0=  IF                ( str len )
        !          3976: 2dup                                ( str len  str len )
        !          3977: I 21 + I 20 + c@                    ( str len  str len  str' len' )
        !          3978: file-name  string=ci  IF            ( str len )
        !          3979: s" File found!"  iso-debug-print ( str len )
        !          3980: I 6 + l@-be 800 *                ( str len file-loc )
        !          3981: file-loc !                       ( str len )
        !          3982: I 0e + l@-be  file-size !        ( str len )
        !          3983: 2drop
        !          3984: TRUE                             ( TRUE )
        !          3985: UNLOOP
        !          3986: EXIT
        !          3987: THEN
        !          3988: THEN
        !          3989: I c@ dup 0=  IF                        ( str len len )
        !          3990: s" file not found"   iso-debug-print
        !          3991: drop  2drop FALSE                   ( FALSE )
        !          3992: UNLOOP
        !          3993: EXIT
        !          3994: THEN
        !          3995: +LOOP
        !          3996: 2drop
        !          3997: FALSE                                     ( FALSE )
        !          3998: s" file not found"   iso-debug-print
        !          3999: ;
        !          4000: : search-path ( str len -- FALSE|TRUE )
        !          4001: 0  ptable !
        !          4002: 1  self !
        !          4003: 1  index !
        !          4004: dup                                             ( str len len )
        !          4005: 0=  IF
        !          4006: 3drop FALSE                                  ( FALSE )
        !          4007: s"  Empty path name "  iso-debug-print  EXIT ( FALSE )
        !          4008: THEN
        !          4009: OVER c@                                         ( str len char )
        !          4010: [char] \ =  IF                                  ( str len )
        !          4011: swap 1 + swap 1 -  BEGIN                     ( str len )
        !          4012: [char] \  split                           ( str len  str' len ' )
        !          4013: dup 0 =   IF                              ( str len  str' len ' )
        !          4014: 2drop search-file-dir EXIT             ( TRUE | FALSE )
        !          4015: ELSE
        !          4016: 2swap path-table-search  invert  IF    ( str' len ' )
        !          4017: 2drop FALSE  EXIT                   ( FALSE )
        !          4018: THEN
        !          4019: THEN
        !          4020: AGAIN
        !          4021: ELSE   BEGIN
        !          4022: [char] \  split   dup 0 =   IF               ( str len str' len' )
        !          4023: 2drop search-file-dir EXIT                ( TRUE | FALSE )
        !          4024: ELSE
        !          4025: 2swap path-table-search  invert  IF       ( str' len ' )
        !          4026: 2drop FALSE  EXIT                      ( FALSE )
        !          4027: THEN
        !          4028: THEN
        !          4029: AGAIN
        !          4030: THEN
        !          4031: ;
        !          4032: 0 VALUE loc
        !          4033: : load ( addr -- len )
        !          4034: dup to loc                     ( addr )
        !          4035: file-loc @  xlsplit seek drop
        !          4036: file-size @  read              ( file-size )
        !          4037: iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN
        !          4038: dup file-size @  <> ABORT" read failed!"
        !          4039: ;
        !          4040: : close ( -- )
        !          4041: free-data   count 1 - dup to count  0 =  IF
        !          4042: path-table path-tbl-size free-mem
        !          4043: 0 TO path-table
        !          4044: THEN
        !          4045: ;
        !          4046: : open ( -- TRUE | FALSE )
        !          4047: 0 data-buff !
        !          4048: 0 #data !
        !          4049: 0 ptable !
        !          4050: 0 file-loc !
        !          4051: 0 file-size !
        !          4052: 0 cur-file-offset !
        !          4053: 1 self !
        !          4054: 1 index !
        !          4055: count 0 =  IF
        !          4056: s" extract-vol-info called "   iso-debug-print
        !          4057: extract-vol-info
        !          4058: THEN
        !          4059: count  1 + to count
        !          4060: my-args search-path  IF
        !          4061: file-loc @  xlsplit seek drop
        !          4062: TRUE    ( TRUE )
        !          4063: ELSE
        !          4064: close
        !          4065: FALSE   ( FALSE )
        !          4066: THEN
        !          4067: 0 cur-file-offset !
        !          4068: s" opened ISO9660 package" iso-debug-print
        !          4069: ;
        !          4070: : seek ( pos.lo pos.hi -- status )
        !          4071: lxjoin dup  cur-file-offset !  ( offset )
        !          4072: file-loc @  + xlsplit          ( pos.lo pos.hi )
        !          4073: s" seek" $call-parent          ( status )
        !          4074: ;
        !          4075: : read ( addr len -- actual )
        !          4076: file-size @ cur-file-offset @ -             ( addr len remainder-of-file )
        !          4077: min                                         ( addr len|remainder-of-file )
        !          4078: s" read" $call-parent                       ( actual )
        !          4079: dup cur-file-offset @ +  cur-file-offset !  ( actual )
        !          4080: cur-file-offset @                           ( offset actual )
        !          4081: xlsplit seek drop                           ( actual )
        !          4082: ;
        !          4083: finish-device
        !          4084: new-device
        !          4085: s" bulk" device-name
        !          4086: : open  true  ;
        !          4087: : close ;
        !          4088: 8 chars alloc-mem VALUE setup-packet
        !          4089: 0 VALUE cbw-addr
        !          4090: : build-cbw ( address tag transfer-len direction lun command-len -- )
        !          4091: 5 pick TO cbw-addr  ( address tag transfer-len direction lun command-len )
        !          4092: cbw-addr 0f erase   ( address tag transfer-len direction lun command-len )
        !          4093: cbw-addr e + c!     ( address tag transfer-len direction lun )
        !          4094: cbw-addr d + c!     ( address tag transfer-len direction )
        !          4095: cbw-addr c + c!     ( address tag transfer-len )
        !          4096: cbw-addr 8 + l!-le  ( address tag )
        !          4097: cbw-addr 4 + l!-le  ( address )
        !          4098: 43425355 cbw-addr l!-le ( address )
        !          4099: drop  ;
        !          4100: 0 VALUE csw-addr
        !          4101: : analyze-csw ( address -- residue tag true|reason false )
        !          4102: TO csw-addr
        !          4103: csw-addr l@-le 53425355 =  IF
        !          4104: csw-addr c + c@ dup 0=  IF ( reason )
        !          4105: drop
        !          4106: csw-addr 8 + l@-le ( residue )
        !          4107: csw-addr 4 + l@-le ( residue tag ) \ command  block tag
        !          4108: TRUE               ( residue tag TRUE )
        !          4109: ELSE
        !          4110: FALSE              ( reason FALSE )
        !          4111: THEN
        !          4112: ELSE
        !          4113: FALSE                 ( FALSE )
        !          4114: THEN
        !          4115: csw-addr 0c erase
        !          4116: ;
        !          4117: : bulk-reset-recovery-procedure ( bulk-out-endp bulk-in-endp usb-addr -- )
        !          4118: s" bulk-reset-recovery-procedure" $call-parent
        !          4119: ;
        !          4120: finish-device
        !          4121: finish-device
        !          4122: : open true ;
        !          4123: : close ;
        !          4124: device-end
        !          4125: 370 cp
        !          4126: : strequal ( str1 len1 str2 len2 -- flag )
        !          4127: rot dup rot = IF comp 0= ELSE 2drop drop 0 THEN ; 
        !          4128: 400 cp
        !          4129: 0 value puid
        !          4130: 440 cp
        !          4131: 480 cp
        !          4132: " /" find-device
        !          4133: " QEMU" encode-string s" model" property
        !          4134: 2 encode-int s" #address-cells" property
        !          4135: 2 encode-int s" #size-cells" property
        !          4136: s" chrp" device-type
        !          4137: new-device
        !          4138: s" mmu" 2dup device-name device-type
        !          4139: 0 0 s" translations" property
        !          4140: : open  true ;
        !          4141: : close ;
        !          4142: finish-device
        !          4143: device-end
        !          4144: 4c0 cp
        !          4145: : fixup-tbfreq
        !          4146: " /cpus/@0" find-device
        !          4147: " timebase-frequency" get-node get-package-property IF
        !          4148: 2drop
        !          4149: ELSE
        !          4150: decode-int to tb-frequency 2drop
        !          4151: THEN
        !          4152: device-end
        !          4153: ;
        !          4154: fixup-tbfreq
        !          4155: 4d0 cp
        !          4156: 4d0 cp
        !          4157: STRUCT
        !          4158: /l field rtas>token
        !          4159: /l field rtas>nargs
        !          4160: /l field rtas>nret
        !          4161: /l field rtas>args0
        !          4162: /l field rtas>args1
        !          4163: /l field rtas>args2
        !          4164: /l field rtas>args3
        !          4165: /l field rtas>args4
        !          4166: /l field rtas>args5
        !          4167: /l field rtas>args6
        !          4168: /l field rtas>args7
        !          4169: /l C * field rtas>args
        !          4170: /l field rtas>bla
        !          4171: CONSTANT /rtas-control-block
        !          4172: CREATE rtas-cb /rtas-control-block allot
        !          4173: rtas-cb /rtas-control-block erase
        !          4174: 0 VALUE rtas-base
        !          4175: 0 VALUE rtas-size
        !          4176: 0 VALUE rtas-entry
        !          4177: 0 VALUE rtas-node
        !          4178: 4d1 cp
        !          4179: : find-qemu-rtas ( -- )
        !          4180: " /rtas" find-device get-node to rtas-node
        !          4181: " linux,rtas-base" rtas-node get-package-property IF
        !          4182: device-end EXIT THEN
        !          4183: drop l@ to rtas-base
        !          4184: " linux,rtas-base" delete-property
        !          4185: " rtas-size" rtas-node get-package-property IF
        !          4186: device-end EXIT THEN
        !          4187: drop l@ to rtas-size
        !          4188: " linux,rtas-entry" rtas-node get-package-property IF
        !          4189: rtas-base to rtas-entry
        !          4190: ELSE
        !          4191: drop l@ to rtas-entry
        !          4192: " linux,rtas-entry" delete-property
        !          4193: THEN
        !          4194: device-end
        !          4195: ;
        !          4196: find-qemu-rtas
        !          4197: 4d2 cp
        !          4198: : enter-rtas ( -- )
        !          4199: rtas-cb rtas-base 0 rtas-entry call-c drop
        !          4200: ;
        !          4201: : rtas-get-token ( str len -- token | 0 )
        !          4202: rtas-node get-package-property IF 0 ELSE drop l@ THEN
        !          4203: ;
        !          4204: : rtas-start-cpu  ( pid loc r3 -- status )
        !          4205: " start-cpu" rtas-get-token rtas-cb rtas>token l!
        !          4206: 3  rtas-cb rtas>nargs l!
        !          4207: 1  rtas-cb rtas>nret l!
        !          4208: rtas-cb rtas>args2 l!
        !          4209: rtas-cb rtas>args1 l!
        !          4210: rtas-cb rtas>args0 l!
        !          4211: 0 rtas-cb rtas>args3 l!
        !          4212: enter-rtas
        !          4213: rtas-cb rtas>args3 l@
        !          4214: ;
        !          4215: : rtas-set-tce-bypass ( unit enable -- )
        !          4216: " ibm,set-tce-bypass" rtas-get-token rtas-cb rtas>token l!
        !          4217: 2 rtas-cb rtas>nargs l!
        !          4218: 0 rtas-cb rtas>nret l!
        !          4219: rtas-cb rtas>args1 l!
        !          4220: rtas-cb rtas>args0 l!
        !          4221: enter-rtas
        !          4222: ;
        !          4223: : rtas-quiesce ( -- )
        !          4224: " quiesce" rtas-get-token rtas-cb rtas>token l!
        !          4225: 0 rtas-cb rtas>nargs l!
        !          4226: 0 rtas-cb rtas>nret l!
        !          4227: enter-rtas
        !          4228: ;
        !          4229: : of-start-cpu rtas-start-cpu ;
        !          4230: rtas-node set-node
        !          4231: : open true ;
        !          4232: : close ;
        !          4233: : instantiate-rtas ( adr -- entry )
        !          4234: dup rtas-base swap rtas-size move
        !          4235: rtas-entry rtas-base - +
        !          4236: ;
        !          4237: device-end
        !          4238: 4d8 cp
        !          4239: 500 cp
        !          4240: : populate-vios ( -- )
        !          4241: ." Populating /vdevice methods" cr
        !          4242: " /vdevice" find-device get-node child
        !          4243: BEGIN
        !          4244: dup 0 <>
        !          4245: WHILE
        !          4246: dup set-node
        !          4247: dup " compatible" rot get-package-property 0 = IF
        !          4248: drop dup from-cstring
        !          4249: 2dup " hvterm1" strequal IF
        !          4250: " vio-hvterm.fs" included
        !          4251: THEN
        !          4252: 2dup " IBM,v-scsi" strequal IF
        !          4253: " vio-vscsi.fs" included
        !          4254: THEN
        !          4255: 2dup " IBM,l-lan" strequal IF
        !          4256: " vio-veth.fs" included
        !          4257: THEN
        !          4258: 2drop
        !          4259: THEN
        !          4260: peer
        !          4261: REPEAT drop
        !          4262: device-end
        !          4263: ;
        !          4264: populate-vios
        !          4265: 580 cp
        !          4266: 5a0 cp
        !          4267: 600 cp
        !          4268: ' rtas-quiesce add-quiesce-xt
        !          4269: 640 cp
        !          4270: 690 cp
        !          4271: 6a0 cp
        !          4272: 6a8 cp
        !          4273: 6b0 cp
        !          4274: 6b8 cp
        !          4275: 6c0 cp
        !          4276: s" /cpus/@0" open-dev encode-int s" cpu" set-chosen
        !          4277: s" /memory" open-dev encode-int s" memory" set-chosen
        !          4278: 6e0 cp
        !          4279: 700 cp
        !          4280: s" /openprom" find-device
        !          4281: s" SLOF," slof-build-id here swap rmove here slof-build-id nip $cat encode-string s" model" property
        !          4282: 0 0 s" relative-addressing" property
        !          4283: device-end
        !          4284: s" /aliases" find-device
        !          4285: : open  true ;
        !          4286: : close ;
        !          4287: device-end
        !          4288: s" /mmu" open-dev encode-int s" mmu" set-chosen
        !          4289: VARIABLE chosen-memory-ih 0 chosen-memory-ih !
        !          4290: : (chosen-memory-ph) ( -- phandle )
        !          4291: chosen-memory-ih @ ?dup 0= IF
        !          4292: s" memory" get-chosen IF
        !          4293: decode-int nip nip dup chosen-memory-ih !
        !          4294: ihandle>phandle
        !          4295: ELSE 0 THEN
        !          4296: ELSE ihandle>phandle THEN
        !          4297: ;
        !          4298: : (set-available-prop) ( prop plen -- )
        !          4299: s" available"
        !          4300: (chosen-memory-ph) ?dup 0<> IF set-property ELSE
        !          4301: cr ." Can't find chosen memory node - "
        !          4302: ." no available property created" cr
        !          4303: 2dup 2dup
        !          4304: THEN
        !          4305: ;
        !          4306: : update-available-property ( available-ptr -- )
        !          4307: dup >r available>size@
        !          4308: 0= r@ available AVAILABLE-SIZE /available * + >= or IF
        !          4309: available r> available - encode-bytes (set-available-prop)
        !          4310: ELSE
        !          4311: r> /available + RECURSE
        !          4312: THEN
        !          4313: ;
        !          4314: : update-available-property available update-available-property ;
        !          4315: : claim ( [ addr ] len align -- base ) claim update-available-property ;
        !          4316: : release ( addr len -- ) release update-available-property ;
        !          4317: update-available-property
        !          4318: : input  ( dev-str dev-len -- )
        !          4319: open-dev ?dup IF
        !          4320: s" stdin" get-chosen IF
        !          4321: decode-int nip nip ?dup IF close-dev THEN
        !          4322: THEN
        !          4323: encode-int s" stdin"  set-chosen
        !          4324: THEN
        !          4325: ;
        !          4326: : output  ( dev-str dev-len -- )
        !          4327: open-dev ?dup IF
        !          4328: s" stdout" get-chosen IF
        !          4329: decode-int nip nip ?dup IF close-dev THEN
        !          4330: THEN
        !          4331: encode-int s" stdout" set-chosen
        !          4332: THEN
        !          4333: ;
        !          4334: : io  ( dev-str dev-len -- )
        !          4335: 2dup input output
        !          4336: ;
        !          4337: 1 BUFFER: (term-io-char-buf)
        !          4338: : term-io-key  ( -- char )
        !          4339: s" stdin" get-chosen IF
        !          4340: decode-int nip nip dup 0= IF 0 EXIT THEN
        !          4341: >r BEGIN
        !          4342: (term-io-char-buf) 1 s" read" r@ $call-method
        !          4343: 0 >
        !          4344: UNTIL
        !          4345: (term-io-char-buf) c@
        !          4346: r> drop
        !          4347: THEN
        !          4348: ;
        !          4349: ' term-io-key to key
        !          4350: : term-io-key?  ( -- true|false )
        !          4351: s" stdin" get-chosen IF
        !          4352: decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set
        !          4353: >r \ store ihandle on return stack
        !          4354: s" device_type" r@ ihandle>phandle ( propstr len phandle )
        !          4355: get-property ( true | data dlen false )
        !          4356: IF
        !          4357: false
        !          4358: ELSE
        !          4359: 1 - \ remove 1 from length to ignore null-termination char
        !          4360: 2dup s" serial" str= IF
        !          4361: 2drop serial-key? r> drop EXIT
        !          4362: THEN \ call serial-key, cleanup return-stack, exit
        !          4363: 2dup s" keyboard" str= IF 
        !          4364: 2drop ( )
        !          4365: s" key-available?" r@ ihandle>phandle find-method IF 
        !          4366: drop s" key-available?" r@ $call-method  
        !          4367: ELSE 
        !          4368: false 
        !          4369: THEN
        !          4370: r> drop EXIT \ cleanup return-stack, exit
        !          4371: THEN
        !          4372: 2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false
        !          4373: THEN
        !          4374: ELSE
        !          4375: false
        !          4376: THEN
        !          4377: ;
        !          4378: ' term-io-key? to key?
        !          4379: " hvterm" find-alias IF drop
        !          4380: " hvterm" io
        !          4381: THEN
        !          4382: 800 cp
        !          4383: 51 CONSTANT nvram-partition-type-cpulog
        !          4384: 60 CONSTANT nvram-partition-type-sas
        !          4385: 61 CONSTANT nvram-partition-type-sms
        !          4386: 6e CONSTANT nvram-partition-type-debug
        !          4387: 6f CONSTANT nvram-partition-type-history
        !          4388: 70 CONSTANT nvram-partition-type-common
        !          4389: 7f CONSTANT nvram-partition-type-freespace
        !          4390: a0 CONSTANT nvram-partition-type-linux
        !          4391: : rztype ( str len -- ) \ stop at zero byte, read with nvram-c@
        !          4392: 0 DO
        !          4393: dup i + nvram-c@ ?dup IF ( str char )
        !          4394: emit
        !          4395: ELSE                     ( str )
        !          4396: drop UNLOOP EXIT
        !          4397: THEN
        !          4398: LOOP
        !          4399: ;
        !          4400: create tmpStr 500 allot
        !          4401: : rzcount ( zstr -- str len )
        !          4402: dup tmpStr >r BEGIN
        !          4403: dup nvram-c@ dup r> dup 1+ >r c!
        !          4404: WHILE
        !          4405: char+
        !          4406: REPEAT
        !          4407: r> drop over - swap drop tmpStr swap
        !          4408: ;
        !          4409: : calc-header-cksum ( offset -- cksum )
        !          4410: dup nvram-c@
        !          4411: 10 2 DO
        !          4412: over I + nvram-c@ +
        !          4413: LOOP
        !          4414: wbsplit + nip
        !          4415: ;
        !          4416: : bad-header? ( offset -- flag )
        !          4417: dup 2+ nvram-w@        ( offset length )
        !          4418: 0= IF                  ( offset )
        !          4419: drop true EXIT      ( )
        !          4420: THEN
        !          4421: dup calc-header-cksum  ( offset checksum' )
        !          4422: swap 1+ nvram-c@       ( checksum ' checksum )
        !          4423: <>                     ( flag )
        !          4424: ;
        !          4425: : .header ( offset -- )
        !          4426: cr                         ( offset )
        !          4427: dup bad-header? IF         ( offset )
        !          4428: ."   BAD HEADER -- trying to print it anyway" cr
        !          4429: THEN
        !          4430: space                      ( offset )
        !          4431: dup nvram-c@ 2 0.r         ( offset )
        !          4432: space space                ( offset )
        !          4433: dup 2+ nvram-w@ 10 * 5 .r  ( offset )
        !          4434: space space                ( offset )
        !          4435: 4 + 0c rztype              ( )
        !          4436: ;
        !          4437: : .headers ( -- )
        !          4438: cr cr ." Type  Size  Name"
        !          4439: cr ." ========================"
        !          4440: 0 BEGIN                      ( offset )
        !          4441: dup nvram-c@              ( offset type )
        !          4442: WHILE
        !          4443: dup .header               ( offset )
        !          4444: dup 2+ nvram-w@ 10 * +    ( offset offset' )
        !          4445: dup nvram-size < IF       ( offset )
        !          4446: ELSE
        !          4447: drop EXIT              ( )
        !          4448: THEN
        !          4449: REPEAT
        !          4450: drop                         ( )
        !          4451: cr cr
        !          4452: ;
        !          4453: : reset-nvram ( -- )
        !          4454: internal-reset-nvram
        !          4455: ;
        !          4456: : dump-partition     ['] nvram-c@      1 (dump) ;
        !          4457: : type-no-zero ( addr len -- )
        !          4458: 0 DO
        !          4459: dup I + dup nvram-c@ 0= IF drop ELSE nvram-c@ emit THEN
        !          4460: LOOP
        !          4461: drop
        !          4462: ;
        !          4463: : type-no-zero-part ( from-str cnt-str addr len )
        !          4464: 0 DO
        !          4465: dup i + dup nvram-c@ 0= IF
        !          4466: drop
        !          4467: ELSE
        !          4468: 3 pick 0= 3 pick 0 > AND IF
        !          4469: dup 1 type-no-zero
        !          4470: THEN
        !          4471: nvram-c@ a = IF
        !          4472: 2 pick 0= IF
        !          4473: over 1- 0 max
        !          4474: rot drop swap
        !          4475: THEN
        !          4476: 2 pick 1- 0 max
        !          4477: 3 roll drop rot rot
        !          4478: THEN
        !          4479: THEN
        !          4480: LOOP
        !          4481: drop
        !          4482: ;
        !          4483: : (dmesg-prepare) ( base-addr -- base-addr' addr len act-off )
        !          4484: 10 - \ go back to header
        !          4485: dup 14 + nvram-l@ dup >r
        !          4486: ( base-addr act-off ) ( R: act-off )
        !          4487: over over over + swap 10 + nvram-w@ + >r
        !          4488: ( base-addr act-off ) ( R:  act-off nvram-act-addr )
        !          4489: over 2 + nvram-w@ 10 * swap - over swap
        !          4490: ( base-addr base-addr start-size ) ( R:  act-off nvram-act-addr )
        !          4491: r> swap rot 10 + nvram-w@ - r>
        !          4492: ;
        !          4493: : .dmesg ( base-addr -- )
        !          4494: (dmesg-prepare) >r
        !          4495: cr type-no-zero
        !          4496: ( base-addr ) ( R: act-off )
        !          4497: dup 10 + nvram-w@ + r> type-no-zero
        !          4498: ;
        !          4499: : .dmesg-part ( from-str cnt-str base-addr -- )
        !          4500: (dmesg-prepare) >r
        !          4501: >r >r -rot r> r>
        !          4502: cr type-no-zero-part rot
        !          4503: ( base-addr ) ( R: act-off )
        !          4504: dup 10 + nvram-w@ + r> type-no-zero-part
        !          4505: ;
        !          4506: : dmesg-part ( from-str cnt-str -- left-from-str left-cnt-str )
        !          4507: 2dup
        !          4508: s" ibm,BE0log" get-named-nvram-partition IF
        !          4509: s" ibm,CPU0log" get-named-nvram-partition IF
        !          4510: 2drop EXIT
        !          4511: THEN
        !          4512: THEN
        !          4513: drop .dmesg-part nip nip
        !          4514: ;
        !          4515: : dmesg2 ( -- )
        !          4516: s" ibm,BE1log" get-named-nvram-partition IF
        !          4517: s" ibm,CPU1log" get-named-nvram-partition IF
        !          4518: ." No log partition." cr EXIT
        !          4519: THEN
        !          4520: THEN
        !          4521: drop .dmesg
        !          4522: ;
        !          4523: : dmesg ( -- )
        !          4524: s" ibm,BE0log" get-named-nvram-partition IF
        !          4525: s" ibm,CPU0log" get-named-nvram-partition IF
        !          4526: ." No log partition." cr EXIT
        !          4527: THEN
        !          4528: THEN
        !          4529: drop .dmesg
        !          4530: ;
        !          4531: 880 cp
        !          4532: wordlist CONSTANT envvars
        !          4533: : listenv  ( -- )
        !          4534: get-current envvars set-current  words  set-current
        !          4535: ;
        !          4536: : create-env ( "name" -- )
        !          4537: get-current  envvars set-current  CREATE  set-current
        !          4538: ;
        !          4539: : env-int     ( n -- )  1 c, align , DOES> char+ aligned @ ;
        !          4540: : env-bytes   ( a len -- )
        !          4541: 2 c, align dup , here swap dup allot move
        !          4542: DOES> char+ aligned dup @ >r cell+ r>
        !          4543: ;
        !          4544: : env-string  ( str len -- )  3 c, string, DOES> char+ count ;
        !          4545: : env-flag    ( f -- )  4 c, c, DOES> char+ c@ 0<> ;
        !          4546: : env-secmode ( sm -- )  5 c, c, DOES> char+ c@ ;
        !          4547: : default-int     ( n "name" -- )      create-env env-int ;
        !          4548: : default-bytes   ( a len "name" -- )  create-env env-bytes ;
        !          4549: : default-string  ( a len "name" -- )  create-env env-string ;
        !          4550: : default-flag    ( f "name" -- )      create-env env-flag ;
        !          4551: : default-secmode ( sm "name" -- )     create-env env-secmode ;
        !          4552: : set-option ( option-name len option len -- )
        !          4553: 2swap encode-string
        !          4554: 2swap s" /options" find-node dup IF set-property ELSE drop 2drop 2drop THEN
        !          4555: ;
        !          4556: : findenv ( name len -- adr def-adr type | 0 )
        !          4557: 2dup envvars voc-find dup 0<> IF ( ABORT" not a configuration variable" )
        !          4558: link> >body char+ >r (find-order) link> >body dup char+ swap c@ r> swap
        !          4559: ELSE
        !          4560: nip nip
        !          4561: THEN
        !          4562: ;
        !          4563: : test-flag ( param len -- true | false )
        !          4564: 2dup s" true" string=ci -rot s" false" string=ci or
        !          4565: ;
        !          4566: : test-secmode ( param len -- true | false )
        !          4567: 2dup s" none" string=ci -rot 2dup s" command" string=ci -rot s" full"
        !          4568: string=ci or or
        !          4569: ;
        !          4570: : isdigit ( char -- true | false )
        !          4571: 30 39 between
        !          4572: ;
        !          4573: : test-int ( param len -- true | false )
        !          4574: drop c@ isdigit if true else false then ;
        !          4575: : test-string ( param len -- true | false )
        !          4576: 0 ?DO
        !          4577: dup i + c@                     \ Get character / byte at current index
        !          4578: dup 20 <  swap 7e >  OR IF     \ Is it out of range 32 to 126 (=ASCII)
        !          4579: drop FALSE UNLOOP EXIT      \ FALSE means: No ASCII string
        !          4580: THEN
        !          4581: LOOP
        !          4582: drop TRUE    \ Only ASCII found --> it is a string
        !          4583: ;
        !          4584: : findtype ( param len name len -- param len name len type )
        !          4585: 2dup findenv dup 0= \ try to find type of envvar
        !          4586: IF             \ no type found
        !          4587: drop 2swap
        !          4588: 2dup test-flag if 4 -rot else
        !          4589: 2dup test-secmode if 5 -rot else
        !          4590: 2dup test-int if 1 -rot else
        !          4591: 2dup test-string IF 3 ELSE 2 THEN  \ 3 = string, 2 = default to bytes
        !          4592: -rot then then then
        !          4593: rot
        !          4594: >r 2swap r>
        !          4595: else           \ take type from default value
        !          4596: nip nip
        !          4597: THEN
        !          4598: ;
        !          4599: : $setenv ( param len name len -- )
        !          4600: 4dup set-option
        !          4601: findtype dup 0=
        !          4602: IF
        !          4603: true ABORT" not a configuration variable"
        !          4604: ELSE
        !          4605: -rot $CREATE CASE
        !          4606: 1 OF evaluate env-int ENDOF \ XXX: wants decimal and 0x...
        !          4607: 2 OF
        !          4608: 2dup                    ( param len param len )
        !          4609: depth >r                ( param len param len  R: depth-before )
        !          4610: ['] evaluate CATCH IF   \ Catch 'unknown Forth words'...
        !          4611: 2drop  r> drop
        !          4612: env-string           \ and encode 'unknown word' as string
        !          4613: ELSE
        !          4614: depth r> = IF env-bytes ELSE env-int THEN
        !          4615: 2drop
        !          4616: THEN
        !          4617: ENDOF
        !          4618: 3 OF env-string ENDOF
        !          4619: 4 OF evaluate env-flag ENDOF
        !          4620: 5 OF evaluate env-secmode ENDOF \ XXX: recognize none, command, full
        !          4621: ENDCASE
        !          4622: THEN
        !          4623: ;
        !          4624: : (printenv) ( adr type -- )
        !          4625: CASE
        !          4626: 1 OF aligned @ . ENDOF
        !          4627: 2 OF aligned dup cell+ swap @ dup IF dump ELSE 2drop THEN ENDOF
        !          4628: 3 OF count type ENDOF
        !          4629: 4 OF c@ IF ." true" ELSE ." false" THEN ENDOF
        !          4630: 5 OF c@ . ENDOF \ XXX: print symbolically
        !          4631: ENDCASE
        !          4632: ;
        !          4633: : .printenv-header ( -- )
        !          4634: cr
        !          4635: s" ---environment variable--------current value-------------default value------"
        !          4636: type cr
        !          4637: ;
        !          4638: DEFER old-emit
        !          4639: 0 VALUE emit-counter
        !          4640: : emit-and-count emit-counter 1 + to emit-counter old-emit ;
        !          4641: : .enable-emit-counter
        !          4642: 0 to emit-counter
        !          4643: ['] emit behavior to old-emit
        !          4644: ['] emit-and-count to emit
        !          4645: ;
        !          4646: : .disable-emit-counter
        !          4647: ['] old-emit behavior to emit
        !          4648: ;
        !          4649: : .spaces
        !          4650: dup 0 > IF spaces ELSE
        !          4651: drop space THEN
        !          4652: ;
        !          4653: : .print-one-env
        !          4654: 3 .spaces
        !          4655: 2dup dup -rot type 1c swap - .spaces
        !          4656: findenv rot over
        !          4657: .enable-emit-counter
        !          4658: (printenv) .disable-emit-counter
        !          4659: 1a emit-counter - .spaces
        !          4660: (printenv)
        !          4661: ;
        !          4662: : .print-all-env
        !          4663: .printenv-header
        !          4664: envvars cell+ BEGIN @ dup WHILE dup link> >name
        !          4665: name>string .print-one-env cr REPEAT drop
        !          4666: ;
        !          4667: : printenv
        !          4668: parse-word dup 0= IF
        !          4669: 2drop .print-all-env ELSE findenv dup 0=
        !          4670: ABORT" not a configuration variable"
        !          4671: rot over cr ." Current: " (printenv)
        !          4672: cr ." Default: " (printenv) THEN
        !          4673: ;
        !          4674: : (set-default)  ( def-xt -- )
        !          4675: dup >name name>string $CREATE dup >body c@ >r execute r> CASE
        !          4676: 1 OF env-int ENDOF
        !          4677: 2 OF env-bytes ENDOF
        !          4678: 3 OF env-string ENDOF
        !          4679: 4 OF env-flag ENDOF
        !          4680: 5 OF env-secmode ENDOF ENDCASE
        !          4681: ;
        !          4682: true default-flag auto-boot?
        !          4683: s" " default-string boot-device
        !          4684: s" " default-string boot-file
        !          4685: s" boot" default-string boot-command
        !          4686: s" " default-string diag-device
        !          4687: s" " default-string diag-file
        !          4688: false default-flag diag-switch?
        !          4689: true default-flag fcode-debug?
        !          4690: s" " default-string input-device
        !          4691: s" " default-string nvramrc
        !          4692: s" " default-string oem-banner
        !          4693: false default-flag oem-banner?
        !          4694: 0 0 default-bytes oem-logo
        !          4695: false default-flag oem-logo?
        !          4696: s" " default-string output-device
        !          4697: 200 default-int screen-#columns
        !          4698: 200 default-int screen-#rows
        !          4699: 0 default-int security-#badlogins
        !          4700: 0 default-secmode security-mode
        !          4701: s" " default-string security-password
        !          4702: 0 default-int selftest-#megs
        !          4703: false default-flag use-nvramrc?
        !          4704: false default-flag direct-serial?
        !          4705: true default-flag real-mode?
        !          4706: true default-flag use-axon-ddr?
        !          4707: VARIABLE nvoff \ offset in envvar partition
        !          4708: : (nvupdate-one) ( adr type -- "value" )
        !          4709: CASE
        !          4710: 1 OF aligned @ (.) ENDOF
        !          4711: 2 OF drop s" 0 0" ENDOF
        !          4712: 3 OF count ENDOF
        !          4713: 4 OF c@ IF s" true" ELSE s" false" THEN ENDOF
        !          4714: 5 OF c@ (.) ENDOF \ XXX: print symbolically
        !          4715: ENDCASE
        !          4716: ;
        !          4717: : nvupdate-one   ( def-xt -- )
        !          4718: >r nvram-partition-type-common get-nvram-partition       ( part.addr part.len FALSE|TRUE R: def-xt )
        !          4719: ABORT" No valid NVRAM." r>      ( part.addr part.len def-xt )
        !          4720: >name name>string               ( part.addr part.len var.a var.l )
        !          4721: 2dup findenv nip (nvupdate-one)
        !          4722: internal-add-env
        !          4723: drop
        !          4724: ;
        !          4725: : (nvupdate) ( -- )
        !          4726: nvram-partition-type-common get-nvram-partition ABORT" No valid NVRAM."
        !          4727: erase-nvram-partition drop
        !          4728: envvars cell+
        !          4729: BEGIN @ dup WHILE dup link> nvupdate-one REPEAT
        !          4730: drop
        !          4731: ;
        !          4732: : nvupdate ( -- )
        !          4733: ." nvupdate is obsolete." cr
        !          4734: ;
        !          4735: : set-default
        !          4736: parse-word envvars voc-find
        !          4737: dup 0= ABORT" not a configuration variable" link> (set-default)
        !          4738: ;
        !          4739: : (set-defaults)
        !          4740: envvars cell+
        !          4741: BEGIN @ dup WHILE dup link> (set-default) REPEAT
        !          4742: drop
        !          4743: ;
        !          4744: (set-defaults)
        !          4745: : set-defaults
        !          4746: (set-defaults) (nvupdate)
        !          4747: ;
        !          4748: : setenv  parse-word ( skipws ) 0d parse -leading 2swap $setenv (nvupdate) ;
        !          4749: : get-nv  ( -- )
        !          4750: nvram-partition-type-common get-nvram-partition ( addr offset not-found | not-found ) \ find partition header
        !          4751: IF
        !          4752: ." No NVRAM common partition, re-initializing..." cr
        !          4753: internal-reset-nvram
        !          4754: (nvupdate)
        !          4755: nvram-partition-type-common get-nvram-partition IF ." NVRAM seems to be broken." cr EXIT THEN
        !          4756: THEN
        !          4757: drop ( addr )           \ throw away offset
        !          4758: BEGIN
        !          4759: dup rzcount  dup     \ make string from offset and make condition
        !          4760: WHILE                   ( offset offset length )
        !          4761: 2dup [char] = split  \ Split string at equal sign (=)
        !          4762: 2swap                ( offset offset length param len name len )
        !          4763: $setenv              \ Set envvar
        !          4764: nip                  \ throw away old string begin
        !          4765: + 1+                 \ calc new offset
        !          4766: REPEAT
        !          4767: 2drop drop              \ cleanup
        !          4768: ;
        !          4769: get-nv
        !          4770: : check-for-nvramrc  ( -- )
        !          4771: use-nvramrc?  IF
        !          4772: s" Executing following code from nvramrc: "
        !          4773: s" nvramrc" evaluate $cat
        !          4774: nvramlog-write-string-cr
        !          4775: s" (!) Executing code specified in nvramrc" type
        !          4776: cr s"  SLOF Setup = " type
        !          4777: .enable-emit-counter
        !          4778: s" nvramrc" evaluate ['] evaluate  CATCH  IF
        !          4779: 2drop
        !          4780: emit-counter 0  DO  8 emit  LOOP
        !          4781: s" (!) Code in nvramrc triggered exception. "
        !          4782: 2dup nvramlog-write-string
        !          4783: type cr 12 spaces s" Aborting nvramrc execution" 2dup
        !          4784: nvramlog-write-string-cr type cr
        !          4785: s"  SLOF Setup = " type
        !          4786: THEN
        !          4787: .disable-emit-counter
        !          4788: THEN
        !          4789: ;
        !          4790: : (nv-findalias) ( alias-ptr alias-len -- pos )
        !          4791: here 0
        !          4792: s" devalias " string-cat
        !          4793: 3 pick 3 pick string-cat
        !          4794: s"  " string-cat
        !          4795: s" nvramrc" evaluate
        !          4796: 2swap find-substr
        !          4797: nip nip
        !          4798: ;
        !          4799: : (nv-build-real-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len )
        !          4800: 2swap here 0
        !          4801: s" devalias " string-cat
        !          4802: 2swap string-cat
        !          4803: s"  " string-cat
        !          4804: 2swap string-cat
        !          4805: 0d char-cat
        !          4806: 0a char-cat
        !          4807: ;
        !          4808: : (nv-build-null-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len )
        !          4809: 4drop here 0
        !          4810: ;
        !          4811: : (nv-build-nvramrc) ( name-str name-len dev-str dev-len xt-build-entry -- )
        !          4812: 4 pick 4 pick (nv-findalias)
        !          4813: dup s" nvramrc" evaluate nip >= IF
        !          4814: drop execute
        !          4815: s" nvramrc" evaluate string-cat
        !          4816: dup allot
        !          4817: s" nvramrc" $setenv
        !          4818: ELSE  \ if our alias is still defined in nvramrc
        !          4819: 5 pick 5 pick 5 pick 5 pick 5 pick execute nip over +
        !          4820: s" nvramrc" evaluate 3 pick string-at
        !          4821: 2dup find-nextline string-at nip +
        !          4822: alloc-mem 0
        !          4823: s" nvramrc" evaluate drop 3 pick string-cat
        !          4824: rot >r >r >r execute r> r> 2swap string-cat
        !          4825: ( mem, len ) ( R: alias-pos )
        !          4826: s" nvramrc" evaluate r> string-at
        !          4827: 2dup find-nextline string-at string-cat
        !          4828: 2dup s" nvramrc" $setenv free-mem
        !          4829: THEN
        !          4830: ;
        !          4831: : $nvalias ( name-str name-len dev-str dev-len -- )
        !          4832: 4dup ['] (nv-build-real-entry) (nv-build-nvramrc)
        !          4833: set-alias
        !          4834: s" true" s" use-nvramrc?" $setenv
        !          4835: (nvupdate)
        !          4836: ;
        !          4837: : nvalias ( "alias-name< >device-specifier<eol>" -- )
        !          4838: parse-word parse-word dup 0<> IF
        !          4839: $nvalias
        !          4840: ELSE
        !          4841: 2drop 2drop
        !          4842: cr
        !          4843: "    Usage: nvalias (""alias-name< >device-specifier<eol>"" -- )" type
        !          4844: cr
        !          4845: THEN    
        !          4846: ;
        !          4847: : $nvunalias ( name-str name-len -- )
        !          4848: s" " ['] (nv-build-null-entry) (nv-build-nvramrc)
        !          4849: (nvupdate)
        !          4850: ;
        !          4851: : nvunalias ( "alias-name< >" -- )
        !          4852: parse-word $nvunalias
        !          4853: ;
        !          4854: : diagnostic-mode? ( -- diag-switch? ) diag-switch? ;
        !          4855: check-for-nvramrc
        !          4856: 890 cp
        !          4857: defer set-boot-device
        !          4858: defer add-boot-device
        !          4859: : qemu-read-bootlist ( -- )
        !          4860: 0 0 set-boot-device
        !          4861: " boot-device" evaluate swap drop 0 <> IF EXIT THEN   
        !          4862: " qemu,boot-device" get-chosen not IF EXIT THEN
        !          4863: 0 ?DO
        !          4864: dup i + c@ CASE
        !          4865: 0        OF ENDOF
        !          4866: [char] a OF ENDOF
        !          4867: [char] b OF ENDOF
        !          4868: [char] c OF " disk"  add-boot-device ENDOF
        !          4869: [char] d OF " cdrom" add-boot-device ENDOF
        !          4870: [char] n OF " net"   add-boot-device ENDOF
        !          4871: ENDCASE cr
        !          4872: LOOP
        !          4873: drop
        !          4874: ;
        !          4875: ' qemu-read-bootlist to read-bootlist
        !          4876: 8a0 cp
        !          4877: VOCABULARY client-voc \ We store all client-interface callable words here.
        !          4878: 6789  CONSTANT  sc-exit
        !          4879: 4711  CONSTANT  sc-yield
        !          4880: VARIABLE  client-callback \ Address of client's callback function
        !          4881: : client-data  ciregs >r3 @ ;
        !          4882: : nargs  client-data la1+ l@ ;
        !          4883: : nrets  client-data la1+ la1+ l@ ;
        !          4884: : client-data-to-stack
        !          4885: client-data 3 la+ nargs 0 ?DO dup l@ swap la1+ LOOP drop ;
        !          4886: : stack-to-client-data
        !          4887: client-data nargs nrets + 2 + la+ nrets 0 ?DO tuck l! /l - LOOP drop ;
        !          4888: : call-client ( args len client-entry -- )
        !          4889: >r  ciregs >r7 !  ciregs >r6 !  client-entry-point @ ciregs >r5 !
        !          4890: cistack ciregs >r1 !
        !          4891: r> jump-client drop
        !          4892: BEGIN
        !          4893: client-data-to-stack
        !          4894: client-data l@ zcount
        !          4895: ALSO client-voc $find PREVIOUS
        !          4896: dup 0= >r IF 
        !          4897: CATCH
        !          4898: ?dup IF
        !          4899: dup CASE
        !          4900: sc-exit OF drop r> drop EXIT ENDOF
        !          4901: sc-yield OF drop r> drop EXIT ENDOF
        !          4902: ENDCASE
        !          4903: THROW
        !          4904: THEN
        !          4905: stack-to-client-data
        !          4906: ELSE
        !          4907: cr type ."  NOT FOUND"
        !          4908: THEN
        !          4909: r> ciregs >r3 !  ciregs >r4 @ jump-client 
        !          4910: UNTIL ;
        !          4911: : flip-stack ( a1 ... an n -- an ... a1 )  ?dup IF 1 ?DO i roll LOOP THEN ;
        !          4912: : (callback) ( "service-name<>" "arguments<cr>" -- )
        !          4913: client-callback @  \ client-callback points to the function prolog
        !          4914: dup 8 + @ ciregs >r2 !  \ Set up the TOC pointer (???)
        !          4915: @ call-client ;  \ Resolve the function's address from the prolog
        !          4916: ' (callback) to callback
        !          4917: : (continue-client)
        !          4918: s" "  \ make call-client happy, client won't use the string anyways.
        !          4919: ciregs >r4 @ call-client ;
        !          4920: ' (continue-client) to continue-client
        !          4921: : string-to-buffer ( str len buf len -- len' )
        !          4922: 2dup erase rot min dup >r move r> ;
        !          4923: ALSO client-voc DEFINITIONS
        !          4924: : exit  sc-exit THROW ;
        !          4925: : yield  sc-yield THROW ;
        !          4926: : test ( zstr -- missing? )
        !          4927: zcount 
        !          4928: ALSO client-voc $find PREVIOUS IF nip FALSE ELSE nip nip TRUE THEN 
        !          4929: ;
        !          4930: : finddevice ( zstr -- phandle )
        !          4931: zcount find-node dup 0= IF drop -1 THEN ;
        !          4932: : getprop ( phandle zstr buf len -- len' )
        !          4933: >r >r zcount rot get-property
        !          4934: 0= IF r> swap dup r> min swap >r move r>
        !          4935: ELSE r> r> 2drop -1 THEN ;
        !          4936: : getproplen ( phandle zstr -- len )
        !          4937: zcount rot get-property 0= IF nip ELSE -1 THEN ;
        !          4938: : setprop ( phandle zstr buf len -- size|-1 )
        !          4939: dup >r            \ save len
        !          4940: encode-bytes      ( phandle zstr prop-addr prop-len )
        !          4941: 2swap zcount rot  ( prop-addr prop-len name-addr name-len phandle )
        !          4942: current-node @ >r \ save current node
        !          4943: set-node          \ change to specified node
        !          4944: property          \ set property
        !          4945: r> set-node       \ restore original node
        !          4946: r>                \ always return size, because we can not fail.
        !          4947: ;
        !          4948: : canon ( zstr buf len -- len' )
        !          4949: over >r move r> zcount nip ;
        !          4950: : nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok
        !          4951: >r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ; 
        !          4952: : open ( zstr -- ihandle )  zcount open-dev ;
        !          4953: : close ( ihandle -- )  close-dev ;
        !          4954: : write ( ihandle str len -- len' )      rot s" write" rot
        !          4955: ['] $call-method CATCH IF 2drop 3drop -1 THEN ;
        !          4956: : read  ( ihandle str len -- len' )      rot s" read"  rot
        !          4957: ['] $call-method CATCH IF 2drop 3drop -1 THEN ;
        !          4958: : seek  ( ihandle hi lo -- status  ) swap rot s" seek" rot
        !          4959: ['] $call-method CATCH IF 2drop 3drop -1 THEN ;
        !          4960: : claim  ( addr len align -- base )
        !          4961: dup  IF  rot drop
        !          4962: ['] claim CATCH  IF  2drop -1  THEN
        !          4963: ELSE
        !          4964: ['] claim CATCH  IF  3drop -1  THEN
        !          4965: THEN
        !          4966: ;
        !          4967: : release ( addr len -- ) release ;
        !          4968: : instance-to-package ( ihandle -- phandle )
        !          4969: ihandle>phandle ;
        !          4970: : package-to-path ( phandle buf len -- len' )
        !          4971: 2>r node>path 2r> string-to-buffer ;
        !          4972: : instance-to-path ( ihandle buf len -- len' )
        !          4973: 2>r instance>path 2r> string-to-buffer ;
        !          4974: : instance-to-interposed-path ( ihandle buf len -- len' )
        !          4975: 2>r instance>qpath 2r> string-to-buffer ;
        !          4976: : call-method ( str ihandle arg ... arg -- result return ... return )
        !          4977: nargs flip-stack zcount rot ['] $call-method CATCH
        !          4978: nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result
        !          4979: dup IF nrets 1 ?DO -444 LOOP THEN
        !          4980: nrets flip-stack 
        !          4981: THEN ;
        !          4982: : test-method ( phandle str -- missing? )
        !          4983: zcount rot find-method dup IF nip THEN 0= ;
        !          4984: : milliseconds  milliseconds ;
        !          4985: : start-cpu ( phandle addr r3 -- )
        !          4986: >r >r 
        !          4987: s" reg" rot get-property 0= IF drop l@ 
        !          4988: ELSE true ABORT" start-cpu called with invalid phandle" THEN 
        !          4989: r> r> of-start-cpu drop
        !          4990: ;
        !          4991: : quiesce  ( -- )
        !          4992: quiesce
        !          4993: ;
        !          4994: : interpret ( ... zstr -- result ... )
        !          4995: zcount ['] evaluate CATCH ;
        !          4996: : set-callback ( newfunc -- oldfunc )
        !          4997: client-callback @ swap client-callback ! ;
        !          4998: PREVIOUS DEFINITIONS
        !          4999: STRUCT
        !          5000: /l field ehdr>e_ident
        !          5001: /c field ehdr>e_class
        !          5002: /c field ehdr>e_data
        !          5003: /c field ehdr>e_version
        !          5004: /c field ehdr>e_pad
        !          5005: /l field ehdr>e_ident_2
        !          5006: /l field ehdr>e_ident_3
        !          5007: /w field ehdr>e_type
        !          5008: /w field ehdr>e_machine
        !          5009: /l field ehdr>e_version
        !          5010: /l field ehdr>e_entry
        !          5011: /l field ehdr>e_phoff
        !          5012: /l field ehdr>e_shoff
        !          5013: /l field ehdr>e_flags
        !          5014: /w field ehdr>e_ehsize
        !          5015: /w field ehdr>e_phentsize
        !          5016: /w field ehdr>e_phnum
        !          5017: /w field ehdr>e_shentsize
        !          5018: /w field ehdr>e_shnum
        !          5019: /w field ehdr>e_shstrndx
        !          5020: END-STRUCT
        !          5021: STRUCT
        !          5022: /l field phdr>p_type
        !          5023: /l field phdr>p_offset
        !          5024: /l field phdr>p_vaddr
        !          5025: /l field phdr>p_paddr
        !          5026: /l field phdr>p_filesz
        !          5027: /l field phdr>p_memsz
        !          5028: /l field phdr>p_flags
        !          5029: /l field phdr>p_align
        !          5030: END-STRUCT
        !          5031: 0 value elf-segment-offset
        !          5032: : xlate-vaddr32 ( programm-header-addr -- addr )
        !          5033: phdr>p_vaddr l@ elf-segment-offset + 
        !          5034: ;
        !          5035: STRUCT
        !          5036: /l field ehdr64>e_ident
        !          5037: /c field ehdr64>e_class
        !          5038: /c field ehdr64>e_data
        !          5039: /c field ehdr64>e_version
        !          5040: /c field ehdr64>e_pad
        !          5041: /l field ehdr64>e_ident_2
        !          5042: /l field ehdr64>e_ident_3
        !          5043: /w field ehdr64>e_type
        !          5044: /w field ehdr64>e_machine
        !          5045: /l field ehdr64>e_version
        !          5046: cell field ehdr64>e_entry
        !          5047: cell field ehdr64>e_phoff
        !          5048: cell field ehdr64>e_shoff
        !          5049: /l field ehdr64>e_flags
        !          5050: /w field ehdr64>e_ehsize
        !          5051: /w field ehdr64>e_phentsize
        !          5052: /w field ehdr64>e_phnum
        !          5053: /w field ehdr64>e_shentsize
        !          5054: /w field ehdr64>e_shnum
        !          5055: /w field ehdr64>e_shstrndx
        !          5056: END-STRUCT
        !          5057: STRUCT
        !          5058: /l field phdr64>p_type
        !          5059: /l field phdr64>p_flags
        !          5060: cell field phdr64>p_offset
        !          5061: cell field phdr64>p_vaddr
        !          5062: cell field phdr64>p_paddr
        !          5063: cell field phdr64>p_filesz
        !          5064: cell field phdr64>p_memsz
        !          5065: cell field phdr64>p_align
        !          5066: END-STRUCT
        !          5067: false value elf-claim?
        !          5068: 0     value last-claim
        !          5069: : claim-segment ( file-addr program-header-addr -- )
        !          5070: elf-claim? IF
        !          5071: >r
        !          5072: here last-claim , to last-claim                \ Setup ptr to last claim
        !          5073: r@ phdr>p_vaddr l@ dup , r> phdr>p_memsz l@ dup , ( file-addr addr size )
        !          5074: 0 ['] claim CATCH IF ABORT" Memory for ELF file already in use " THEN
        !          5075: THEN
        !          5076: 2drop
        !          5077: ;
        !          5078: : claim-segment64 ( file-addr program-header-addr -- )
        !          5079: elf-claim? IF
        !          5080: >r
        !          5081: here last-claim , to last-claim                \ Setup ptr to last claim
        !          5082: r@ phdr64>p_vaddr @ dup , r> phdr64>p_memsz @ dup , ( file-addr addr size )
        !          5083: 0 ['] claim CATCH IF ABORT" Memory for ELF file already in use " THEN
        !          5084: THEN
        !          5085: 2drop
        !          5086: ;
        !          5087: : load-segment ( file-addr program-header-addr -- )
        !          5088: >r
        !          5089: r@ phdr>p_offset l@ +  r@ xlate-vaddr32 r@ phdr>p_filesz l@  move
        !          5090: r@ xlate-vaddr32 r@ phdr>p_filesz l@ +
        !          5091: r@ phdr>p_memsz l@ r@ phdr>p_filesz l@ - erase
        !          5092: r@ xlate-vaddr32 r> phdr>p_memsz l@ dup 0= IF 2drop ELSE flushcache THEN
        !          5093: ;
        !          5094: : load-segments ( file-addr -- )
        !          5095: dup dup ehdr>e_phoff l@ +        \ Calculate program header address
        !          5096: over ehdr>e_phnum w@ 0 ?DO       \ loop e_phnum times
        !          5097: dup phdr>p_type l@ 1 = IF        \ PT_LOAD ?
        !          5098: 2dup claim-segment       \ claim segment
        !          5099: 2dup load-segment THEN   \ copy segment
        !          5100: over ehdr>e_phentsize w@ + LOOP  \ step to next header
        !          5101: over ehdr>e_entry l@
        !          5102: nip nip                          \ cleanup
        !          5103: ;
        !          5104: : load-segment64 ( file-addr program-header-addr -- )
        !          5105: >r
        !          5106: r@ phdr64>p_offset @ +  r@ phdr64>p_vaddr @  r@ phdr64>p_filesz @  move
        !          5107: r@ phdr64>p_vaddr @ r@ phdr64>p_filesz @ +
        !          5108: r@ phdr64>p_memsz @ r@ phdr64>p_filesz @ - erase
        !          5109: r@ phdr64>p_vaddr @ r> phdr64>p_memsz @ dup 0= IF 2drop ELSE flushcache THEN
        !          5110: ;
        !          5111: : load-segments64 ( file-addr -- entry )
        !          5112: dup dup ehdr64>e_phoff @ +       \ Calculate program header address
        !          5113: over ehdr64>e_phnum w@ 0 ?DO     \ loop e_phnum times
        !          5114: dup phdr64>p_type l@ 1 = IF      \ PT_LOAD ?
        !          5115: 2dup claim-segment64             \ claim segment
        !          5116: 2dup load-segment64 THEN         \ copy segment
        !          5117: over ehdr64>e_phentsize w@ + LOOP  \ step to next header
        !          5118: over ehdr64>e_entry @
        !          5119: nip nip                          \ cleanup
        !          5120: ;
        !          5121: : elf-check-file ( file-addr --  image-type  )
        !          5122: dup ehdr>e_ident l@-be 7f454c46 <> IF
        !          5123: ABORT" Not an ELF executable"
        !          5124: THEN
        !          5125: dup ehdr>e_data c@
        !          5126: ?bigendian IF
        !          5127: 2 <> ABORT" Not a Big Endian ELF file"
        !          5128: ELSE
        !          5129: 2 = ABORT" Not a Little Endian ELF file"
        !          5130: THEN
        !          5131: dup ehdr>e_type w@ 2 <> ABORT" Not an ELF executable"
        !          5132: dup ehdr>e_machine w@
        !          5133: CASE
        !          5134: 14 OF ehdr>e_class c@ ENDOF       \ PPC 32 bit executable        
        !          5135: 15 OF ehdr>e_class c@ ENDOF       \ PPC 64 bit executable        
        !          5136: 17 OF ehdr>e_class c@ 4 or ENDOF  \ SPU 32 bit executable
        !          5137: dup OF drop ABORT" Not a PPC / SPU ELF executable" ENDOF 
        !          5138: ENDCASE
        !          5139: ;
        !          5140: : load-elf32 ( file-addr -- entry )
        !          5141: ( file-addr)
        !          5142: load-segments
        !          5143: ;
        !          5144: : load-elf32-claim ( file-addr -- claim-list entry )
        !          5145: true to elf-claim?
        !          5146: 0 to last-claim
        !          5147: ['] load-elf32 CATCH IF false to elf-claim? ABORT THEN
        !          5148: last-claim swap
        !          5149: false to elf-claim?
        !          5150: ;
        !          5151: : load-elf64 ( file-addr -- entry )
        !          5152: ( file-addr)
        !          5153: load-segments64
        !          5154: ;
        !          5155: : load-elf64-claim ( file-addr -- claim-list entry )
        !          5156: true to elf-claim?
        !          5157: 0 to last-claim
        !          5158: ['] load-elf64 CATCH IF false to elf-claim? ABORT THEN
        !          5159: last-claim swap
        !          5160: false to elf-claim?
        !          5161: ;
        !          5162: : load-elf-file ( file-addr -- entry 32-bit )
        !          5163: dup elf-check-file
        !          5164: CASE
        !          5165: 1 OF 0 to elf-segment-offset load-elf32 true ENDOF
        !          5166: 2 OF 0 to elf-segment-offset load-elf64 false ENDOF
        !          5167: 5 OF load-elf32 true ENDOF
        !          5168: dup OF true ABORT" load-elf-file: Not valid image" ENDOF
        !          5169: ENDCASE
        !          5170: ;
        !          5171: : elf-spu-load ( ls-start-addr file-addr -- entry )
        !          5172: swap to elf-segment-offset
        !          5173: load-elf-file drop
        !          5174: ;
        !          5175: : elf-release ( claim-list -- )
        !          5176: BEGIN
        !          5177: dup cell+                   ( claim-list claim-list-addr )
        !          5178: dup @ swap cell+ @          ( claim-list claim-list-addr claim-list-sz )
        !          5179: release                     ( claim-list )
        !          5180: @ dup 0=                    ( Next-element )
        !          5181: UNTIL
        !          5182: drop
        !          5183: ;
        !          5184: CREATE bootdevice 2 cells allot bootdevice 2 cells erase
        !          5185: CREATE bootargs 2 cells allot bootargs 2 cells erase
        !          5186: CREATE load-list 2 cells allot load-list 2 cells erase
        !          5187: : start-elf ( arg len entry -- )
        !          5188: msr@ 7fffffffffffffff and 2000 or ciregs >srr1 ! call-client
        !          5189: ;
        !          5190: : start-elf64 ( arg len entry -- )
        !          5191: msr@ 2000 or ciregs >srr1 !
        !          5192: dup 8 + @ ciregs >r2 ! @ call-client \ entry point is pointer to .opd
        !          5193: ;
        !          5194: 10000000 VALUE LOAD-BASE
        !          5195: 2000000 VALUE FLASH-LOAD-BASE
        !          5196: : set-bootpath
        !          5197: s" disk" find-alias
        !          5198: dup IF ELSE drop s" boot-device" evaluate find-alias THEN
        !          5199: dup IF strdup ELSE 0 THEN
        !          5200: encode-string s" bootpath" set-chosen
        !          5201: ;
        !          5202: : set-netbootpath
        !          5203: s" net" find-alias
        !          5204: ?dup IF strdup encode-string s" bootpath" set-chosen THEN
        !          5205: ;
        !          5206: : set-bootargs
        !          5207: skipws 0 parse dup 0= IF
        !          5208: 2drop s" boot-file" evaluate
        !          5209: THEN
        !          5210: encode-string s" bootargs" set-chosen
        !          5211: ;
        !          5212: : .(client-exec) ( arg len -- rc )
        !          5213: s" snk" romfs-lookup 0<> IF load-elf-file drop start-elf64 client-data
        !          5214: ELSE 2drop false THEN
        !          5215: ;
        !          5216: ' .(client-exec) to (client-exec)
        !          5217: : .client-exec ( arg len -- rc ) set-bootargs (client-exec) ;
        !          5218: ' .client-exec to client-exec
        !          5219: : netflash ( -- rc ) s" netflash 2000000 " (parse-line) $cat set-netbootpath
        !          5220: client-exec
        !          5221: ;
        !          5222: : netsave  ( "addr len {filename}[,params]" -- rc )
        !          5223: (parse-line) dup 0> IF
        !          5224: s" netsave " 2swap $cat set-netbootpath client-exec
        !          5225: ELSE
        !          5226: cr
        !          5227: ." Usage: netsave addr len [bootp|dhcp,]filename[,siaddr][,ciaddr][,giaddr][,bootp-retries][,tftp-retries][,use_ci]"
        !          5228: cr 2drop
        !          5229: THEN
        !          5230: ;
        !          5231: : ping  ( "{device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]}" -- )
        !          5232: my-self >r current-node @ >r  \ Save my-self
        !          5233: (parse-line) open-dev dup  IF
        !          5234: dup to my-self dup ihandle>phandle set-node
        !          5235: s" ping" rot ['] $call-method CATCH  IF
        !          5236: cr
        !          5237: ." Not a pingable device"
        !          5238: cr 3drop
        !          5239: THEN
        !          5240: ELSE
        !          5241: cr
        !          5242: ." Usage: ping device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]"
        !          5243: cr drop
        !          5244: THEN
        !          5245: r> set-node r> to my-self  \ Restore my-self
        !          5246: ;
        !          5247: 8b0 cp
        !          5248: 8e0 cp
        !          5249: 8ff cp
        !          5250: : (boot) ( -- )
        !          5251: s" Executing following boot-command: "
        !          5252: boot-command $cat nvramlog-write-string-cr
        !          5253: s" boot-command" evaluate      \ get boot command
        !          5254: ['] evaluate catch ?dup IF     \ and execute it
        !          5255: ." boot attempt returned: "
        !          5256: abort"-str @ count type cr
        !          5257: nip nip                     \ drop string from 1st evaluate
        !          5258: throw
        !          5259: THEN
        !          5260: ;
        !          5261: : (function-key) ( -- n )
        !          5262: key? IF
        !          5263: key CASE
        !          5264: 50  OF 1 ENDOF
        !          5265: 7e  OF 1 ENDOF
        !          5266: dup OF 0 ENDOF
        !          5267: ENDCASE
        !          5268: THEN
        !          5269: ;
        !          5270: : (esc-sequence) ( -- n )
        !          5271: key? IF
        !          5272: key CASE
        !          5273: 4f  OF (function-key) ENDOF
        !          5274: 5b  OF
        !          5275: key key drop (function-key) ENDOF
        !          5276: dup OF 0 ENDOF
        !          5277: ENDCASE
        !          5278: THEN
        !          5279: ;
        !          5280: : (s-pressed) ( -- )
        !          5281: s" An 's' has been pressed. Entering Open Firmware Prompt"
        !          5282: nvramlog-write-string-cr
        !          5283: ;
        !          5284: : (boot?) ( -- )
        !          5285: of-prompt? not auto-boot? and IF
        !          5286: (boot)
        !          5287: THEN
        !          5288: ;
        !          5289: false VALUE (sms-loaded?)
        !          5290: false value (sms-available?)
        !          5291: s" sms.fs" romfs-lookup IF true to (sms-available?) drop THEN
        !          5292: (sms-available?) [IF]
        !          5293: s" /packages" find-device
        !          5294: new-device
        !          5295: s" sms" device-name
        !          5296: : open true ;
        !          5297: : close ;
        !          5298: finish-device
        !          5299: device-end \ leave /packages
        !          5300: : sms-init-nvram ( -- )
        !          5301: nvram-partition-type-sms get-nvram-partition IF
        !          5302: cr ." Could not find SMS partition in NVRAM - "
        !          5303: nvram-partition-type-sms s" SMS" d# 1024 new-nvram-partition
        !          5304: ABORT" Failed to create SMS NVRAM partition"
        !          5305: 2dup erase-nvram-partition drop
        !          5306: 2dup s" lang"                    s" 1" internal-set-env drop
        !          5307: 2dup s" tftp-retries"            s" 5" internal-set-env drop
        !          5308: 2dup s" tftp-blocksize"                s" 512" internal-set-env drop
        !          5309: 2dup s" bootp-retries"         s" 255" internal-set-env drop
        !          5310: 2dup s" client"            s" 000.000.000.000" internal-set-env drop
        !          5311: 2dup s" server"       s" 000.000.000.000" internal-set-env drop
        !          5312: 2dup s" gateway"      s" 000.000.000.000" internal-set-env drop
        !          5313: 2dup s" netmask"      s" 255.255.255.000" internal-set-env drop
        !          5314: 2dup s" net-protocol"            s" 0" internal-set-env drop
        !          5315: 2dup s" net-flags"               s" 0" internal-set-env drop
        !          5316: 2dup s" net-device"              s" 0" internal-set-env drop
        !          5317: 2dup s" net-client-name"                  s" " internal-set-env drop
        !          5318: 2dup s" scsi-spinup"             s" 6" internal-set-env drop
        !          5319: 2dup s" scsi-id-0"               s" 7" internal-set-env drop
        !          5320: 2dup s" scsi-id-1"               s" 7" internal-set-env drop
        !          5321: 2dup s" scsi-id-2"               s" 7" internal-set-env drop
        !          5322: 2dup s" scsi-id-3"               s" 7" internal-set-env drop
        !          5323: ." created" cr
        !          5324: THEN
        !          5325: s" sms-nvram-partition" $2constant
        !          5326: ;
        !          5327: sms-init-nvram
        !          5328: : sms-add-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-add-env drop ;
        !          5329: : sms-set-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-set-env drop ;
        !          5330: : sms-get-env ( "name" -- "value" TRUE | FALSE) sms-nvram-partition 2swap internal-get-env ;
        !          5331: : sms-get-net-device ( -- n )  s" net-device" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
        !          5332: : sms-set-net-device ( n -- )  (.d) s" net-device" 2swap sms-set-env ;
        !          5333: : sms-get-net-flags ( -- n )   s" net-flags" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
        !          5334: : sms-set-net-flags ( n -- )   (.d) s" net-flags" 2swap sms-set-env ;
        !          5335: : sms-get-net-protocol ( -- n )        s" net-protocol" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ;
        !          5336: : sms-set-net-protocol ( n -- )        (.d) s" net-protocol" 2swap sms-set-env ;
        !          5337: : sms-get-lang ( -- n )        s" lang" sms-get-env IF $dnumber IF 1 THEN ELSE 1 THEN ;
        !          5338: : sms-set-lang ( n -- )        (.d) s" lang" 2swap sms-set-env ;
        !          5339: : sms-get-bootp-retries ( -- n ) s" bootp-retries" sms-get-env IF $dnumber IF 255 THEN ELSE 255 THEN ;
        !          5340: : sms-set-bootp-retries ( n -- ) (.d) s" bootp-retries" 2swap sms-set-env ;
        !          5341: : sms-get-tftp-retries ( -- n )        s" tftp-retries" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ;
        !          5342: : sms-set-tftp-retries ( n -- ) (.d) s" tftp-retries" 2swap sms-set-env ;
        !          5343: : sms-get-tftp-blocksize ( -- n ) s" tftp-blocksize" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ;
        !          5344: : sms-set-tftp-blocksize ( n -- ) (.d) s" tftp-blocksize" 2swap sms-set-env ;
        !          5345: : sms-get-client ( -- FALSE | n1 n2 n3 n4 TRUE ) s" client" sms-get-env IF (ipaddr) ELSE false THEN ;
        !          5346: : sms-set-client ( n1 n2 n3 n4 -- ) (ipformat) s" client" 2swap sms-set-env ;
        !          5347: : sms-get-server ( -- FALSE | n1 n2 n3 n4 TRUE ) s" server" sms-get-env IF (ipaddr) ELSE false THEN ;
        !          5348: : sms-set-server ( n1 n2 n3 n4 -- ) (ipformat) s" server" 2swap sms-set-env ;
        !          5349: : sms-get-gateway ( -- FALSE | n1 n2 n3 n4 TRUE ) s" gateway" sms-get-env IF (ipaddr) ELSE false THEN ;
        !          5350: : sms-set-gateway ( n1 n2 n3 n4 -- ) (ipformat) s" gateway" 2swap sms-set-env ;
        !          5351: : sms-get-subnet ( -- FALSE | n1 n2 n3 n4 TRUE ) s" netmask" sms-get-env IF (ipaddr) ELSE false THEN ;
        !          5352: : sms-set-subnet ( n1 n2 n3 n4 -- ) (ipformat) s" netmask" 2swap sms-set-env ;
        !          5353: : sms-get-client-name ( -- FALSE | addr len TRUE ) s" net-client-name" sms-get-env ;
        !          5354: : sms-set-client-name ( addr len -- ) s" net-client-name" 2swap sms-set-env ;
        !          5355: : sms-get-scsi-spinup ( -- n ) s" scsi-spinup" sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ;
        !          5356: : sms-set-scsi-spinup ( n -- ) (.d) s" scsi-spinup" 2swap sms-set-env ;
        !          5357: : sms-get-scsi-id ( n -- id )  s" scsi-id-" rot (.) $cat sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ;
        !          5358: : sms-set-scsi-id ( id n -- ) swap (.d) rot s" scsi-id-" rot (.) $cat sms-set-env ;
        !          5359: : sms-get-net-boot-file ( -- addr len )
        !          5360: s" net" sms-get-net-device (.) $cat
        !          5361: s" :dhcp," $cat
        !          5362: sms-get-server IF (ipformat) $cat THEN
        !          5363: s" ," $cat
        !          5364: sms-get-client-name IF $cat THEN
        !          5365: s" ," $cat
        !          5366: sms-get-client IF (ipformat) $cat THEN
        !          5367: s" ," $cat
        !          5368: sms-get-gateway IF (ipformat) $cat THEN
        !          5369: s" ," $cat
        !          5370: sms-get-bootp-retries dup ff <> IF (.) $cat ELSE drop THEN
        !          5371: s" ," $cat
        !          5372: sms-get-tftp-retries (.) $cat
        !          5373: dup IF
        !          5374: strdup ( s" :" 2swap $cat strdup )
        !          5375: THEN
        !          5376: ;
        !          5377: ' sms-get-net-boot-file to furnish-boot-file
        !          5378: : $sms-node s" /packages/sms" ;
        !          5379: : (sms-init-package) ( -- true|false )
        !          5380: (sms-loaded?) ?dup IF EXIT THEN
        !          5381: $sms-node ['] find-device catch IF 2drop false EXIT THEN
        !          5382: s" sms.fs" [COMPILE] included
        !          5383: device-end
        !          5384: true dup to (sms-loaded?)
        !          5385: ;
        !          5386: : (sms-evaluate) ( addr len -- )
        !          5387: (sms-init-package) not IF
        !          5388: cr ." SMS is not available." cr 2drop exit
        !          5389: THEN
        !          5390: s" Entering SMS ..." type
        !          5391: disable-watchdog
        !          5392: reset-dual-emit
        !          5393: 2>r $sms-node find-device
        !          5394: 2r> evaluate
        !          5395: device-end
        !          5396: vpd-boot-import
        !          5397: ;
        !          5398: : sms-start ( -- ) s" sms-start" (sms-evaluate) ;
        !          5399: : sms-fru-replacement ( -- ) s" sms-fru-replacement" (sms-evaluate) ;
        !          5400: [ELSE]
        !          5401: : sms-start ( -- ) cr ." SMS is not available." cr ;
        !          5402: : sms-fru-replacement ( -- ) cr ." SMS FRU replacement is not available." cr ;
        !          5403: [THEN]
        !          5404: TRUE VALUE use-load-watchdog?
        !          5405: : start-it ( -- )
        !          5406: key? IF
        !          5407: key CASE
        !          5408: [char] s  OF (s-pressed) ENDOF
        !          5409: 1b        OF
        !          5410: (esc-sequence) CASE
        !          5411: 1   OF console-clean-fifo sms-start (boot) ENDOF
        !          5412: dup OF (boot?) ENDOF
        !          5413: ENDCASE
        !          5414: ENDOF
        !          5415: dup OF (boot?) ENDOF
        !          5416: ENDCASE
        !          5417: ELSE
        !          5418: (boot?)
        !          5419: THEN
        !          5420: disable-watchdog  FALSE to use-load-watchdog?
        !          5421: .banner
        !          5422: ;
        !          5423: ."      "   \ Clear last checkpoint
        !          5424: 0 VALUE load-size
        !          5425: 0 VALUE go-entry
        !          5426: VARIABLE state-valid false state-valid !
        !          5427: CREATE go-args 2 cells allot go-args 2 cells erase
        !          5428: : $bootargs
        !          5429: bootargs 2@ ?dup IF
        !          5430: ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate
        !          5431: ELSE s" boot-file" evaluate THEN THEN
        !          5432: ;
        !          5433: : $bootdev ( -- device-name len )
        !          5434: bootdevice 2@ dup IF s"  " $cat THEN
        !          5435: s" diagnostic-mode?" evaluate IF
        !          5436: s" diag-device" evaluate
        !          5437: ELSE
        !          5438: s" boot-device" evaluate
        !          5439: THEN
        !          5440: $cat \ prepend bootdevice setting from vpd-bootlist
        !          5441: strdup
        !          5442: ?dup 0= IF
        !          5443: disable-watchdog
        !          5444: drop true ABORT" No boot device!"
        !          5445: THEN
        !          5446: ;
        !          5447: : set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ;
        !          5448: : (set-boot-device) ( str len -- )
        !          5449: ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2!
        !          5450: ;
        !          5451: ' (set-boot-device) to set-boot-device
        !          5452: : (add-boot-device) ( str len -- )     \ Concatenate " str" to "bootdevice"
        !          5453: bootdevice 2@ ?dup IF $cat-space ELSE drop THEN set-boot-device
        !          5454: ;
        !          5455: ' (add-boot-device) to add-boot-device
        !          5456: 0 value claim-list
        !          5457: : no-go ( -- ) -64 boot-exception-handler ABORT ;
        !          5458: defer go ( -- )
        !          5459: : go-32 ( -- )
        !          5460: state-valid @ IF
        !          5461: 0 ciregs >r3 ! 0 ciregs >r4 !
        !          5462: go-args 2@ go-entry start-elf client-data
        !          5463: claim-list elf-release 0 to claim-list
        !          5464: THEN
        !          5465: -6d boot-exception-handler ABORT
        !          5466: ;
        !          5467: : go-64 ( -- )
        !          5468: state-valid @ IF
        !          5469: 0 ciregs >r3 ! 0 ciregs >r4 !
        !          5470: go-args 2@ go-entry start-elf64 client-data
        !          5471: claim-list elf-release 0 to claim-list
        !          5472: THEN
        !          5473: -6d boot-exception-handler ABORT
        !          5474: ;
        !          5475: : load-elf-init ( arg len file-addr -- success )
        !          5476: false state-valid !                            \ Not valid anymore ...
        !          5477: claim-list IF                                    \ Release claimed mem
        !          5478: claim-list elf-release 0 to claim-list        \ from last load
        !          5479: THEN
        !          5480: dup ['] elf-check-file CATCH IF
        !          5481: ( -64 THROW ) \ Not now, let the 'go' (i.e. no-go) whine about it
        !          5482: drop 0
        !          5483: THEN
        !          5484: CASE
        !          5485: 1 OF true swap ['] load-elf32-claim CATCH IF
        !          5486: 2drop drop -66 THROW
        !          5487: THEN
        !          5488: ['] go-32 ENDOF                            ( arg len true claim-list entry go )
        !          5489: 2 OF true swap ['] load-elf64-claim CATCH IF
        !          5490: 2drop drop -66 THROW
        !          5491: THEN
        !          5492: ['] go-64 ENDOF                            ( arg len true claim-list entry go )
        !          5493: dup OF drop ['] no-go to go
        !          5494: 2drop false EXIT   ENDOF                   ( false )
        !          5495: ENDCASE
        !          5496: to go to go-entry to claim-list
        !          5497: dup state-valid ! -rot
        !          5498: 2 pick IF
        !          5499: go-args 2!
        !          5500: ELSE
        !          5501: 2drop
        !          5502: THEN
        !          5503: ;
        !          5504: : init-program ( -- )
        !          5505: $bootargs LOAD-BASE ['] load-elf-init CATCH ?dup IF
        !          5506: boot-exception-handler
        !          5507: 2drop 2drop false          \ Could not claim
        !          5508: ELSE IF
        !          5509: 0 ciregs 2dup >r3 ! >r4 !  \ Valid (ELF ) Image
        !          5510: THEN
        !          5511: THEN
        !          5512: ;
        !          5513: : do-load ( devstr len -- img-size )   \ Device method wrapper
        !          5514: use-load-watchdog? IF
        !          5515: 4ec set-watchdog
        !          5516: THEN
        !          5517: my-self >r current-node @ >r         \ Save my-self
        !          5518: ." Trying to load: " $bootargs type ."  from: " 2dup type ."  ... "
        !          5519: 2dup open-dev dup IF
        !          5520: dup to my-self
        !          5521: dup ihandle>phandle set-node
        !          5522: -rot                              ( ihandle devstr len )
        !          5523: my-args nip 0= IF
        !          5524: 2dup 1- + c@ [char] : <> IF    \ Add : to device path if missing
        !          5525: 1+ strdup 2dup 1- + [char] : swap c!
        !          5526: THEN
        !          5527: THEN
        !          5528: encode-string s" bootpath" set-chosen
        !          5529: $bootargs encode-string s" bootargs" set-chosen
        !          5530: LOAD-BASE s" load" 3 pick ['] $call-method CATCH IF
        !          5531: -67 boot-exception-handler 3drop drop false
        !          5532: ELSE
        !          5533: dup 0> IF
        !          5534: init-program
        !          5535: ELSE
        !          5536: false state-valid !
        !          5537: drop 0                                     \ Could not load
        !          5538: THEN
        !          5539: THEN
        !          5540: swap close-dev device-end dup to load-size
        !          5541: ELSE -68 boot-exception-handler 3drop false THEN
        !          5542: r> set-node r> to my-self                           \ Restore my-self
        !          5543: ;
        !          5544: : parse-load ( "{devlist}" -- success )        \ Parse-execute boot-device list
        !          5545: cr BEGIN parse-word dup WHILE
        !          5546: ( de-alias ) do-load dup 0< IF drop 0 THEN IF
        !          5547: state-valid @ IF ."   Successfully loaded" cr THEN
        !          5548: true 0d parse strdup load-list 2! EXIT
        !          5549: THEN
        !          5550: REPEAT 2drop 0 0 load-list 2! false
        !          5551: ;
        !          5552: : load ( "{params}<eol>"} -- success ) \ Client interface to load
        !          5553: parse-word 0d parse -leading 2swap ?dup IF
        !          5554: de-alias
        !          5555: set-boot-device
        !          5556: ELSE
        !          5557: drop
        !          5558: THEN
        !          5559: set-boot-args s" parse-load " $bootdev $cat strdup evaluate
        !          5560: ;
        !          5561: : load-next ( -- success )     \ Continue after go failed
        !          5562: load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate
        !          5563: ELSE drop false THEN
        !          5564: ;
        !          5565: : noload false ;
        !          5566: ' no-go to go
        !          5567: : (go-and-catch)  ( -- )
        !          5568: ['] go behavior CATCH IF -69 boot-exception-handler THEN
        !          5569: ;
        !          5570: read-bootlist
        !          5571: : boot
        !          5572: load 0= IF -65 boot-exception-handler EXIT THEN
        !          5573: disable-watchdog (go-and-catch)
        !          5574: BEGIN load-next WHILE
        !          5575: disable-watchdog (go-and-catch)
        !          5576: REPEAT
        !          5577: .banner
        !          5578: ;
        !          5579: : load load 0= IF -65 boot-exception-handler THEN ;
        !          5580: : yaboot ." Use 'boot disk' instead " ;
        !          5581: : netboot ( -- rc ) ." Use 'boot net' instead " ;
        !          5582: : netboot-arg ( arg-string -- rc )
        !          5583: s" boot net " 2swap $cat (parse-line) $cat
        !          5584: evaluate
        !          5585: ;
        !          5586: : netload ( -- rc ) (parse-line)
        !          5587: load-base >r FLASH-LOAD-BASE to load-base
        !          5588: s" load net:" strdup 2swap $cat strdup evaluate
        !          5589: r> to load-base
        !          5590: load-size
        !          5591: ;
        !          5592: : neteval ( -- ) FLASH-LOAD-BASE netload evaluate ;
        !          5593: cr .(   Welcome to Open Firmware)
        !          5594: cr
        !          5595: cr .(   Copyright (c) char ) emit .(  2004, 2011 IBM Corporation All rights reserved.)
        !          5596: cr .(   This program and the accompanying materials are made available)
        !          5597: cr .(   under the terms of the BSD License available at)
        !          5598: cr .(   http://www.opensource.org/licenses/bsd-license.php)
        !          5599: cr cr
        !          5600: ' start-it CATCH drop
        !          5601: cr ." Ready!"
        !          5602: GNU���jƤ�
M�����&GCC: (Debian 4.4.5-10) 4.4.5.shstrtab.slof.loader.text.opd.got.data.comment.branch_lt.bss&&&@&&_�&bb�#&f�f��(&ghgh�.&0a�a�&&7&a�a�Bpa���9&a�G&��������H0bootinfo&&��������&0p&0@(snkELF&&�0@&.@@8&@&&-�2ұ&|�����8c��|�#x�&�!��|c"xc H�1`8!�|�;���|�||c8�&����|�N� &�&`|�������8`�&�!����肀��P{� ��x��H��`9 �J;�U)0W�0��PW�����|Hl|�|O�|�L&,9)�B��H1`8!��&����|�N� &�&`|���������|~x|�#x�&�!��8 9`�A���a��|      ���������9@�!�A�"� ```8&�i�I9)@|�B�쀢�,�€<8�p;����b�0|�0Px� H5�`/�A�&�"�@�&p8�;@낀����"���P� {� #�x��x��H�i`��x��x8`H�U`I�xk�x}kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L&,9)�B��H�`��x��xH        �`||xH�`$�x��x8`H��`{�;{WZ0W{0z�PW{��i�|�l|�|׬|�L&,;Z�B��H �`8!���x�&�!���A���a��|���������������N� &�``|�xi �&�!��8      ��+�&@�(+�@�x8`��8!p�&|�N� ``/�@��8&9&p| �|�#x} Cx9@
�8�&� | P9)&�(���/
        !          5603: A�p@�B��`|�HP}Cx�"�Hx`6d}i|  ./�A��xxc6d8})*/�A��d� �A(}c[x|     ��i�IN�!�A(K��D``�I9)&K���8�9&pK���&�```|����������&�!����&���&�|dx��&���&��&&��!&��A&�;�p8�&���xH�`��x|~x8`&��xK���8!&���x�&��������|�N� &�```|��&�!��H]`8!p�&|�N� &�|���������8`|�#x�&�!��|�+xH
        !          5604: �`,#A�T�#@/�A�H�     �A(��x��x| ��i�IN�!�A(8!��&��������|�N� ``�b�PK���8`��K���&�`|�+�
��������|x�&�A���a�����������!�QA�d�"�XyJ�|     R�} J})�N� HH&&H&x8HHhxHHH�|�+�@�``8`��8!��&�A���a�����|������������N� `/�A�|A��/�&@���8`��pH    5`��p|yA���?/�A�؀/�A��|�;x8�P8�H��``8!�8`�&�A���a�����|������������N� `|�+�A��8�"�H{�6d|i�|      �./�A�� �#/�@�&hK��```8!�|c��&�A���a�����|������������K���`�b�H8 |��;�}i[x|     �H`;�&9)@��B@&4�     /�@���{�6dK�뢀`;�HH� �A(C�x��xe�x|     ��i�IN�!�A(/�A��;�&;���/�
        !          5605: A��@�}/�A����+0/�A��؀/�@����+�  �A(| ��i�IN�!�A(�=�)0K��p```|�+�A����"�H{�6d|i|     ./�A����#|��/�A�&`�     �A(| ��i�IN�!�A(K���```��xK���``�b�h��xK��y8`��K��d```8!�|��|�+x|��|���&�A���a�����|������������K���``/�A���/�@��8`��x��pHu`�x��p,#A���#8/�A�t�     �A(|�+x|��| ��i�IN�!�A(K����"�H{�6d|i�|     �./�A����#0/�A���� �A(| ��i�IN�!�A(8`��K��h�b��K��m8`��K��X8`��p��xH�`�p�x,#A���#H/�A�t�     �A(|�#x|�+x| ��i�IN�!�A(K��� �A(| ��i��p�IN�!�A(���p8`��/�A���K��<�b�xK���8`��K����b�pK���8`��K���&�`|��!���A��; ;@�a������|�+x�"��������|}x|~x�&�&�������!�Q�/� H���x/� ;�&A���@@����P��P{ �xH�u`8�����xx� ��x�{H�9`����?��`�&/� A���<�@@�;Z&;{Z�/
        !          5606: ��x@���8!�8z&|c��&�&���!���A��|��a����������������N� &�|�����|���&�!�1;�p��xK�����xH�=`8!��&����|�N� &�&`|�����|���&�!�1;�p��xK��u��xH��`8!��&����|�N� &�&`T`�>Tc@.|cxxc N� x` xc�T  D.T�>} xTiD.Tc�>}#xT�|xxc N� `x` xc"xi x UhD.U*D.xc�x�Uk�>U)�>}[x}IKxTD.TjD.T�>Tc�>}x}CxUk�U)�}`x}#xx�xc |xN� ```|mB�|B�|�B�| @���xc�|cxN� `}mB�|B�|�B�| @���yk�}kx}k}-B�|B�|�B�|      @���y)�})x�H@@�8�|     �`B@��B��K���N� `}-B�|B�|�B�|      @���y)�})x�b������k}cY�}kykt�}iZ``}-B�|B�|�B�|  @���y)�})x�H@@�8�|     �`B@��B��K���N� `}-B�|B�|�B�|      @���y)�})x�b������k}cY�yk��}kyk�}iZ`}-B�|B�|�B�|  @���y)�})x�H@@�8�|     �`B@��B��K���N� `��������|��†����;��&�!�q;�PH``��;���A�L�?/�A���     /�A����) � �A(| ��i�IN�!�A(��;���@���8!��&�����������|�N� &�8
        !          5607: �"��|  �`�i9)/�A���A�B��9`}c[xN� ``��������|��†����;������&|}x�!�q;�PH;���A�8�?/�A��� ��@����     /�@�4��;���@���8!��&����������|�����N� �) � �A(| ��i�IN�!�A(��K���&�```��������}�&뢀�||x����|������&�}���!�a.#A�&\;�;�H$```�|�;�.#A�&0��xH�Y`8&/�@���A�&{�.�{�$�P8
        !          5608: ���€�|      ���x��x�``�i9)/�@�dB��9`
        !          5609: ;�}i��
        !          5610: 9?&/�A�d}?�9JB��;���8!���x�&��������|���������}�� N� `���@���;���K���```��x8�pH'�`||�/�A�h8!�;�����x�&��������|���������}�� N� `8!�;�����x�&��������|���������}�� N� �p|ex��xH��`��x�J;�U)0W�0��PW�����|Hl|�|O�|�L&,9)�B����b���A(|    �8�x�}�]N�!�A({�$/�|~&*A� �/�@���8cPH=`K���;���K����```��������|~x�
|��&�!���/�A�4;�`���@�K��E/�@�<�;�/�@���8!�8`�&��������|�N� ```8!��"��xc$�&����|i*����|�N� &�|������b���&�!���"���B���������`�KX9`       }i��   9)8�     9)B���
�/�A�;�K��q�;�/�@���8!��&����|�N� &�&`|�3x|�;x|&x|��B�`&�<X}��(|!B�A@��8���€����B���*K��Y�8|���A@�!N� |��&�!��|�3x|�;xK����!�&|�N� �"���!K����b���#��&0}���A@�aH�P�X��`��h�&p�!x�A������������&��!��A��a������������&��!��A&�a&�&�&��& ��&(8!&0�&H|��&P|��&8|��&0�a@8!XL$���`N� |����������&�����!�q�€���xHq`���/��A��肁8�8�H�`�/�@��x� 8�&K���`|}yA����xH
�`/�|dxA�L�b� ��H�`/��@�x��8`8!��&�����������|�N� ``�b�H�
`8`��K���```�b�H��`8`��K����b�H��`8`��K����b�(H��`8`��K���&�``|��������|dx�&�!�a�/�A�@8�p8�H�`8/���A��&r8!�|x�&����|�N� `���K��]���K���&�&|������&�!��K��1/�@���b�0K��a��8��b�@K��Q��b�HK��E��b�PK��9��b�XK��-��b�`K��!��b�hK����b�pK��       ��b�xK���� �b��K���$�b��K���(�b��K��ِ,8!��&����|�N� &�&|���������x�d�&����/�|�3x�!�q�⁘8}`Z�!��&�����A�������P9!�@�49D��|xyJH9J}IR`9)�P�   ���9k@���/�@��;����P8{� ;�&{�d9=��y)��9)&})�9 `|I.9)B���"����x��H#�`/�A�,�P9 ```|H.|I.9)��@����?P�i8!��&�����������|�N� �"����x��H#}`8`K���&�```�"�8|�8�8�&�&�!��8 8` � ,8�pK��i�b��K��`�ar8!��&|�N� &�``|���������|~x�&����8|�#x뢁8�!�a�}*/�A�$|�+x8�8�&8�p��x��K����*�r�b��|x��x��xK��y`�ar8!��&�����������|�N� &�`|��"�8|kx8`���&�!�a8���&���&/�A�D���|�3x8��+�K8�&8������k��p�ax�&�K��-�a�8!��&|�N� &�``|��"�8����|x8`���&�!�A8���&��     "/�A�D|x8&��&p8&�8��&x8�8&�8��8���&�9&�9!�9A�K����a��&���&���&���&���&���&���&�8!���&����|�N� &�&``|��"�8�&�!���i/�A�8�8�&8�pK��   �ar8!��&|�N� &�`|��b�8|ix�&�!�q|�#x�k/�A�(9`8�&�!��&�8�&8�p�ax8�xK����ar8!��&|�N� &�``|��"�8|gx�&�!���i/�A�8�&8�&8�pK��E�ar8!��&|�N� &�|��b�8|ix�&�!�q|�#x�k/�A�(9`8�&�!��&�8�&8�p�ax8�xK����ar8!��&|�N� &�``|��"�8}Cx�&�!�q|`x�i/�A�/�@�HT�@.�i
        !          5611: |�;xT��|�+x|�#x8��|��}i[x8�8�&K��Y�a�8!��&|�N� T�@.|�;xT��|�+xx   �ap|�#x8��|v|��8�8�&K���a�8!��&|�N� &�```|��"�8�&�!��|`x�i/�A�/�@�L�i/�A�,T�@.|�;xT��|�+x|�#x|��8�8�8�pK����av8!��&|�N� T�@.|�;xT��|�+xx  |�#x8�p|v|��8�8�K��E�av8!��&|�N� &��"��8&8`�     N� �"��88`� N� |�#xN� ```|�#xN� ```8`N� ```|���������|~x8��&�!�18�L;�p��xH��`�����x��|�&p8&�&tH�`8!��&��������|�N� &�```|���������|~x8��&�!�18�L;�p��xH�y`�����x��|�&p8&�&tHQ`8!��&��������|�N� &�```|�|iy8`���&�!��A�8� �)8�iK��Y8`8!p�&|�N� &�`|���������||x|�+x�&����8�L|�#x�����!�!8�;�p��xH��`�����x��|�&p���8�&t���Hi`8!��&��������������|�N� &�```|���������||x|�+x�&����8�L|�#x�����!�!8�;�p��xH��`�����x��|�&p���8�&t���H�`8!��&��������������|�N� &�```|���������|}x|�#x�&����8�8�L�!�!;�p��xH�a`�����x��|�&p���8�&tH5`8!��&�����������|�N� &�```|���������|}x|�#x�&����8�8�L�!�!;�p��xH��`�����x��|�&p���8�&tH�`8!��&�����������|�N� &�```�"�� /�M� ���iK��X``|���������|~x8��&�!�18�L;�p��xH�`8&��x�"���|�&t�&x�!pH�`�a�8!��&��������|�N� &�`|���������|~x8��&�!�18�L;�p��xH��`8&��x�"����|�&t�&x�!pHm`�a�8!��&��������|�N� &�`|���������|x|�#x�&�!����K��a�"��|`x/�8`��{�d���A�<��B�9)8`�b����_0��yd})B�?89 &�?8!��&��������|�N� &�|���������|~x8��&�!�18�L;�p��xH�y`8&��x�"���|�&t�&x�!pHM`�a�8!��&��������|�N� &�`|���������|~x8��&�!�18�L;�p��xH��`8&��x�"� ��|�&t�&x�!pH�`�a�8!��&��������|�N� &�`|���������|~x8��&�!�18�L;�p��xH�y`8&��x�"�(��|�&t�&x�!pHM`�a�8!��&��������|�N� &�`|���������|~x8��&�!�18�L;�p��xH��`8&��x�"�0��|�&t�&x�!pH�`�a�8!��&��������|�N� &�`|�����8�8�L�&�!�1;�p��xH��`��8��x�&p8&�&xH]`�a~8!��&����|�N� &�&``|��A���a��|zx|�#x�&����8�|�+x��������8�L;������!�;�&;�p��xH��`��@��x��t�&p���8�&|H�`��x8�8�LH��`��H��x��t�&p��x�A|�a����H�`�a�8!��&�A���a�����|������������N� &�``|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH�   `��P��x��|�&p���8�&t���8&�&xH�`�a�8!��&����������|�����N� &�|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH�i`��X��x��|�&p���8�&t���8&�&xH1`�a�8!��&����������|�����N� &�|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH��`��`��x��|�&p���8�&t���8&�&xH�`�a�8!��&����������|�����N� &�|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH�)`��h��x��|�&p���8�&t���8&�&xH�`�a�8!��&����������|�����N� &�|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH��`��p��x��|�&p���8�&t���8&�&xHQ`�a�8!��&����������|�����N� &�|�|iy8`���&�!��A��)8|���iK��=8!p�&|�N� &�```|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH��`��x��x��|�&p���8�&t���8&�&xHa`�a�8!��&����������|�����N� &�|�|iy8`���&�!��A��)8|���iK��=8!p�&|�N� &�```|���������||x|�#x�&����8�|�+x�����!�!8�L;�p��xH�`�����x��|�&p���8�&t���8�&xHq`�&��a�8!�|4T�~x ������|���������|c8�&|�N� &�``|��a������||x|�3x�&����|�#x8���������|�+x8�L�!�;�p��xH~�`�����x��|�&p���8�&t���8&�&x�a�H�`�a�8!��&�a��������|���������N� &�|������b���&�!��K���/���A�D;�p肂�8���xK��!��xK���|`x8!�|x�&����|�N� ``�b��K��m/���|`xA���;�p肂�8���xK���K���&�&``|�����|x�&�!��K��M/���A�$8!�肂���x8��&����|�K��t8!��&����|�N� &�&}�&|�.&����|�#x�&���!��A��肂�8�p8��K��!/�@�x9!�H@```�   ��}c���@A��i��|x �@@�`/�9)@�49c��9I��@��Ȉ     ��}c�/�A���/�9)A���``8`��8!&`�&������|�}�� N� �jxcG�/�@���8!&`8`�&������|�}�� N� 肂�K��$�&```|��!���&��8�&��&������������|�#x��������|x��x�������������A���a���!�!�"��$�x;�|��xK������x8�K��u/���|~xA����x{� K���:�t:�x;&p|}x��xK���|{yA�``�B��~ųx8���xD�xK��m肂�8�~�x��xK��YD�x�x8�c�xK��E�&t�Ap��x��x肂�8�&�Z�&xZK��{Z /�A�&�/�A�&X��t�!x{U(��x��p|uP~��9     ��{Zd|�"y�x�d|�*9z� xc }B,�/,$�Gy@G���A�A�d|�+x8A� `�i9)x��@|[x@���A�&HA�&x|�;x9 |��H�Ky)�}IKxB����|     �0@A�4|c�|��xc }�|�/�@�x|��K��l```�0@A���/�A��/�8A�<9L��x�dyJ }gZ9J&}I�```�Kx�9k|SxB��})0P|     ���x8�&�$�x��xK���}�xc�x$�x��x8�&�K�����xK��|{y@���8!��&����������|������&���!���A���a����������������N� `�'�gy)�})[xK���8&xd}G}g.�
        !          5612: yk�}`xK��D9 K������x8�&K���|~xK��,&�|�����|x�&�!��K��m8!�|dx��x�&����|�K��p&�&|���������||x�&����8�����!�a�&x�&pK��e|yA�@뢂�;�x�&x��x��x��x8��&pK��9/���x@�<K��)|y@���8!�8`�&����������|�����N� ``8ap��xK����ap8!��&����������|�����N� &�`|���������|~x�&���������!��K��A8��/���|xA�&@K��}낂�;�p8�@��x��xK��e肂���xHt�`/�A�&<肂�8��8���x;��K��5肃8��8���xK��!肃8��8���xK��
肃8��8���xK���肃8��8���xK���肂���x��x8�&�K���9^x8��/�@���&�x    �"x�"���>�``�8c��|c�T     >xG"9)��/�y)�y+&�y)d}iXP}jZ9+ � �� �;��     A�����xK���8�~x8!`|x�&����������|�����N� ```肂�8�x8���xK��&��x��x8�|8�@K���8!`8|x�&����������|�����N� &�`|��A���a��|�3x|�+x�&������������|~x|�#x�b���������������&���!���!�AK������8��/���||x��_@�L8!�|x�&���������&��|��!���A���a����������������N� ```�b� ��8:�&���B�; |x肃(8��8�[0���;���K���8��@��H8��x�[p|x��x�P�;X肃0K����肃88�&K���8��/�A��,��xK���/���A�t�b�HK���/���A� K���/���A�肃P��x8�K��9K���`��`�B�p8��"�X�b�h�p�>h�^(�~ ���K��!8�K����>�b�@� �A(| ��i�IN�!�A(K��l&�
        !          5613: ```|���������|}x|�#x�&����8�L8��!�!;�p��xHs�`��x��x��|�&p8&�&t8�&xHq`�&���a�8!��&�����������|�N� &�```|���������||x�&����|�#x�����!�Hq-`;�x8�8�L|}x��xHr�`�����x����&x���8�&|8�&�H�`�&��!��a�8!�x�|Kx��&������|���������N� &�``/�A�L/�A�4/�&8A�|xN� ```�|xN� `�|xN� `�|xN� ``/�|ixA�8/�A� /�&8`��L� ��8`N� `��8`N� `��8`N� ``|�|�;x�&�!��8T:|�+x|�|�#x8�K��)`8!p�&|�N� &�`|�8�|�+x�&�!��T�:|�#x|��8�K��`8!p�&|�N� &�``|��A���a���&����||x��������|�#x|�+x�����!�a;�W�:����x��x��x8�K��5`9����x��x��x|zx8���xK��A`��x��x��x��x8�K���`��x��x��xH�x|{x8���xW{:K���`8!�|{�|c��&�A���a�����|������������N� &�肃�|���!��|���&N�!�&|�8!N� |��N� `�"��9I�        /�A�0}`=J �P@8`��M� �i|xN� ```}@Sx�I=J }`8`���P@@���N� `8DN� ``8DN� ``8
DN� ``8D|c�N� `8D|c�N� `8D|c�N� `|�#x|�+x|�3x|dx|x}%Kx8       8`&D|c�N� ``|�#x|�+x|�3x|�;x}   Cx|dx|x}�cx}FSx}g[x8       8`D|c�N� ``|�#x|�+x|�3x|dx|x}%Kx8 8`D|c�N� ``|�#x|�+x|�3x|dx|x}%Kx8 8`D|c�N� ``�"������ixc��|cxc�|c�N� `�"���iN� ``|v�N� ```|v�|c�N� ``�b��N� ```��������|x|�3x|�8c�&�!����|�+x8�Hl�`��x��x8�Hl�`8!��&��������|�N� &�`|�|�#x8��&�!��|dx8`K��E`8!p�&|�N� &�|�|dy�&�!��A�0�b��8�HlU`8!p�&|�N� ```�b��8�8�Hk�`8!p�&|�N� &�|���������8�8���&�����!�a�ƒ�;���xHk�`8`��x8��8�K���`8,#@�,8!�|x�&�����������|�N� ``x} +�
A�8��K���```肃���x8�Hk�`/�A�<肃���x8�Hk�`/�A� ��x��x8�Hkm`/�@�P�/�A�(/�@���8���8~|��H�`|`xK��88���8~|��H1`|`xK��|$x833��x8��pHj�`/�A���8��K���&�``�"���iN� ``�"���iN� ``�"���iN� ``�"���iN� ``89 ���� ���
        !          5614: ����8�&�#8E���N� ``�"���iN� ``�"��|���������;��&����8;������!�q��x�  �     ;�� ��{�>${�M�|`P8�|P;�&xcd||8�8c��Hh�`/�
        !          5615: ���;��@����"�����8!��������      �&��������|�N� &��"���iK��8``�"���iK��``�"���iK���``|�=# �&�!��<�`���@A�T�"���b��x`�bTj�>8!p� �I8^�     �i8�     &�k8&�     �&|�N� ``�"���b��88��8��     Hg�`8!p�&|�N� &�`|���������}Cx|�;x�&����8|�3x�����!�q|x���8|�+x�88��8&�8cHge`����x88�HgM`8!����&����������|�����N� &�`|�+������a��||x�&�������������!�QA�88`��8!��&�a��������|���������N� ```�/�&@��Ġ/�@���뢃���=�@����#/�&A�4/�@���K��1`8�8�Hf�`/�A��8`K��l/�A����;�8�8�*�&p;�xM�x     >$})XP|HPxd�;�
        !          5616: ��xHe�`K���`8���x|ex��xK���`K���`���&p��x8�|ex8~K�����x8�*K��&`8`K��ā|/�A���<��́=����x`���y >$y%M�|(P�8@|      P9I&xd�A��|�?�XA�$|
        !          5617: 0T��T        8T<} J})PPy) K���;�肃�8��;���xHei`|{y@��(8���x8�Hd�`�/�@���;�
        !          5618: ��x8���xHd�`���xK��`�8`K���&�``}�&|���������|�#x�&����8|x+�������&��8`���!���A���a�������!�!A�&��/�A�(/�&A� �ƒ�9`
        !          5619: 8}i��
        !          5620: ��x��x;8``�i9)|ZB��x       x�| �?   x�|/�|��
        !          5621: A�܂�z� /���A�&Ё>} H�~�8�A�&����A�\�|�x|H8,@�X�>�~�H@A��y*M�y >$|PP=��|      Pa��x
        !          5622: d}^R�J��@�H�`�J��A��9)&|    @T��T
        !          5623: 8T<|R} HPy) y*M�y >$|PP�H@|    Px
        !          5624: d}^R@���;��b���"��.<y`>$yxM��P8��P8�*{d�;[;�
        !          5625: ��xHb�`K���`��~�x8�&G�x|ex8xK���K��]`8�F�x|ex��xK��e`��x8�*K���`A� 8`��8!��&�������&��|��!���A��}�� �a����������������N� ``�ƒ���K��܀|�x|H8,@��L��B��;�x  >$xM�})XP;Z|HPxd�K���`;�
        !          5626: F�x{� 8�|ex��xK���`��x��x8|;�Ha�`��x��K���`8!��&�������&��|��!���A��}�� �a����������������N� ``�>�~��H@A��,y*M�y >$|PP<���|  P`���x
        !          5627: d}^R�J�@@� H````�J�@A�H9)&|    8T��T
        !          5628: 8T<|R} HPy) y*M�y >$|PP�H@|    Px
        !          5629: d}^R@���K���xd;>�.<A��b��;\8�C�xd�xH`�`/�@������~K��l```��B��;�x    >$xM�})XP|HPxd�K��X``�ƒ�����K���``8;Ap�C�x8�8�H_�`�;�       ����&y�a|/�8����!rA�,8   ��9T<}k8�<;��X|J@���9a�``�:;Z�X|J@���x  x�| x     �|     |��K��|�>�=@��aJ��8 &y&M�}`PUk��Ug8Uk<}k:y'>$|P|�0Px |     8Pxd�X�~�@�$9k&}+PU)��U*8U)<})R}iXP�~�?8�8�}9&.8|{� H^�`K��y`f�x8�|ex8|
        !          5630: K��`��x��x8|;�H^�`���8`K���b���~K��x�      ```�"��|�/����������&�!�|`x�i@�8!��&��������|�N� ;�p9@E�Ap9@;��9 9`�_&�9@p8�_�9@��8a��_�9@&8�*�_   �?
        !          5631: 8�T�?�&�8�v��>8&��~&H]Y`��x9A�8`�i9)�P|Z@���x       x�| ��xx �|     8�p|��K���8!��&��������|�N� &�|���������|�#x�&�!���A���a�����������!�Q�|?x/�A�&�/�A��/�A�88`8?��&�!���A���a��|���������������N� `�DmK��/��vA�&�8?�8`���&�!���A���a��|���������������N� 82�!|:xx�9`E|�;`}!&j�9%;�x� %�x;�p;���x�>�~9 ���~�>9`9 &�~&�>       ����~��
        !          5632: H[�`�~��9`.��x}i�8```�i9)|ZB��x   x�| 8�x �|     ��x|�|���K����&8`�A�x8?��&�!���A���a��|���������������N� ``�/�A�,/�@��\8�����&8ix� H
`8`K��@8�����&8ix� H=`8`K�� �$/�&@��T�"���c�I�X@��@/�A��8� 8`K���&�```|�+���������|x�&�!��@�@�ƒ��>/�A�T�_y@ �@A�t/���A�l�>/�A�`�H@A�X8`��8!��&��������|�N� ``�_=`��ak��y@ �X@@���= ��a)���H@A���K���`9`
        !          5633: 8�
        !          5634: }i��
        !          5635: ��x8�8�i9)|ZB��x   x�| x     �|     |�T>�@@��\�x �@�4x ��A������x8~;�HY}`8`K��0```;�;���~�A�8`K���~   �     �@���~��@��܀�P@��Р�y)$8i8���|~x� HY&`�x��@����?T8��x��x|J��     /�A�X/�A�4/�&@��x8!���8�8����&����|������|�K��t��88���|��H�`K��8��88���|��H&�`K��&�```8�������N� ```|�+��&�!��@��/��A�8!p�&|�N� |�+xH&�`8!p�&|�N� &�``|�x� +��&�!��A�8`��8!p�&|�N� `�/��A�Hl
        !          5636: ��/��&A�L/�D@��̠/�C@���9)��8c}$�H�`K���```H-�`|ctK����/�5@���9)��8c}$�H&�`|ctK��h&�```8`��N� ```N� �"��i8`N� `|��a������|{x;���������|�+x|�+x�����&|�#x�!�a```�?|�P��x��x})tU+28�&|J/��x� ,��/)A�\A�lA��HV`�?})t8        &��|�P��x��x�?})tU+28�&|J/��x� ,��/)@����;�x���K��d/��>A�p8!���x�&�a��������|���������N� ```肃���xHS   `8!�8`�&�a��������|���������N� ;�&K���&�`|���������|x�&�&���!���A���a�����������!�Q�/�4A�88`8!��&�&���!���A��|��a����������������N� �T(mi��/��@���x       !@�h�;�/�A�x낄;�H``�;���@�T��x��x��x;�&K�����,#@���8`��K��\``�"��8&8`� K��@```�/�A��$�b��;�;;;�;[&8�xH ``;�&�����@�����x��x��xK��1|~yA��x�/�&@���D�x��xHP�`/�@�4�/�&/A�dA�@�>8     
        !          5637: �K���```��x�xHPy`/�@���K���`8�
        !          5638: ��x%�xK���/�@���8`��K��D�
        !          5639: 8`�K��4&�`|��!���A��;@&�&�a��|{x�����������������!�QHP�`뢃�8�;�;�{� ��x;�(;=8{� {� ��xHR]`9=,84�,8&d�x#�x�      �IHP`c�xHPI`8�8�x� `��&8c&8�5xc }9Y.8}$�IK���`��8�(��xx� 8�8�K��`��x��K��e`8!��&�!���A���a��|���������������N� &�`|��!���A��|�#x�&�a��8��������||x��������������&���!�A�B���b��;�    D�x��x��xHO        `肄��xHP)`/�A�肄��xHP`;�뢄��x��xHO�`/�A���x��xHO�`;�&뢄 ��x��xHO�`/�A�&���x��xHO�`뢄(||P��xxx ��xHO�`/�A�&���x��xHO}`�P{� ��@@��x{�!A�+��@�T�b�0HY�`8!�8`�&�����&���!��|��A���a����������������N� ```��x��x��x;&HNQ`8D�x|��x�xHM�`��xHM�`+��A��;�  &�xH8```HN&`���P}}�/�A����x;�&;�&�}>�P;�&|��Py) /�.x� ��x��x/ (�?A�@��ș+@���~�xD�xHM`�b�8HX�`8!�8`�&�����&���!��|��A���a����������������N� ``��xHL�`뢄(xx ��x��xHM�`/�@��4`��xHL�`x} K��4```��;/�A�&��;�D�x��x��x;�~�xHL1`��xHLe`/�A����xK��qK���`K���````K��Q`�/�@�@�
        !          5640: /�@��K���`/�A���;�&��/�@����b�H8�HWy`8!�8`�&�����&���!��|��A���a����������������N� ``�xK���K��L`�b�@HW`8!�8`�&�����&���!��|��A���a����������������N� ```8!��8`&�&�����&���!��|��A���a����������������N� &�  ``8��/�x @�T8���9#x� 88�&|��H`9)�c}#Kx|ZB��x  x�| x     �|     |�x |xN� ```|�|ix�b�P�&�!��������&��HU�`8!p�&|�N� &�``|���������|}x8��&����8�&V�!�q�&|?x�&��;�p��xHK�`����x;�8�&H8�8�K���`��x;�8�C8�D8�&4K��`8&9 肄X�&�=8~��HII`K��a`8�|dx8~8HK�`����xK���`8?�8`�&�����������|�N� &�``|������&��8�8���&�!��|yx;�A���a�������������������!�A�&|?x�&�!;�p��x;\"HJ�`;�;|*K��9`:�F^�xK��I`8`��x8��8�K�ܡ`�]
        !          5641: �
        !          5642: ��x8``�i9)��|Z@���x   x�| x     �|     |�T>�P@�̈   /�@���/�D@���/�C@���/�@��K���`~�x8�HJi`/�@�|�"�`�i/�A�d�x8��HI�`��;8y8�l��9HGq`8?�8`�&�����&���!��|��A���a����������������N� K��1`/�A���8?�8`���&�����&���!��|��A���a����������������N� &�   ```|��a������;e&�&����8|}x�b�h����{~ �����|�#x�!�aHRe`�"�`낄p������x��xHRE`/���xA�TK�����x;���K��u{� /�@����b��HR`8!�8`�&�a��������|���������N� �b�x{d HQ�`8!�8`���&�a��������|���������N� &�```|��A���a���&����|�3x��������;�&|�#x�����!�a{� |x��|�;d��;Ape�P`�P{{ |� Pe�x|�"C�xHG�`��|&D�xe�x|c|{P|HG�`���&8�{P|�HG}`}?讈&|     |鮈&�>| �8!��&�A���a�����|������������N� &�|��!���A��|�3x�&�a��|�#x��������|�+x��������|x�&���!�A�/�;!pA�X�c9 /��@� H&�}ISx�H@@�8}H�/��A�&�9I&/�yJ 9)A���}P�})Zy) �H@A���;�;{� ��@@�(}]���/�@�`;�&��{� ��@A���8!�Cx|ct�&�&��xcт�!���A��|��a����������������N� ```/��A�̀��x�!A�t�9 �@A��/��@�4HX```}i[x�H@@�@|H��@/�A��A�,9i&/�yk 9)A���|X�})y) �H@A��Ȉ�&x� ��x|:8�HEe`�{�<&8|J��&;����K���`8!�8`&�&�&���!���A��|��a����������������N� ```�;K��l``�9}%Kx��xd�x��xK���K���&�``|��a���A��|�#x8��&����|�+x8���������|~x��x�����&���!�������!�AHD)`肄���x8�HD�`/�@��:�;;�;�&; {� ��@@�X|��}>��&�|��/�4A��+�4A�x/�A�P+�A��/�@�&;�&��{� ��@A���``8!�cx|ct�&����xcт�&���!��|��A���a����������������N� /�BA�&�+�BA�d/�5A��/�6@�d�     ;���     &���K��(`/�A��/�2@�4�     ;���     &���K���`/�CA��/��A��     &;����K���```/�&@��ܘ&;�� �� &���K���``�i8��T>+�A�&@�};��     &���K��h`;_&8�|�"�x;�|�ЮHBy`}>Ю}=J�)|Ю���K��(`��;��     �� &���K��8!�8`&�&�����&���!��|��A���a����������������N� ``;_&8�|�"~�x;�|�ЮHA�`}>Ю}=J�)|Ю���K���`��;�� �� &���K��d� ;���     &���K��H`8!�8`�&�����&���!��|��A���a����������������N� &�     ```|���������|�#x8�肄��&|}x�����!�qH@�`�+�@�$8!�8`�&�����������|�N� |t9 &} 6p&�A���9}85�;��+&���/�A�84��?&��;�
        !          5643: �2/�A� 82�8�&��;��6/�@��9`&��x}i���x8``�i&9)&|Zx B��/�A�@9 7�&�?;�9 �j&8  &9J&/�A��?;�&x  /�&@��܈B/�@���C/�@�L8��8!��8`&�&�����������|�N� 86�8�&��;�K��08C;����xH=9`��x8�&8x� ��&H?=`�?&8     �K��x8B;����xH<�`��x8�&8x� ��&H>�`�?&8     ��C/�A��,K��p&�``|��a���A��|�#x8��&����|}x8����������!�������!�;�t��xH>A`�/�A�@8`��8!��&�!���A���a��|���������������N� ```�ℐ�/�A�/��A����x{e H>`肄�;]�8�C�x;���H>E`/�A���};},�=�c�x�?�H;�`/�A�(��/�@�d�x88�@H;�`��X;�l��xH;i`/�A� ��x8&8��H;�`8�&�88`�8!��&�!���A���a��|���������������N� `��x8��H=`K��```{{ C�x8����xx� K��=/�A��x�&�/�@�\�&�/�@��=�;},�?�c�xH:�`/�A���/�A��;�l��xH:m`/�@�`��8��K���`�&u/�A��&w/�@�T�&z/�@�8`K��Ѐa|K��`8`K�����x8&8��H:E`8�&�K���d�x88�@H:%`��XK��T��/�&A�8/�@��h/�A�&�/�@���89 �?�8`�K��@/�@��d�;� 8���&t8�&H��x�;��H;9`9?<8��<� ��&K��`8�|dx8XH;I`8�8���xH:�`88���8�8a��&�H;`8�8����8a�H;&`��x8(��ϛ�Λ�›��������K���8�&48�D8�C84K��`8�����xx� 8�&H8�8�K�Х`��x8�&HK���`88`�K��9;�;a�y) D�x8�c�x�!px� H:]`�&�/�A�&/�A��/�&@���8a�8�p8�l8��K��   /�A�����pc�x��x8�x� K��Y/�@��,K����a�K��E`�a�K��`K����a���=�/��&t�?�A��88��H7Q`���/�A�t8&8��H75`8�K��;!�;Ap#�xD�x8�l8��K��I/�A���#�xD�x8�,8�@K��-K��$8a�8�p8�,8�@K��K��肄�;�&��xH6�`�&�/�&A���/�A��|;�l��xH6�`/�A��d��x��x8��H7`��&�K��H肄�;���xH6e`�&�0��T>+�&@����/�@�����x8�,8�@H6�`��XK���&�`|��a������8�&H8��&����;�&���������!�A�ℐ;� ;�<��xH7�`8��&��<8��肄�;apH5�`K���`8�|dx8XH7�`�8�8��c�xH7�`�9 d�x���8(�&p�!�K���848�&48�D8�CK��a`������x8�&H8�K�ͅ`��x8�&HK���`8!��&�a��������|���������N� &�```|���������8�8�&H�&����;�&�����!�Q�„�;� ��xH6�`9><8��<;�p�       ��&K�ɝ`8�|dx8~XH6�`8�8���xH6u`��x8~(��&���&������&q��&v��&sK��m8~48�&48�D8�CK��9`��8�����xx� 8�&H8�K��Y`��x8�&HK�ѩ`8!��&����������|�����N� &�`|��A���a��;@�&����8||x��������;������!�a�ℐ�;ap|t/�|x/A�&,A��H7U`/���xA��뢄���xH4i`��x/���xA��H4Q`��x|P|}4{� c�xH3�`}!����Ip8�c�x8�
        !          5644: ;�&H8�`|c4T`>+��A�<��4T@.|`�|�|t/�.@��@�&|tK��4``8`8!&��&�A���a�����|������������N� `��xc�xH2Y`c�xH2�`�K��P```k�|c4Tc�~xc K���&�|����������&�&��8|�+x�!���A���a������|{x|�#x��������;�&�����������!�!�ℐ�„�;?&;_��x#�x�&pW�x��xH1�`��xC�xH1�`��b��;`&H=I`�„�;�����x����xH=-`H>�`/�A��/�A�&�K��m�:�K���`K��        `K�ǁ`�/�/A��A���K��`/�A���:�&~��/�@���;�����x����xH<�`H>]`/�@��|```�b��H<}`8!�8`���&�����������|��&���!���A���a����������������N� `�b��H<-`�/�A���/�A���/�@��~�xH0e`/�A�&;�p��xK��]/�A���&p�?�8|$�x�<H/�`8`8!��&�����������|��&���!���A���a����������������N� #�x8�H/�`K��h```C�x��xK��`/�@��l�8`��/�A����&pK��X�b���xH;`8!�8`���&�����������|��&���!���A���a����������������N� �8`��/�A���&pK���&�```�"�� c��8&�       �iN� ```|���������|�#x�&�a��뢄����������!���
        !          5645: }  P}+�q@����؁?/�A�\낄��Vp��x|��H:`8&��9 �8�8!&�?�&�a��������|���������N� 낄�|Vp;ap|�c�x��xH8�`�&p/�A�(i�x9````�i�      &/�@���c�xH9}`K��P��؁?y+�A��09)&/�y) @�� K��X&�|���������|�#x|~x�&����8�8�&�a�������!�a;�p��xH/Y`�"�Ѐ /�A��;�8`;`��x8�8��K��)`8���"����x�d�x�)� �A(| ��i�IN�!�A(8!&��&�a��������|���������N� `�)��x8� 8�8�;��;` ��K���`8a�K��`&�`|��a���A��8�8�&�&���������������������&���!���������������!�!�"��     �)�!p�&t;avc�xH.!`��Ѐ/�A�&��„�;:�;@;�p;��;88cH,`|tx��xH+�`|ux��xH+�`|vx��xH+�`|��8�E8�8��|��|�~�xx� K�Ս`8&��;�xH+�`�x8�&#�xx� H-�`�8cH+i`8&��xx 9H+Q`��x8�&#�xx� H-Y`��xH+-`8&��xx 9H+`��x8�&#�xx� H-`��xH*�`|x��xH*�`8&��xx 8�&|yx� H,�`�"��c�xD�x�)� �A(| ��i�IN�!�A(8!&��&����������|������&���!���A���a����������������N� ```�;�p;�:��8cH*-`|xx��xH*`�„�|zx��xH*       `X�;&�;Z"|yx��xH)�`�?Z�8�8�Zc�xZ���{D K���`K���&�``��������|����9`/������&�!�q8|�#x��$�� 8��(�_���8��0��@�/��A�&`}%�肅8��xH3�`�b�H4�`8�8`��K��1��@K���`K���`K��YH,K��`�?0� �i�@A���)�@A���/�@��K��}`/�A����=0�i+�@�@�B�ب�/���A�0�Hx� +�&|x@�K����=0�i```9k&�iK���`K���`K��i`�?0� �i�@@��\8��8`�ؐH```8��8`�א8�@8!��&�����������|�N� 9 �K���``�}8�@/�@����N8`��K����b�H3=`�R/�@�,�N8!��&�����������|�N� ``�b�H2�`�NK���&�|����������&�A��|�#x�������|}x�a�������!�a�@/�A���N8`;}K��)K���`K���`�낄ؠ�|�4/���A�&</�A�T   >/�A�x/�A���?08`�i8&�     8!&��&�A���a�����|������������N� 8!&�8`�&�A���a�����|������������N� `�T >+�@�&�8��8`���`8&�8!&��&�A���a�����|������������N� �?H�{9I&yc }@��A��m*��/���A���@A�LA���?0Uk>8`�֐     �i8�֐K���```{[ }�;�
        !          5646: ��@@�&�„�HD`��x8�H$i`,#A��8c&8�H$Q`,#A��;�&��@@����xH%A`��x8�&��xx� H'�`/�@�����xH%`8�8�
        !          5647: 8c&|}H)-`xc 8���8T>+��A����8`K��%8`K��$``�"� x�|  �} J})�N� ���h&8&(���h&&���h�``��8�8;�p8���x8�&H&E`�/�A�&�;�8`;`{� 8�
8��K��`8�"����x�8d�x�8��)� �A(| ��i�IN�!�A(8��8`���K���```88`�8K��8`K��``8��8`���K��t8��8`���K��d8��8`���K��T8��8`���K��D8��8`���K��4�_H�?N�0���$9I��}J*�8�@�88��8`���K���`�_(/�A��@+�&A��8�HK���`�@8���8�x� |cJH%
`�{��K��-�?L�8�9)��9k�| �L@���?Hm ��/���@��(�(/�@��8��8`���K��\K����?0�P8`8&�i�P8&� K����?��x8�!8�8�;��;`!��K��a`8a�K���8&8`�K��|��K���&�```}�&|���������|vx8��&�&���!���A���a������|�#x8���������������;��a�����������!���{H'1`8�8�;A�;�t|xx�{H'`8�8�|yx�{H&�`88�8�
        !          5648: |wx�{ �&pH&�`8�8�
        !          5649: |}x�{(H&�`|~x�b�(H,�`�b�0H,�`8�8�&C�xH"�`8`8�8���xK��)`/���@�l``H.!`/�A� �;�&��/�XA� �K��1`K��I`K��a`/�A���8`8�8���xK���`/���A���/���A�
���t��u��v��w�&x�!y�b�@H+�`��xK���`/�@����0~óxHI`.#|ux@�L8�&&��b�h;�&��/�A��@��8X�&&�8�&&̀&&�|P|�/�WA��8X�&&�C�x��x8�H!�`�/�A���&&�/�&A�/�A�&t;��/�A�(����b��x� x�Fxņ"x��"H*�`;�+�&@�
        !          5650: x�&&T;��/�@�����b����x�x� x��"x��"x�FH*�`�[��&���C�x$�x��x��8�|K��a`�&&�/�|~xA��/�A�D/���A��/���A��/���A�        D/���A��/���A�
        !          5651: t/���A�
        !          5652: �/���A�
        !          5653: �/���A�@/���A��8+�@��/���A��/���A�    �/���A� @8!P��x�&���a�����|��������}�� �����&���!���A���a����������������N� �b�xH)�`��&�~�xD�xK��`|x/�@��l/���A�Ȁ���b��x� x�Fxņ"x��"H)i`/���@��h���肅�;�&�;�����xx� x�Fx�"x��"H(u`8�&�8`0K���`��xH�`8��|dx��xK��%`K���``8�8�|8a&T;�&�H1`�b�h8C�x�&&�8X��x�&&�8�8�&&�HA`�/�@��h;�p��x��x8�Hm`/�A��H:�&���x~óx8�HM`/�A��(�&&T/�A��~ijx8a�8�H�`8�&&�K���Vp�b����x|��H(!`K���b�p;�&�H(
`��x8�p8�H�`/�@�L8���&Ԁ�&�~�xD�xK��5`|xK��8��x8�&T8��Hy`8�&�K��А&&�K��HA��:��8�~��x8�d~óx;�&�H�`~��x��xH!`/�@�$�&�/�@� ��x8�8�H�`~óx8�&;���HE`{� /�|vx@�8�&&T;�&�8���x8�HU`8a&�8�8�HA`A��d:��~óx8�~��x8�dHA`�&�/�@�&�8X�&&�~óx8�&H�`/�&|vxA�� 8�~��x8�dH�`�&�/�@�&`8�&&�~óx8�&Hy`K���;��8���x8�d~óxH�`肅P��xH�`/�@��~óx8�&8&�&&�:���H%`z� |vx.5K��dK��`K��|:�p��x~�x8�H�`/�@�&h;�&�~�x��x8�H�`/�@�&�a�K���`K�����x8a�8�H%`K���肅X��xH�`/�A��肅`��xH�`/�@���8~óx8�&�&&�:���HU`�b�hz� 8.5;�&�|vx�K���~��x8�8�
        !          5654: H`|c�/��a&�@���K���~óx8�&8K���8a&�8�8�H)`K���~��x8�8�
        !          5655: H�`|c�/��a&�@���K���:����x~�x8�Hu`/�A���~�x��x8�H    `K�����xD�x8�HA`/�A�����xC�x8�H�`K��l��x8�8�~��xHy`:a&T~óx8�~e�x8�dH}`�&&T/�A�(9 /H�&/�A�/�\@���3K���~óx8�&H�`;���{�!|vxA���8�~��x8�d;�&�H`~��x��xHE`/�@�$�&�/�@�&�8�8���xH�`~óx8�&Hm`8��x /�|vxA��H8�~��x8�d~óx:a&�H�`~��x~d�xH�`/�@�<�&�/�A�~c�x8�8�HE`K��d~c�x8�8�H-`~óx8�&H�`|vxK��8肅�;�&���xH�`8�&�8`0&K��a`��x;���H&`8��|dx��xK���`K��p肅H;�&���xH�`8�&�8`0K���肅�;�&�;���xH!�`+�@����xH�`肆0|H!]`��x;���H}`肆8|H!=`8�&�8`0K���`��xHQ`8��|dx��xK���`K�����x8�8�H`K��l肅�8`0;���K��]`K���;�&�肅�;�����xH�`8�&�8`0K��1`��xH�`8��|dx��xK��q`K��D�"�{��|       �} J})�N� �� @;�&�肅���x��xH I`8�&�8`0       K���`��xH]`8��|dx��xK���`;���K��Ȁ�����;�&�;���肆P��xH�`8�&�8`0K��a`��xH`8��|dx��xK���`K��t;�&�肅�;�����xH�`8�&�8`0K��`��xH�`8��|dx��xK��U`K��(���肆H;�&�;�����xHU`8�&�8`0K���`��xHi`8��|dx��xK��`K���;�&�肅�;�����xH�`8�&�8`0K��y`��xH`8��|dx��xK���`K���;�&�肅�;�����xH�`8�&�8`0K��-`��xH�`8��|dx��xK��m`K��@;�&�肅�;�����xHa`8�&�8`0K���`��xH�`8��|dx��xK��!`K���;�&�肅�;�����xH`8�&�8`0K���`��xH9`8��|dx��xK���`K���;�&�肅�;�����xH�`8�&�8`0K��I`��xH�`8��|dx��xK���`K��\��|肆@;�&�;�����xH�`8�&�8`0K���`��xH�`8��|dx��xK��9`K��;�&�肅8;�����xH-`8�&�8`0K���`��xHQ`8��|dx��xK���`K���;�&�肅���x��x��xH�`8�&�8`0K��]`��xH&`8��|dx��xK���`;���K��l��xH�`肆|H�`K��<��xH�`肆 |Hy`K����xH�`肆(|HY`K�����xHy`肆|H9`K�����xHY`肆|H`K����
|���������|�#x�&����|x�b�X�����!�Q;�&�H�`8���x8�&H�`/�A�&�/�@�&��>�   /�-@�&�     &/�f@�&��     /�@�&��~8�8�H5`/���|xA�X�b�H;�pH`8`8�8���xK���`/���A�/���A�Ȉ�p��q��r��s�&t�!u�b��H�`��xK���`�b��H�`8`��x8�K���`|c4/�A�&��a&�K���`��&��b��x�Fx� xņ"x��"Hi`��/�A�<9 /H``�&/�A�/�\@���$�&/�@�����b��H`�;�&���xH1`��x��x<��8�8�x99 9@K��`|}xK���`/�A�&@/���A��/���A��8+�@�&�/�A�x�b�@��x;�H�`H`�>� /�-A���b�h;���Hi`�b�pH]`�b�xHQ`�b��HE`�b��H9`�b��H-`8!���x�&����������|�����N� /���A�&</���@��t��&�肆�8a�;�&x� x�Fx�"x��"H`K���`�     &/�cA�&/�r@��@�     /�@��48`K��`|}xK��l```�Vp�b����x|��Hq`�b��He`��x��xK�%`8!�|}x�&�����x�������|�����N� �b��;���H`K����b��;�H   `+�@�p�b�0H�````�b�8;�&H�`K���```�b��;�&H�`K����       /�@��48`&K�~�`|}xK��l�"�{��| �} J})�N� 4$DT�b�H]`K��t�b� HM`K��d�b�(H=`K��T�b�H-`K��D�b�H`K��4�b����x;�&H`K����b����x;�&H�`K����b��;���H�`K����b�`;���H�`K���&�```|���������|�#x|~x�����&8�8������!�;�x��xH
�`/�@������xH�`8
        !          5656: �&�||yA�p/�&A��;��8�@��x8���xH�`��x��xH�`/�A����x8�@8���xHa`��x��xH�`/�@���b�PH�`8`��8!&��&����������|�����N� ;��8�@��x8���xH�`��x��xH-`/�A���;��8�8�&��xH�`�b��;�pHM`8`8�8���xK���`/���A��/���A����p��q��r��s�&t�!u�b�hH&`��xK��`�&|/�@�&4�b�pH�`��x8`8�K���`|c4/���A���a�K���`����b��x� x��"x�Fx��"H�`��x8�8a�H
`����b��x� x�Fxņ"x��"H]`�a�K���`K��9`<ff`fg|�|c�p|p|cP�&�|c&�|c�K��-``K��A`/�@��K���`K���`/�@����b��H�`8!&�8`�&����������|�����N� ``��x8�|8�H5`�b��H�`K���```�b��H}`8!&�8`���&����������|�����N� ��x8�&H&Y`;���{�!|~xA���8���x8�@H�`��x8�|H�`/�A��8��x8�&H&
`;���{�!|~xA��|8���x8�@HI`��x8��Hy`/�A�����x8�&H�`/�&|~xA��4��x8�8�@H&`��x8�8�
        !          5657: H
}`�a�K��```��x8�&Hi`;���{� |~xK��D�b�`H=`8`��K��p�b�XH)`8`��K��\�b�xH`8`��K��H&�``,$M� 9 `�/�,A�,/�@�H<``A�0�&/�,/ @���9)&8c&y) �H@A���N� `8`N� ```|ix8`&``�  /�,A�,/�@�H@``A�0�     &/�,/ @���5)&A� 8c&xc K���``N� N� N� ``�|kx/�,A�8/�A�0|ix`9)&|HPx � /�,/ M� @���N� 8`N� ``|���������|�+x�&�!��|�#yA�\9````�#/�,A�,/�@�H�``A���#&/�,/)@���9k&8c&yk �X@A���/�A���/�,A��/�A��|ixH`A� 9)&�HP{� �     /�,/ @���|dx|�3x��xH�`/�A�(88!�|���x�&��������|�N� 8!�;���x�&��������|�N� ;�K���&�```|��A���a��;@��������|�#x;���������|x�&�!���!�A�c;ap/�A��/�A��H1`/�A���"����x$�xHE`|~yA��$�x��xH-`�P�4{� +�       A�t��xc�x��x��Ha`}!��Ipc�x8�8�
        !          5658: H     �`|c�+��A�4�|�/�.A�T;�&/�{� ;�&@��H/�8`��A�8`8!��&�!���A���a��|���������������N� �&K���``��x8�        c�xH�`c�x��yHU`�K��H&�``|���������|}x|�#x�b���&���������!�qH�`�b��H�`/�@�8낇�;�`���x;�&��x��H]`��;�A���8!�8`���&����������|�����N� &�``|���������|�#x�&����|x�b�������!�qK�z�`肇��}H&�`/�@�/�A��肇��}H&i`/�A�L肇��}H&Q`/�@����x��xK���`8!��&����������|�����N� ��x��xK��`8!��&����������|�����N� ��x��xK�ߙ`8!��&����������|�����N� �b��H�`/�@�8낇�;�`���x;�&��x��H�`��;�A���8`��K��4&�`�/�A�,x� �@@�N� `M� �&/�@@���8`N� ``�c/�A�\�}i[x/�A�@�@A�$H4``�/�       @A�@��#&8�&/�@����} HP}#�N� �9 K���`|ix```��     9)&�8�&/�@���N� `|ix9`8`� /�M� ``�     &9k&}k�/�@���yc N� ``�|ix/�A�4/�M� |��HB@p�     8���9)&x� �&/�@���/�M� 8���9i&x� 88�&|��H```9k&� }i[xB��N� ```N� |���������|y|�#x�&���������!�q@�,8!���x�&����������|�����N� `/�A�dK���`||x��xK���`/�|}x@���������@@�0`��x��x��xH`/�A���;�&��@A���8!�;���x�&����������|�����N� &�`,%M� 8���x� x� |ix8�&|����9)&B��N� `,%M� 8���|ixx� 8�&|��`�8�&�     9)&B��N� ```,%A�L�#�8���x� �@A�(H@```�#&�&ye �@@� /�9e��@���8`N� ``|`HPN� ```|���������|x|�#x�&�����!�q�c/�@�8HhH�`|}x�~H�`��@�D�&;�&/�A�8�/�@���8!�8|`P�&�����������|�N� �8!��|`P�&�����������|�N� &�```8��+�   8A�8c���"��|c�xcd|       �|xN� ``8��+�M� 8c��|c�N� ```,$|ixA�&@+�$�$@�H&`9)&�$�i/� /       ,�
        !          5659: A���/�
A���A���A���/�@��/�0A��8�
        !          5660: /�A��8``8��9K��T>UJ>+�    +
        !          5661: 9)&9K��|4@�$8��T>+�}@4@�M� 9k��}`4�(L� �$|c)҉i/�|`@���N� `/�@��|/�08�@��p�        &9I&/�x@��h9*&�$�j&K��P```8`N� �     &9I&/�x@��(9*&�$�j&K���8���K���`,$|ixA�&X+�$�$8`@�N� 9)&�$�i/� /       ,�
        !          5662: A���/�
A���A���A���/�-8�A��/�@��/�08�
        !          5663: A�&/�8`A�t8`H�$|c)҉i/�|`A�T8��9K��T>UJ>+�    +
        !          5664: 9)&9K��|4@�$8��T>+�}@4@�A�9k��}`4�(A���/�M� |c�N� ``/�A�,�$�iK��\9)&/��$8�&�i@���K��4�$/�08�@��0�    &9i&/�x@�<9+&�$�k&K��8���+�$8`�$@���N� � &9i&/�xA�9`0K���9+&�$�k&K���`|��!���A���a��������������;������&{� |x�&���!�Q;]�ˆWZ&��Y���x�```/�A���>|�8h�H@@�&��~}i[x```� )@@T
        !          5665: 6x�(/�|�3x@�,�I&��yJ��}F3xx�E�I|�3x}F3x��@@�@@�D�        &�Ix��|;xyJE�     }G;x|;x8�}):K���```�@@A�&��@@@�& 8�9 H@`9 ��&�Kx�(��xƃ�|�xyJE�}Jx|�Sx8
        !          5666: }k�X@@�Ј/)T
        !          5667: 6x�(/�@���A����&�I�    &��� ��yC�(y���{�䈉}�;xxxE�x�E�|�;x|x|�3x|�x|�:UJ688�&xG"x�}J;xx��I��&���     ���&�K��x�(xƃ�|�xyJE�}Jx|�Sx8
        !          5668: }k�X@A��8/�@��(c�xK���`��@�&|c��|K���}i[xK���{�G"{�a){�����H�h&�(�8!��&�&���!���A��|��a����������������N� �0@@�P8i|�0P��}c�{�G"`�{�{��x�G"x��x������&��}�����K�&K���T>8i`�        K��l#�xK���`/���|hx�~A�}#��|�<K�� 8`K��8&�```���T>���N� `|�/��&�!������������&��!��A�@�8!p8`���&|�N� /�A���8��H%`8!p�&|�N� &�|�|�+x�&�!��|�#x8���|xx�`H`8!p�&|�N� &�```|��&�!��|`x�b�������|x�������&��!��A�8��H�`8!p�&|�N� &�`|�����|x�&�!�q�/�A�&�/�A���#
        !          5669: /�A�/�O@�d�8�PK��i`8|c�/�A�x/�O@��8�9 &���?8!�|x�&����|�N� ``|H�9)&})�/�@����8�PK���`8|c�/�@����?9`}i&�8�9 &��K���``�?|`x9`}i&�K���```�8�p8�&K���`8��/�&@��D�&pK��<&�&```�b�K���```K���}�&|��a������|�+x;�&��������|}x�&�&���!���A���������!�Q�$&/�A�&�;@;�;�;!pH08      ��T>+�       A�;Z��}:J}:�`�<&/�A�&�8       ��T>+�)A����b�x�|�}`Z}i�N� ���������������������������������&�����������������������������������������������������������������������������������������������������������&�`��xK��
x` /� A���/�       A���/�
        !          5670: A���/�
A���/�A����;��x9i�{�)�      K���xc /� A���/�   A���/�
        !          5671: A���/�
A���/�A����/�A����=
        !          5672: /�@���9)���=�<&/�@���8!&�8`&�&���&���!��|��A���a��}�& ������}�� ��������N� ``��xK��/�xx A��. A� -�    A��/�
        !          5673: A��/�
A��/�A�x��@�p```�xH
        !          5674: `/�A��}!���x;�&��� pK���xx . A��-�   A�$/�
        !          5675: A�/�
A�/�A���A���}!���pA�H/�
        !          5676: A�@/�
A�8/�A�0�/�A�$�=
        !          5677: /�@�9)���=```#�xK��-`/�A���;#�x8�8�8      �� K���`�xK�����xK���/�xi A��/� A�/�       A�/�
        !          5678: A��/  
A��/)A�x�@�p```8     ��T>+A�T}a���x;�&���+pK��mxi /� A��/�   A��/�
        !          5679: A� /  
A�/)A��A���`}a���pA�4/�
A�,/�A�$�/�A��=
        !          5680: /�@�9)���=#�xK��&`/�A�T�;#�x8�8�8  �� K��e`�xK���`��xK���/�x` A�P/� |xA�T/�       A�L/�
        !          5681: A�t/�
A�l/�A�d��@�\``}!���x;�&���  pK��Mx` /� |xA�&�/�       A�&�/�
        !          5682: A�/�
A�/�A���A���}!�/�
        !          5683: ��pA�4/�
A�,/�A�$�/�A��=
        !          5684: /�@�9)���=�;$�x8      ��iK��`K�����xK���/�xx A��. A�0-�   A��/�
        !          5685: A��/�
A��/�A�x��@�p```�xK��-`/�A�h}!���x;�&���  pK��9xx . A��-�   A�$/�
        !          5686: A�/�
A�/�A���A���}!���pA�H/�
        !          5687: A�@/�
A�8/�A�0�/�A�$�=
        !          5688: /�@�9)���=```#�xK��`/�A�&�;#�x8�8�
        !          5689: 8      �� K��!`�xK���}!���x;�&���     pK��]x` /� @�```}!�$�x��p�;8 ��iK���`K��,``/� A�```/�       A�P/�
        !          5690: A���/  
A���/)A���8 ��T>+A���}a���x;�&���+pK���xi /� @���}!�#�x��pK��`/�@���8!&�8`�&���&���!��|��A���a��}�& ������}�� ��������N� . A�d``-�       A���/�
        !          5691: A���/�
A���/�A����xHm`/�A�&}!���x;�&���      pK���xx . @���}!���pK���```. A�d``-�   A���/�
        !          5692: A���/�
A���/�A����xK��m`/�A��}!���x;�&���      pK��yxx . @���}!���pK���```/� A��``/�   A���/�
        !          5693: A�$/�
A�,/�@���9`K��``9`
        !          5694: K���``9`
K���}!���pA���K���}!���pA��0K����```}�&|��a���A��|{x��������;��&�����������!�1��&�x!A�&`;�p;�;A&H ```�&8�&x!A�&4/�%|�#x@���x ��x�      ;�&9)&|�P|
        !          5695: ��-s/�d}&U@-%/i,�x,X.p-�c�&�}&U@-O�&�}&U@-o�&�A��A�&A�&A�&A�&(A�&4�&�U >} U�>A�&0�&�U >} U�>A� �&�U >} U�>A�&@��H9`o9*&}AR})�}!J�jp��p�/�%A���c�x��xE�xK���/�@�$�&;�&8�&��x!@���``8!���x�&���A���a��|�������}�& ��������}�& }�� N� `9`dK��```9`iK��P``9`xK��@``9`XK��0``9`pK�� ``9`cK��``9`sK��``9`OK����```,%|ix8`M� �I/�A�p�}KSx/�A�T8���x�!A�H�@@�@|��H$``�/�@A� B@@��i&8�&/�@��܈}`XP}c�N� �9`K���xc 9#��8��(�+  8c��L�(BOY�B+�O��B} &U#?�U)��|&T��|cKx|cx|c�N� ``|���������|�+x|~x�&����|�#x8�&@�!�1;�p��xH�`��x|}x�~{� K�w�`8!&���x�&�����������|�N� &�`|��"� ����|�#x�&����8��|�+x��������T>|x�!�a+�
�I�)8�!p�AxA�X� @@�|�"�(�       /�A���c8-�8�c9k&�c� ��8&�=p�+�?9)&�?8!�|x�&����������|�����N� ``�+������x��PK��!���?8!�8&|x�}p�i�&�?������|�9)&�����?����N� ``�cK��T&�```|��a������}Cx|�;x�&����|�3x��������|~x|�+x�!�a|�#x8�
        !          5696: 8�K��`/�9 8&|c�A� `��9)&/�})�@���y  |�|��@�@|P|�/�@�0x �>|  �```���>9)&�>B��8!�8`�&�a��������|���������N� &�``|����p���x9�x9�0�&�&��:&��������:� �����&��|�#x|xx�!���A��; �a�������!���A���a�������������������!��;a&P;Ap:���{1�%/�A�8|P��@�,/�%A���#8�&�a&�8c&�a&��%/�@���8��a&�8!&P|xP�&���p|c����x�&��|��!���A���a�����������������&���!���A���a����������������N� `K�x|�+x8%�;�&|�P|
        !          5697: ��/�dA��/�iA��/�uA��/�xA��/�XA��/�pA��/�cA��/�sA��/�%A�/�OA��/�o9k&@���9 o9j&}AR}k�}aZ�*p�+p�/�%@� 9#&��!&�8�&�a&�K���`�&q��:&/�0A�/�.:` ;�qA��</�A�P|�:��&�;�8        ��T>+�)@�D8 ��T>+�       A�}z�;�&{� �+�<&/�@���~&�xK��p```�b�0x�|�}`Z}i�N� X������������������������������������������������������������������������&������������������������X��������X&h������������������������8�8�
        !          5698: ~��x�?K��m`x ��xK��-`�@@�D|c�Pxc!A�8/��!&�|i�A��A��```���!&�9)&�!&�B��;�H(`�!&�|��;�&{� �  �!&�8 &�&&���xK�ޭ`��@A���K��l``}:�~��x��x8�8� 9�)c�xK����!&�c�x��x8����!&�8     &�&&���&�!&�8 &�&&�K��]�<&K��}:�c�x~��x8�&8�
        !          5699: 8� �)9K����!&����a&��<&8c&�a&�K���}:��b� z�$8�~g�x}k9�)~��xc�x�KҐ8~E�xK��-c�x~D�x8�K��͍<&K��x}:��b� z�$8�~g�x}k9�)~��xc�x�KҐ8~E�xK���c�x~D�x8�K��}�<&K��(�<&:�/�h@���<&:�&K��`V�88      ��}:�~6��x�)�9A�4�a&��"� z�$})8-��I�!&��a�8 &}r�8�&&�~E�x8�
        !          5700: ~g�x9~��xc�xK��9c�x~D�x8�
        !          5701: K��ٍ<&K���```�<&:�/�l@��hK��````:`0;�rK���`9 dK���``9 iK��|``9 uK��l9 xK��d9 XK��\9 pK��T9 cK��L9 sK��D9 OK��<8&|  �K�� &��x�ш�ѐ�Ѡ�Ѱ����No net_xmit function availableCan not open "%s" because file descriptor list is full
        !          5702: No net_ioctl function availableNo net_init function availableNo net_receive function availablenet_e1000net_bcmnet_nx203xnet_mcmalnet_spidernet_veth``/rtasCould not open /rtas
        !          5703: rtas-sizeSize of rtas (%x) too small to make sense
        !          5704: Failed to allocated memory for RTAS
        !          5705: instantiate-rtasinstantiate-rtas failed
        !          5706: read-pci-configibm,read-pci-configwrite-pci-configibm,write-pci-configibm,update-flash-64-and-rebootibm,update-flash-64ibm,manage-flash-imagesystem-rebootget-time-of-dayset-time-of-daystart-cpustop-selfTOK
        !          5707: start-cpu called %d %x %x %x
        !          5708: bootmsg-cpclosebootmsg-debugcpbootmsg-warningbootmsg-errorreleaseset-callbackopenfinddeviceparentchildpeeryieldset-ledwrite-mm-logrtas-write-vpdrtas-read-vpdclaimseekreadwritecall-methodgetprop/chosen/aliasesnetbootpathlocal-mac-addressregassigned-addressesname#address-cells#size-cellsrangescompatibleIBM,vdevicevendor-iddevice-idrevision-idclass-codeinterruptsstdinstdout  No net device found 
        !          5709: /cpustimebase-frequencyinterpretibm,romfs-lookup``������������`:////@/:
        !          5710: ERROR:                 Bad URL!
        !          5711: 
        !          5712: ERROR:                 Bad host name!
        !          5713: 
        !          5714: ERROR:                 Can't resolve domain name (DNS server is not presented)!
        !          5715: 
        !          5716: Giving up after %d DNS requests
        !          5717: %d.%d.%d.%d
        !          5718: bla   %02d
        !          5719: Giving up after %d bootp requests
        !          5720: .    %03d
        !          5721: Aborted
        !          5722: 
        !          5723: Giving up after %d DHCP requests
        !          5724: %d KBytesblksizeoctet%d  Receiving data:  Lost ACK packets: %d
        !          5725:  Bootloader 1.6 
        !          5726: E3000: (net) Could not read MAC address  Reading MAC address from device: %02x:%02x:%02x:%02x:%02x:%02x
        !          5727: E3006: (net) Could not initialize network devicebootpdhcpipv6  Requesting IP address via BOOTP:   Requesting IP address via DHCP: E3001: (net) Could not get IP addressE3002: (net) ARP request to TFTP server (%d.%d.%d.%d) failedE3008: (net) Can't obtain TFTP server IP address  Requesting file "%s" via TFTP from %d.%d.%d.%d
        !          5728:   TFTP: Received %s (%d KBytes)
        !          5729: (net) unknown TFTP errorE3004: (net) TFTP buffer of %d bytes is too small for %sE3009: (net) file not found: %sE3010: (net) TFTP access violationE3011: (net) illegal TFTP operationE3012: (net) unknown TFTP transfer IDE3013: (net) no such TFTP userE3017: (net) TFTP blocksize negotiation failedE3018: (net) file exceeds maximum TFTP transfer sizeE3005: (net) ICMP ERROR "net unreachablehost unreachableprotocol unreachableport unreachablefragmentation needed and DF setsource route failedE3014: (net) TFTP error occurred after %d bad packets receivedE3015: (net) TFTP error occurred after missing %d responsesE3016: (net) TFTP error missing block %d, expected block was %d
        !          5730:  Flasher 1.4 
        !          5731:    Bad buffer address. Exiting...
        !          5732:    Usage: netflash [options] [<filename>]
        !          5733:    Options:
        !          5734:             -f     <filename> flash temporary image
        !          5735:             -c     commit temporary image
        !          5736:             -r     reject temporary image
        !          5737:    Bad arguments. Exiting...
        !          5738: 
        !          5739: 
        !          5740: E3000: Could not read MAC address
        !          5741: 
        !          5742: E3006: Could not initialize network device
        !          5743: %02x:%02x:%02x:%02x:%02x:%02x
        !          5744: 
        !          5745:   DHCP: Could not get ip address
        !          5746: 
        !          5747:   ARP request to TFTP server (%d.%d.%d.%d) failed  Requesting file "%s" via TFTP
        !          5748:   Now flashing:
        !          5749:   Tftp: Could not load file %s
        !          5750:   Tftp: Buffer to small for %s
        !          5751: 
        !          5752:   ICMP ERROR: Destination unreachable:  UNKNOWN: rc = %d!  Reading MAC address from device: 
        !          5753: ping device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]
        !          5754:   Own IP address:   Ping to %d.%d.%d.%d success
        !          5755: failed
        !          5756: 
        !          5757:   Reading MAC address from device: No such callback function
        !          5758: argv[%d] %s
        !          5759: netbootnetflashpingUnknown client application called
        !          5760: &&&&&&&&&&0123456789ABCDEF������������������������������������&&��&`&��&���&��&���&���&��`&��`&���&���&��
 &��
@&��
�&��&��0&���&��0&���&��p&���&���&��&���&��X&���&���&��&���&��P&���&�� &���&��P&�� &��p&���&��0&���&��p&�� 0&�� P&�� p&�� �&�� �&�� �&��!P&��!�&��" &��"�&��#`&��#�&��$�&��$�&��%0&��%�&��&P&��&�&��'P&��'�&��(P&��(�&��)�&��*P&��*�&��+�&��,0&��,�&��- &��-�&��.&��.�&��/�&��0 &��0�&��1�&��5&��5@&��6 &��8 &��: &��:�&��;�&��;�&��<P&��<�&��<�&��> &��>�&��>�&��>�&��>�&��?&��?0&��?P&��?�&��?�&��@ &��@`&��@�&��@�&��@�&��@�&��A&��A�&��A�&��B0&��C�&��C�&��C�&��D&��D0&��D�&��D�&��E`&��E�&��E�&��E�&��Fp&��G &��I�&��O�&��Q&��S�&��U�&��V &��V�&��WP&��Wp&��W�&��W�&��Y&��[0&��\p&��a &��a�&��a�&��b�&��e&��f&��g&��i�&��m&��op&��u�&��w&��x &��y�&��}&��}0&��~`&��p&���p&����&���&����&���&����&���0&����&���&���P&����&����&���&���P&����&���&���`&���&����&���0&����&���&����&���&���@&����&���P&����&����&���P&����&���&���`&����&����&���@&��Ű&���P&��ư&���0&��Ȁ&��ɀ&��````````````````````````````````````````````````````````&�P�p������h�8�x��H�0����&&&&���������&^������c�Sc&������`&2�P&&2�`P�!���&0|��&8|��&H|��&P�a@8�``H-A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H,A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8��`�H+��&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H+A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8��`�H*��&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H*A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H)A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H(A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H'A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8   �`     `H&A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8
        !          5761: �`
        !          5762: `H%A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H$A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!��}h��a0}z��a@}{��aH�b���k}i�|
        !          5763: xN�!�a0}h��a@}z��aH}{�8!PL$�!���&0|��&8|��&H|��&P�a@8
�`
`H"A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H!A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``H A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8�``HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8 �` `HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8!�`!`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8"�`"`H
A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8#�`#`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8$�`$`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8%�`%`H
        !          5764: A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8&�`&`H        A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8'�`'`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8(�`(`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8)�`)`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8*�`*`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8+�`+`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8,�`,`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8-�`-`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8.�`.`H&A�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���&0|��&8|��&H|��&P�a@8/�`/`HA�&H|��&P|��&8|��&0�a@8!XL$``&`N� �!���A@�aH��P��X��`��h�&p�!x�A��a��������������&��!��A��a��������������&��!��A&�a&��&��&��& ��&(}����&0}i�<``cxc�dc`c�0�C�b���#}��N�!}����&0}���A@�aH�P�X��`��h�&p�!x�A������������&��!��A��a������������&��!��A&�a&�&�&��& ��&(8!&0N� &��&%��&.n&�2ұvPnи�v����0�PvPCނ׶4� ě��S��v����� ���vX��w(������0�X�pҐv`ҠҸ������ �8�H�X�h�xw@ӈӐ� Ӱ����������v����8�h�X��(�0�8�@�H�P�`�pԀԈԐԘԠ԰Ը����������� �(�8�H�P�`�pՀՐՠհn������������������ �w�vP ě��S��1w��8�x1}�2���0���@1}�2���H2���P�X�`�h�p�x֐ְ��� �02ɀ�8�@�H�p��2Ɉ�H�x׀׈אנ��2ј����2�����������8��h�8�(�@�hذ����������(�P� �xٸ���(�P�pڰ����� �H�hۘ���t�����0�H�h��܀����@�P�xݨݸ��� �P�pޘ���(���� �H�(�p߈ߨ���,�����0�H�h�8����8�pޘ���(����� �������x�8����H�(�0�@�H�p2�������D�2Ұ�GCC: (Debian 4.4.5-10) 4.4.5.shstrtab.client.lowmem.got.comment.branch_lt.bss&&&�&��.�&&&%�&%�8 &0&-�&-�&&)&&.&.4&.&-�1��&&.9&��������(�0net_veth� ���|��"��b��&�!��<�`��}IZ�@@�@�#�b�}d[x�  �A(| ��i�IN�!�A(8`8!p�&|�N� 8��x&��@A���yk 89k&}i�B@�     9)&K���H=`K���&�8`N� ```|��"� ����|kx�&����|�#x���!����?�C� 8`�A�$8!��&��������|�N� ``�+H肀(8~�     �A(| ��i�IN�!�A(/�@���>��8�?�K����?�b�0�)� �A(| ��i�IN�!�A(8`K��l&�```|���������|�#x8��&�!��g���€xd,x8�8�8�99 �~HQ`|dy@� 8!���x�&��������|�N� �>�b�@;����)�     �A(| ��i�IN�!�A(K���&�`|��!���A��|yx|�#x�&�a��?`���������c{���������!�A����x�```�?�_ x&�}     }i.U`�P@�&y`�;�A�\����@A��/��|��A�@8���yk x� }}Z8�&)�x|��```�9k&�     9)&B��t�ap8`&���pHA`�?8     &x /��@��< =)��< /�A��88!���x�&�!���A���a��|���������������N� `�<�b�H�)� �A(| ��i�IN�!�A(K��\`8!�;���x�&�!���A���a��|���������������N� &�|��������&�!���?�     /�@� 8!�8`�&����|�N� `��8`&H!`�(/�A�(�?�)@�     �A(| ��i�IN�!�A(�0/�A�(�?�)@� �A(| ��i�IN�!�A(�/�A�(�?�)@� �A(| ��i�IN�!�A(�8/�A�(�?�)@� �A(| ��i�IN�!�A(�?8!�88`����� �&|�N� &�&|���������8`�&�a�������������!�Q���/�A�,8!��&�a��������|���������N� `= ��8��? �?8` �)8� �A(| ��i�IN�!�A(�?8�8�08`&�(�)8� �A(| ��i�IN�!�A(�?�8``c��)0� �A(| ��i�IN�!�A(�0/��8A����(/�A���?/�A��/�A��8�<��P��y&,`&`cx8&y��@8`&;�H&�`|dy@�&�;�?��c�c����x``�?@��8`&| �|     �*�&t;���p�pH&u`��@����;8!�8&8`�a������     �&�������|�����N� �?�b�P�)� �A(| ��i�IN�!�A(�(/�A�(�?�)@� �A(| ��i�IN�!�A(�0/�A�(�?�)@� �A(| ��i�IN�!�A(�/�A�(�?�)@� �A(| ��i�IN�!�A(�88`��/�A��|�?|x�)@� �A(| ��i�IN�!�A(8`��K��L�?�b�X�)� �A(| ��i�IN�!�A(K��&�D"N� xf��8`X8�8�&D"N� }H�H-}H�,M� = �a)8��|dH�8�&��N� 8`��= �a)8����|0@L� 8`T8�D"= �a)8��8`�i(M� 8`������N� ���|dx8`&D"N� 9`}*Kx} Cx|�;x|�3x|�+x|�#x|dx8`& D"N� BSS size (%llu bytes) is too big!
        !          5765: IBM,l-lanveth: netdevice not supported
        !          5766: veth: Error %ld sending packet !
        !          5767: veth: Dropping too big packet [%d bytes]
        !          5768: veth: Failed to allocate memory !
        !          5769: veth: Error %ld registering interface !
        !          5770: &�x�`�H�0������������&����������P����������`� ����
        !          5771: ��        �� ��� ��
        !          5772:  �
        !          5773: P�
        !          5774: x��������<�<](ide.fs1 encode-int s" #address-cells" property
        !          5775: 0 encode-int s" #size-cells" property
        !          5776: : decode-unit  1 hex-decode-unit ;
        !          5777: : encode-unit  1 hex-encode-unit ;
        !          5778: 0 VALUE >ata                                 \ base address for command-block
        !          5779: 0 VALUE >ata1                                \ base address for control block
        !          5780: true VALUE no-timeout                        \ flag that no timeout occured
        !          5781: 0c  CONSTANT #cdb-bytes                      \ command descriptor block (12 bytes)
        !          5782: 800 CONSTANT atapi-size
        !          5783: 200 CONSTANT ata-size
        !          5784: : ata-ctrl! 2 >ata1 + io-c! ;                      \ device control reg
        !          5785: : ata-astat@ 2 >ata1 + io-c@ ;                     \ read alternate status
        !          5786: : ata-data@ 0 >ata + io-w@ ;                       \ data reg
        !          5787: : ata-data! 0 >ata + io-w! ;                       \ data reg
        !          5788: : ata-err@  1 >ata + io-c@ ;                       \ error reg
        !          5789: : ata-feat! 1 >ata + io-c! ;                       \ feature reg
        !          5790: : ata-cnt@  2 >ata + io-c@ ;                       \ sector count reg
        !          5791: : ata-cnt!  2 >ata + io-c! ;                       \ sector count reg
        !          5792: : ata-lbal! 3 >ata + io-c! ;                       \ lba low reg
        !          5793: : ata-lbal@ 3 >ata + io-c@ ;                       \ lba low reg
        !          5794: : ata-lbam! 4 >ata + io-c! ;                       \ lba mid reg
        !          5795: : ata-lbam@ 4 >ata + io-c@ ;                       \ lba mid reg
        !          5796: : ata-lbah! 5 >ata + io-c! ;                       \ lba high reg
        !          5797: : ata-lbah@ 5 >ata + io-c@ ;                       \ lba high reg
        !          5798: : ata-dev!  6 >ata + io-c! ;                       \ device reg
        !          5799: : ata-dev@  6 >ata + io-c@ ;                       \ device reg
        !          5800: : ata-cmd!  7 >ata + io-c! ;                       \ command reg
        !          5801: : ata-stat@ 7 >ata + io-c@ ;                       \ status reg
        !          5802: 00 CONSTANT cmd#nop                                \ ATA and ATAPI
        !          5803: 08 CONSTANT cmd#device-reset                       \ ATAPI only (mandatory)
        !          5804: 20 CONSTANT cmd#read-sector                        \ ATA and ATAPI
        !          5805: 90 CONSTANT cmd#execute-device-diagnostic          \ ATA and ATAPI
        !          5806: a0 CONSTANT cmd#packet                             \ ATAPI only (mandatory)
        !          5807: a1 CONSTANT cmd#identify-packet-device             \ ATAPI only (mandatory)
        !          5808: ec CONSTANT cmd#identify-device                    \ ATA and ATAPI
        !          5809: : set-regs ( n -- )
        !          5810: dup
        !          5811: 01 and                                    \ only Chan 0 or Chan 1 allowed
        !          5812: 3 lshift dup 10 + config-l@ -4 and to >ata
        !          5813: 14 + config-l@ -4 and to >ata1
        !          5814: 02 ata-ctrl!                              \ disable interrupts
        !          5815: 02 and
        !          5816: IF
        !          5817: 10
        !          5818: ELSE
        !          5819: 00
        !          5820: THEN
        !          5821: ata-dev!
        !          5822: ;
        !          5823: ata-size VALUE block-size
        !          5824: 80000    VALUE max-transfer            \ Arbitrary, really
        !          5825: CREATE sector d# 512 allot
        !          5826: CREATE packet-cdb #cdb-bytes allot
        !          5827: CREATE return-buffer atapi-size allot
        !          5828: scsi-open                             \ add scsi functions
        !          5829: : show-regs
        !          5830: cr
        !          5831: cr ." alt. Status: " ata-astat@ .
        !          5832: cr ." Status     : " ata-stat@ .
        !          5833: cr ." Device     : " ata-dev@ .
        !          5834: cr ." Error-Reg  : " ata-err@ .
        !          5835: cr ." Sect-Count : " ata-cnt@ .
        !          5836: cr ." LBA-Low    : " ata-lbal@ .
        !          5837: cr ." LBA-Med    : " ata-lbam@ .
        !          5838: cr ." LBA-High   : " ata-lbah@ .
        !          5839: ;
        !          5840: : status-check               ( -- )
        !          5841: ata-stat@
        !          5842: dup   
        !          5843: 01 and                                    \ is 'check' flag set ?
        !          5844: IF
        !          5845: cr
        !          5846: ."    - ATAPI-Status: " .
        !          5847: ata-err@                               \ retrieve sense code
        !          5848: dup
        !          5849: 60 =                                   \ sense code = 6 ?
        !          5850: IF
        !          5851: ." ( media changed or reset )"      \ 'unit attention'
        !          5852: drop                                \ drop err-reg content
        !          5853: ELSE
        !          5854: dup
        !          5855: ." (Err : " .                       \ show err-reg content
        !          5856: space
        !          5857: rshift 4 .sense-text                \ show text string
        !          5858: 29 emit
        !          5859: THEN
        !          5860: cr
        !          5861: ELSE
        !          5862: drop                                   \ remove unused status      
        !          5863: THEN      
        !          5864: ;
        !          5865: : wait-for-ready
        !          5866: get-msecs                                 \ start timer
        !          5867: BEGIN
        !          5868: ata-stat@ 80 and 0<>                   \ busy flag still set ?
        !          5869: no-timeout and
        !          5870: WHILE                                  \ yes
        !          5871: dup get-msecs swap
        !          5872: -                                   \ calculate timer difference
        !          5873: FFFF AND                            \ reduce to 65.5 seconds
        !          5874: d# 5000 >                           \ difference > 5 seconds ?
        !          5875: IF
        !          5876: false to no-timeout
        !          5877: THEN
        !          5878: REPEAT
        !          5879: drop
        !          5880: ;
        !          5881: : wait-for-status          ( val mask -- )
        !          5882: get-msecs                                 \ initial timer value (start)
        !          5883: >r
        !          5884: BEGIN
        !          5885: 2dup                                   \ val mask
        !          5886: ata-stat@ and <>                       \ expected status ?
        !          5887: no-timeout and                         \ and no timeout ?
        !          5888: WHILE      
        !          5889: get-msecs r@ -                         \ calculate timer difference
        !          5890: FFFF AND                               \ mask-off overflow bits
        !          5891: d# 5000 >                              \ 5 seconds exceeded ?
        !          5892: IF
        !          5893: false to no-timeout                 \ set global flag
        !          5894: THEN      
        !          5895: REPEAT                  
        !          5896: r>                                        \ clean return stack
        !          5897: 3drop
        !          5898: ;
        !          5899: : cut-string      ( saddr nul -- )
        !          5900: swap
        !          5901: over +
        !          5902: swap   
        !          5903: 1 rshift                                  \ bytecount -> wordcount
        !          5904: 0 do
        !          5905: /w -
        !          5906: dup               ( addr -- addr addr )
        !          5907: w@                ( addr addr -- addr nuw )
        !          5908: dup               ( addr nuw -- addr nuw nuw )
        !          5909: 2020 =
        !          5910: IF
        !          5911: drop
        !          5912: 0 
        !          5913: ELSE
        !          5914: LEAVE         
        !          5915: THEN
        !          5916: over         
        !          5917: w!
        !          5918: LOOP
        !          5919: drop
        !          5920: drop
        !          5921: ; 
        !          5922: : show-model          ( dev# chan# -- )
        !          5923: 2dup
        !          5924: ."    CH " .                  \ channel 0 / 1
        !          5925: 0= IF ." / MA"                \ Master / Slave
        !          5926: ELSE  ." / SL"
        !          5927: THEN
        !          5928: swap
        !          5929: 2 * + ."  (@" . ." ) : "      \ device number
        !          5930: sector 1 +
        !          5931: c@
        !          5932: 80 AND 0=
        !          5933: IF
        !          5934: ." ATA-Drive    "
        !          5935: ELSE
        !          5936: ." ATAPI-Drive  "
        !          5937: THEN
        !          5938: 22 emit                       \ start string display with "
        !          5939: sector d# 54 +                \ string starts 54 bytes from buffer start
        !          5940: dup
        !          5941: d# 40                         \ and is 40 chars long
        !          5942: cut-string                    \ remove all trailing spaces
        !          5943: BEGIN
        !          5944: dup
        !          5945: w@
        !          5946: wbflip
        !          5947: wbsplit
        !          5948: dup 0<>                    \ first char
        !          5949: IF                   
        !          5950: emit
        !          5951: dup 0<>                 \ second char
        !          5952: IF
        !          5953: emit
        !          5954: wa1+                 \ increment address for next
        !          5955: false
        !          5956: ELSE                    \ second char = EndOfString
        !          5957: drop
        !          5958: true
        !          5959: THEN   
        !          5960: ELSE                       \ first char = EndOfString
        !          5961: drop
        !          5962: drop
        !          5963: true
        !          5964: THEN
        !          5965: UNTIL                         \ end of string detected
        !          5966: drop
        !          5967: 22 emit                       \ end string display
        !          5968: sector c@                     \ get lower byte of first doublet
        !          5969: 80 AND                        \ check bit 7
        !          5970: IF
        !          5971: ."  (removable media)"
        !          5972: THEN
        !          5973: sector 1 +
        !          5974: c@
        !          5975: 80 AND 0= IF                  \ is this an ATA drive ?
        !          5976: sector d# 120 +            \ get word 60 + 61
        !          5977: rl@-le                     \ read 32-bit as little endian value
        !          5978: d# 512                     \ standard ATA block-size
        !          5979: swap
        !          5980: .capacity-text ( block-size #blocks -- )
        !          5981: THEN
        !          5982: sector d# 98 +               \ goto word 49
        !          5983: w@
        !          5984: wbflip
        !          5985: 200 and 0= IF cr ."    ** LBA is not supported " THEN   
        !          5986: sector c@                     \ get lower byte of first doublet
        !          5987: 03 AND 01 =                   \ we use 12-byte packet commands (=00b)
        !          5988: IF
        !          5989: cr ."    packet size = 16 ** not supported ! **"
        !          5990: THEN
        !          5991: no-timeout not                \ any timeout occured so far ?
        !          5992: IF
        !          5993: cr   ."    ** timeout **"
        !          5994: THEN
        !          5995: ;
        !          5996: : pio-sector ( addr -- )  100 0 DO ata-data@
        !          5997: over w! wa1+ LOOP drop ;
        !          5998: : pio-sector ( addr -- ) 
        !          5999: wait-for-ready pio-sector ;
        !          6000: : pio-sectors ( n addr -- )  swap 0 ?DO dup pio-sector 200 + LOOP drop ;
        !          6001: : lba!  lbsplit   
        !          6002: 0f and 40 or                  \ always set LBA-mode + LBA (27..24)
        !          6003: ata-dev@ 10 and or            \ add current device-bit (DEV)
        !          6004: ata-dev!                      \ set LBA (27..24)
        !          6005: ata-lbah!                     \ set LBA (23..16)
        !          6006: ata-lbam!                     \ set LBA (15..8)
        !          6007: ata-lbal!                     \ set LBA (7..0)
        !          6008: ;
        !          6009: : read-sectors ( lba count addr -- ) 
        !          6010: >r dup >r ata-cnt! lba! 20 ata-cmd! r> r> pio-sectors ;
        !          6011: : read-sectors ( lba count addr dev-nr -- )
        !          6012: set-regs             ( lba count addr ) \ Set ata regs 
        !          6013: BEGIN >r dup 100 > WHILE
        !          6014: over 100 r@ read-sectors
        !          6015: >r 100 + r> 100 - r> 20000 + REPEAT
        !          6016: r> read-sectors
        !          6017: ;
        !          6018: : ata-read-blocks                ( addr block# #blocks dev# -- #read )
        !          6019: swap dup >r swap >r rot r>    ( addr block# #blocks dev # R: #blocks )
        !          6020: read-sectors r>               ( R: #read )
        !          6021: ;    
        !          6022: : set-lba                              ( block-length -- )
        !          6023: lbsplit                             ( quad -- b1.lo b2 b3 b4.hi )
        !          6024: drop                                \ skip upper two bytes
        !          6025: drop
        !          6026: ata-lbah!
        !          6027: ata-lbam!
        !          6028: ;
        !          6029: : read-pio-block                        ( buff-addr -- buff-addr-new )
        !          6030: ata-lbah@ 8 lshift                  \ get block length High
        !          6031: ata-lbam@ or                        \ get block length Low
        !          6032: 1 rshift                            \ bcount -> wcount
        !          6033: dup
        !          6034: 0> IF                               \ any data to transfer?
        !          6035: 0 DO                             \ words to read
        !          6036: dup                           \ buffer-address
        !          6037: ata-data@ swap w!             \ write 16-bits
        !          6038: wa1+                          \ address of next entry
        !          6039: LOOP
        !          6040: ELSE
        !          6041: drop                          ( buff-addr wcount -- buff-addr )
        !          6042: THEN
        !          6043: wait-for-ready
        !          6044: ;
        !          6045: : send-atapi-packet                    ( req-buffer -- )
        !          6046: >r                                  (   R: req-buffer )
        !          6047: atapi-size set-lba                  \ set regs to length limit
        !          6048: 00 ata-feat!
        !          6049: cmd#packet ata-cmd!                 \ A0 = ATAPI packet command
        !          6050: 48 C8  wait-for-status     ( val mask -- )  \ BSY:0 DRDY:1 DRQ:1
        !          6051: 6 0  do
        !          6052: packet-cdb i 2 * +                \ transfer command block (12 bytes)
        !          6053: w@
        !          6054: ata-data!                        \ 6 doublets PIO transfer to device
        !          6055: loop                             \ copy packet to data-reg
        !          6056: status-check                        ( -- ) \ status err bit set ? -> display
        !          6057: wait-for-ready                      ( -- ) \ busy released ?
        !          6058: BEGIN
        !          6059: ata-stat@ 08 and 08 = WHILE         \ Data-Request-Bit set ?
        !          6060: r>                               \ get last target buffer address
        !          6061: read-pio-block                   \ only if from device requested
        !          6062: >r                               \ start of next block
        !          6063: REPEAT
        !          6064: r>                                  \ original value
        !          6065: drop                                \ return clean
        !          6066: ;   
        !          6067: : atapi-packet-io                      ( -- )
        !          6068: return-buffer atapi-size erase      \ clear return buffer
        !          6069: return-buffer send-atapi-packet     \ send 'packet-cdb' , get 'return-buffer'
        !          6070: ;
        !          6071: : atapi-test ( -- true|false )
        !          6072: packet-cdb scsi-build-test-unit-ready     \ command-code: 00
        !          6073: atapi-packet-io                           ( )  \ send CDB, get return-buffer
        !          6074: ata-stat@ 1 and IF false ELSE true THEN
        !          6075: ;
        !          6076: : atapi-sense ( -- ascq asc sense-key )
        !          6077: d# 252 packet-cdb scsi-build-request-sense ( alloc-len cdb -- )
        !          6078: atapi-packet-io                           ( )  \ send CDB, get return-buffer
        !          6079: return-buffer scsi-get-sense-data         ( cdb-addr -- ascq asc sense-key )
        !          6080: ;
        !          6081: : atapi-read-blocks                    ( address block# #blocks dev# -- #read-blocks )
        !          6082: set-regs                            ( address block# #blocks )
        !          6083: dup >r                              ( address block# #blocks )
        !          6084: packet-cdb scsi-build-read-10       ( address block# #blocks cdb -- )
        !          6085: send-atapi-packet                   ( address -- )
        !          6086: r>                                  \ return requested number of blocks
        !          6087: ;
        !          6088: : atapi-read-capacity                        ( -- )
        !          6089: packet-cdb scsi-build-read-cap-10         \ fill block with command
        !          6090: atapi-packet-io                           ( )  \ send CDB, get return-buffer
        !          6091: return-buffer scsi-get-capacity-10        ( cdb -- block-size #blocks )
        !          6092: .capacity-text                            ( block-size #blocks -- )
        !          6093: status-check                              ( -- )
        !          6094: ;
        !          6095: : atapi-read-capacity-ext                    ( -- )
        !          6096: packet-cdb scsi-build-read-cap-16         \ fill block with command
        !          6097: atapi-packet-io                           ( )  \ send CDB, get return-buffer
        !          6098: return-buffer scsi-get-capacity-16        ( cdb -- block-size #blocks )
        !          6099: .capacity-text                            ( block-size #blocks -- )
        !          6100: status-check                              ( -- )
        !          6101: ;
        !          6102: : wait-for-media-ready                 ( -- true|false )
        !          6103: get-msecs                                 \ initial timer value (start)
        !          6104: >r
        !          6105: BEGIN
        !          6106: atapi-test                             \ unit ready? false if not      
        !          6107: not
        !          6108: no-timeout and
        !          6109: WHILE
        !          6110: atapi-sense  ( -- ascq asc sense-key )
        !          6111: 02 =                                \ sense key 2 = media error
        !          6112: IF                                  \ check add. sense code
        !          6113: 3A =                             \ asc: device not ready ?
        !          6114: IF
        !          6115: false to no-timeout
        !          6116: ."  empty (" . 29 emit        \ show asc qualifier
        !          6117: ELSE
        !          6118: drop                          \ discard asc qualifier
        !          6119: THEN                             \ medium not present, abort waiting
        !          6120: ELSE
        !          6121: drop                             \ discard asc
        !          6122: drop                             \ discard ascq
        !          6123: THEN
        !          6124: get-msecs r@ -                      \ calculate timer difference
        !          6125: FFFF AND                            \ mask-off overflow bits
        !          6126: d# 5000 >                           \ 5 seconds exceeded ?
        !          6127: IF
        !          6128: false to no-timeout              \ set global flag
        !          6129: THEN      
        !          6130: REPEAT
        !          6131: r>
        !          6132: drop
        !          6133: no-timeout
        !          6134: ;
        !          6135: 2 CONSTANT #chan 
        !          6136: 2 CONSTANT #dev
        !          6137: : #totaldev #dev #chan * ;
        !          6138: CREATE read-blocks-xt #totaldev cells allot read-blocks-xt #totaldev cells erase
        !          6139: : dev-read-blocks  ( address block# #blocks dev# -- #read-blocks )
        !          6140: dup cells read-blocks-xt + @ execute
        !          6141: ;
        !          6142: : read-ident  ( -- true|false )
        !          6143: false
        !          6144: 00 ata-lbal!                              \ clear previous signature
        !          6145: 00 ata-lbam!
        !          6146: 00 ata-lbah!
        !          6147: cmd#identify-device ata-cmd! wait-for-ready \ first try ATA, ATAPI aborts command
        !          6148: ata-stat@ CF and 48 =
        !          6149: IF
        !          6150: drop true                                          \ cmd accepted, this is a ATA
        !          6151: d# 512 set-lba                                     \ set LBA to sector-length
        !          6152: ELSE                                                  \ ATAPI sends signature instead
        !          6153: ata-lbam@ 14 = IF                                  \ cylinder low  = 14 ?
        !          6154: ata-lbah@ EB = IF                               \ cylinder high = EB ?
        !          6155: cmd#device-reset ata-cmd! wait-for-ready     \ only supported by ATAPI
        !          6156: cmd#identify-packet-device ata-cmd! wait-for-ready                     \ first try ata
        !          6157: ata-stat@ CF and 48 = IF               
        !          6158: drop true                                 \ replace flag
        !          6159: THEN
        !          6160: THEN
        !          6161: THEN
        !          6162: THEN
        !          6163: dup IF
        !          6164: ata-stat@ 8 AND IF                        \ data requested (as expected) ?      
        !          6165: sector read-pio-block 
        !          6166: drop                                   \ discard address end 
        !          6167: ELSE
        !          6168: drop false
        !          6169: THEN
        !          6170: THEN
        !          6171: no-timeout not IF                            \ check without any timeout ?
        !          6172: drop
        !          6173: false                                     \ no, detection discarded
        !          6174: THEN
        !          6175: ;
        !          6176: scsi-close                             \ remove scsi commands from word list
        !          6177: : find-disks      ( -- )   
        !          6178: #chan 0 DO                                      \ check 2 channels (primary & secondary)
        !          6179: #dev 0 DO                                    \ check 2 devices per channel (master / slave)
        !          6180: i 2 * j +
        !          6181: set-regs                                  \ set base address and dev-register for register access
        !          6182: ata-stat@ 7f and 7f <>                    \ Check, if device is connected
        !          6183: IF
        !          6184: true to no-timeout                     \ preset timeout-flag
        !          6185: read-ident        ( -- true|false )
        !          6186: IF
        !          6187: i j show-model                      \ print manufacturer + device string
        !          6188: sector 1+ c@ C0 and 80 =            \ Check for ata or atapi
        !          6189: IF
        !          6190: wait-for-media-ready             \ wait up to 5 sec if not ready
        !          6191: no-timeout and
        !          6192: IF
        !          6193: atapi-read-capacity
        !          6194: atapi-size to block-size      \ ATAPI: 2048 bytes
        !          6195: 80000 to max-transfer
        !          6196: ['] atapi-read-blocks i 2 * j + cells read-blocks-xt + !
        !          6197: s" cdrom" strdup i 2 * j + s" generic-disk.fs" included
        !          6198: ELSE
        !          6199: ."  -"                        \ show hint for not registered
        !          6200: THEN    
        !          6201: ELSE
        !          6202: ata-size to block-size           \ ATA: 512 bytes
        !          6203: 80000 to max-transfer
        !          6204: ['] ata-read-blocks i 2 * j + cells read-blocks-xt + !
        !          6205: s" disk" strdup i 2 * j + s" generic-disk.fs" included
        !          6206: THEN
        !          6207: cr
        !          6208: THEN    
        !          6209: THEN
        !          6210: i 2 * j + 200 + cp
        !          6211: LOOP
        !          6212: LOOP
        !          6213: ;
        !          6214: find-disks
        !          6215: ��������)`)%0fbuffer.fs0 VALUE line#
        !          6216: 0 VALUE column#
        !          6217: false VALUE inverse?
        !          6218: false VALUE inverse-screen?
        !          6219: 18 VALUE #lines
        !          6220: 50 VALUE #columns
        !          6221: false VALUE cursor
        !          6222: false VALUE saved-cursor
        !          6223: defer draw-character   \ 2B inited by display driver
        !          6224: defer reset-screen     \ 2B inited by display driver
        !          6225: defer toggle-cursor    \ 2B inited by display driver
        !          6226: defer erase-screen     \ 2B inited by display driver
        !          6227: defer blink-screen     \ 2B inited by display driver
        !          6228: defer invert-screen    \ 2B inited by display driver
        !          6229: defer insert-characters        \ 2B inited by display driver
        !          6230: defer delete-characters        \ 2B inited by display driver
        !          6231: defer insert-lines     \ 2B inited by display driver
        !          6232: defer delete-lines     \ 2B inited by display driver
        !          6233: defer draw-logo                \ 2B inited by display driver
        !          6234: : nop-toggle-cursor ( nop ) ;
        !          6235: ' nop-toggle-cursor to toggle-cursor
        !          6236: : (cursor-off) ( -- ) cursor dup to saved-cursor
        !          6237: IF toggle-cursor false to cursor THEN ;
        !          6238: : (cursor-on) ( -- ) cursor dup to saved-cursor
        !          6239: 0= IF toggle-cursor true to cursor THEN ;
        !          6240: : restore-cursor ( -- ) saved-cursor dup cursor
        !          6241: <> IF toggle-cursor to cursor ELSE drop THEN ;
        !          6242: ' (cursor-off) to cursor-off
        !          6243: ' (cursor-on) to cursor-on
        !          6244: false VALUE esc-on
        !          6245: false VALUE csi-on
        !          6246: defer esc-process
        !          6247: 0 VALUE esc-num-parm
        !          6248: 0 VALUE esc-num-parm2
        !          6249: 0 VALUE saved-line#
        !          6250: 0 VALUE saved-column#
        !          6251: : get-esc-parm ( default -- value )
        !          6252: esc-num-parm dup 0> IF nip ELSE drop THEN 0 to esc-num-parm ;
        !          6253: : get-esc-parm2 ( default -- value )
        !          6254: esc-num-parm2 dup 0> IF nip ELSE drop THEN 0 to esc-num-parm2 ;
        !          6255: : set-esc-parm ( newdigit -- ) [char] 0 - esc-num-parm a * + to esc-num-parm ;
        !          6256: : reverse-cursor ( oldpos -- newpos) dup IF 1 get-esc-parm - THEN ;
        !          6257: : advance-cursor ( bound oldpos -- newpos) tuck > IF 1 get-esc-parm + THEN ;
        !          6258: : erase-in-line #columns column# - dup 0> IF delete-characters ELSE drop THEN ;
        !          6259: : terminal-line++ ( -- )
        !          6260: line# 1+ dup #lines = IF 1- 0 to line# 1 delete-lines THEN
        !          6261: to line#
        !          6262: ;
        !          6263: 0 VALUE dang
        !          6264: 0 VALUE blipp
        !          6265: : ansi-esc ( char -- )
        !          6266: csi-on IF
        !          6267: dup [char] 0 [char] 9 between IF set-esc-parm
        !          6268: ELSE CASE
        !          6269: [char] A OF line# reverse-cursor to line# ENDOF
        !          6270: [char] B OF #lines line# advance-cursor to line# ENDOF
        !          6271: [char] C OF #columns column# advance-cursor to column# ENDOF
        !          6272: [char] D OF column# reverse-cursor to column# ENDOF
        !          6273: [char] E OF ( FIXME: Cursor Next Line - No idea what does it mean )
        !          6274: #lines line# advance-cursor to line#
        !          6275: ENDOF
        !          6276: [char] f OF
        !          6277: 1 get-esc-parm2 to line# column# get-esc-parm to column#
        !          6278: ENDOF
        !          6279: [char] H OF
        !          6280: 1 get-esc-parm2 to line# column# get-esc-parm to column#
        !          6281: ENDOF
        !          6282: [char] ; OF 0 get-esc-parm to esc-num-parm2 ENDOF
        !          6283: [char] J OF
        !          6284: #lines line# - dup 0> IF
        !          6285: line# 1+ to line# delete-lines line# 1- to line#
        !          6286: ELSE drop THEN
        !          6287: erase-in-line
        !          6288: ENDOF
        !          6289: [char] K OF erase-in-line ENDOF
        !          6290: [char] L OF 1 get-esc-parm insert-lines ENDOF
        !          6291: [char] M OF 1 get-esc-parm delete-lines ENDOF
        !          6292: [char] @ OF 1 get-esc-parm insert-characters ENDOF
        !          6293: [char] P OF 1 get-esc-parm delete-characters ENDOF
        !          6294: [char] m OF 0 get-esc-parm 0<> to inverse? ENDOF
        !          6295: [char] p OF inverse-screen? IF false to inverse-screen?
        !          6296: inverse? 0= to inverse? invert-screen
        !          6297: THEN
        !          6298: ENDOF
        !          6299: [char] q OF inverse-screen? 0= IF true to inverse-screen?
        !          6300: inverse? 0= to inverse? invert-screen
        !          6301: THEN
        !          6302: ENDOF
        !          6303: [char] u OF saved-line# to line# saved-column# to column# ENDOF
        !          6304: dup dup to dang OF blink-screen ENDOF
        !          6305: ENDCASE false to csi-on
        !          6306: false to esc-on 0 to esc-num-parm 0 to esc-num-parm2
        !          6307: THEN
        !          6308: ELSE CASE
        !          6309: [char] 7 OF line# to saved-line# column# to saved-column# ENDOF
        !          6310: [char] 8 OF saved-line# to line# saved-column# to column# ENDOF
        !          6311: [char] [ OF true to csi-on ENDOF
        !          6312: dup dup OF false to esc-on to blipp ENDOF
        !          6313: ENDCASE
        !          6314: csi-on 0= IF false to esc-on THEN 0 to esc-num-parm 0 to esc-num-parm2
        !          6315: THEN
        !          6316: ;
        !          6317: ' ansi-esc to esc-process
        !          6318: CREATE twtracebuf 4000 allot twtracebuf 4000 erase
        !          6319: twtracebuf VALUE twbp
        !          6320: 0 VALUE twbc
        !          6321: : twtrace
        !          6322: twbc 4000 = IF 0 to twbc twtracebuf to twbp THEN
        !          6323: dup twbp c! twbp 1+ to twbp twbc 1+ to twbc
        !          6324: ;
        !          6325: : terminal-write ( addr len -- actual-len )
        !          6326: cursor-off
        !          6327: tuck bounds ?DO i c@
        !          6328: twtrace
        !          6329: esc-on IF esc-process
        !          6330: ELSE CASE
        !          6331: 1B OF true to esc-on ENDOF
        !          6332: carret OF 0 to column# ENDOF
        !          6333: linefeed OF terminal-line++ ENDOF
        !          6334: bell OF blink-screen ENDOF
        !          6335: 9 ( TAB ) OF column# 7 + -8 and dup #columns < IF
        !          6336: to column#
        !          6337: ELSE drop THEN
        !          6338: ENDOF
        !          6339: B ( VT ) OF line# ?dup IF 1- to line# THEN ENDOF
        !          6340: C ( FF ) OF 0 to line# 0 to column# erase-screen ENDOF
        !          6341: bs OF  column# 1- dup 0< IF
        !          6342: line# IF
        !          6343: line# 1- to line#
        !          6344: drop #columns 1-
        !          6345: ELSE drop column#
        !          6346: THEN
        !          6347: THEN
        !          6348: to column# ( bl draw-character )
        !          6349: ENDOF
        !          6350: dup OF
        !          6351: i c@ draw-character
        !          6352: column# 1+ dup #columns >= IF
        !          6353: drop 0 terminal-line++
        !          6354: THEN
        !          6355: to column#
        !          6356: ENDOF
        !          6357: ENDCASE
        !          6358: THEN
        !          6359: LOOP
        !          6360: restore-cursor
        !          6361: ;
        !          6362: 0 VALUE char-height
        !          6363: 0 VALUE char-width
        !          6364: 0 VALUE fontbytes
        !          6365: CREATE display-emit-buffer 20 allot
        !          6366: defer dis-old-emit
        !          6367: ' emit behavior to dis-old-emit
        !          6368: : display-write terminal-write ;
        !          6369: : display-emit dup dis-old-emit display-emit-buffer tuck c! 1 terminal-write drop ;
        !          6370: : is-install ( 'open -- )
        !          6371: s" defer vendor-open to vendor-open" eval
        !          6372: s" : open deadbeef vendor-open dup deadbeef = IF drop true ELSE nip THEN ;" eval
        !          6373: s" defer write ' display-write to write" eval
        !          6374: s" : draw-logo ['] draw-logo CATCH IF 2drop 2drop THEN ;" eval
        !          6375: s" : reset-screen ['] reset-screen CATCH drop ;" eval
        !          6376: ;
        !          6377: : is-remove ( 'close -- )
        !          6378: s" defer close to close" eval
        !          6379: ;
        !          6380: : is-selftest ( 'selftest -- )
        !          6381: s" defer selftest to selftest" eval
        !          6382: ;
        !          6383: STRUCT
        !          6384: cell FIELD font>addr
        !          6385: cell FIELD font>width
        !          6386: cell FIELD font>height
        !          6387: cell FIELD font>advance
        !          6388: cell FIELD font>min-char
        !          6389: cell FIELD font>#glyphs
        !          6390: CONSTANT /font
        !          6391: CREATE default-font-ctrblk /font allot default-font-ctrblk
        !          6392: dup font>addr 0 swap !
        !          6393: dup font>width 8 swap !
        !          6394: dup font>height -10 swap !
        !          6395: dup font>advance 1 swap !
        !          6396: dup font>min-char 20 swap !
        !          6397: font>#glyphs 7f swap !
        !          6398: : display-default-font ( str len -- )
        !          6399: romfs-lookup dup 0= IF drop EXIT THEN
        !          6400: 600 <> IF ." Only support 60x8x16 fonts ! " drop EXIT THEN
        !          6401: default-font-ctrblk font>addr !
        !          6402: ;
        !          6403: s" default-font.bin" display-default-font
        !          6404: : .scan-lines ( height -- scanlines ) dup 0>= IF 1- ELSE negate THEN ;
        !          6405: : set-font ( addr width height advance min-char #glyphs -- )
        !          6406: default-font-ctrblk /font + /font 0
        !          6407: DO
        !          6408: 1 cells - dup >r ! r> 1 cells
        !          6409: +LOOP drop
        !          6410: default-font-ctrblk dup font>height @ abs to char-height
        !          6411: dup font>width @ to char-width font>advance @ to fontbytes
        !          6412: ;
        !          6413: : >font ( char -- addr )
        !          6414: dup default-font-ctrblk dup >r font>min-char @ dup r@ font>#glyphs + within
        !          6415: IF
        !          6416: r@ font>min-char @ -
        !          6417: r@ font>advance @ * r@ font>height @ .scan-lines *
        !          6418: r> font>addr @ +
        !          6419: ELSE
        !          6420: drop r> font>addr @
        !          6421: THEN
        !          6422: ;
        !          6423: : default-font ( -- addr width height advance min-char #glyphs )
        !          6424: default-font-ctrblk /font 0 DO dup cell+ >r @ r> 1 cells +LOOP drop
        !          6425: ;
        !          6426: 0 VALUE frame-buffer-adr
        !          6427: 0 VALUE screen-height
        !          6428: 0 VALUE screen-width
        !          6429: 0 VALUE window-top
        !          6430: 0 VALUE window-left
        !          6431: 0 VALUE .sc
        !          6432: : screen-#rows .sc IF 18 ELSE true to .sc s" screen-#rows" eval false to .sc THEN ;
        !          6433: : screen-#columns .sc IF 50 ELSE true to .sc s" screen-#columns" eval false to .sc THEN ;
        !          6434: : fb8-background inverse-screen? ;
        !          6435: : fb8-foreground inverse? invert ;
        !          6436: : fb8-lines2bytes ( #lines -- #bytes ) char-height * screen-width * ;
        !          6437: : fb8-columns2bytes ( #columns -- #bytes ) char-width * ;
        !          6438: : fb8-line2addr ( line# -- addr )
        !          6439: char-height * window-top + screen-width *
        !          6440: frame-buffer-adr + window-left +
        !          6441: ;
        !          6442: : fb8-erase-block ( addr len ) fb8-background rfill ;
        !          6443: 0 VALUE .ab
        !          6444: CREATE bitmap-buffer 400 allot
        !          6445: : active-bits ( -- new ) .ab dup 8 > IF 8 - to .ab 8 ELSE
        !          6446: char-width to .ab ?dup 0= IF recurse THEN
        !          6447: THEN ;
        !          6448: : fb8-char2bitmap ( font-height font-addr -- bitmap-buffer )
        !          6449: bitmap-buffer >r
        !          6450: char-height rot 0> IF r> char-width 2dup fb8-erase-block + >r 1- THEN
        !          6451: r> -rot char-width to .ab
        !          6452: fontbytes * bounds ?DO
        !          6453: i c@ active-bits 0 ?DO
        !          6454: dup 80 and IF fb8-foreground ELSE fb8-background THEN
        !          6455: ( fb-addr fbyte colr ) 2 pick ! 1 lshift swap 1+ swap
        !          6456: LOOP drop
        !          6457: LOOP drop
        !          6458: bitmap-buffer
        !          6459: ;
        !          6460: : fb8-draw-logo ( line# addr width height -- ) ." fb8-draw-logo ( " .s ."  )" cr
        !          6461: 2drop 2drop
        !          6462: ;
        !          6463: : fb8-toggle-cursor ( -- )
        !          6464: line# fb8-line2addr column# fb8-columns2bytes +
        !          6465: char-height 0 ?DO
        !          6466: char-width 0 ?DO dup dup rb@ -1 xor swap rb! 1+ LOOP
        !          6467: screen-width + char-width -
        !          6468: LOOP drop
        !          6469: ;
        !          6470: : fb8-draw-character ( char -- )
        !          6471: >r default-font over + r@ -rot between IF
        !          6472: 2swap 3drop r> >font fb8-char2bitmap ( bitmap-buf )
        !          6473: line# fb8-line2addr column# fb8-columns2bytes + ( bitmap-buf fb-addr )
        !          6474: char-height 0 ?DO
        !          6475: 2dup char-width mrmove
        !          6476: screen-width + >r char-width + r>
        !          6477: LOOP 2drop
        !          6478: ELSE 2drop r> 3drop THEN
        !          6479: ;
        !          6480: : fb8-insert-lines ( n -- )
        !          6481: fb8-lines2bytes >r line# fb8-line2addr dup dup r@ +
        !          6482: #lines line# - fb8-lines2bytes r@ - rmove
        !          6483: r> fb8-erase-block
        !          6484: ;
        !          6485: : fb8-delete-lines ( n -- )
        !          6486: fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + swap
        !          6487: #lines fb8-lines2bytes r@ - dup >r rmove
        !          6488: r> + r> fb8-erase-block
        !          6489: ;
        !          6490: : fb8-insert-characters ( n -- )
        !          6491: line# fb8-line2addr column# fb8-columns2bytes + >r
        !          6492: #columns column# - 2dup >= IF
        !          6493: nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
        !          6494: ELSE
        !          6495: fb8-columns2bytes swap fb8-columns2bytes tuck -
        !          6496: over r@ tuck + rot char-height 0 ?DO
        !          6497: 3dup rmove
        !          6498: -rot screen-width tuck + -rot + swap rot
        !          6499: LOOP
        !          6500: 3drop r>
        !          6501: THEN
        !          6502: char-height 0 ?DO dup 2 pick fb8-erase-block screen-width + LOOP 2drop
        !          6503: ;
        !          6504: : fb8-delete-characters ( n -- )
        !          6505: line# fb8-line2addr column# fb8-columns2bytes + >r
        !          6506: #columns column# - 2dup >= IF
        !          6507: nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN
        !          6508: ELSE
        !          6509: fb8-columns2bytes swap fb8-columns2bytes tuck -
        !          6510: over r@ + 2dup + r> swap >r rot char-height 0 ?DO
        !          6511: 3dup rmove
        !          6512: -rot screen-width tuck + -rot + swap rot
        !          6513: LOOP
        !          6514: 3drop r> over -
        !          6515: THEN
        !          6516: char-height 0 ?DO dup 2 pick fb8-erase-block screen-width + LOOP 2drop
        !          6517: ;
        !          6518: : fb8-reset-screen ( -- ) ( Left as no-op by design ) ;
        !          6519: : fb8-erase-screen ( -- )
        !          6520: frame-buffer-adr screen-height screen-width * fb8-erase-block
        !          6521: ;
        !          6522: : fb8-invert-screen ( -- )
        !          6523: frame-buffer-adr screen-height screen-width * 2dup /x / 0 ?DO
        !          6524: dup rx@ -1 xor over rx! xa1+
        !          6525: LOOP 3drop
        !          6526: ;
        !          6527: : fb8-blink-screen ( -- ) fb8-invert-screen fb8-invert-screen ;
        !          6528: : fb8-install ( width height #columns #lines -- )
        !          6529: screen-#rows min to #lines
        !          6530: screen-#columns min to #columns
        !          6531: dup to screen-height char-height #lines * - 2/ to window-top
        !          6532: dup to screen-width char-width #columns * - 2/ to window-left
        !          6533: ['] fb8-toggle-cursor to toggle-cursor
        !          6534: ['] fb8-draw-character to draw-character
        !          6535: ['] fb8-insert-lines to insert-lines
        !          6536: ['] fb8-delete-lines to delete-lines
        !          6537: ['] fb8-insert-characters to insert-characters
        !          6538: ['] fb8-delete-characters to delete-characters
        !          6539: ['] fb8-erase-screen to erase-screen
        !          6540: ['] fb8-blink-screen to blink-screen
        !          6541: ['] fb8-invert-screen to invert-screen
        !          6542: ['] fb8-reset-screen to reset-screen
        !          6543: ['] fb8-draw-logo to draw-logo
        !          6544: ;
        !          6545: : fb8-dump-bitmap cr char-height 0 ?do char-width 0 ?do dup c@ if ." @" else ." ." then 1+ loop cr loop drop ;
        !          6546: : fb8-dump-char >font -b swap fb8-char2bitmap fb8-dump-bitmap ;
        !          6547: ���������0generic-disk.fsnew-device set-unit                                          ( str len )
        !          6548: 2dup device-name 
        !          6549: s" 0 pci-alias-" 2swap $cat evaluate
        !          6550: s" block" device-type      
        !          6551: s" block-size" $call-parent   CONSTANT block-size
        !          6552: s" max-transfer" $call-parent CONSTANT max-transfer 
        !          6553: : read-blocks ( addr block# #blocks -- #read )
        !          6554: my-unit s" dev-read-blocks" $call-parent
        !          6555: ;    
        !          6556: INSTANCE VARIABLE deblocker
        !          6557: : open ( -- okay? )
        !          6558: 0 0 s" deblocker" $open-package dup deblocker ! dup IF 
        !          6559: s" disk-label" find-package IF
        !          6560: my-args rot interpose
        !          6561: THEN
        !          6562: THEN 0<> ;
        !          6563: : close ( -- )
        !          6564: deblocker @ close-package ;
        !          6565: : seek ( pos.lo pos.hi -- status )
        !          6566: s" seek" deblocker @ $call-method ;
        !          6567: : read ( addr len -- actual )
        !          6568: s" read" deblocker @ $call-method ;
        !          6569: finish-device
        !          6570: ��������X0pci-device.fss" my-puid" $call-parent CONSTANT my-puid
        !          6571: : config-b@  puid >r my-puid TO puid my-space + rtas-config-b@ r> TO puid ;
        !          6572: : config-w@  puid >r my-puid TO puid my-space + rtas-config-w@ r> TO puid ;
        !          6573: : config-l@  puid >r my-puid TO puid my-space + rtas-config-l@ r> TO puid ;
        !          6574: : config-b!  puid >r my-puid TO puid my-space + rtas-config-b! r> TO puid ;
        !          6575: : config-w!  puid >r my-puid TO puid my-space + rtas-config-w! r> TO puid ;
        !          6576: : config-l!  puid >r my-puid TO puid my-space + rtas-config-l! r> TO puid ;
        !          6577: : config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ;
        !          6578: : open
        !          6579: puid >r             \ save the old puid
        !          6580: my-puid TO puid     \ set up the puid to the devices Hostbridge
        !          6581: pci-master-enable   \ And enable Bus Master, IO and MEM access again.
        !          6582: pci-mem-enable      \ enable mem access
        !          6583: pci-io-enable       \ enable io access
        !          6584: r> TO puid          \ restore puid
        !          6585: true
        !          6586: ;
        !          6587: : close 
        !          6588: puid >r             \ save the old puid
        !          6589: my-puid TO puid     \ set up the puid
        !          6590: pci-device-disable  \ and disable the device
        !          6591: r> TO puid          \ restore puid
        !          6592: ;
        !          6593: : devicefile ( -- str len )
        !          6594: s" pci-device_"
        !          6595: my-space pci-vendor@ 4 int2str $cat
        !          6596: s" _" $cat
        !          6597: my-space pci-device@ 4 int2str $cat
        !          6598: s" .fs" $cat
        !          6599: ;
        !          6600: : classfile ( -- str len )
        !          6601: s" pci-class_"
        !          6602: my-space pci-class@ 10 rshift 2 int2str $cat
        !          6603: s" .fs" $cat
        !          6604: ;
        !          6605: : setup ( -- )
        !          6606: devicefile romfs-lookup ?dup
        !          6607: IF
        !          6608: evaluate
        !          6609: ELSE
        !          6610: classfile romfs-lookup ?dup
        !          6611: IF
        !          6612: evaluate
        !          6613: ELSE
        !          6614: my-space pci-class-name type 2a emit cr
        !          6615: my-space pci-device-generic-setup
        !          6616: THEN
        !          6617: THEN
        !          6618: ;
        !          6619: pci-device-disable
        !          6620: pci-error-enable
        !          6621: my-space 44 pci-out     \ config-addr ascii('D')
        !          6622: setup
        !          6623: ��������`'0pci-bridge.fss" my-puid" $call-parent CONSTANT my-puid
        !          6624: pci-bus-number 1+ CONSTANT my-bus
        !          6625: s" pci-config-bridge.fs" included
        !          6626: : filename ( -- str len )
        !          6627: s" pci-bridge_"
        !          6628: my-space pci-vendor@ 4 int2str $cat
        !          6629: s" _" $cat
        !          6630: my-space pci-device@ 4 int2str $cat
        !          6631: s" .fs" $cat
        !          6632: ;
        !          6633: : setup ( -- )
        !          6634: filename romfs-lookup ?dup
        !          6635: IF
        !          6636: evaluate
        !          6637: ELSE
        !          6638: my-space pci-class-name type 2a emit cr
        !          6639: my-space pci-bridge-generic-setup
        !          6640: my-space pci-reset-2nd
        !          6641: THEN
        !          6642: ;
        !          6643: pci-device-disable
        !          6644: pci-error-enable
        !          6645: my-space 42 pci-out     \ config-addr ascii('B')
        !          6646: setup
        !          6647: pci-master-enable
        !          6648: pci-mem-enable
        !          6649: pci-io-enable
        !          6650: ���������X�8pci-properties.fs: pci-class-name-00 ( addr -- str len )
        !          6651: pci-class@ 8 rshift FF and CASE
        !          6652: 01  OF s" display"               ENDOF
        !          6653: dup OF s" unknown-legacy-device" ENDOF
        !          6654: ENDCASE
        !          6655: ;
        !          6656: : pci-class-name-01 ( addr -- str len )
        !          6657: pci-class@ 8 rshift FF and CASE
        !          6658: 00  OF s" scsi"         ENDOF
        !          6659: 01  OF s" ide"          ENDOF
        !          6660: 02  OF s" fdc"          ENDOF
        !          6661: 03  OF s" ipi"          ENDOF
        !          6662: 04  OF s" raid"         ENDOF
        !          6663: 05  OF s" ata"          ENDOF
        !          6664: 06  OF s" sata"         ENDOF
        !          6665: 07  OF s" sas"          ENDOF
        !          6666: dup OF s" mass-storage" ENDOF
        !          6667: ENDCASE
        !          6668: ;
        !          6669: : pci-class-name-02 ( addr -- str len )
        !          6670: pci-class@ 8 rshift FF and CASE
        !          6671: 00  OF s" ethernet"   ENDOF
        !          6672: 01  OF s" token-ring" ENDOF
        !          6673: 02  OF s" fddi"       ENDOF
        !          6674: 03  OF s" atm"        ENDOF
        !          6675: 04  OF s" isdn"       ENDOF
        !          6676: 05  OF s" worldfip"   ENDOF
        !          6677: 05  OF s" picmg"      ENDOF
        !          6678: dup OF s" network"    ENDOF
        !          6679: ENDCASE
        !          6680: ;
        !          6681: : pci-class-name-03 ( addr -- str len )
        !          6682: pci-class@ FFFF and CASE
        !          6683: 0000  OF s" vga"             ENDOF
        !          6684: 0001  OF s" 8514-compatible" ENDOF
        !          6685: 0100  OF s" xga"             ENDOF
        !          6686: 0200  OF s" 3d-controller"   ENDOF
        !          6687: dup OF s" display"           ENDOF
        !          6688: ENDCASE
        !          6689: ;
        !          6690: : pci-class-name-04 ( addr -- str len )
        !          6691: pci-class@ 8 rshift FF and CASE
        !          6692: 00  OF s" video"             ENDOF
        !          6693: 01  OF s" sound"             ENDOF
        !          6694: 02  OF s" telephony"         ENDOF
        !          6695: dup OF s" multimedia-device" ENDOF
        !          6696: ENDCASE
        !          6697: ;
        !          6698: : pci-class-name-05 ( addr -- str len )
        !          6699: pci-class@ 8 rshift FF and CASE
        !          6700: 00  OF s" memory"            ENDOF
        !          6701: 01  OF s" flash"             ENDOF
        !          6702: dup OF s" memory-controller" ENDOF
        !          6703: ENDCASE
        !          6704: ;
        !          6705: : pci-class-name-06 ( addr -- str len )
        !          6706: pci-class@ 8 rshift FF and CASE
        !          6707: 00  OF s" host"                 ENDOF
        !          6708: 01  OF s" isa"                  ENDOF
        !          6709: 02  OF s" eisa"                 ENDOF
        !          6710: 03  OF s" mca"                  ENDOF
        !          6711: 04  OF s" pci"                  ENDOF
        !          6712: 05  OF s" pcmcia"               ENDOF
        !          6713: 06  OF s" nubus"                ENDOF
        !          6714: 07  OF s" cardbus"              ENDOF
        !          6715: 08  OF s" raceway"              ENDOF
        !          6716: 09  OF s" semi-transparent-pci" ENDOF
        !          6717: 0A  OF s" infiniband"           ENDOF
        !          6718: dup OF s" unkown-bridge"        ENDOF
        !          6719: ENDCASE
        !          6720: ;
        !          6721: : pci-class-name-07 ( addr -- str len )
        !          6722: pci-class@ FFFF and CASE
        !          6723: 0000  OF s" serial"                   ENDOF
        !          6724: 0001  OF s" 16450-serial"             ENDOF
        !          6725: 0002  OF s" 16550-serial"             ENDOF
        !          6726: 0003  OF s" 16650-serial"             ENDOF
        !          6727: 0004  OF s" 16750-serial"             ENDOF
        !          6728: 0005  OF s" 16850-serial"             ENDOF
        !          6729: 0006  OF s" 16950-serial"             ENDOF
        !          6730: 0100  OF s" parallel"                 ENDOF
        !          6731: 0101  OF s" bi-directional-parallel"  ENDOF
        !          6732: 0102  OF s" ecp-1.x-parallel"         ENDOF
        !          6733: 0103  OF s" ieee1284-controller"      ENDOF
        !          6734: 01FE  OF s" ieee1284-device"          ENDOF
        !          6735: 0200  OF s" multiport-serial"         ENDOF
        !          6736: 0300  OF s" modem"                    ENDOF
        !          6737: 0301  OF s" 16450-modem"              ENDOF
        !          6738: 0302  OF s" 16550-modem"              ENDOF
        !          6739: 0303  OF s" 16650-modem"              ENDOF
        !          6740: 0304  OF s" 16750-modem"              ENDOF
        !          6741: 0400  OF s" gpib"                     ENDOF
        !          6742: 0500  OF s" smart-card"               ENDOF
        !          6743: dup   OF s" communication-controller" ENDOF
        !          6744: ENDCASE
        !          6745: ;
        !          6746: : pci-class-name-08 ( addr -- str len )
        !          6747: pci-class@ FFFF and CASE
        !          6748: 0000  OF s" interrupt-controller" ENDOF
        !          6749: 0001  OF s" isa-pic"              ENDOF
        !          6750: 0002  OF s" eisa-pic"             ENDOF
        !          6751: 0010  OF s" io-apic"              ENDOF
        !          6752: 0020  OF s" iox-apic"             ENDOF
        !          6753: 0100  OF s" dma-controller"       ENDOF
        !          6754: 0101  OF s" isa-dma"              ENDOF
        !          6755: 0102  OF s" eisa-dma"             ENDOF
        !          6756: 0200  OF s" timer"                ENDOF
        !          6757: 0201  OF s" isa-system-timer"     ENDOF
        !          6758: 0202  OF s" eisa-system-timer"    ENDOF
        !          6759: 0300  OF s" rtc"                  ENDOF
        !          6760: 0301  OF s" isa-rtc"              ENDOF
        !          6761: 0400  OF s" hot-plug-controller"  ENDOF
        !          6762: 0500  OF s" sd-host-conrtoller"   ENDOF
        !          6763: dup   OF s" system-periphal"      ENDOF
        !          6764: ENDCASE
        !          6765: ;
        !          6766: : pci-class-name-09 ( addr -- str len )
        !          6767: pci-class@ 8 rshift FF and CASE
        !          6768: 00  OF s" keyboard"         ENDOF
        !          6769: 01  OF s" pen"              ENDOF
        !          6770: 02  OF s" mouse"            ENDOF
        !          6771: 03  OF s" scanner"          ENDOF
        !          6772: 04  OF s" gameport"         ENDOF
        !          6773: dup OF s" input-controller" ENDOF
        !          6774: ENDCASE
        !          6775: ;
        !          6776: : pci-class-name-0A ( addr -- str len )
        !          6777: pci-class@ 8 rshift FF and CASE
        !          6778: 00  OF s" dock"            ENDOF
        !          6779: dup OF s" docking-station" ENDOF
        !          6780: ENDCASE
        !          6781: ;
        !          6782: : pci-class-name-0B ( addr -- str len )
        !          6783: pci-class@ 8 rshift FF and CASE
        !          6784: 00  OF s" 386"           ENDOF
        !          6785: 01  OF s" 486"           ENDOF
        !          6786: 02  OF s" pentium"       ENDOF
        !          6787: 10  OF s" alpha"         ENDOF
        !          6788: 20  OF s" powerpc"       ENDOF
        !          6789: 30  OF s" mips"          ENDOF
        !          6790: 40  OF s" co-processor"  ENDOF
        !          6791: dup OF s" cpu"           ENDOF
        !          6792: ENDCASE
        !          6793: ;
        !          6794: : pci-class-name-0C ( addr -- str len )
        !          6795: pci-class@ FFFF and CASE
        !          6796: 0000  OF s" firewire"      ENDOF
        !          6797: 0100  OF s" access-bus"    ENDOF
        !          6798: 0200  OF s" ssa"           ENDOF
        !          6799: 0300  OF s" usb-uhci"      ENDOF
        !          6800: 0310  OF s" usb-ohci"      ENDOF
        !          6801: 0320  OF s" usb-ehci"      ENDOF
        !          6802: 0380  OF s" usb"           ENDOF
        !          6803: 03FE  OF s" usb-device"    ENDOF
        !          6804: 0400  OF s" fibre-channel" ENDOF
        !          6805: 0500  OF s" smb"           ENDOF
        !          6806: 0600  OF s" infiniband"    ENDOF
        !          6807: 0700  OF s" ipmi-smic"     ENDOF
        !          6808: 0701  OF s" ipmi-kbrd"     ENDOF
        !          6809: 0702  OF s" ipmi-bltr"     ENDOF
        !          6810: 0800  OF s" sercos"        ENDOF
        !          6811: 0900  OF s" canbus"        ENDOF
        !          6812: dup OF s" serial-bus"      ENDOF
        !          6813: ENDCASE
        !          6814: ;
        !          6815: : pci-class-name-0D ( addr -- str len )
        !          6816: pci-class@ 8 rshift FF and CASE
        !          6817: 00  OF s" irda"                ENDOF
        !          6818: 01  OF s" consumer-ir"         ENDOF
        !          6819: 10  OF s" rf-controller"       ENDOF
        !          6820: 11  OF s" bluetooth"           ENDOF
        !          6821: 12  OF s" broadband"           ENDOF
        !          6822: 20  OF s" enet-802.11a"        ENDOF
        !          6823: 21  OF s" enet-802.11b"        ENDOF
        !          6824: dup OF s" wireless-controller" ENDOF
        !          6825: ENDCASE
        !          6826: ;
        !          6827: : pci-class-name-0E ( addr -- str len )
        !          6828: pci-class@ 8 rshift FF and CASE
        !          6829: dup OF s" intelligent-io" ENDOF
        !          6830: ENDCASE
        !          6831: ;
        !          6832: : pci-class-name-0F ( addr -- str len )
        !          6833: pci-class@ 8 rshift FF and CASE
        !          6834: 01  OF s" satelite-tv"     ENDOF
        !          6835: 02  OF s" satelite-audio"  ENDOF
        !          6836: 03  OF s" satelite-voice"  ENDOF
        !          6837: 04  OF s" satelite-data"   ENDOF
        !          6838: dup OF s" satelite-devoce" ENDOF
        !          6839: ENDCASE
        !          6840: ;
        !          6841: : pci-class-name-10 ( addr -- str len )
        !          6842: pci-class@ 8 rshift FF and CASE
        !          6843: 00  OF s" network-encryption"       ENDOF
        !          6844: 01  OF s" entertainment-encryption" ENDOF
        !          6845: dup OF s" encryption"               ENDOF
        !          6846: ENDCASE
        !          6847: ;
        !          6848: : pci-class-name-11 ( addr -- str len )
        !          6849: pci-class@ 8 rshift FF and CASE
        !          6850: 00  OF s" dpio"                       ENDOF
        !          6851: 01  OF s" counter"                    ENDOF
        !          6852: 10  OF s" measurement"                ENDOF
        !          6853: 20  OF s" managment-card"             ENDOF
        !          6854: dup OF s" data-processing-controller" ENDOF
        !          6855: ENDCASE
        !          6856: ;
        !          6857: : pci-class-name ( addr -- str len )
        !          6858: dup pci-class@ 10 rshift CASE
        !          6859: 00  OF pci-class-name-00 ENDOF
        !          6860: 01  OF pci-class-name-01 ENDOF
        !          6861: 02  OF pci-class-name-02 ENDOF
        !          6862: 03  OF pci-class-name-03 ENDOF
        !          6863: 04  OF pci-class-name-04 ENDOF
        !          6864: 05  OF pci-class-name-05 ENDOF
        !          6865: 06  OF pci-class-name-06 ENDOF
        !          6866: 07  OF pci-class-name-07 ENDOF
        !          6867: 08  OF pci-class-name-08 ENDOF
        !          6868: 09  OF pci-class-name-09 ENDOF
        !          6869: 0A  OF pci-class-name-0A ENDOF
        !          6870: 0B  OF pci-class-name-0B ENDOF
        !          6871: 0C  OF pci-class-name-0C ENDOF
        !          6872: 0C  OF pci-class-name-0D ENDOF
        !          6873: 0C  OF pci-class-name-0E ENDOF
        !          6874: 0C  OF pci-class-name-0F ENDOF
        !          6875: 0C  OF pci-class-name-10 ENDOF
        !          6876: 0C  OF pci-class-name-11 ENDOF
        !          6877: dup OF drop s" unknown"  ENDOF
        !          6878: ENDCASE
        !          6879: ;
        !          6880: : pci-bar-size@     ( bar-addr -- bar-size ) -1 over rtas-config-l! rtas-config-l@ ;
        !          6881: : pci-bar-size-mem@ ( bar-addr -- mem-size ) pci-bar-size@ -10 and invert 1+ FFFFFFFF and ;
        !          6882: : pci-bar-size-io@  ( bar-addr -- io-size  ) pci-bar-size@ -4 and invert 1+ FFFFFFFF and ;
        !          6883: : pci-bar-size ( bar-addr -- bar-size-raw )
        !          6884: dup rtas-config-l@ swap \ fetch original Value  ( bval baddr )
        !          6885: -1 over rtas-config-l!  \ make BAR show size    ( bval baddr )
        !          6886: dup rtas-config-l@      \ and fetch the size    ( bval baddr bsize )
        !          6887: -rot rtas-config-l!     \ restore Value
        !          6888: ;
        !          6889: : pci-bar-size-mem32 ( bar-addr -- bar-size )
        !          6890: pci-bar-size            \ fetch raw size
        !          6891: -10 and invert 1+       \ calc size
        !          6892: FFFFFFFF and            \ keep lower 32 bits
        !          6893: ;
        !          6894: : pci-bar-size-rom ( bar-addr -- bar-size )
        !          6895: pci-bar-size            \ fetch raw size
        !          6896: FFFFF800 and invert 1+  \ calc size
        !          6897: FFFFFFFF and            \ keep lower 32 bits
        !          6898: ;
        !          6899: : pci-bar-size-mem64 ( bar-addr -- bar-size )
        !          6900: dup pci-bar-size        \ fetch raw size lower 32 bits
        !          6901: swap 4 + pci-bar-size   \ fetch raw size upper 32 bits
        !          6902: 20 lshift +             \ and put them together
        !          6903: -10 and invert 1+       \ calc size
        !          6904: ;
        !          6905: : pci-bar-size-io ( bar-addr -- bar-size )
        !          6906: pci-bar-size            \ fetch raw size
        !          6907: -4 and invert 1+        \ calc size
        !          6908: FFFFFFFF and            \ keep lower 32 bits
        !          6909: ;
        !          6910: : pci-bar-code@ ( bar-addr -- 0|1..4|5 )
        !          6911: rtas-config-l@ dup                \ fetch the BaseAddressRegister
        !          6912: 1 and IF                          \ IO BAR ?
        !          6913: 2 and IF 0 ELSE 1 THEN    \ only '01' is valid
        !          6914: ELSE                              \ Memory BAR ?
        !          6915: F and CASE
        !          6916: 0   OF 2 ENDOF    \ Memory 32 Bit Non-Prefetchable
        !          6917: 8   OF 3 ENDOF    \ Memory 32 Bit Prefetchable
        !          6918: 4   OF 4 ENDOF    \ Memory 64 Bit Non-Prefetchable
        !          6919: C   OF 5 ENDOF    \ Memory 64 Bit Prefechtable
        !          6920: dup OF 0 ENDOF    \ Not a valid BarType
        !          6921: ENDCASE
        !          6922: THEN
        !          6923: ;
        !          6924: : assign-var ( size var -- al-mem )
        !          6925: 2dup @                          \ ( size var size cur-mem ) read current free mem
        !          6926: swap #aligned                   \ ( size var al-mem )       align the mem to the size
        !          6927: dup 2swap -rot +                \ ( al-mem var new-mem )    add size to aligned mem
        !          6928: swap !                          \ ( al-mem )                set variable to new mem
        !          6929: ;
        !          6930: : assign-bar-value32 ( bar size var -- 4 )
        !          6931: over IF                         \ IF size > 0
        !          6932: assign-var              \ | ( bar al-mem ) set variable to next mem
        !          6933: swap rtas-config-l!     \ | ( -- )         set the bar to al-mem
        !          6934: ELSE                            \ ELSE
        !          6935: 2drop drop              \ | clear stack
        !          6936: THEN                            \ FI
        !          6937: 4                               \ size of the base-address-register
        !          6938: ;
        !          6939: : assign-bar-value64 ( bar size var -- 8 )
        !          6940: over IF                         \ IF size > 0
        !          6941: assign-var              \ | ( bar al-mem ) set variable to next mem
        !          6942: swap                    \ | ( al-mem addr ) calc config-addr of this bar
        !          6943: 2dup rtas-config-l!     \ | ( al-mem addr ) set the Lower part of the bar to al-mem
        !          6944: 4 + swap 20 rshift      \ | ( al-mem>>32 addr ) prepare the upper part of the al-mem
        !          6945: swap rtas-config-l!     \ | ( -- ) and set the upper part of the bar
        !          6946: ELSE                            \ ELSE
        !          6947: 2drop drop              \ | clear stack
        !          6948: THEN                            \ FI
        !          6949: 8                               \ size of the base-address-register
        !          6950: ;
        !          6951: : assign-mem64-bar ( bar-addr -- 8 )
        !          6952: dup pci-bar-size-mem64         \ fetch size
        !          6953: pci-next-mem                    \ var to change
        !          6954: assign-bar-value64              \ and set it all
        !          6955: ;
        !          6956: : assign-mem32-bar ( bar-addr -- 4 )
        !          6957: dup pci-bar-size-mem32          \ fetch size
        !          6958: pci-next-mem                    \ var to change
        !          6959: assign-bar-value32              \ and set it all
        !          6960: ;
        !          6961: : assign-mmio64-bar ( bar-addr -- 8 )
        !          6962: dup pci-bar-size-mem64          \ fetch size
        !          6963: pci-next-mmio                   \ var to change
        !          6964: assign-bar-value64              \ and set it all
        !          6965: ;
        !          6966: : assign-mmio32-bar ( bar-addr -- 4 )
        !          6967: dup pci-bar-size-mem32          \ fetch size
        !          6968: pci-next-mmio                   \ var to change
        !          6969: assign-bar-value32              \ and set it all
        !          6970: ;
        !          6971: : assign-io-bar ( bar-addr -- 4 )
        !          6972: dup pci-bar-size-io             \ fetch size
        !          6973: pci-next-io                     \ var to change
        !          6974: assign-bar-value32              \ and set it all
        !          6975: ;
        !          6976: : assign-rom-bar ( bar-addr -- )
        !          6977: dup pci-bar-size-rom            \ fetch size
        !          6978: dup IF                          \ IF size > 0
        !          6979: over >r                 \ | save bar addr for enable
        !          6980: pci-next-mmio           \ | var to change
        !          6981: assign-bar-value32      \ | and set it
        !          6982: drop                    \ | forget the BAR length
        !          6983: r@ rtas-config-l@       \ | fetch BAR
        !          6984: 1 or r> rtas-config-l!  \ | and enable the ROM
        !          6985: ELSE                            \ ELSE
        !          6986: 2drop                   \ | clear stack
        !          6987: THEN
        !          6988: ;
        !          6989: : assign-bar ( bar-addr -- reg-size )
        !          6990: dup pci-bar-code@                       \ calc BAR type
        !          6991: dup IF                                  \ IF >0
        !          6992: CASE                            \ | CASE Setup the right type
        !          6993: 1 OF assign-io-bar     ENDOF    \ | - set up an IO-Bar
        !          6994: 2 OF assign-mmio32-bar ENDOF    \ | - set up an 32bit MMIO-Bar
        !          6995: 3 OF assign-mem32-bar  ENDOF    \ | - set up an 32bit MEM-Bar (prefetchable)
        !          6996: 4 OF assign-mmio64-bar ENDOF    \ | - set up an 64bit MMIO-Bar
        !          6997: 5 OF assign-mem64-bar  ENDOF    \ | - set up an 64bit MEM-Bar (prefetchable)
        !          6998: ENDCASE                         \ | ESAC
        !          6999: ELSE                                    \ ELSE
        !          7000: ABORT                           \ | Throw an exception
        !          7001: THEN                                    \ FI
        !          7002: ;
        !          7003: : assign-all-device-bars ( configaddr -- )
        !          7004: 28 10 DO                        \ BARs start at 10 and end at 27
        !          7005: dup i +                 \ calc config-addr of the BAR
        !          7006: assign-bar              \ and set it up
        !          7007: +LOOP                           \ add 4 or 8 to the index and loop
        !          7008: 30 + assign-rom-bar             \ set up the ROM if available
        !          7009: ;
        !          7010: : assign-all-bridge-bars ( configaddr -- )
        !          7011: 18 10 DO                        \ BARs start at 10 and end at 17
        !          7012: dup i +                 \ calc config-addr of the BAR
        !          7013: assign-bar              \ and set it up
        !          7014: +LOOP                           \ add 4 or 8 to the index and loop
        !          7015: 38 + assign-rom-bar             \ set up the ROM if available
        !          7016: ;
        !          7017: : gen-mem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 )
        !          7018: dup pci-bar-size-mem64                  \ fetch BAR Size        ( paddr plen baddr bsize )
        !          7019: dup IF                                  \ IF Size > 0
        !          7020: >r dup rtas-config-l@           \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size)
        !          7021: over 4 + rtas-config-l@         \ | fetch upper 32 bits               ( paddr plen baddr val.lo val.hi R: size)
        !          7022: 20 lshift + -10 and >r          \ | calc 64 bit value and save it     ( paddr plen baddr R: size val )
        !          7023: 83000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
        !          7024: r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
        !          7025: r> encode-64+                   \ | Encode size                       ( paddr plen )
        !          7026: ELSE                                    \ ELSE
        !          7027: 2drop                           \ | don't do anything
        !          7028: THEN                                    \ FI
        !          7029: 8                                       \ sizeof(BAR) = 8 Bytes
        !          7030: ;
        !          7031: : gen-pmem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 )
        !          7032: dup pci-bar-size-mem64                  \ fetch BAR Size        ( paddr plen baddr bsize )
        !          7033: dup IF                                  \ IF Size > 0
        !          7034: >r dup rtas-config-l@           \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size)
        !          7035: over 4 + rtas-config-l@         \ | fetch upper 32 bits               ( paddr plen baddr val.lo val.hi R: size)
        !          7036: 20 lshift + -10 and >r          \ | calc 64 bit value and save it     ( paddr plen baddr R: size val )
        !          7037: C3000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
        !          7038: r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
        !          7039: r> encode-64+                   \ | Encode size                       ( paddr plen )
        !          7040: ELSE                                    \ ELSE
        !          7041: 2drop                           \ | don't do anything
        !          7042: THEN                                    \ FI
        !          7043: 8                                       \ sizeof(BAR) = 8 Bytes
        !          7044: ;
        !          7045: : gen-mem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 )
        !          7046: dup pci-bar-size-mem32                  \ fetch BAR Size        ( paddr plen baddr bsize )
        !          7047: dup IF                                  \ IF Size > 0
        !          7048: >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
        !          7049: -10 and >r                      \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
        !          7050: 82000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
        !          7051: r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
        !          7052: r> encode-64+                   \ | Encode size                       ( paddr plen )
        !          7053: ELSE                                    \ ELSE
        !          7054: 2drop                           \ | don't do anything
        !          7055: THEN                                    \ FI
        !          7056: 4                                       \ sizeof(BAR) = 4 Bytes
        !          7057: ;
        !          7058: : gen-pmem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 )
        !          7059: dup pci-bar-size-mem32                  \ fetch BAR Size        ( paddr plen baddr bsize )
        !          7060: dup IF                                  \ IF Size > 0
        !          7061: >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
        !          7062: -10 and >r                      \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
        !          7063: C2000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
        !          7064: r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
        !          7065: r> encode-64+                   \ | Encode size                       ( paddr plen )
        !          7066: ELSE                                    \ ELSE
        !          7067: 2drop                           \ | don't do anything
        !          7068: THEN                                    \ FI
        !          7069: 4                                       \ sizeof(BAR) = 4 Bytes
        !          7070: ;
        !          7071: : gen-io-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 )
        !          7072: dup pci-bar-size-io                     \ fetch BAR Size                      ( paddr plen baddr bsize )
        !          7073: dup IF                                  \ IF Size > 0
        !          7074: >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
        !          7075: -4 and >r                       \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
        !          7076: 81000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
        !          7077: r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
        !          7078: r> encode-64+                   \ | Encode size                       ( paddr plen )
        !          7079: ELSE                                    \ ELSE
        !          7080: 2drop                           \ | don't do anything
        !          7081: THEN                                    \ FI
        !          7082: 4                                       \ sizeof(BAR) = 4 Bytes
        !          7083: ;
        !          7084: : gen-rom-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len )
        !          7085: dup pci-bar-size-rom                    \ fetch BAR Size                      ( paddr plen baddr bsize )
        !          7086: dup IF                                  \ IF Size > 0
        !          7087: >r dup rtas-config-l@           \ | save size and fetch value         ( paddr plen baddr val R: size)
        !          7088: FFFFF800 and >r                 \ | calc 32 bit value and save it     ( paddr plen baddr R: size val )
        !          7089: 82000000 or encode-int+         \ | Encode config addr                ( paddr plen R: size val )
        !          7090: r> encode-64+                   \ | Encode assigned addr              ( paddr plen R: size )
        !          7091: r> encode-64+                   \ | Encode size                       ( paddr plen )
        !          7092: ELSE                                    \ ELSE
        !          7093: 2drop                           \ | don't do anything
        !          7094: THEN                                    \ FI
        !          7095: ;
        !          7096: : pci-add-assigned-address ( prop-addr prop-len bar-addr -- prop-addr prop-len bsize )
        !          7097: dup pci-bar-code@                               \ calc BAR type                         ( paddr plen baddr btype)
        !          7098: CASE                                            \ CASE for the BAR types                ( paddr plen baddr )
        !          7099: 0 OF drop 4              ENDOF          \ - not a valid type so do nothing
        !          7100: 1 OF gen-io-bar-prop     ENDOF          \ - IO-BAR
        !          7101: 2 OF gen-mem32-bar-prop  ENDOF          \ - MEM32
        !          7102: 3 OF gen-pmem32-bar-prop ENDOF          \ - MEM32 prefetchable
        !          7103: 4 OF gen-mem64-bar-prop  ENDOF          \ - MEM64
        !          7104: 5 OF gen-pmem64-bar-prop ENDOF          \ - MEM64 prefetchable
        !          7105: ENDCASE                                         \ ESAC ( paddr plen bsize )
        !          7106: ;
        !          7107: : pci-device-assigned-addresses-prop ( addr -- )
        !          7108: encode-start                                    \ provide mem for property              ( addr paddr plen )
        !          7109: 2 pick 30 + gen-rom-bar-prop                    \ assign the rom bar
        !          7110: 28 10 DO                                        \ we have 6 possible BARs
        !          7111: 2 pick i +                              \ calc BAR address                      ( addr paddr plen bar-addr )      
        !          7112: pci-add-assigned-address                \ and generate the props for the BAR
        !          7113: +LOOP                                           \ increase Index by returned len
        !          7114: s" assigned-addresses" property drop            \ and write it into the device tree
        !          7115: ;
        !          7116: : pci-bridge-assigned-addresses-prop ( addr -- )
        !          7117: encode-start                                    \ provide mem for property
        !          7118: 2 pick 38 + gen-rom-bar-prop                    \ assign the rom bar
        !          7119: 18 10 DO                                        \ we have 2 possible BARs
        !          7120: 2 pick i +                              \ ( addr paddr plen current-addr )
        !          7121: pci-add-assigned-address                \ and generate the props for the BAR
        !          7122: +LOOP                                           \ increase Index by returned len
        !          7123: s" assigned-addresses" property drop            \ and write it into the device tree
        !          7124: ;
        !          7125: : pci-bridge-gen-range ( paddr plen base limit type -- paddr plen )
        !          7126: >r over -                       \ calc size             ( paddr plen base size R:type )
        !          7127: dup 0< IF                       \ IF Size < 0           ( paddr plen base size R:type )
        !          7128: 2drop r> drop           \ | forget values       ( paddr plen )
        !          7129: ELSE                            \ ELSE
        !          7130: 1+ swap 2swap           \ | adjust stack        ( size base paddr plen R:type )
        !          7131: r@ encode-int+          \ | Child type          ( size base paddr plen R:type )
        !          7132: 2 pick encode-64+       \ | Child address       ( size base paddr plen R:type )
        !          7133: r> encode-int+          \ | Parent type         ( size base paddr plen )
        !          7134: rot encode-64+          \ | Parent address      ( size paddr plen )
        !          7135: rot encode-64+          \ | Encode size         ( paddr plen )
        !          7136: THEN                            \ FI
        !          7137: ;
        !          7138: : pci-bridge-gen-mmio-range ( addr prop-addr prop-len -- addr prop-addr prop-len )
        !          7139: 2 pick 20 + rtas-config-l@      \ fetch Value           ( addr paddr plen val )
        !          7140: dup 0000FFF0 and 10 lshift      \ calc base-address     ( addr paddr plen val base )
        !          7141: swap 000FFFFF or                \ calc limit-address    ( addr paddr plen base limit )
        !          7142: 02000000 pci-bridge-gen-range   \ and generate it       ( addr paddr plen )
        !          7143: ;
        !          7144: : pci-bridge-gen-mem-range ( addr prop-addr prop-len -- addr prop-addr prop-len )
        !          7145: 2 pick 24 + rtas-config-l@      \ fetch Value           ( addr paddr plen val )
        !          7146: dup 000FFFFF or                 \ calc limit Bits 31:0  ( addr paddr plen val limit.31:0 )
        !          7147: swap 0000FFF0 and 10 lshift     \ calc base Bits 31:0   ( addr paddr plen limit.31:0 base.31:0 )
        !          7148: 4 pick 28 + rtas-config-l@      \ fetch upper Basebits  ( addr paddr plen limit.31:0 base.31:0 base.63:32 )
        !          7149: 20 lshift or swap               \ and calc Base         ( addr paddr plen base.63:0 limit.31:0 )
        !          7150: 4 pick 2C + rtas-config-l@      \ fetch upper Limitbits ( addr paddr plen base.63:0 limit.31:0 limit.63:32 )
        !          7151: 20 lshift or                    \ and calc Limit        ( addr paddr plen base.63:0 limit.63:0 )
        !          7152: 42000000 pci-bridge-gen-range   \ and generate it       ( addr paddr plen )
        !          7153: ;
        !          7154: : pci-bridge-gen-io-range ( addr prop-addr prop-len -- addr prop-addr prop-len )
        !          7155: 2 pick 1C + rtas-config-l@      \ fetch Value           ( addr paddr plen val )
        !          7156: dup 0000F000 and 00000FFF or    \ calc Limit Bits 15:0  ( addr paddr plen val limit.15:0 )
        !          7157: swap 000000F0 and 8 lshift      \ calc Base Bits 15:0   ( addr paddr plen limit.15:0 base.15:0 )
        !          7158: 4 pick 30 + rtas-config-l@      \ fetch upper Bits      ( addr paddr plen limit.15:0 base.15:0 val )
        !          7159: dup FFFF and 10 lshift rot or   \ calc Base             ( addr paddr plen limit.15:0 val base.31:0 )
        !          7160: -rot FFFF0000 and or            \ calc Limit            ( addr paddr plen base.31:0 limit.31:0 )
        !          7161: 01000000 pci-bridge-gen-range   \ and generate it       ( addr paddr plen )
        !          7162: ;
        !          7163: : pci-bridge-range-props ( addr -- )
        !          7164: encode-start                    \ provide mem for property
        !          7165: pci-bridge-gen-mmio-range       \ generate the non prefetchable Memory Entry
        !          7166: pci-bridge-gen-mem-range        \ generate the prefetchable Memory Entry
        !          7167: pci-bridge-gen-io-range         \ generate the IO Entry
        !          7168: dup IF                          \ IF any space present (propsize>0)
        !          7169: s" ranges" property     \ | write it into the device tree
        !          7170: ELSE                            \ ELSE
        !          7171: 2drop                   \ | forget the properties
        !          7172: THEN                            \ FI
        !          7173: drop                            \ forget the address
        !          7174: ;
        !          7175: : pci-bridge-interrupt-map ( -- )
        !          7176: encode-start                                    \ create the property                           ( paddr plen )
        !          7177: get-node child                                  \ find the first child                          ( paddr plen handle )
        !          7178: BEGIN dup WHILE                                 \ Loop as long as the handle is non-zero        ( paddr plen handle )
        !          7179: dup >r >space                           \ Get the my-space                              ( paddr plen addr R: handle )
        !          7180: pci-gen-irq-entry                       \ and Encode the interrupt settings             ( paddr plen R: handle)
        !          7181: r> peer                                 \ Get neighbour                                 ( paddr plen handle )
        !          7182: REPEAT                                          \ process next childe node                      ( paddr plen handle )
        !          7183: drop                                            \ forget the null                               ( paddr plen )
        !          7184: s" interrupt-map" property                      \ and set it                                    ( -- )
        !          7185: 1 encode-int s" #interrupt-cells" property      \ encode the cell#
        !          7186: f800 encode-int 0 encode-int+ 0 encode-int+     \ encode the bit mask for config addr (Dev only)
        !          7187: 7 encode-int+ s" interrupt-map-mask" property   \ encode IRQ#=7 and generate property
        !          7188: ;
        !          7189: : encode-mem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 )
        !          7190: dup pci-bar-size-mem32                  \ calc BAR-size ( not changing the BAR )
        !          7191: dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
        !          7192: >r 02000000 or encode-int+      \ | save size and encode BAR addr
        !          7193: 0 encode-64+                    \ | make mid and lo zero
        !          7194: r> encode-64+                   \ | encode size
        !          7195: ELSE                                    \ ELSE
        !          7196: 2drop                           \ | don't do anything
        !          7197: THEN                                    \ FI
        !          7198: 4                                       \ BAR-Len = 4 (32Bit)
        !          7199: ;
        !          7200: : encode-pmem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 )
        !          7201: dup pci-bar-size-mem32                  \ calc BAR-size ( not changing the BAR )
        !          7202: dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
        !          7203: >r 42000000 or encode-int+      \ | save size and encode BAR addr
        !          7204: 0 encode-64+                    \ | make mid and lo zero
        !          7205: r> encode-64+                   \ | encode size
        !          7206: ELSE                                    \ ELSE
        !          7207: 2drop                           \ | don't do anything
        !          7208: THEN                                    \ FI
        !          7209: 4                                       \ BAR-Len = 4 (32Bit)
        !          7210: ;
        !          7211: : encode-mem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 )
        !          7212: dup pci-bar-size-mem64                  \ calc BAR-size ( not changing the BAR )
        !          7213: dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
        !          7214: >r 03000000 or encode-int+      \ | save size and encode BAR addr
        !          7215: 0 encode-64+                    \ | make mid and lo zero
        !          7216: r> encode-64+                   \ | encode size
        !          7217: ELSE                                    \ ELSE
        !          7218: 2drop                           \ | don't do anything
        !          7219: THEN                                    \ FI
        !          7220: 8                                       \ BAR-Len = 8 (64Bit)
        !          7221: ;
        !          7222: : encode-pmem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 )
        !          7223: dup pci-bar-size-mem64                  \ calc BAR-size ( not changing the BAR )
        !          7224: dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
        !          7225: >r 43000000 or encode-int+      \ | save size and encode BAR addr
        !          7226: 0 encode-64+                    \ | make mid and lo zero
        !          7227: r> encode-64+                   \ | encode size
        !          7228: ELSE                                    \ ELSE
        !          7229: 2drop                           \ | don't do anything
        !          7230: THEN                                    \ FI
        !          7231: 8                                       \ BAR-Len = 8 (64Bit)
        !          7232: ;
        !          7233: : encode-rom-bar ( prop-addr prop-len configaddr -- prop-addr prop-len )
        !          7234: dup pci-bar-size-rom                            \ fetch raw BAR-size
        !          7235: dup IF                                          \ IF BAR is used
        !          7236: >r 02000000 or encode-int+              \ | save size and encode BAR addr
        !          7237: 0 encode-64+                            \ | make mid and lo zero
        !          7238: r> encode-64+                           \ | calc and encode the size
        !          7239: ELSE                                            \ ELSE
        !          7240: 2drop                                   \ | don't do anything
        !          7241: THEN                                            \ FI
        !          7242: ;
        !          7243: : encode-io-bar ( prop-addr prop-len BAR-addr BAR-value -- prop-addr prop-len 4 )
        !          7244: dup pci-bar-size-io                     \ calc BAR-size ( not changing the BAR )
        !          7245: dup IF                                  \ IF BAR-size > 0       ( paddr plen baddr bsize )
        !          7246: >r 01000000 or encode-int+      \ | save size and encode BAR addr
        !          7247: 0 encode-64+                    \ | make mid and lo zero
        !          7248: r> encode-64+                   \ | encode size
        !          7249: ELSE                                    \ ELSE
        !          7250: 2drop                           \ | don't do anything
        !          7251: THEN                                    \ FI
        !          7252: 4                                       \ BAR-Len = 4 (32Bit)
        !          7253: ;
        !          7254: : encode-bar ( prop-addr prop-len bar-addr -- prop-addr prop-len bar-len )
        !          7255: dup pci-bar-code@                               \ calc BAR type
        !          7256: CASE                                            \ CASE for the BAR types ( paddr plen baddr val )
        !          7257: 0 OF drop 4             ENDOF           \ - not a valid type so do nothing
        !          7258: 1 OF encode-io-bar      ENDOF           \ - IO-BAR
        !          7259: 2 OF encode-mem32-bar   ENDOF           \ - MEM32
        !          7260: 3 OF encode-pmem32-bar  ENDOF           \ - MEM32 prefetchable
        !          7261: 4 OF encode-mem64-bar   ENDOF           \ - MEM64
        !          7262: 5 OF encode-pmem64-bar  ENDOF           \ - MEM64 prefetchable
        !          7263: ENDCASE                                         \ ESAC ( paddr plen blen )
        !          7264: ;
        !          7265: : pci-reg-props ( configaddr -- )
        !          7266: dup encode-int                  \ configuration space           ( caddr paddr plen )
        !          7267: 0 encode-64+                    \ make the rest 0
        !          7268: 0 encode-64+                    \ encode the size as 0
        !          7269: 2 pick pci-htype@               \ fetch Header Type             ( caddr paddr plen type )
        !          7270: 1 and IF                        \ IF Bridge                     ( caddr paddr plen )
        !          7271: 18 10 DO                \ | loop over all BARs
        !          7272: 2 pick i +      \ | calc bar-addr               ( caddr paddr plen baddr )
        !          7273: encode-bar      \ | encode this BAR             ( caddr paddr plen blen )
        !          7274: +LOOP              \ | increase LoopIndex by the BARlen
        !          7275: 2 pick 38 +             \ | calc ROM-BAR for a bridge   ( caddr paddr plen baddr )
        !          7276: encode-rom-bar          \ | encode the ROM-BAR          ( caddr paddr plen )
        !          7277: ELSE                            \ ELSE ordinary device          ( caddr paddr plen )
        !          7278: 28 10 DO                 \ | loop over all BARs
        !          7279: 2 pick i +      \ | calc bar-addr               ( caddr paddr plen baddr )
        !          7280: encode-bar      \ | encode this BAR             ( caddr paddr plen blen )
        !          7281: +LOOP              \ | increase LoopIndex by the BARlen
        !          7282: 2 pick 30 +             \ | calc ROM-BAR for a device   ( caddr paddr plen baddr )
        !          7283: encode-rom-bar          \ | encode the ROM-BAR          ( caddr paddr plen )
        !          7284: THEN                            \ FI                            ( caddr paddr plen )
        !          7285: s" reg" property                \ and store it into the property
        !          7286: drop
        !          7287: ;
        !          7288: : pci-common-props ( addr -- )
        !          7289: dup pci-class-name 2dup device-name device-type
        !          7290: dup pci-vendor@    encode-int s" vendor-id"      property
        !          7291: dup pci-device@    encode-int s" device-id"      property
        !          7292: dup pci-revision@  encode-int s" revision-id"    property
        !          7293: dup pci-class@     encode-int s" class-code"     property
        !          7294: 3 encode-int s" #address-cells" property
        !          7295: 2 encode-int s" #size-cells"    property
        !          7296: dup pci-config-ext? IF 1 encode-int s" ibm,pci-config-space-type" property THEN
        !          7297: dup pci-status@
        !          7298: dup 9 rshift 3 and encode-int s" devsel-speed" property
        !          7299: dup 7 rshift 1 and IF 0 0 s" fast-back-to-back" property THEN
        !          7300: dup 6 rshift 1 and IF 0 0 s" 66mhz-capable" property THEN
        !          7301: 5 rshift 1 and IF 0 0 s" udf-supported" property THEN
        !          7302: dup pci-cache@     ?dup IF encode-int s" cache-line-size" property THEN
        !          7303: pci-interrupt@ ?dup IF encode-int s" interrupts"      property THEN
        !          7304: ;
        !          7305: : pci-device-props ( addr -- )
        !          7306: dup pci-common-props
        !          7307: dup pci-min-grant@ encode-int s" min-grant"   property
        !          7308: dup pci-max-lat@   encode-int s" max-latency" property
        !          7309: dup pci-sub-device@ ?dup IF encode-int s" subsystem-id" property THEN
        !          7310: dup pci-sub-vendor@ ?dup IF encode-int s" subsystem-vendor-id" property THEN
        !          7311: dup pci-device-assigned-addresses-prop
        !          7312: pci-reg-props
        !          7313: ;
        !          7314: : pci-bridge-props ( addr -- )
        !          7315: dup pci-bus@
        !          7316: encode-int s" primary-bus" property
        !          7317: encode-int s" secondary-bus" property
        !          7318: encode-int s" subordinate-bus" property
        !          7319: dup pci-bus@ drop encode-int rot encode-int+ s" bus-range" property
        !          7320: pci-device-slots encode-int s" slot-names" property
        !          7321: dup pci-bridge-range-props
        !          7322: dup pci-bridge-assigned-addresses-prop
        !          7323: pci-bridge-interrupt-map
        !          7324: pci-reg-props
        !          7325: ;
        !          7326: : assign-bar-mapping ( bar-offset size var -- )
        !          7327: rot my-unit-64 + -rot
        !          7328: assign-bar-value32 drop
        !          7329: ;
        !          7330: : assigned-addresses-property (  -- )
        !          7331: my-unit-64
        !          7332: dup pci-common-props
        !          7333: pci-device-assigned-addresses-prop
        !          7334: ;
        !          7335: : pci-bridge-generic-setup ( addr -- )
        !          7336: pci-device-slots >r             \ save the slot array on return stack
        !          7337: dup pci-common-props            \ set the common properties before scanning the bus
        !          7338: s" pci" device-type             \ the type is allways "pci"
        !          7339: dup pci-bridge-probe            \ find all device connected to it
        !          7340: dup assign-all-bridge-bars      \ set up all memory access BARs
        !          7341: dup pci-set-irq-line            \ set the interrupt pin
        !          7342: dup pci-set-capabilities        \ set up the capabilities
        !          7343: pci-bridge-props            \ and generate all properties
        !          7344: r> TO pci-device-slots          \ and reset the slot array
        !          7345: ;
        !          7346: : pci-device-generic-setup ( config-addr -- )
        !          7347: dup assign-all-device-bars      \ calc all BARs
        !          7348: dup pci-set-irq-line            \ set the interrupt pin
        !          7349: dup pci-set-capabilities        \ set up the capabilities
        !          7350: dup pci-device-props            \ and generate all properties
        !          7351: drop                            \ forget the config-addr
        !          7352: ;
        !          7353: ���������8pci-config-bridge.fs: config-b@  puid >r my-puid TO puid my-space + rtas-config-b@ r> TO puid ;
        !          7354: : config-w@  puid >r my-puid TO puid my-space + rtas-config-w@ r> TO puid ;
        !          7355: : config-l@  puid >r my-puid TO puid my-space + rtas-config-l@ r> TO puid ;
        !          7356: : config-b!  puid >r my-puid TO puid my-space + rtas-config-b! r> TO puid ;
        !          7357: : config-w!  puid >r my-puid TO puid my-space + rtas-config-w! r> TO puid ;
        !          7358: : config-l!  puid >r my-puid TO puid my-space + rtas-config-l! r> TO puid ;
        !          7359: : config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ;
        !          7360: : decode-unit ( addr len -- phys.lo ... phys.hi )
        !          7361: 2 hex-decode-unit       \ decode string
        !          7362: B lshift swap           \ shift the devicenumber to the right spot
        !          7363: 8 lshift or             \ add the functionnumber
        !          7364: my-bus 10 lshift or     \ add the busnumber
        !          7365: 0 0 rot                 \ make phys.lo = 0 = phys.mid
        !          7366: ;
        !          7367: : encode-unit ( phys.lo ... phys.hi -- unit-str unit-len )
        !          7368: nip nip                         \ forget the both zeros
        !          7369: dup 8 rshift 7 and swap         \ calc Functionnumber
        !          7370: B rshift 1F and                 \ calc Devicenumber
        !          7371: over IF                         \ IF Function!=0
        !          7372: 2 hex-encode-unit       \ | create string with DevNum,FnNum
        !          7373: ELSE                            \ ELSE
        !          7374: nip 1 hex-encode-unit   \ | create string with only DevNum
        !          7375: THEN                            \ FI
        !          7376: ;
        !          7377: : map-in ( phys.lo ... phys.hi size -- virt )
        !          7378: 2drop drop
        !          7379: ;
        !          7380: : map-out ( virt size -- )
        !          7381: 2drop 
        !          7382: ;
        !          7383: : dma-alloc ( ... size -- virt )
        !          7384: alloc-mem
        !          7385: ;
        !          7386: : dma-free ( virt size -- )
        !          7387: free-mem
        !          7388: ;
        !          7389: : dma-map-in ( ... virt size cacheable? -- devaddr )
        !          7390: 2drop
        !          7391: ;
        !          7392: : dma-map-out ( virt devaddr size -- )
        !          7393: 2drop drop
        !          7394: ;
        !          7395: : dma-sync ( virt devaddr size -- )
        !          7396: 2drop drop
        !          7397: ;
        !          7398: : open true ;
        !          7399: : close ;
        !          7400: ����������0update_flash.fsfalse value flash-new
        !          7401: : update-flash-help ( -- )
        !          7402: cr ." update-flash tool to flash host FW " cr
        !          7403: ."              -f <filename>      : Flash from file (e.g. net:\boot_rom.bin)" cr
        !          7404: ."              -l                 : Flash from load-base" cr
        !          7405: ."              -d                 : Flash from old load base (used by drone)" cr
        !          7406: ."              -c                 : Flash from temp to perm" cr
        !          7407: ."              -r                 : Flash from perm to temp" cr
        !          7408: ;
        !          7409: : flash-read-temp ( -- success? )
        !          7410: get-flashside 1 = IF flash-addr load-base over flash-image-size rmove true
        !          7411: ELSE
        !          7412: false
        !          7413: THEN
        !          7414: ;
        !          7415: : flash-read-perm ( -- success? )
        !          7416: get-flashside 0= IF
        !          7417: flash-addr load-base over flash-image-size rmove true
        !          7418: ELSE
        !          7419: false
        !          7420: THEN
        !          7421: ;
        !          7422: : flash-switch-side ( side -- success? )
        !          7423: set-flashside 0<> IF
        !          7424: s" Cannot change flashside" type cr false
        !          7425: ELSE
        !          7426: true
        !          7427: THEN
        !          7428: ;
        !          7429: : flash-ensure-temp ( -- success? )
        !          7430: get-flashside 0= IF
        !          7431: cr ." Cannot flash perm! Switching to temp side!"
        !          7432: 1 flash-switch-side
        !          7433: ELSE
        !          7434: true
        !          7435: THEN
        !          7436: ;
        !          7437: : update-flash ( "text" )
        !          7438: get-flashside >r                              \ Save old flashside
        !          7439: parse-word                      ( str len )   \ Parse first string
        !          7440: drop dup c@                     ( str first-char )
        !          7441: [char] - <> IF
        !          7442: update-flash-help r> 2drop EXIT
        !          7443: THEN
        !          7444: 1+ c@                           ( second-char )
        !          7445: CASE
        !          7446: [char] f OF
        !          7447: parse-word cr s" do-load" evaluate
        !          7448: flash-ensure-temp TO flash-new
        !          7449: ENDOF
        !          7450: [char] l OF
        !          7451: flash-ensure-temp
        !          7452: ENDOF
        !          7453: [char] d OF
        !          7454: flash-load-base load-base 200000 move
        !          7455: flash-ensure-temp
        !          7456: ENDOF
        !          7457: [char] c OF
        !          7458: flash-read-temp 0= flash-new or IF
        !          7459: ." Cannot commit temp, need to boot on temp first " cr false
        !          7460: ELSE
        !          7461: 0 flash-switch-side
        !          7462: THEN
        !          7463: ENDOF
        !          7464: [char] r OF
        !          7465: flash-read-perm 0= IF
        !          7466: ." Cannot commit perm, need to boot on perm first " cr false
        !          7467: ELSE
        !          7468: 1 flash-switch-side
        !          7469: THEN
        !          7470: ENDOF
        !          7471: dup      OF
        !          7472: false
        !          7473: ENDOF
        !          7474: ENDCASE
        !          7475: 0= IF
        !          7476: update-flash-help r> drop EXIT
        !          7477: THEN
        !          7478: load-base flash-write 0= IF ." Flash write failed !! " cr THEN
        !          7479: r> set-flashside drop                           \ Restore old flashside
        !          7480: ;
        !          7481: ��������0�0xmodem.fs01 CONSTANT XM-SOH   \ Start of header
        !          7482: 04 CONSTANT XM-EOT   \ End-of-transmission
        !          7483: 06 CONSTANT XM-ACK   \ Acknowledge
        !          7484: 15 CONSTANT XM-NAK   \ Neg. acknowledge
        !          7485: 0 VALUE xm-retries   \ Retry count
        !          7486: 0 VALUE xm-block#
        !          7487: : xmodem-get-byte  ( timeout -- byte|-1 )
        !          7488: d# 1000 *
        !          7489: 0 DO
        !          7490: key? IF key UNLOOP EXIT THEN
        !          7491: 1 ms
        !          7492: LOOP
        !          7493: -1
        !          7494: ;
        !          7495: : xmodem-rx-packet  ( address -- success? )
        !          7496: 1 xmodem-get-byte    \ Get block number
        !          7497: dup 0 < IF
        !          7498: 2drop false EXIT  \ Timeout
        !          7499: THEN
        !          7500: 1 xmodem-get-byte    \ Get neg. block number
        !          7501: dup 0 < IF
        !          7502: 3drop false EXIT  \ Timeout
        !          7503: THEN
        !          7504: rot 0                ( blk# ~blk# address chksum )
        !          7505: 80 0 DO
        !          7506: 1 xmodem-get-byte dup 0 < IF     ( blk# ~blk# address chksum byte )
        !          7507: 3drop 2drop UNLOOP FALSE EXIT
        !          7508: THEN
        !          7509: dup 3 pick c!            ( blk# ~blk# address chksum byte )
        !          7510: + swap 1+ swap           ( blk# ~blk# address+1 chksum' )
        !          7511: LOOP
        !          7512: 0ff and
        !          7513: 1 xmodem-get-byte <> IF
        !          7514: 3drop FALSE EXIT
        !          7515: THEN
        !          7516: drop                        ( blk# ~blk# )
        !          7517: over xm-block# <> IF
        !          7518: 2drop FALSE EXIT
        !          7519: THEN                        ( blk# ~blk# )
        !          7520: ff xor =
        !          7521: ;
        !          7522: : (xmodem-load)  ( address -- bytes )
        !          7523: 1 to xm-block#
        !          7524: 0 to xm-retries
        !          7525: dup
        !          7526: BEGIN
        !          7527: d# 10 xmodem-get-byte dup >r
        !          7528: CASE
        !          7529: XM-SOH OF
        !          7530: dup xmodem-rx-packet IF
        !          7531: XM-ACK emit
        !          7532: 80 +                     ( start-addr next-addr  R: rx-byte )
        !          7533: 0 to xm-retries                    \ Reset retry count
        !          7534: xm-block# 1+ ff and to xm-block#   \ Increase current block#
        !          7535: ELSE
        !          7536: XM-NAK emit
        !          7537: xm-retries 1+ to xm-retries  \ Increase retry count
        !          7538: THEN
        !          7539: ENDOF
        !          7540: XM-EOT OF
        !          7541: XM-ACK emit
        !          7542: ENDOF
        !          7543: dup OF
        !          7544: XM-NAK emit
        !          7545: xm-retries 1+ to xm-retries  \ Increase retry count
        !          7546: ENDOF
        !          7547: ENDCASE
        !          7548: r> XM-EOT =
        !          7549: xm-retries d# 10 >= OR
        !          7550: UNTIL                         ( start-address end-address )
        !          7551: swap -                        ( bytes received )
        !          7552: ;
        !          7553: : xmodem-load  ( -- bytes )
        !          7554: cr ." Waiting for start of XMODEM upload..." cr
        !          7555: load-base (xmodem-load)
        !          7556: ;
        !          7557: ��������@8default-font.bin(($$~$$~$$*((
        !          7558: 
        !          7559: *0H00@8DD@"THT"    |(||00  @8DDDDDDDD88DD @x8DD8@@@HH~~@@@xx @@@xDDD8~B   8DDD8DDDD88DDD<D800000000 @ @@ ~~  "$BNRN@@$$$$~BBBB|BBB||BBB|<"`@@@@`"<xDBBBBBBDx~@@@~~@@@~~@@@~~@@@@<B@@@@NBB<BBBB~~BBBB<<$BDHP``PHDB@@@@@@@@@~Bf~ZBBBBBBBbbRRJJFFB$BBBBBB$pHDDHp@@@@$BBBBBJ$pHDDHpPHDB @@ ~~BBBBBBBBB<BBBBB$$$$BBBBBBBZfBBB$$$$BBBB$$~B  B~0        0@  <fB~ 8D<D:@@@@XdDDdX8D@@D8<LDDL<8Dx@D884LDL4D8@@@XdDDDDDH0@@@DHPpHDB08T****jX$$$$v""""XdDdX@@@4LDL4xD@@@@$$8$$$$$DDD((*****DD((D"" < <  $THDDD((��������h3(core.fs: ?offset16 ( -- true|false )
        !          7560: fcode-offset 16 =
        !          7561: ;
        !          7562: : ?arch64 ( -- true|false )
        !          7563: cell 8 =
        !          7564: ;
        !          7565: : ?bigendian ( -- true|false )
        !          7566: deadbeef fcode-num !
        !          7567: fcode-num ?arch64 IF 4 + THEN 
        !          7568: c@ de =
        !          7569: ;
        !          7570: : reset-fcode-end ( -- )
        !          7571: false fcode-end !
        !          7572: ;
        !          7573: : get-ip ( -- n )
        !          7574: ip @
        !          7575: ;
        !          7576: : set-ip ( n -- )
        !          7577: ip !
        !          7578: ;
        !          7579: : next-ip ( -- )
        !          7580: get-ip 1+ set-ip
        !          7581: ;
        !          7582: : jump-n-ip ( n -- )
        !          7583: get-ip + set-ip
        !          7584: ;
        !          7585: : read-byte ( -- n )
        !          7586: get-ip fcode-rb@
        !          7587: ;
        !          7588: : ?compile-mode ( -- on|off )
        !          7589: state @
        !          7590: ;
        !          7591: : save-evaluator-state
        !          7592: get-ip               eva-debug? IF ." saved ip "           dup . cr THEN
        !          7593: fcode-end @          eva-debug? IF ." saved fcode-end "    dup . cr THEN
        !          7594: fcode-offset         eva-debug? IF ." saved fcode-offset " dup . cr THEN
        !          7595: fcode-spread         eva-debug? IF ." saved fcode-spread " dup . cr THEN  
        !          7596: ['] fcode@ behavior  eva-debug? IF ." saved fcode@ "       dup . cr THEN
        !          7597: ;
        !          7598: : restore-evaluator-state
        !          7599: eva-debug? IF ." restored fcode@ "       dup . cr THEN  to fcode@            
        !          7600: eva-debug? IF ." restored fcode-spread " dup . cr THEN  to fcode-spread
        !          7601: eva-debug? IF ." restored fcode-offset " dup . cr THEN  to fcode-offset
        !          7602: eva-debug? IF ." restored fcode-end "    dup . cr THEN  fcode-end !
        !          7603: eva-debug? IF ." restored ip "           dup . cr THEN  set-ip
        !          7604: ;
        !          7605: : token-table-index ( fcode# -- addr )
        !          7606: cells token-table +
        !          7607: ;
        !          7608: : join-immediate ( xt immediate? addr -- xt+immediate? addr )
        !          7609: -rot + swap
        !          7610: ;
        !          7611: : split-immediate ( xt+immediate? -- xt immediate? )
        !          7612: dup 1 and 2dup - rot drop swap
        !          7613: ;
        !          7614: : literal, ( n -- )
        !          7615: postpone literal
        !          7616: ;
        !          7617: : fc-string,
        !          7618: postpone sliteral
        !          7619: dup c, bounds ?do i c@ c, loop
        !          7620: ;
        !          7621: : set-token ( xt immediate? fcode# -- )
        !          7622: token-table-index join-immediate !
        !          7623: ;
        !          7624: : get-token ( fcode# -- xt immediate? )
        !          7625: token-table-index @ split-immediate
        !          7626: ;
        !          7627: -1 VALUE break-fcode-addr 
        !          7628: : exec ( FCode# -- )
        !          7629: eva-debug? IF
        !          7630: dup
        !          7631: get-ip 8 u.r ." : "
        !          7632: ." [" 3 u.r ." ] "
        !          7633: THEN
        !          7634: get-ip break-fcode-addr = IF
        !          7635: TRUE fcode-end ! drop EXIT
        !          7636: THEN
        !          7637: get-token 0= IF  \ imm == 0 == false
        !          7638: ?compile-mode IF
        !          7639: compile,
        !          7640: ELSE
        !          7641: eva-debug? IF dup xt>name type space THEN        
        !          7642: execute
        !          7643: THEN
        !          7644: ELSE \ immediate
        !          7645: eva-debug? IF dup xt>name type space THEN
        !          7646: execute
        !          7647: THEN
        !          7648: eva-debug? IF .s cr THEN
        !          7649: ;
        !          7650: 0 ?bigendian INCLUDE? big.fs
        !          7651: 0 ?bigendian NOT INCLUDE? little.fs
        !          7652: : read-fcode# ( -- FCode# )
        !          7653: read-byte
        !          7654: dup 01 0F between IF drop read-fcode-num16 THEN
        !          7655: ;
        !          7656: : read-header ( adr -- )
        !          7657: next-ip read-byte        drop
        !          7658: next-ip read-fcode-num16 drop 
        !          7659: next-ip read-fcode-num32 drop 
        !          7660: ;
        !          7661: : read-fcode-string ( -- str len )
        !          7662: read-byte            \ get string length ( -- len )
        !          7663: next-ip get-ip       \ get string addr   ( -- len str )
        !          7664: swap                 \ type needs the parameters swapped ( -- str len )
        !          7665: dup 1- jump-n-ip     \ jump to the end of the string in FCode
        !          7666: ;
        !          7667: : evaluate-fcode ( -- )
        !          7668: fcode@ exec              \ read start code
        !          7669: BEGIN
        !          7670: next-ip fcode@ exec
        !          7671: fcode-end @
        !          7672: UNTIL
        !          7673: ;
        !          7674: : step-fcode ( -- )
        !          7675: break-fcode-addr >r -1 to break-fcode-addr      
        !          7676: fcode@ exec next-ip
        !          7677: r> to break-fcode-addr   
        !          7678: ;    
        !          7679: ���������0evaluator.fshex
        !          7680: -1 constant true
        !          7681: 0 constant false
        !          7682: variable ip
        !          7683: variable fcode-end 
        !          7684: variable fcode-num
        !          7685: 1 value fcode-spread
        !          7686: 16 value fcode-offset
        !          7687: false value eva-debug?
        !          7688: false value fcode-debug?
        !          7689: defer fcode-rb@
        !          7690: defer fcode@
        !          7691: ' c@ to fcode-rb@
        !          7692: create token-table 2000 cells allot    \ 1000h = 4096d
        !          7693: include core.fs
        !          7694: include 1275.fs
        !          7695: include tokens.fs
        !          7696: 0 value buff
        !          7697: 0 value buff-size
        !          7698: ' read-fcode# to fcode@
        !          7699: : step next-ip fcode@ exec ; immediate
        !          7700: : rom-code-ignored ( image# name len -- )
        !          7701: diagnostic-mode? IF type ."  code found in image " .  ." , ignoring ..." cr
        !          7702: ELSE 3drop THEN
        !          7703: ;
        !          7704: : pci-find-rom ( baseaddr -- addr )
        !          7705: -8 and dup IF
        !          7706: dup rw@ 55aa = IF
        !          7707: diagnostic-mode? IF ." Device ROM found at " dup . cr THEN
        !          7708: ELSE drop 0 THEN
        !          7709: THEN
        !          7710: ;
        !          7711: : pci-find-fcode ( baseaddr -- addr len | false )
        !          7712: pci-find-rom ?dup IF
        !          7713: dup 18 + rw@ wbflip +
        !          7714: 0 swap BEGIN
        !          7715: dup rl@ 50434952 ( 'PCIR') <> IF
        !          7716: diagnostic-mode? IF
        !          7717: ." Invalid PCI Data structure, ignoring ROM contents" cr
        !          7718: THEN
        !          7719: 2drop false EXIT
        !          7720: THEN
        !          7721: dup 14 + rb@ CASE
        !          7722: 0 OF over . s" Intel x86 BIOS" rom-code-ignored ENDOF
        !          7723: 1 OF swap diagnostic-mode? IF
        !          7724: ." Open Firmware FCode found at image " . cr
        !          7725: ELSE drop THEN
        !          7726: dup a + rw@ wbflip over + \ This code start
        !          7727: swap 10 + rw@ wbflip 200 * \ This code length
        !          7728: EXIT
        !          7729: ENDOF
        !          7730: 2 OF over . s" HP PA RISC" rom-code-ignored ENDOF
        !          7731: 3 OF over . s" EFI" rom-code-ignored ENDOF
        !          7732: dup OF over . s" Unknown type" rom-code-ignored ENDOF
        !          7733: ENDCASE
        !          7734: dup 15 + rb@ 80 and IF 2drop EXIT THEN \ End of last image
        !          7735: dup 10 + rw@ wbflip 200 * + \ Next image start
        !          7736: swap 1+ swap \ Next image #
        !          7737: 0 UNTIL
        !          7738: THEN false
        !          7739: ;
        !          7740: : execute-rom-fcode ( addr len | false -- )
        !          7741: ?dup IF
        !          7742: diagnostic-mode? IF ." , executing ..." cr THEN
        !          7743: dup >r r@ alloc-mem dup >r swap rmove
        !          7744: r@ set-ip evaluate-fcode
        !          7745: diagnostic-mode? IF ." Done." cr THEN
        !          7746: r> r> free-mem
        !          7747: THEN
        !          7748: ;
        !          7749: ��������P(big.fs: read-fcode-num16 ( -- n )
        !          7750: 0 fcode-num !
        !          7751: ?arch64 IF
        !          7752: read-byte fcode-num 6 + C!
        !          7753: next-ip read-byte fcode-num 7 + C!
        !          7754: ELSE
        !          7755: read-byte fcode-num 2 + C!
        !          7756: next-ip read-byte fcode-num 3 + C!
        !          7757: THEN
        !          7758: fcode-num @
        !          7759: ;
        !          7760: : read-fcode-num32 ( -- n )
        !          7761: 0 fcode-num !
        !          7762: ?arch64 IF
        !          7763: read-byte fcode-num 4 + C!
        !          7764: next-ip read-byte fcode-num 5 + C!
        !          7765: next-ip read-byte fcode-num 6 + C!
        !          7766: next-ip read-byte fcode-num 7 + C!
        !          7767: ELSE
        !          7768: read-byte fcode-num 0 + C!
        !          7769: next-ip read-byte fcode-num 1 + C!
        !          7770: next-ip read-byte fcode-num 2 + C!
        !          7771: next-ip read-byte fcode-num 3 + C!
        !          7772: THEN
        !          7773: fcode-num @
        !          7774: ;
        !          7775: ��������+`+!0tokens.fs: fc-abort ." FCode called abort: IP " get-ip . ( ." STACK: " .s ) depth dup 0< IF abort THEN . rdepth . cr  abort ;
        !          7776: : fc-0 ." 0(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 0 ;
        !          7777: : fc-1 ." 1(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 1 ;
        !          7778: : parse-1hex 1 hex-decode-unit ;
        !          7779: : reset-token-table
        !          7780: FFF 0 DO ['] ferror 0 i set-token LOOP
        !          7781: ;
        !          7782: reset-token-table
        !          7783: ' end0 0        00 set-token
        !          7784: ' b(lit)      1 10 set-token
        !          7785: ' b(')        1 11 set-token
        !          7786: ' b(")        1 12 set-token
        !          7787: ' bbranch     1 13 set-token
        !          7788: ' b?branch    1 14 set-token
        !          7789: ' b(loop)     1 15 set-token
        !          7790: ' b(+loop)    1 16 set-token
        !          7791: ' b(do)       1 17 set-token
        !          7792: ' b(?do)      1 18 set-token
        !          7793: ' i           0 19 set-token
        !          7794: ' j           0 1A set-token
        !          7795: ' b(leave)    1 1B set-token
        !          7796: ' b(of)       1 1C set-token
        !          7797: ' execute     0 1D set-token
        !          7798: ' +           0 1E set-token
        !          7799: ' -           0 1F set-token
        !          7800: ' *           0 20 set-token
        !          7801: ' /           0 21 set-token
        !          7802: ' mod         0 22 set-token 
        !          7803: ' and         0 23 set-token 
        !          7804: ' or          0 24 set-token 
        !          7805: ' xor         0 25 set-token 
        !          7806: ' invert      0 26 set-token 
        !          7807: ' lshift      0 27 set-token 
        !          7808: ' rshift      0 28 set-token 
        !          7809: ' >>a         0 29 set-token 
        !          7810: ' /mod        0 2A set-token 
        !          7811: ' u/mod       0 2B set-token
        !          7812: ' negate      0 2C set-token 
        !          7813: ' abs         0 2D set-token 
        !          7814: ' min         0 2E set-token 
        !          7815: ' max         0 2F set-token 
        !          7816: ' >r          0 30 set-token 
        !          7817: ' r>          0 31 set-token 
        !          7818: ' r@          0 32 set-token 
        !          7819: ' exit        0 33 set-token 
        !          7820: ' 0=          0 34 set-token 
        !          7821: ' 0<>         0 35 set-token 
        !          7822: ' 0<          0 36 set-token 
        !          7823: ' 0<=         0 37 set-token 
        !          7824: ' 0>          0 38 set-token 
        !          7825: ' 0>=         0 39 set-token 
        !          7826: ' <           0 3A set-token
        !          7827: ' >           0 3B set-token
        !          7828: ' =           0 3C set-token
        !          7829: ' <>          0 3D set-token
        !          7830: ' u>          0 3E set-token
        !          7831: ' u<=         0 3F set-token 
        !          7832: ' u<          0 40 set-token 
        !          7833: ' u>=         0 41 set-token 
        !          7834: ' >=          0 42 set-token 
        !          7835: ' <=          0 43 set-token 
        !          7836: ' between     0 44 set-token 
        !          7837: ' within      0 45 set-token 
        !          7838: ' DROP        0 46 set-token
        !          7839: ' DUP         0 47 set-token
        !          7840: ' OVER        0 48 set-token
        !          7841: ' SWAP        0 49 set-token
        !          7842: ' ROT         0 4A set-token
        !          7843: ' -ROT        0 4B set-token
        !          7844: ' TUCK        0 4C set-token
        !          7845: ' nip         0 4D set-token 
        !          7846: ' pick        0 4E set-token 
        !          7847: ' roll        0 4F set-token 
        !          7848: ' ?dup        0 50 set-token 
        !          7849: ' depth       0 51 set-token 
        !          7850: ' 2drop       0 52 set-token 
        !          7851: ' 2dup        0 53 set-token 
        !          7852: ' 2over       0 54 set-token 
        !          7853: ' 2swap       0 55 set-token 
        !          7854: ' 2rot        0 56 set-token 
        !          7855: ' 2/          0 57 set-token 
        !          7856: ' u2/         0 58 set-token 
        !          7857: ' 2*          0 59 set-token 
        !          7858: ' /c          0 5A set-token
        !          7859: ' /w          0 5B set-token 
        !          7860: ' /l          0 5C set-token 
        !          7861: ' /n          0 5D set-token 
        !          7862: ' ca+         0 5E set-token 
        !          7863: ' wa+         0 5F set-token 
        !          7864: ' la+         0 60 set-token 
        !          7865: ' na+         0 61 set-token 
        !          7866: ' char+       0 62 set-token 
        !          7867: ' wa1+        0 63 set-token 
        !          7868: ' la1+        0 64 set-token 
        !          7869: ' cell+       0 65 set-token 
        !          7870: ' chars       0 66 set-token 
        !          7871: ' /w*         0 67 set-token 
        !          7872: ' /l*         0 68 set-token 
        !          7873: ' cells       0 69 set-token 
        !          7874: ' on          0 6A set-token 
        !          7875: ' off         0 6B set-token 
        !          7876: ' +!          0 6C set-token 
        !          7877: ' @           0 6D set-token 
        !          7878: ' l@          0 6E set-token 
        !          7879: ' w@          0 6F set-token 
        !          7880: ' <w@         0 70 set-token 
        !          7881: ' c@          0 71 set-token 
        !          7882: ' !           0 72 set-token 
        !          7883: ' l!          0 73 set-token 
        !          7884: ' w!          0 74 set-token 
        !          7885: ' c!          0 75 set-token 
        !          7886: ' 2@          0 76 set-token 
        !          7887: ' 2!          0 77 set-token 
        !          7888: ' move        0 78 set-token 
        !          7889: ' fill        0 79 set-token 
        !          7890: ' comp        0 7A set-token 
        !          7891: ' noop        0 7B set-token
        !          7892: ' lwsplit     0 7C set-token 
        !          7893: ' wljoin      0 7D set-token 
        !          7894: ' lbsplit     0 7E set-token 
        !          7895: ' bljoin      0 7F set-token 
        !          7896: ' wbflip      0 80 set-token 
        !          7897: ' upc         0 81 set-token 
        !          7898: ' lcc         0 82 set-token 
        !          7899: ' pack      0 83 set-token 
        !          7900: ' count       0 84 set-token 
        !          7901: ' body>       0 85 set-token 
        !          7902: ' >body       0 86 set-token 
        !          7903: ' fcode-revision 0 87 set-token 
        !          7904: ' span        0 88 set-token 
        !          7905: ' unloop      0 89 set-token 
        !          7906: ' expect      0 8A set-token 
        !          7907: ' alloc-mem   0 8B set-token \ alloc-mem  
        !          7908: ' free-mem    0 8C set-token \ free-mem 
        !          7909: ' key?        0 8D set-token 
        !          7910: ' key         0 8E set-token 
        !          7911: ' emit        0 8F set-token 
        !          7912: ' type        0 90 set-token 
        !          7913: ' cr          0 91 set-token \ should be (cr but terminal support is not
        !          7914: ' cr          0 92 set-token 
        !          7915: ' hold        0 95 set-token 
        !          7916: ' <#          0 96 set-token 
        !          7917: ' u#>         0 97 set-token 
        !          7918: ' sign        0 98 set-token 
        !          7919: ' u#          0 99 set-token 
        !          7920: ' u#s         0 9A set-token 
        !          7921: ' u.          0 9B set-token 
        !          7922: ' u.r         0 9C set-token 
        !          7923: ' .           0 9D set-token 
        !          7924: ' .r          0 9E set-token 
        !          7925: ' .s          0 9F set-token 
        !          7926: ' base        0 A0 set-token 
        !          7927: ' $number     0 A2 set-token 
        !          7928: ' digit       0 A3 set-token 
        !          7929: ' -1          0 A4 set-token
        !          7930: '  0          0 A5 set-token
        !          7931: '  1          0 A6 set-token
        !          7932: '  2          0 A7 set-token
        !          7933: '  3          0 A8 set-token
        !          7934: ' bl          0 A9 set-token
        !          7935: ' bs          0 AA set-token 
        !          7936: ' bell        0 AB set-token 
        !          7937: ' bounds      0 AC set-token 
        !          7938: ' here        0 AD set-token 
        !          7939: ' aligned     0 AE set-token 
        !          7940: ' wbsplit     0 AF set-token 
        !          7941: ' bwjoin      0 B0 set-token 
        !          7942: ' b(<mark)    1 B1 set-token
        !          7943: ' b(>resolve) 1 B2 set-token
        !          7944: ' new-token   0 B5 set-token 
        !          7945: ' named-token 0 B6 set-token
        !          7946: ' b(:)        1 B7 set-token
        !          7947: ' b(value)    1 B8 set-token 
        !          7948: ' b(variable) 1 B9 set-token 
        !          7949: ' b(constant) 1 BA set-token 
        !          7950: ' b(create)   1 BB set-token 
        !          7951: ' b(defer)    1 BC set-token 
        !          7952: ' b(buffer:)  1 BD set-token 
        !          7953: ' b(field)    1 BE set-token 
        !          7954: ' INSTANCE     0 C0 set-token 
        !          7955: ' b(;)        1 C2 set-token
        !          7956: ' b(to)       1 C3 set-token 
        !          7957: ' b(case)     1 C4 set-token
        !          7958: ' b(endcase)  1 C5 set-token
        !          7959: ' b(endof)    1 C6 set-token
        !          7960: ' #           0 C7 set-token
        !          7961: ' #s          0 C8 set-token
        !          7962: ' #>          0 C9 set-token
        !          7963: ' external-token 0 CA set-token 
        !          7964: ' $find       0 CB set-token
        !          7965: ' offset16    0 CC set-token 
        !          7966: ' evaluate    0 CD set-token
        !          7967: ' c,          0  D0 set-token
        !          7968: ' w,          0  D1 set-token
        !          7969: ' l,          0  D2 set-token
        !          7970: ' ,           0  D3 set-token
        !          7971: ' um*         0  D4 set-token
        !          7972: ' um/mod      0  D5 set-token
        !          7973: ' d+          0  D8 set-token
        !          7974: ' d-          0  D9 set-token
        !          7975: ' get-token   0  DA set-token 
        !          7976: ' set-token   0  DB set-token 
        !          7977: ' state       0  DC set-token  \ possibly broken
        !          7978: ' compile,    0  DD set-token
        !          7979: ' behavior    0  DE set-token 
        !          7980: ' start0             0  F0 set-token
        !          7981: ' start1             0  F1 set-token
        !          7982: ' start2             0  F2 set-token
        !          7983: ' start4             0  F3 set-token
        !          7984: ' ferror             0  FC set-token
        !          7985: ' version1           0  FD set-token
        !          7986: ' end1               0  FF set-token
        !          7987: ' my-address        0 102 set-token 
        !          7988: ' my-space          0 103 set-token
        !          7989: ' property          0 110 set-token
        !          7990: ' encode-int        0 111 set-token
        !          7991: ' encode+           0 112 set-token
        !          7992: ' encode-phys       0 113 set-token
        !          7993: ' encode-string     0 114 set-token
        !          7994: ' encode-bytes      0 115 set-token
        !          7995: ' reg               0 116 set-token
        !          7996: ' model             0 119 set-token    
        !          7997: ' device-type       0 11A set-token
        !          7998: ' parse-2int        0 11B set-token
        !          7999: ' is-install        0 11C set-token
        !          8000: ' is-remove         0 11D set-token
        !          8001: ' is-selftest       0 11E set-token
        !          8002: ' new-device        0 11F set-token
        !          8003: ' diagnostic-mode?  0 120 set-token
        !          8004: ' memory-test-suite 0 122 set-token
        !          8005: ' mask              0 124 set-token
        !          8006: ' get-msecs         0 125 set-token
        !          8007: ' ms                0 126 set-token
        !          8008: ' finish-device     0 127 set-token
        !          8009: ' decode-phys       0 128 set-token
        !          8010: ' #lines            0 150 set-token
        !          8011: ' #columns          0 151 set-token
        !          8012: ' line#             0 152 set-token
        !          8013: ' column#           0 153 set-token
        !          8014: ' inverse?          0 154 set-token
        !          8015: ' inverse-screen?   0 155 set-token
        !          8016: ' draw-character    0 157 set-token
        !          8017: ' reset-screen      0 158 set-token
        !          8018: ' toggle-cursor     0 159 set-token
        !          8019: ' erase-screen      0 15A set-token
        !          8020: ' blink-screen      0 15B set-token
        !          8021: ' invert-screen     0 15C set-token
        !          8022: ' insert-characters 0 15D set-token
        !          8023: ' delete-characters 0 15E set-token
        !          8024: ' insert-lines      0 15F set-token
        !          8025: ' delete-lines      0 160 set-token
        !          8026: ' draw-logo         0 161 set-token
        !          8027: ' frame-buffer-adr  0 162 set-token
        !          8028: ' screen-height     0 163 set-token
        !          8029: ' screen-width      0 164 set-token
        !          8030: ' window-top        0 165 set-token
        !          8031: ' window-left       0 166 set-token
        !          8032: ' default-font      0 16A set-token
        !          8033: ' set-font          0 16B set-token
        !          8034: ' char-height       0 16C set-token
        !          8035: ' char-width        0 16D set-token
        !          8036: ' >font             0 16E set-token
        !          8037: ' fontbytes         0 16F set-token
        !          8038: ' fb8-install       0 18B set-token
        !          8039: ' device-name       0 201 set-token
        !          8040: ' my-args           0 202 set-token
        !          8041: ' my-self           0 203 set-token
        !          8042: ' find-package      0 204 set-token
        !          8043: ' open-package      0 205 set-token
        !          8044: ' close-package     0 206 set-token
        !          8045: ' find-method       0 207 set-token
        !          8046: ' call-package      0 208 set-token
        !          8047: ' $call-parent      0 209 set-token
        !          8048: ' my-parent         0 20A set-token
        !          8049: ' ihandle>phandle   0 20B set-token
        !          8050: ' my-unit           0 20D set-token
        !          8051: ' $call-method      0 20E set-token
        !          8052: ' $open-package     0 20F set-token
        !          8053: ' (is-user-word)    0 214 set-token
        !          8054: ' suspend-fcode     0 215 set-token
        !          8055: ' fc-abort             0 216 set-token
        !          8056: ' catch             0 217 set-token
        !          8057: ' throw             0 218 set-token
        !          8058: ' get-my-property   0 21A set-token
        !          8059: ' decode-int        0 21B set-token
        !          8060: ' decode-string     0 21C set-token
        !          8061: ' get-inherited-property 0 21D set-token  
        !          8062: ' delete-property   0 21E set-token  
        !          8063: ' get-package-property 0 21F set-token
        !          8064: ' cpeek             0 220 set-token 
        !          8065: ' wpeek             0 221 set-token 
        !          8066: ' lpeek             0 222 set-token 
        !          8067: ' cpoke             0 223 set-token 
        !          8068: ' wpoke             0 224 set-token 
        !          8069: ' lpoke             0 225 set-token 
        !          8070: ' lwflip            0 226 set-token 
        !          8071: ' lbflip            0 227 set-token 
        !          8072: ' lbflips           0 228 set-token
        !          8073: ' rx@               0 22E set-token
        !          8074: ' rx!               0 22F set-token
        !          8075: ' rb@               0 230 set-token
        !          8076: ' rb!               0 231 set-token
        !          8077: ' rw@               0 232 set-token 
        !          8078: ' rw!               0 233 set-token 
        !          8079: ' rl@               0 234 set-token 
        !          8080: ' rl!               0 235 set-token 
        !          8081: ' wbflips           0 236 set-token 
        !          8082: ' lwflips           0 237 set-token 
        !          8083: ' child             0 23B set-token
        !          8084: ' peer              0 23C set-token
        !          8085: ' next-property     0 23D set-token
        !          8086: ' byte-load         0 23E set-token
        !          8087: ' set-args          0 23F set-token
        !          8088: ' left-parse-string 0 240 set-token
        !          8089: ' bxjoin            0 241 set-token
        !          8090: ' <l@               0 242 set-token
        !          8091: ' lxjoin            0 243 set-token
        !          8092: ' wxjoin            0 244 set-token
        !          8093: ' x,                0 245 set-token
        !          8094: ' x@                0 246 set-token
        !          8095: ' x!                0 247 set-token
        !          8096: ' /x                0 248 set-token
        !          8097: ' /x*               0 249 set-token
        !          8098: ' xa+               0 24A set-token
        !          8099: ' xa1+              0 24B set-token
        !          8100: ' xbflip            0 24C set-token
        !          8101: ' xbflips           0 24D set-token
        !          8102: ' xbsplit           0 24E set-token
        !          8103: ' xlflip            0 24F set-token
        !          8104: ' xlflips           0 250 set-token
        !          8105: ' xlsplit           0 251 set-token
        !          8106: ' xwflip            0 252 set-token
        !          8107: ' xwflips           0 253 set-token
        !          8108: ' xwsplit           0 254 set-token
        !          8109: ����������(1275.fs0 value function-type    ' function-type @ constant <value>
        !          8110: variable function-type ' function-type @ constant <variable>
        !          8111: 0 constant function-type ' function-type @ constant <constant>
        !          8112: : function-type ;        ' function-type @ constant <colon>
        !          8113: create function-type     ' function-type @ constant <create>
        !          8114: defer function-type      ' function-type @ constant <defer>
        !          8115: : fcode-revision ( -- n )
        !          8116: 00030000 \ major * 65536 + minor
        !          8117: ;
        !          8118: : b(lit) ( -- n )
        !          8119: next-ip read-fcode-num32
        !          8120: ?compile-mode IF literal, THEN
        !          8121: ;
        !          8122: : b(")
        !          8123: next-ip read-fcode-string
        !          8124: ?compile-mode IF fc-string, align postpone count THEN
        !          8125: ;
        !          8126: : b(')
        !          8127: next-ip read-fcode# get-token drop ?compile-mode IF literal, THEN
        !          8128: ;
        !          8129: : ?jump-direction ( n -- )
        !          8130: dup 8000 >= IF FFFF swap - negate 2- THEN
        !          8131: ;
        !          8132: : ?negative
        !          8133: 8000 and
        !          8134: ;
        !          8135: : dest-on-top
        !          8136: 0 >r BEGIN dup @ 0= WHILE >r REPEAT
        !          8137: BEGIN r> dup WHILE swap REPEAT 
        !          8138: drop
        !          8139: ;
        !          8140: : ?branch
        !          8141: true =
        !          8142: ;
        !          8143: : read-fcode-offset \ ELSE needs to be fixed!
        !          8144: ?offset16 IF next-ip read-fcode-num16 ELSE THEN
        !          8145: ;
        !          8146: : b?branch ( flag -- )
        !          8147: ?compile-mode IF  
        !          8148: read-fcode-offset ?negative IF   dest-on-top postpone until
        !          8149: ELSE postpone if
        !          8150: THEN
        !          8151: ELSE
        !          8152: ?branch IF   2 jump-n-ip
        !          8153: ELSE read-fcode-offset
        !          8154: ?jump-direction 2- jump-n-ip
        !          8155: THEN
        !          8156: THEN
        !          8157: ; immediate
        !          8158: : bbranch ( -- )
        !          8159: ?compile-mode IF 
        !          8160: read-fcode-offset
        !          8161: ?negative IF   dest-on-top postpone again
        !          8162: ELSE postpone else
        !          8163: get-ip next-ip fcode@ B2 = IF drop ELSE set-ip THEN
        !          8164: THEN
        !          8165: ELSE  
        !          8166: read-fcode-offset ?jump-direction 2- jump-n-ip
        !          8167: THEN
        !          8168: ; immediate
        !          8169: : b(<mark) ( -- )
        !          8170: ?compile-mode IF postpone begin THEN
        !          8171: ; immediate
        !          8172: : b(>resolve) ( -- )
        !          8173: ?compile-mode IF postpone then THEN
        !          8174: ; immediate
        !          8175: : ffwto; ( -- )
        !          8176: BEGIN fcode@ dup c2 <> WHILE
        !          8177: ." ffwto: skipping " dup . ." @ " get-ip . cr
        !          8178: CASE   10 OF ( lit ) read-fcode-num32 drop ENDOF
        !          8179: 11 OF ( ' ) read-fcode# drop ENDOF
        !          8180: 12 OF ( " ) read-fcode-string 2drop ENDOF
        !          8181: 13 OF ( bbranch ) read-fcode-offset drop ENDOF
        !          8182: 14 OF ( b?branch ) read-fcode-offset drop ENDOF
        !          8183: 15 OF ( loop ) read-fcode-offset drop ENDOF
        !          8184: 16 OF ( +loop ) read-fcode-offset drop ENDOF
        !          8185: 17 OF ( do ) read-fcode-offset drop ENDOF
        !          8186: 18 OF ( ?do ) read-fcode-offset drop ENDOF
        !          8187: 1C OF ( of ) read-fcode-offset drop ENDOF
        !          8188: C6 OF ( endof ) read-fcode-offset drop ENDOF
        !          8189: C3 OF ( to ) read-fcode# drop ENDOF
        !          8190: dup OF next-ip ENDOF
        !          8191: ENDCASE
        !          8192: REPEAT next-ip
        !          8193: ;
        !          8194: : rpush ( rparm -- ) \ push the rparm to be on top of return stack after exit
        !          8195: r> swap >r >r
        !          8196: ;
        !          8197: : rpop ( -- rparm ) \ pop the rparm that was on top of return stack before this
        !          8198: r> r> swap >r
        !          8199: ;
        !          8200: : b1(;) ( -- )
        !          8201: ." b1(;)" cr
        !          8202: rpop set-ip 
        !          8203: ;
        !          8204: : b(;) ( -- )
        !          8205: postpone exit reveal postpone [ 
        !          8206: ; immediate
        !          8207: : b(:) ( -- )
        !          8208: <colon> compile, ]
        !          8209: ; immediate
        !          8210: : b(case) ( sel -- sel )
        !          8211: postpone case
        !          8212: ; immediate
        !          8213: : b(endcase)
        !          8214: postpone endcase
        !          8215: ; immediate
        !          8216: : b(of)
        !          8217: postpone of
        !          8218: read-fcode-offset drop   \ read and discard offset
        !          8219: ; immediate
        !          8220: : b(endof)
        !          8221: postpone endof
        !          8222: read-fcode-offset drop   
        !          8223: ; immediate
        !          8224: : b(do)
        !          8225: postpone do
        !          8226: read-fcode-offset drop   
        !          8227: ; immediate
        !          8228: : b(?do)
        !          8229: postpone ?do
        !          8230: read-fcode-offset drop   
        !          8231: ; immediate
        !          8232: : b(loop)
        !          8233: postpone loop
        !          8234: read-fcode-offset drop   
        !          8235: ; immediate
        !          8236: : b(+loop)
        !          8237: postpone +loop
        !          8238: read-fcode-offset drop   
        !          8239: ; immediate
        !          8240: : b(leave)
        !          8241: postpone leave
        !          8242: ; immediate
        !          8243: : new-token  \ unnamed local fcode function
        !          8244: align here next-ip read-fcode# 0 swap set-token
        !          8245: ;
        !          8246: : external-token ( -- )  \ named local fcode function 
        !          8247: next-ip read-fcode-string
        !          8248: header         ( str len -- )  \ create a header in the current dictionary entry
        !          8249: new-token
        !          8250: ;
        !          8251: : new-token
        !          8252: eva-debug? IF
        !          8253: s" x" get-ip >r next-ip read-fcode# r> set-ip (u.) $cat strdup
        !          8254: header
        !          8255: THEN new-token
        !          8256: ;
        !          8257: : named-token  \ decide wether or not to give a new token an own name in the dictionary
        !          8258: fcode-debug? IF new-token ELSE external-token THEN
        !          8259: ;
        !          8260: : b(to) ( x -- )
        !          8261: next-ip read-fcode#
        !          8262: get-token drop
        !          8263: >body cell -
        !          8264: ?compile-mode IF literal, postpone !  ELSE !  THEN
        !          8265: ; immediate
        !          8266: : b(value)
        !          8267: <value> , , reveal
        !          8268: ;
        !          8269: : b(variable)
        !          8270: <variable> , 0 , reveal
        !          8271: ;
        !          8272: : b(constant)
        !          8273: <constant> , , reveal
        !          8274: ;
        !          8275: : undefined-defer
        !          8276: cr cr ." Unititialized defer word has been executed!" cr cr 
        !          8277: true fcode-end !
        !          8278: ;
        !          8279: : b(defer)
        !          8280: <defer> , reveal
        !          8281: postpone undefined-defer
        !          8282: ;
        !          8283: : b(create)
        !          8284: <variable> , 
        !          8285: postpone noop reveal
        !          8286: ;
        !          8287: : b(field) ( E: addr -- addr+offset ) ( F: offset size -- offset+size )
        !          8288: <colon> , over literal,
        !          8289: postpone + postpone exit
        !          8290: +
        !          8291: ;
        !          8292: : b(buffer:) ( E: -- a-addr) ( F: size -- )
        !          8293: <variable> , allot
        !          8294: ;
        !          8295: : suspend-fcode ( -- )
        !          8296: noop        \ has to be implemented more efficiently ;-)
        !          8297: ;
        !          8298: : offset16 ( -- )
        !          8299: 16 to fcode-offset
        !          8300: ;
        !          8301: : version1 ( -- )
        !          8302: 1 to fcode-spread
        !          8303: 8 to fcode-offset
        !          8304: read-header
        !          8305: ;
        !          8306: : start0 ( -- )
        !          8307: 0 to fcode-spread
        !          8308: offset16
        !          8309: read-header
        !          8310: ;
        !          8311: : start1 ( -- )
        !          8312: 1 to fcode-spread
        !          8313: offset16
        !          8314: read-header
        !          8315: ;
        !          8316: : start2 ( -- )
        !          8317: 2 to fcode-spread
        !          8318: offset16
        !          8319: read-header
        !          8320: ;
        !          8321: : start4 ( -- )
        !          8322: 4 to fcode-spread
        !          8323: offset16
        !          8324: read-header
        !          8325: ;
        !          8326: : end0 ( -- ) 
        !          8327: true fcode-end ! 
        !          8328: ;
        !          8329: : end1 ( -- ) 
        !          8330: end0 
        !          8331: ;
        !          8332: : ferror ( -- )
        !          8333: clear end0
        !          8334: cr ." FCode# " fcode-num @ . ." not assigned!"
        !          8335: cr ." FCode evaluation aborted." cr
        !          8336: ." ( -- S:" depth . ." R:" rdepth . ." ) " .s cr
        !          8337: abort
        !          8338: ;
        !          8339: : reset-local-fcodes
        !          8340: FFF 800 DO ['] ferror 0 i set-token LOOP
        !          8341: ;
        !          8342: : byte-load ( addr xt -- )
        !          8343: >r >r 
        !          8344: save-evaluator-state
        !          8345: r> r>
        !          8346: reset-fcode-end
        !          8347: 1 to fcode-spread
        !          8348: dup 1 = IF drop ['] rb@ THEN to fcode-rb@
        !          8349: set-ip
        !          8350: reset-local-fcodes
        !          8351: depth >r
        !          8352: evaluate-fcode
        !          8353: r> depth 1- <> IF   clear end0 
        !          8354: cr ." Ambiguous stack depth after byte-load!"
        !          8355: cr ." FCode evaluation aborted." cr cr
        !          8356: ELSE restore-evaluator-state 
        !          8357: THEN
        !          8358: ['] c@ to fcode-rb@                
        !          8359: ;
        !          8360: create byte-load-test-fcode
        !          8361: f1 c, 08 c, 18 c, 69 c, 00 c, 00 c, 00 c, 68 c,
        !          8362: 12 c, 16 c, 62 c, 79 c, 74 c, 65 c, 2d c, 6c c, 
        !          8363: 6f c, 61 c, 64 c, 2d c, 74 c, 65 c, 73 c, 74 c, 
        !          8364: 2d c, 66 c, 63 c, 6f c, 64 c, 65 c, 21 c, 21 c, 
        !          8365: 90 c, 92 c, ( a6 c, a7 c, 2e c, ) 00 c,
        !          8366: : byte-load-test
        !          8367: byte-load-test-fcode ['] w@
        !          8368: ; immediate
        !          8369: : fcode-ms
        !          8370: s" ms" $find IF 0= IF compile, ELSE execute THEN THEN ; immediate
        !          8371: : fcode-$find
        !          8372: $find
        !          8373: IF
        !          8374: drop true
        !          8375: ELSE
        !          8376: false
        !          8377: THEN    
        !          8378: ;
        !          8379: ���������P0pci-class_0c.fss" serial bus [ " type my-space pci-class-name type s"  ]" type cr
        !          8380: my-space pci-device-generic-setup
        !          8381: : handle-usb-ohci-class  ( -- )
        !          8382: 4 config-w@ 110 or 4 config-w!
        !          8383: pci-master-enable               \ set PCI Bus master bit and
        !          8384: pci-mem-enable                  \ memory space enable for USB scan
        !          8385: 10 config-l@                    \ get base address on stack for usb-ohci.fs
        !          8386: s" usb-ohci.fs" included
        !          8387: ;
        !          8388: : handle-sbc-subclass  ( -- )
        !          8389: my-space pci-class@ ffff and CASE         \ get PCI sub-class and interface
        !          8390: 0310 OF handle-usb-ohci-class ENDOF    \ USB OHCI controller
        !          8391: ENDCASE
        !          8392: ;
        !          8393: handle-sbc-subclass
        !          8394: ��������P(O�0usb-ohci.fsCONSTANT baseaddrs
        !          8395: s" OHCI base address = " baseaddrs usb-debug-print-val
        !          8396: s" usb" 2dup device-name device-type
        !          8397: 1 encode-int s" #address-cells" property
        !          8398: 0 encode-int s" #size-cells" property
        !          8399: : encode-unit ( port -- unit-str unit-len ) 1 hex-encode-unit ;
        !          8400: : decode-unit ( addr len -- port ) 1 hex-decode-unit ;
        !          8401: STRUCT
        !          8402: /l field td>tattr
        !          8403: /l field td>cbptr
        !          8404: /l field td>ntd
        !          8405: /l field td>bfrend
        !          8406: CONSTANT /tdlen
        !          8407: STRUCT
        !          8408: /l field ed>eattr
        !          8409: /l field ed>tdqtp
        !          8410: /l field ed>tdqhp
        !          8411: /l field ed>ned
        !          8412: CONSTANT /edlen
        !          8413: STRUCT
        !          8414: /l field hc>hcattr
        !          8415: /l field hc>hcdone
        !          8416: CONSTANT /hclen
        !          8417: baseaddrs      CONSTANT HcRevision
        !          8418: baseaddrs 4  + CONSTANT hccontrol
        !          8419: baseaddrs 8  + CONSTANT hccomstat
        !          8420: baseaddrs 0c + CONSTANT hcintstat
        !          8421: baseaddrs 14 + CONSTANT hcintdsbl
        !          8422: baseaddrs 18 + CONSTANT hchccareg
        !          8423: baseaddrs 20 + CONSTANT hcctrhead
        !          8424: baseaddrs 24 + CONSTANT hccurcont
        !          8425: baseaddrs 28 + CONSTANT hcbulkhead
        !          8426: baseaddrs 2c + CONSTANT hccurbulk
        !          8427: baseaddrs 30 + CONSTANT hcdnehead
        !          8428: baseaddrs 34 + CONSTANT hcintrval
        !          8429: baseaddrs 40 + CONSTANT HcPeriodicStart
        !          8430: baseaddrs 48 + CONSTANT hcrhdescA
        !          8431: baseaddrs 4c + CONSTANT hcrhdescB
        !          8432: baseaddrs 50 + CONSTANT HcRhStatus
        !          8433: baseaddrs 54 + CONSTANT hcrhpstat
        !          8434: baseaddrs 58 + CONSTANT hcrhpstat2
        !          8435: baseaddrs 5c + CONSTANT hcrhpstat3
        !          8436: usb-debug-flag IF
        !          8437: 0 config-l@ ."    - VENDOR: " 8 .r cr
        !          8438: 40 config-l@ ."    - PMC   : " 8 .r
        !          8439: 44 config-l@ ."      PMCSR : " 8 .r cr
        !          8440: E0 config-l@ ."    - EXT1  : " 8 .r
        !          8441: E4 config-l@ ."      EXT2  : " 8 .r cr
        !          8442: THEN
        !          8443: 2 CONSTANT WDH
        !          8444: 1      CONSTANT RHP-CCS    \ Current Connect Status
        !          8445: 2      CONSTANT RHP-PES    \ Port Enable Status
        !          8446: 10     CONSTANT RHP-PRS    \ Port Reset Status
        !          8447: 100    CONSTANT RHP-PPS    \ Port Power Status
        !          8448: 10000  CONSTANT RHP-CSC    \ Connect Status Changed
        !          8449: 100000 CONSTANT RHP-PRSC   \ Port Reset Status Changed
        !          8450: 0 CONSTANT OHCI-DP-SETUP
        !          8451: 1 CONSTANT OHCI-DP-OUT
        !          8452: 2 CONSTANT OHCI-DP-IN
        !          8453: 3 CONSTANT OHCI-DP-INVALID
        !          8454: 8006000100001200 CONSTANT get-ddescp
        !          8455: 8006000200000900 CONSTANT get-cdescp
        !          8456: 8006000400000900 CONSTANT get-idescp
        !          8457: 8006000500000700 CONSTANT get-edescp
        !          8458: A006000000001000 CONSTANT get-hdescp
        !          8459: 0009010000000000 CONSTANT set-cdescp
        !          8460: 2303010004000000 CONSTANT hpenable-set
        !          8461: 2303040001000000 CONSTANT hp1rst-set
        !          8462: 2303040002000000 CONSTANT hp2rst-set
        !          8463: 2303040003000000 CONSTANT hp3rst-set
        !          8464: 2303040004000000 CONSTANT hp4rst-set
        !          8465: 2303080001000000 CONSTANT hp1pwr-set
        !          8466: 2303080002000000 CONSTANT hp2pwr-set
        !          8467: 2303080003000000 CONSTANT hp3pwr-set
        !          8468: 2303080004000000 CONSTANT hp4pwr-set
        !          8469: A003000000000400 CONSTANT hstatus-get
        !          8470: A300000001000400 CONSTANT hp1sta-get
        !          8471: A300000002000400 CONSTANT hp2sta-get
        !          8472: A300000003000400 CONSTANT hp3sta-get
        !          8473: A300000004000400 CONSTANT hp4sta-get
        !          8474: 8008000000000100 CONSTANT get-config
        !          8475: A1FE000000000100 CONSTANT GET-MAX-LUN
        !          8476: 2    18 lshift CONSTANT DATA0-TOGGLE
        !          8477: 3    18 lshift CONSTANT DATA1-TOGGLE
        !          8478: 0f   1c lshift CONSTANT CC-FRESH-TD
        !          8479: 8 CONSTANT STD-REQUEST-SETUP-SIZE
        !          8480: 0    13 lshift CONSTANT TD-DP-SETUP
        !          8481: 1    13 lshift CONSTANT TD-DP-OUT
        !          8482: 2    13 lshift CONSTANT TD-DP-IN
        !          8483: 400001    CONSTANT ed-cntatr
        !          8484: 400002    CONSTANT ed-cntatr1
        !          8485: 80081     CONSTANT ed-hubatr
        !          8486: 80000     CONSTANT ed-defatr
        !          8487: 0f0e40000 CONSTANT td-attr
        !          8488: 00 VALUE ptr
        !          8489: 200 CONSTANT MAX-TDS
        !          8490: 0 VALUE td-freelist-head
        !          8491: 0 VALUE td-freelist-tail
        !          8492: 0 VALUE num-free-tds
        !          8493: 0 VALUE max-rh-ports
        !          8494: 0 VALUE current-stat
        !          8495: INSTANCE VARIABLE td-list-region
        !          8496: 14 CONSTANT MAX-EDS
        !          8497: 0 VALUE ed-freelist-head
        !          8498: 0 VALUE num-free-eds
        !          8499: INSTANCE VARIABLE ed-list-region
        !          8500: 0 VALUE usb-address
        !          8501: 0 VALUE initial-hub-address
        !          8502: 0 VALUE new-device-address
        !          8503: 0 VALUE mps
        !          8504: 0 VALUE DEBUG-TDS
        !          8505: 0 VALUE case-failed  \ available for general use to see IF a CASE statement
        !          8506: 0 VALUE WHILE-failed \ available for general use to see IF a WHILE LOOP
        !          8507: 8 CONSTANT DEFAULT-CONTROL-MPS
        !          8508: 12 CONSTANT DEVICE-DESCRIPTOR-LEN
        !          8509: 1 CONSTANT DEVICE-DESCRIPTOR-TYPE
        !          8510: 1 CONSTANT DEVICE-DESCRIPTOR-TYPE-OFFSET
        !          8511: 4 CONSTANT DEVICE-DESCRIPTOR-DEVCLASS-OFFSET
        !          8512: 7 CONSTANT DEVICE-DESCRIPTOR-MPS-OFFSET
        !          8513: 20 CONSTANT BULK-CONFIG-DESCRIPTOR-LEN
        !          8514: 9 CONSTANT HUB-DEVICE-CLASS
        !          8515: 0 CONSTANT NO-CLASS
        !          8516: VARIABLE  setup-packet     \ 8 bytes for setup packet
        !          8517: VARIABLE  ch-buffer        \ 1 byte character buffer
        !          8518: INSTANCE VARIABLE dd-buffer
        !          8519: INSTANCE VARIABLE cd-buffer
        !          8520: 0 VALUE temp1
        !          8521: 0 VALUE temp2
        !          8522: 0 VALUE temp3
        !          8523: 0 VALUE extra-bytes
        !          8524: 0 VALUE num-td
        !          8525: 0 VALUE current
        !          8526: 0 VALUE device-speed
        !          8527: : Show-OHCI-Register
        !          8528: ." -> OHCI-Register: " cr
        !          8529: ." - HcControl : " hccontrol       rl@-le 8 .r
        !          8530: ."   CmdStat   : " hccomstat       rl@-le 8 .r
        !          8531: ."   HcInterr. : " hcintstat       rl@-le 8 .r cr
        !          8532: ." - HcFmIntval: " hcintrval       rl@-le 8 .r
        !          8533: ."   Per. Start: " HcPeriodicStart rl@-le 8 .r cr
        !          8534: ." - PortStat-1: " hcrhpstat       rl@-le 8 .r
        !          8535: ."   PortStat-2: " hcrhpstat2      rl@-le 8 .r
        !          8536: ."   PortStat-3: " hcrhpstat3      rl@-le 8 .r cr
        !          8537: ."   Descr-A   : " hcrhdescA       rl@-le 8 .r
        !          8538: ."   Descr-B   : " hcrhdescB       rl@-le 8 .r
        !          8539: ."   HcRhStat  : " HcRhStatus      rl@-le 8 .r cr
        !          8540: ;
        !          8541: : display-ed ( ED-ADDRESS -- )
        !          8542: TO temp1
        !          8543: usb-debug-flag IF
        !          8544: s" Dump OF ED " type temp1 u. cr
        !          8545: s" eattr    : " type temp1 ed>eattr l@-le u. cr
        !          8546: s" tdqhp    : " type temp1 ed>tdqhp l@-le u. cr
        !          8547: s" tdqtp    : " type temp1 ed>tdqtp l@-le u. cr
        !          8548: s" ned      : " type temp1 ed>ned   l@-le u. cr
        !          8549: THEN
        !          8550: ;
        !          8551: : display-td ( TD-ADDRESS -- )
        !          8552: TO temp1
        !          8553: usb-debug-flag IF
        !          8554: s" TD " type temp1 u. s" dump: " type cr
        !          8555: s" td>tattr  : " type temp1 td>tattr l@-le u. cr
        !          8556: s" td>cbptr  : " type temp1 td>cbptr l@-le u. cr
        !          8557: s" td>ntd    : " type temp1 td>ntd l@-le u. cr
        !          8558: s" td>bfrend : " type temp1 td>bfrend l@-le u. cr
        !          8559: THEN
        !          8560: ;
        !          8561: : display-descriptors ( ED-ADDRESS -- )
        !          8562: 10  1- not and             ( ED-ADDRESS~ )
        !          8563: dup display-ed ed>tdqhp l@-le  BEGIN ( ED-ADDRESS~ )
        !          8564: 10  1- not and         ( ED-ADDRESS~ )
        !          8565: dup 0<>                ( ED-ADDRESS~ TRUE | FALSE )
        !          8566: WHILE
        !          8567: dup  display-td td>ntd l@-le ( ED-ADDRESS~ )
        !          8568: REPEAT
        !          8569: drop
        !          8570: ;
        !          8571: : zero-out-a-td-except-link ( td -- )
        !          8572: dup 0 swap td>tattr  l!-le             ( td )
        !          8573: dup 0 swap td>cbptr  l!-le             ( td )
        !          8574: dup 0 swap td>bfrend l!-le             ( td )
        !          8575: drop
        !          8576: ;
        !          8577: : initialize-td-free-list ( -- )
        !          8578: MAX-TDS 0= IF EXIT THEN
        !          8579: td-list-region @ 0= IF EXIT THEN
        !          8580: td-list-region @ TO temp1
        !          8581: 0 TO temp2  BEGIN
        !          8582: temp1 zero-out-a-td-except-link
        !          8583: temp1 /tdlen + dup   temp1 td>ntd   l!-le TO temp1
        !          8584: temp2 1+ TO temp2
        !          8585: temp2 MAX-TDS =                ( TRUE | FALSE )
        !          8586: UNTIL
        !          8587: temp1 /tdlen - dup 0 swap td>ntd l!-le TO td-freelist-tail
        !          8588: td-list-region @ TO td-freelist-head
        !          8589: MAX-TDS TO num-free-tds
        !          8590: ;
        !          8591: : allocate-td-list ( n -- head tail )
        !          8592: dup 0= IF drop 0 0 EXIT THEN           ( 0 0 )
        !          8593: dup num-free-tds > IF drop 0 0 EXIT THEN     ( 0 0 )
        !          8594: dup num-free-tds = IF                  ( n )
        !          8595: drop td-freelist-head td-freelist-tail ( td-freelist-head td-freelist-tail )
        !          8596: 0 TO td-freelist-head                  ( td-freelist-head td-freelist-tail )
        !          8597: 0 TO td-freelist-tail                  ( td-freelist-head td-freelist-tail )
        !          8598: 0 TO num-free-tds                              ( td-freelist-head td-freelist-tail )
        !          8599: EXIT
        !          8600: THEN
        !          8601: dup num-free-tds swap - TO num-free-tds        ( n )
        !          8602: td-freelist-head                               ( n td-list-head )
        !          8603: dup TO temp1                                   ( n td-list-head )
        !          8604: swap                                   ( td-list-head n )
        !          8605: 0 DO                                           ( td-list-head   )
        !          8606: temp1 TO temp2                         ( td-list-head   )
        !          8607: temp1 td>ntd l@-le   TO   temp1                ( td-list-head   )
        !          8608: LOOP                                           ( td-list-head   )
        !          8609: temp2                                  ( td-list-head td-list-tail )
        !          8610: dup td>ntd 0 swap l!-le                        ( td-list-head td-list-tail )
        !          8611: temp1 TO td-freelist-head                      ( td-list-head td-list-tail )
        !          8612: ;
        !          8613: : find-td-list-tail-and-size  ( head -- tail n )
        !          8614: TO temp1
        !          8615: 0 TO temp2
        !          8616: 0 TO temp3
        !          8617: DEBUG-TDS  IF
        !          8618: s" BEGIN find-td-list-tail-and-size: "   usb-debug-print
        !          8619: THEN
        !          8620: BEGIN
        !          8621: temp1 0<>                                      ( TRUE|FALSE )
        !          8622: WHILE
        !          8623: DEBUG-TDS  IF
        !          8624: temp1 u. cr
        !          8625: THEN
        !          8626: temp1 TO temp3
        !          8627: temp1 td>ntd l@-le TO temp1
        !          8628: temp2 1+ TO temp2
        !          8629: REPEAT
        !          8630: temp3 temp2                                    ( tail n )
        !          8631: DEBUG-TDS  IF
        !          8632: s" END find-td-list-tail-and-size"   usb-debug-print
        !          8633: THEN
        !          8634: ;
        !          8635: : (free-td-list) ( head  -- )
        !          8636: dup find-td-list-tail-and-size num-free-tds + TO num-free-tds ( head tail )
        !          8637: td-freelist-tail 0=  IF                                         ( head tail )
        !          8638: dup TO td-freelist-tail                                         ( head tail )
        !          8639: THEN                                                            ( head tail )
        !          8640: td>ntd td-freelist-head swap l!-le                              ( head )
        !          8641: TO td-freelist-head
        !          8642: ;
        !          8643: : zero-out-an-ed-except-link ( ed -- )
        !          8644: dup 0 swap ed>eattr  l!-le             ( ed )
        !          8645: dup 0 swap ed>tdqtp  l!-le             ( ed )
        !          8646: dup 0 swap ed>tdqhp  l!-le             ( ed )
        !          8647: drop
        !          8648: ;
        !          8649: : initialize-ed-free-list ( -- )
        !          8650: MAX-EDS 0= IF EXIT THEN
        !          8651: ed-list-region @ 0= IF
        !          8652: s" init-ed-list: ed-list-region is not allocated!"   usb-debug-print
        !          8653: EXIT
        !          8654: THEN
        !          8655: ed-list-region @ TO temp1
        !          8656: 0 TO temp2   BEGIN
        !          8657: temp1 zero-out-an-ed-except-link
        !          8658: temp1 /edlen + dup   temp1 ed>ned   l!-le TO temp1
        !          8659: temp2 1+ TO temp2
        !          8660: temp2 MAX-EDS =
        !          8661: UNTIL
        !          8662: temp1 /edlen - ed>ned 0 swap l!-le
        !          8663: ed-list-region @ TO ed-freelist-head
        !          8664: MAX-EDS TO num-free-eds
        !          8665: ;
        !          8666: : allocate-ed  ( -- ed-ptr )
        !          8667: num-free-eds 0= IF 0 EXIT THEN
        !          8668: ed-freelist-head                                       ( ed-freelist-head )
        !          8669: ed-freelist-head ed>ned l@-le TO ed-freelist-head      ( ed-freelist-head )
        !          8670: num-free-eds 1- TO num-free-eds                        ( ed-freelist-head )
        !          8671: dup ed>ned 0 swap l!-le \ Terminate the Link.  ( ed-freelist-head )
        !          8672: ;
        !          8673: : free-ed ( ed-ptr  -- )
        !          8674: dup zero-out-an-ed-except-link                 ( ed-ptr )
        !          8675: dup ed>ned ed-freelist-head swap l!-le                 ( ed-ptr )
        !          8676: TO ed-freelist-head
        !          8677: num-free-eds 1+ TO num-free-eds
        !          8678: ;
        !          8679: 100 alloc-mem VALUE hchcca
        !          8680: hchcca ff and IF
        !          8681: s" Warning: hchcca not aligned!" usb-debug-print
        !          8682: THEN
        !          8683: 84 hchcca + CONSTANT hchccadneq
        !          8684: : (allocate-mem)  ( -- )
        !          8685: /tdlen MAX-TDS * 10 + alloc-mem dup td-list-region !  ( td-list-region-ptr )
        !          8686: f and IF
        !          8687: s" Warning: td-list-region not aligned!" usb-debug-print
        !          8688: THEN
        !          8689: initialize-td-free-list
        !          8690: /edlen MAX-EDS * 10 + alloc-mem dup ed-list-region !  ( ed-list-region-ptr )
        !          8691: f and IF
        !          8692: s" Warning: ed-list-region not aligned!" usb-debug-print
        !          8693: THEN
        !          8694: initialize-ed-free-list
        !          8695: DEVICE-DESCRIPTOR-LEN chars alloc-mem dd-buffer !
        !          8696: BULK-CONFIG-DESCRIPTOR-LEN chars alloc-mem cd-buffer !
        !          8697: ;
        !          8698: : (de-allocate-mem)  ( -- )
        !          8699: td-list-region @ ?dup IF
        !          8700: /tdlen MAX-TDS * 10 + free-mem
        !          8701: 0 td-list-region !
        !          8702: THEN
        !          8703: ed-list-region @ ?dup IF
        !          8704: /edlen MAX-EDS * 10 + free-mem
        !          8705: 0 ed-list-region !
        !          8706: THEN
        !          8707: dd-buffer @ ?dup IF
        !          8708: DEVICE-DESCRIPTOR-LEN free-mem
        !          8709: 0 dd-buffer !
        !          8710: THEN
        !          8711: cd-buffer @ ?dup IF
        !          8712: BULK-CONFIG-DESCRIPTOR-LEN free-mem
        !          8713: 0 cd-buffer !
        !          8714: THEN
        !          8715: ;
        !          8716: : hc-suspend  ( -- )
        !          8717: 00C3 hccontrol rl!-le             \ Suspend USB host controller
        !          8718: ;
        !          8719: : open  ( -- TRUE|FALSE )
        !          8720: (allocate-mem)
        !          8721: TRUE
        !          8722: ;
        !          8723: : close  ( -- )
        !          8724: (de-allocate-mem)
        !          8725: ;
        !          8726: : HC-enable-control-list-processing ( -- )
        !          8727: hccomstat dup rl@-le 02 or swap rl!-le
        !          8728: hccontrol dup rl@-le 10 or swap rl!-le
        !          8729: ;
        !          8730: : HC-enable-bulk-list-processing ( -- )
        !          8731: hccomstat dup rl@-le 04 or swap rl!-le
        !          8732: hccontrol dup rl@-le 20 or swap rl!-le
        !          8733: ;
        !          8734: : HC-enable-interrupt-list-processing ( -- )
        !          8735: hccontrol dup rl@-le 04 or swap rl!-le
        !          8736: ;
        !          8737: : (HC-ACK-WDH) ( -- )   WDH hcintstat rl!-le ;
        !          8738: : (HC-CHECK-WDH) ( -- ) hcintstat rl@-le WDH and 0<> ;
        !          8739: : disable-control-list-processing ( -- )
        !          8740: hccontrol dup rl@-le ffffffef and swap rl!-le
        !          8741: hccomstat dup rl@-le fffffffd and swap rl!-le
        !          8742: ;
        !          8743: : disable-bulk-list-processing ( -- )
        !          8744: hccontrol dup rl@-le ffffffdf and swap rl!-le
        !          8745: hccomstat dup rl@-le fffffffb and swap rl!-le
        !          8746: ;
        !          8747: : disable-interrupt-list-processing ( -- )
        !          8748: hccontrol dup rl@-le fffffffb and swap rl!-le
        !          8749: ;
        !          8750: 0 VALUE current-toggle
        !          8751: : fill-TD-list ( start-toggle addr dlen dp MPS TD-List-Head -- )
        !          8752: TO temp1                               ( start-toggle addr dlen dp MPS )
        !          8753: TO temp2                               ( start-toggle addr dlen dp )
        !          8754: CASE                                   ( start-toggle addr dlen )
        !          8755: OHCI-DP-SETUP  OF  TD-DP-SETUP TO temp3 ENDOF ( start-toggle addr dlen )
        !          8756: OHCI-DP-IN     OF  TD-DP-IN    TO temp3 ENDOF ( start-toggle addr dlen )
        !          8757: OHCI-DP-OUT    OF  TD-DP-OUT   TO temp3 ENDOF ( start-toggle addr dlen )
        !          8758: dup            OF  -1          TO temp3       ( start-toggle addr dlen )
        !          8759: s" fill-TD-list: Invalid DP specified"   usb-debug-print
        !          8760: ENDOF
        !          8761: ENDCASE
        !          8762: temp3 -1 = IF EXIT THEN                          ( start-toggle addr dlen )
        !          8763: rot                                              ( addr dlen start-toggle )
        !          8764: TO current-toggle swap                             ( dlen addr )
        !          8765: BEGIN
        !          8766: over temp2 >=                              ( dlen addr TRUE|FALSE )
        !          8767: WHILE                                      ( dlen addr )
        !          8768: dup temp1 td>cbptr l!-le                           ( dlen addr )
        !          8769: current-toggle 18 lshift                      ( dlen addr current-toggle~ )
        !          8770: DATA0-TOGGLE                        ( dlen  addr current-toggle~ toggle )
        !          8771: CC-FRESH-TD temp3 or or or          ( dlen  addr or-result )
        !          8772: temp1 td>tattr l!-le                ( dlen addr~  )
        !          8773: dup temp2 1- + temp1 td>bfrend l!-le ( dlen addr~  )
        !          8774: temp2 +                             ( dlen next-addr )
        !          8775: swap temp2 - swap
        !          8776: temp1 td>ntd l@-le TO temp1         ( dlen next-addr )
        !          8777: current-toggle                      ( dlen next-addr current-toggle )
        !          8778: CASE
        !          8779: 0 OF 1 TO current-toggle ENDOF
        !          8780: 1 OF 0 TO current-toggle ENDOF
        !          8781: ENDCASE
        !          8782: REPEAT                                   ( dlen addr )
        !          8783: over 0<>  IF
        !          8784: dup temp1 td>cbptr l!-le              ( dlen addr )
        !          8785: current-toggle 18 lshift              ( dlen addr curent-toggle~ )
        !          8786: DATA0-TOGGLE                          ( dlen addr curent-toggle~ toggle )
        !          8787: CC-FRESH-TD temp3 or or or            ( dlen addr or-result )
        !          8788: temp1 td>tattr l!-le                  ( dlen addr )
        !          8789: + 1- temp1 td>bfrend l!-le
        !          8790: ELSE
        !          8791: 2drop
        !          8792: THEN
        !          8793: ;
        !          8794: : (td-list-status) ( PointerToTDlist -- failingTD CCode TRUE | 0 )
        !          8795: BEGIN   ( PointerToTDlist )
        !          8796: dup 0<>         ( PointerToTDlist TRUE|FALSE )
        !          8797: IF              ( PointerToTDlist )
        !          8798: dup td>tattr l@-le f0000000 and 1c rshift dup 0= TRUE swap
        !          8799: ELSE
        !          8800: drop FALSE dup ( FALSE )
        !          8801: THEN
        !          8802: WHILE
        !          8803: drop drop td>ntd l@-le
        !          8804: REPEAT
        !          8805: ;
        !          8806: : (wait-for-done-q)           ( timeout -- TD-list TRUE | FALSE )
        !          8807: BEGIN                      ( timeout )
        !          8808: dup 0<>                 ( timeout TRUE|FALSE )
        !          8809: (HC-CHECK-WDH) NOT      ( timeout TRUE|FALSE TRUE|FALSE )
        !          8810: AND                     \ not timed out AND WDH-bit not set
        !          8811: WHILE
        !          8812: 1 ms                    \ wait
        !          8813: 1-                      ( timeout )
        !          8814: dup ff and 0= IF show-proceed THEN
        !          8815: REPEAT                   ( timeout )
        !          8816: drop
        !          8817: hchccadneq  l@-le          \ read last HcDoneHead (RAM)
        !          8818: (HC-CHECK-WDH)             \ HcDoneHead was updated ?
        !          8819: IF
        !          8820: (HC-ACK-WDH)            \ clear register bit: WDH
        !          8821: TRUE                    ( td-list TRUE )
        !          8822: ELSE
        !          8823: FALSE
        !          8824: THEN
        !          8825: ;
        !          8826: : debug-td ( -- )
        !          8827: s" Num Free TDs = " num-free-tds usb-debug-print-val
        !          8828: ;
        !          8829: : HC-reset ( -- )
        !          8830: hccomstat dup rl@-le 01 or swap rl!-le    \ issue HC reset
        !          8831: BEGIN
        !          8832: hccomstat rl@-le 01 and 0<>            \ wait for reset end
        !          8833: WHILE
        !          8834: REPEAT
        !          8835: 23f02edf hcintrval rl!-le                 \ frame-interval register
        !          8836: hchcca   hchccareg rl!-le                 \ HC communication area
        !          8837: 0000     hcctrhead rl!-le                 \ control transfer head
        !          8838: 0000     hcbulkhead rl!-le                \ bulk transfer head
        !          8839: 0ffff    hcintdsbl rl!-le                 \ interrupt disable reg.
        !          8840: 83       hccontrol rl!-le                 \ set USBOPERATIONAL
        !          8841: 23f02edf hcintrval rl!-le                 \ frame-interval register
        !          8842: hchcca   hchccareg rl!-le                 \ HC communication area
        !          8843: d# 50 ms
        !          8844: hcrhdescA rl@-le ff and     ( total-rh-ports )
        !          8845: to max-rh-ports
        !          8846: hcrhpstat TO current-stat              \ start with first port status reg
        !          8847: 0                                      \ port status default
        !          8848: max-rh-ports 0                         \ checking all ports
        !          8849: DO
        !          8850: current-stat rl@-le or              \ OR-ing all stats
        !          8851: 200 current-stat rl!-le             \ Clear Port Power (CPP)
        !          8852: current-stat 4 + TO current-stat    \ check next RH-Port
        !          8853: LOOP
        !          8854: 100 and 0<>                            \ any of the ports had power ?
        !          8855: IF
        !          8856: d# 750 wait-proceed                 \ wait for power discharge
        !          8857: THEN
        !          8858: hcrhpstat TO current-stat              \ start with first port status reg
        !          8859: max-rh-ports 0
        !          8860: DO
        !          8861: 102 current-stat rl!-le             \ power on and enable
        !          8862: hcrhdescA 3 + rb@ 2 * ms            \ startup delay 30 ms (2 * POTPGT)
        !          8863: current-stat 4 + TO current-stat    \ check next RH-Port
        !          8864: LOOP
        !          8865: d# 500 wait-proceed                    \ STEC device needs 300 ms
        !          8866: ;
        !          8867: : error-recovery ( -- )
        !          8868: initialize-td-free-list
        !          8869: initialize-ed-free-list
        !          8870: HC-reset
        !          8871: ;
        !          8872: : store-initial-usb-hub-address ( -- )
        !          8873: usb-address TO initial-hub-address
        !          8874: ;
        !          8875: : reset-to-initial-usb-hub-address ( -- )
        !          8876: initial-hub-address TO usb-address
        !          8877: ;
        !          8878: : allocate-usb-address ( -- usb-address )
        !          8879: usb-address    7f <>           ( TRUE|FALSE )
        !          8880: IF
        !          8881: usb-address 1+ TO usb-address \ RISK: Check to see IF it overflows 127
        !          8882: usb-address            ( usb-address )
        !          8883: THEN                           ( usb-address )
        !          8884: ;
        !          8885: s" usb-support.fs" INCLUDED
        !          8886: : control-std-set-address        ( speedbit -- usb-address TRUE | FALSE )
        !          8887: >r                                                 ( R: speedbit )
        !          8888: 0005000000000000 setup-packet !
        !          8889: allocate-usb-address dup setup-packet 2 + c!       ( usb-addr  R: speedbit )
        !          8890: s" USB set-address: " 2 pick usb-debug-print-val   ( usb-addr  R: speedbit )
        !          8891: 0 0 0 setup-packet 8 r> controlxfer                ( usb-addr TRUE | FALSE )
        !          8892: IF                                                   ( TRUE | FALSE )
        !          8893: TRUE                                         ( TRUE )
        !          8894: ELSE
        !          8895: drop FALSE \ PENDING: Return the allocated address back. ( FALSE )
        !          8896: THEN                                                 ( TRUE | FALSE )
        !          8897: ;
        !          8898: : control-std-get-device-descriptor
        !          8899: 8006000100000000 setup-packet !
        !          8900: 2 pick setup-packet 6 + w!-le
        !          8901: setup-packet -rot ( data-buffer data-len setup-packet MPS fa )
        !          8902: >r >r >r >r >r 0 r> r> r> r> r>
        !          8903: controlxfer         ( TRUE | FALSE )
        !          8904: ;
        !          8905: : control-std-get-configuration-descriptor
        !          8906: TO temp1 ( data-buffer data-len MPS )
        !          8907: TO temp2 ( data-buffer data-len )
        !          8908: TO temp3 ( data-buffer )
        !          8909: 8006000200000000 setup-packet !
        !          8910: temp3 setup-packet 6 + w!-le
        !          8911: 0 swap temp3 setup-packet temp2 temp1 controlxfer
        !          8912: ;
        !          8913: : control-std-get-maxlun ( MPS fun-addr dir data-buff data-len -- TRUE | FALSE )
        !          8914: GET-MAX-LUN setup-packet !  ( MPS fun-addr dir data-buff data-len )
        !          8915: setup-packet 5 pick 5 pick
        !          8916: controlxfer ( MPS fun-addr  TRUE | FALSE )
        !          8917: nip nip    ( TRUE | FALSE )
        !          8918: ;
        !          8919: : control-bulk-reset ( MPS fun-addr dir data-buff data-len -- TRUE | FALSE )
        !          8920: 21FF000000000000 setup-packet !  ( MPS fun-addr dir data-buff data-len )
        !          8921: setup-packet 5 pick 5 pick
        !          8922: controlxfer ( MPS fun-addr  TRUE | FALSE )
        !          8923: nip nip    ( TRUE | FALSE )
        !          8924: ;
        !          8925: : control-std-get-string-descriptor
        !          8926: TO temp1  ( StringIndex data-buffer data-len MPS )
        !          8927: TO temp2  ( StringIndex data-buffer data-len )
        !          8928: TO temp3  ( StringIndex )
        !          8929: 8006000300000000 setup-packet !
        !          8930: temp3 setup-packet 6 + w!-le
        !          8931: 409 setup-packet 4 + w!-le \ US English Language code.
        !          8932: swap      ( data buffer StringIndex )
        !          8933: setup-packet 2 + c! ( data-buffer )
        !          8934: 0 swap temp3 setup-packet temp2 temp1 controlxfer ( TRUE | FALSE )
        !          8935: ;
        !          8936: : control-std-set-configuration ( configvalue FuncAddr -- TRUE|FALSE )
        !          8937: TO temp1                     ( configvalue )
        !          8938: TO temp2
        !          8939: 0009000000000000 setup-packet ! \ RISK: Endian and 64-bit assumptions
        !          8940: temp2 setup-packet 2 + w!-le
        !          8941: 0 0 0 setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer
        !          8942: ;
        !          8943: 0 VALUE port-number
        !          8944: s" usb-enumerate.fs" INCLUDED
        !          8945: : rhport-enumerate ( port-num -- )
        !          8946: TO port-number
        !          8947: device-speed control-std-set-address        ( usb-addr TRUE | FALSE )
        !          8948: IF
        !          8949: device-speed or                          ( usb-addr+speedbit )
        !          8950: TO new-device-address
        !          8951: dd-buffer @ 8 erase
        !          8952: dd-buffer @ DEFAULT-CONTROL-MPS DEFAULT-CONTROL-MPS      ( buffer mps mps )
        !          8953: new-device-address control-std-get-device-descriptor   ( TRUE | FALSE )
        !          8954: IF
        !          8955: ELSE
        !          8956: s" USB: Read Dev Descriptor failed"   usb-debug-print EXIT
        !          8957: THEN
        !          8958: dd-buffer @ DEVICE-DESCRIPTOR-TYPE-OFFSET + c@  ( Descriptor-type )
        !          8959: DEVICE-DESCRIPTOR-TYPE <> IF
        !          8960: s" USB: Error Reading Device Descriptor"   usb-debug-print
        !          8961: s" Read descriptor is not OF the right type"  usb-debug-print
        !          8962: s" Aborting enumeration"  usb-debug-print
        !          8963: EXIT
        !          8964: THEN
        !          8965: dd-buffer @ DEVICE-DESCRIPTOR-MPS-OFFSET + c@ TO mps
        !          8966: create-usb-device-tree
        !          8967: ELSE
        !          8968: s" Set address failed on port " port-number usb-debug-print-val
        !          8969: s" Aborting Enumeration."   usb-debug-print
        !          8970: EXIT
        !          8971: THEN
        !          8972: ;
        !          8973: : rhport-initialize ( -- )
        !          8974: hcrhpstat TO current-stat              \ start with first port status reg
        !          8975: max-rh-ports 1+ 1
        !          8976: DO
        !          8977: current-stat rl@-le RHP-CCS and 0<>    ( TRUE|FALSE )
        !          8978: IF
        !          8979: current-stat hcrhpstat3 =        \ third port of NEC ?
        !          8980: IF
        !          8981: 81 to uDOC-present            \ uDOC is present and now processed
        !          8982: THEN
        !          8983: s" Device connected to this port!" usb-debug-print
        !          8984: RHP-PRS current-stat rl!-le      \ issue a port reset
        !          8985: BEGIN
        !          8986: current-stat rl@-le RHP-PRS AND    \ wait for reset end
        !          8987: WHILE
        !          8988: REPEAT
        !          8989: hcrhdescA 3 + rb@ 2 * ms         \ startup delay 30 ms (POTPGT)
        !          8990: d# 100 ms
        !          8991: current-stat rl@-le 200 and 4 lshift
        !          8992: to device-speed                  \ store speed bit
        !          8993: RHP-CSC RHP-PRSC or current-stat rl!-le
        !          8994: I ['] rhport-enumerate CATCH IF  \ Scan port
        !          8995: s" USB scan failed on root hub port: " rot usb-debug-print-val
        !          8996: reset-to-initial-usb-hub-address
        !          8997: THEN
        !          8998: ELSE
        !          8999: s" No device detected at this port." usb-debug-print
        !          9000: current-stat hcrhpstat3 =        \ third port of NEC ? (=ModFD)
        !          9001: IF                               \ here a ModFD should be on ELBA
        !          9002: current-stat rl@-le 80000 and 0<>      \ is over-current detected ?
        !          9003: IF
        !          9004: uDOC-present 08 or to uDOC-present  \ set flag for uDOC-check
        !          9005: THEN
        !          9006: THEN
        !          9007: THEN
        !          9008: current-stat 4 + TO current-stat    \ check next RH-Port
        !          9009: uDOC-present 0f and to uDOC-present \ remove processing flag
        !          9010: LOOP
        !          9011: ;
        !          9012: : enumerate ( -- )
        !          9013: HC-reset
        !          9014: ['] hc-suspend add-quiesce-xt     \ Assert that HC will be supsended
        !          9015: store-initial-usb-hub-address
        !          9016: rhport-initialize                 \ Probe all available RH ports
        !          9017: reset-to-initial-usb-hub-address
        !          9018: ;
        !          9019: set-ohci-alias
        !          9020: ��������;�;�0usb-support.fs0 value NEXT-TD
        !          9021: 0 VALUE num-tds
        !          9022: 0 VALUE td-retire-count
        !          9023: 0 VALUE saved-tail
        !          9024: 0 VALUE poll-timer
        !          9025: VARIABLE controlxfer-cmd
        !          9026: : (ed-prepare) ( dir addr dlen setup-packet MPS ep-fun --
        !          9027: FALSE | dir addr dlen ed-ptr setup-ptr )
        !          9028: allocate-ed dup 0=  IF ( dir addr dlen setup-packet MPS ep-fun ed-ptr )
        !          9029: drop 3drop 2drop FALSE EXIT  ( FALSE )
        !          9030: THEN
        !          9031: TO temp1               ( dir addr dlen setup-packet MPS ep-fun )
        !          9032: temp1 zero-out-an-ed-except-link ( dir addr dlen setup-packet MPS ep-fun )
        !          9033: temp1 ed>eattr l@-le or temp1 ed>eattr l!-le ( dir addr dlen setup-ptr MPS )
        !          9034: dup TO temp2 10 lshift temp1 ed>eattr l@-le or temp1 ed>eattr l!-le
        !          9035: temp1 swap TRUE            ( dir addr dlen ed-ptr setup-ptr TRUE )
        !          9036: ;
        !          9037: : (td-prepare) ( dir addr dlen ed-ptr setup-ptr --
        !          9038: dir FALSE | dir addr dlen ed-ptr setup-ptr td-head td-tail )
        !          9039: 2 pick         ( dir addr dlen ed-ptr setup-ptr dlen )
        !          9040: temp2          ( dir addr dlen ed-ptr setup-ptr dlen MPS )
        !          9041: /mod           ( dir addr dlen ed-ptr setup-ptr rem quo )
        !          9042: swap 0<>   IF  ( dir addr dlen ed-ptr setup-ptr quo )
        !          9043: 1+
        !          9044: THEN
        !          9045: 2+
        !          9046: dup TO num-tds                ( dir addr dlen ed-ptr setup-ptr quo+2 )
        !          9047: allocate-td-list dup 0=  IF   ( dir addr dlen ed-ptr setup-ptr quo+2 )
        !          9048: 2drop                      ( dir addr dlen ed-ptr setup-ptr )
        !          9049: drop                       ( dir addr dlen ed-ptr )
        !          9050: free-ed                    ( dir addr dlen )
        !          9051: 2drop                      ( dir )
        !          9052: FALSE                      ( dir FALSE )
        !          9053: EXIT
        !          9054: THEN TRUE
        !          9055: ;
        !          9056: : (td-ready)  ( dir addr dlen ed-ptr setup-ptr td-head td-tail -- )
        !          9057: 3 pick     ( dir addr dlen ed-ptr setup-ptr td-head td-tail ed-ptr )
        !          9058: tuck       ( dir addr dlen ed-ptr setup-ptr td-head ed-ptr td-tail ed-ptr )
        !          9059: ed>tdqtp l!-le            ( dir addr dlen ed-ptr setup-ptr td-head ed-ptr )
        !          9060: ed>tdqhp l!-le            ( dir addr dlen ed-ptr setup-ptr )
        !          9061: over ed>ned 0 swap l!-le  ( dir addr dlen ed-ptr setup-ptr )
        !          9062: ;
        !          9063: : (td-setup-status) ( dir addr dlen ed-ptr setup-ptr -- dir addr dlen ed-ptr )
        !          9064: over ed>tdqhp l@-le             ( dir addr dlen ed-ptr setup-ptr td-head )
        !          9065: dup zero-out-a-td-except-link   ( dir addr dlen ed-ptr setup-ptr td-head )
        !          9066: dup td>tattr DATA0-TOGGLE CC-FRESH-TD or swap l!-le
        !          9067: 2dup td>cbptr l!-le             ( dir addr dlen ed-ptr setup-ptr td-head )
        !          9068: 2dup td>bfrend swap STD-REQUEST-SETUP-SIZE 1- + swap l!-le
        !          9069: 2drop                           ( dir addr dlen ed-ptr )
        !          9070: ;
        !          9071: : (td-tailpointer) ( dir addr dlen ed-ptr -- dir addr dlen ed-ptr )
        !          9072: dup ed>tdqtp l@-le              ( dir addr dlen ed-ptr td-tail )
        !          9073: dup zero-out-a-td-except-link   ( dir addr dlen ed-ptr td-tail )
        !          9074: dup td>tattr dup l@-le DATA1-TOGGLE CC-FRESH-TD or or swap l!-le
        !          9075: 4 pick 0=                       ( dir addr dlen ed-ptr td-tail flag )
        !          9076: 3 pick 0<>                      ( dir addr dlen ed-ptr td-tail flag flag )
        !          9077: and   IF                        ( dir addr dlen ed-ptr td-tail )
        !          9078: dup td>tattr dup l@-le TD-DP-OUT or swap l!-le
        !          9079: ELSE
        !          9080: dup td>tattr dup l@-le TD-DP-IN or swap l!-le
        !          9081: THEN
        !          9082: drop                           ( dir addr dlen ed-ptr )
        !          9083: ;
        !          9084: : (td-data) ( dir addr dlen ed-ptr --  ed-ptr )
        !          9085: -rot             ( dir ed-ptr addr dlen )
        !          9086: dup 0<>  IF      ( dir ed-ptr addr dlen )
        !          9087: >r >r >r TO temp1 r> r> r> temp1 ( ed-ptr addr dlen dir )
        !          9088: 3 pick                             ( ed-ptr addr dlen dir ed-ptr )
        !          9089: ed>tdqhp l@-le td>ntd l@-le   ( ed-ptr addr dlen dir td-datahead )
        !          9090: 4 pick                            ( ed-ptr addr dlen dir td-datahead ed-ptr )
        !          9091: td>tattr l@-le 10 rshift ( ed-ptr addr dlen dir td-head-data MPS )
        !          9092: swap                       ( ed-ptr addr dlen dir MPS td-head-data )
        !          9093: >r >r >r >r >r 1 r> r> r> r> r>
        !          9094: >r >r 0=  IF                 ( ed-ptr 1 addr dlen dir )
        !          9095: OHCI-DP-IN                ( ed-ptr 1 addr dlen dir  OHCI-DP-IN )
        !          9096: ELSE
        !          9097: OHCI-DP-OUT               ( ed-ptr 1 addr dlen dir  OHCI-DP-OUT )
        !          9098: THEN
        !          9099: r> r>               ( ed-ptr 1 addr dlen dir  OHCI-DP- MPS td-head-data )
        !          9100: fill-TD-list
        !          9101: ELSE
        !          9102: 2drop nip           ( ed-ptr )
        !          9103: THEN
        !          9104: ;
        !          9105: 10 CONSTANT max-retire-td
        !          9106: : (transfer-wait-for-doneq)  ( ed-ptr -- TRUE | FALSE )
        !          9107: dup                               ( ed-ptr ed-ptr )
        !          9108: hcctrhead rl!-le                  ( ed-ptr )
        !          9109: HC-enable-control-list-processing ( ed-ptr )
        !          9110: 0 TO td-retire-count              ( ed-ptr )
        !          9111: 0 TO poll-timer                   ( ed-ptr )
        !          9112: BEGIN
        !          9113: td-retire-count num-tds <>     ( ed-ptr TRUE | FALSE )
        !          9114: poll-timer max-retire-td < and       ( ed-ptr TRUE | FALSE )
        !          9115: WHILE
        !          9116: (HC-CHECK-WDH)                                      ( ed-ptr )
        !          9117: IF
        !          9118: hchccadneq l@-le find-td-list-tail-and-size nip ( ed-ptr n )
        !          9119: td-retire-count + TO td-retire-count             ( ed-ptr )
        !          9120: hchccadneq l@-le dup              ( ed-ptr done-td done-td )
        !          9121: (td-list-status)                  ( ed-ptr done-td failed-td CCcode )
        !          9122: IF
        !          9123: dup >r
        !          9124: s" (transfer-wait-for-doneq: USB device communication error."
        !          9125: usb-debug-print                 ( ed-ptr done-td failed-td CCcode R: CCcode )
        !          9126: dup 4 = swap dup 5 = rot or     ( ed-ptr done-td failed-td CCcode R: CCcode )
        !          9127: IF
        !          9128: max-retire-td TO poll-timer ( ed-ptr done-td failed-td CCcode R: CCcode )
        !          9129: THEN
        !          9130: usb-debug-flag
        !          9131: IF
        !          9132: s" CC code ->" type . cr
        !          9133: s" Failing TD contents:" type cr display-td
        !          9134: ELSE
        !          9135: 2drop
        !          9136: THEN                           ( ed-ptr done-td R: CCcode )
        !          9137: controlxfer-cmd @ GET-MAX-LUN = r> 4 = and
        !          9138: IF
        !          9139: s" (transfer-wait-for-doneq): GET-MAX-LUN ControlXfer STALLed"
        !          9140: usb-debug-print
        !          9141: ELSE
        !          9142: drop
        !          9143: 5030 error" (USB) Device communication error."
        !          9144: ABORT
        !          9145: THEN
        !          9146: THEN                              ( ed-ptr done-td )
        !          9147: (free-td-list)                    ( ed-ptr )
        !          9148: 0 hchccadneq l!-le                ( ed-ptr )
        !          9149: (HC-ACK-WDH) \ TDs were written to DOne queue. ACK the HC.
        !          9150: THEN
        !          9151: poll-timer 1+ TO poll-timer
        !          9152: 4 ms              \ longer  1 ms
        !          9153: REPEAT                                  ( ed-ptr )
        !          9154: disable-control-list-processing         ( ed-ptr )
        !          9155: td-retire-count num-tds <>              ( ed-ptr )
        !          9156: IF
        !          9157: dup display-descriptors              ( ed-ptr )
        !          9158: s" maximum of retire " usb-debug-print                                              
        !          9159: THEN
        !          9160: free-ed
        !          9161: td-retire-count num-tds <>
        !          9162: IF
        !          9163: FALSE                                ( FALSE )
        !          9164: ELSE
        !          9165: TRUE                                 ( TRUE )
        !          9166: THEN
        !          9167: ;
        !          9168: : controlxfer ( dir addr dlen setup-packet MPS ep-fun -- TRUE | FALSE )
        !          9169: 2 pick @ controlxfer-cmd !
        !          9170: (ed-prepare)       ( FALSE | dir addr dlen ed-ptr setup-ptr  )
        !          9171: invert IF FALSE EXIT THEN
        !          9172: (td-prepare)       ( pt ed-type toggle buffer length mps head )
        !          9173: invert IF FALSE EXIT THEN
        !          9174: (td-ready)         ( dir addr dlen ed-ptr setup-ptr )
        !          9175: (td-setup-status)  ( dir addr dlen ed-ptr )
        !          9176: (td-tailpointer)   ( dir addr dlen ed-ptr )
        !          9177: (td-data)          ( ed-ptr )
        !          9178: dup ed>tdqtp l@-le TO saved-tail    ( ed-ptr )
        !          9179: dup ed>tdqtp 0 swap l!-le           ( ed-ptr )
        !          9180: (transfer-wait-for-doneq)           ( TRUE | FALSE )
        !          9181: ;
        !          9182: 0201000000000000 CONSTANT CLEARHALTFEATURE
        !          9183: 0 VALUE endpt-num
        !          9184: 0 VALUE usb-addr-contr-req
        !          9185: : control-std-clear-feature ( endpoint-nr usb-addr -- TRUE|FALSE )
        !          9186: TO usb-addr-contr-req                        \ usb address
        !          9187: TO endpt-num                                 \ endpoint number
        !          9188: CLEARHALTFEATURE setup-packet !
        !          9189: endpt-num setup-packet 4 + c!                \ endpoint number
        !          9190: 0 0 0 setup-packet DEFAULT-CONTROL-MPS usb-addr-contr-req controlxfer
        !          9191: ;  
        !          9192: 21FF000000000000 CONSTANT BULK-RESET
        !          9193: : control-std-bulk-reset ( usb-addr -- TRUE|FALSE )
        !          9194: TO usb-addr-contr-req
        !          9195: BULK-RESET setup-packet !
        !          9196: 0 0 0 setup-packet DEFAULT-CONTROL-MPS usb-addr-contr-req controlxfer
        !          9197: ;
        !          9198: : bulk-reset-recovery-procedure ( bulk-out-endp bulk-in-endp usb-addr -- )
        !          9199: >r                                          ( bulk-out-endp bulk-in-endp R: usb-addr )
        !          9200: r@ control-std-bulk-reset
        !          9201: IF s" bulk reset OK" 
        !          9202: ELSE s" bulk reset failed" 
        !          9203: THEN usb-debug-print
        !          9204: 80 or r@ control-std-clear-feature
        !          9205: IF s" control-std-clear IN endpoint OK" 
        !          9206: ELSE s" control-std-clear-IN endpoint failed" 
        !          9207: THEN usb-debug-print
        !          9208: r@ control-std-clear-feature
        !          9209: IF s" control-std-clear OUT endpoint OK" 
        !          9210: ELSE s" control-std-clear-OUT endpoint failed" 
        !          9211: THEN usb-debug-print
        !          9212: r> drop
        !          9213: ;
        !          9214: 0 VALUE saved-rw-ed
        !          9215: 0 VALUE num-rw-tds
        !          9216: 0 VALUE num-rw-retired-tds
        !          9217: 0 VALUE saved-rw-start-toggle
        !          9218: 0 VALUE saved-list-type
        !          9219: : (ed-prepare-rw)
        !          9220: ( pt ed-type toggle buffer length mps address ed-ptr --
        !          9221: FALSE | pt ed-type toggle buffer length mps )
        !          9222: allocate-ed dup 0=  IF
        !          9223: drop 2drop 2drop 2drop drop
        !          9224: saved-rw-start-toggle FALSE EXIT  ( toggle FALSE )
        !          9225: THEN
        !          9226: TO saved-rw-ed             ( pt ed-type toggle buffer length mps address )
        !          9227: saved-rw-ed zero-out-an-ed-except-link
        !          9228: saved-rw-ed ed>eattr l!-le   ( pt ed-type toggle buffer length mps )
        !          9229: dup 10 lshift saved-rw-ed ed>eattr l@-le or
        !          9230: saved-rw-ed ed>eattr l!-le TRUE  ( pt ed-type toggle buffer length mps TRUE )
        !          9231: ;
        !          9232: : (td-prepare-rw)
        !          9233: ( pt ed-type toggle buffer length mps --
        !          9234: FALSE | pt ed-type toggle buffer length mps head )
        !          9235: 2dup              ( pt ed-type toggle buffer length mps  length mps )
        !          9236: /mod              ( pt ed-type toggle buffer length mps num-tds rem )
        !          9237: swap 0<> IF       ( pt ed-type toggle buffer length mps num-tds )
        !          9238: 1+             ( pt ed-type toggle buffer length mps num-tds+1 )
        !          9239: THEN
        !          9240: dup TO num-rw-tds ( pt ed-type toggle buffer length mps num-tds )
        !          9241: allocate-td-list  ( pt ed-type toggle buffer length mps head tail )
        !          9242: dup 0=  IF
        !          9243: 2drop 2drop 2drop 2drop
        !          9244: saved-rw-ed free-ed
        !          9245: ." rw-endpoint: TD list allocation failed" cr
        !          9246: saved-rw-start-toggle FALSE   ( FALSE )
        !          9247: EXIT
        !          9248: THEN
        !          9249: drop  TRUE         ( pt ed-type toggle buffer length mps head TRUE )
        !          9250: ;
        !          9251: : (td-data-rw)
        !          9252: 6 pick                    ( pt ed-type toggle buffer length mps head  pt )
        !          9253: FALSE TO case-failed  CASE
        !          9254: 0   OF OHCI-DP-IN    ENDOF
        !          9255: 1   OF OHCI-DP-OUT   ENDOF
        !          9256: 2   OF OHCI-DP-SETUP ENDOF
        !          9257: dup OF TRUE TO case-failed
        !          9258: ." rw-endpoint: Invalid Packet Type!" cr
        !          9259: ENDOF
        !          9260: ENDCASE                   ( pt ed-type toggle buffer length mps head dp )
        !          9261: case-failed  IF
        !          9262: saved-rw-ed free-ed    ( pt ed-type toggle buffer length mps head dp )
        !          9263: drop (free-td-list)         ( pt ed-type toggle buffer length mps head )
        !          9264: 2drop 2drop 2drop
        !          9265: saved-rw-start-toggle FALSE ( FALSE )
        !          9266: EXIT                        ( FALSE )
        !          9267: THEN
        !          9268: -rot                      ( pt ed-type toggle buffer length dp mps head )
        !          9269: dup >r                      ( pt ed-type toggle buffer length dp mps head )
        !          9270: fill-TD-list r>  TRUE      ( pt et head TRUE )
        !          9271: ;
        !          9272: : (ed-ready-rw)  ( pt et  -- - | toggle FALSE )
        !          9273: nip           ( et )
        !          9274: FALSE TO case-failed  CASE
        !          9275: 0   OF \ Control List. Queue the ED to control list
        !          9276: 0 TO saved-list-type
        !          9277: saved-rw-ed hcctrhead rl!-le
        !          9278: HC-enable-control-list-processing
        !          9279: ENDOF
        !          9280: 1   OF \ Bulk List. Queue the ED to bulk list
        !          9281: 1 TO saved-list-type
        !          9282: saved-rw-ed hcbulkhead rl!-le
        !          9283: HC-enable-bulk-list-processing
        !          9284: ENDOF
        !          9285: 2   OF \ Interrupt List.
        !          9286: 2 TO saved-list-type
        !          9287: saved-rw-ed hchccareg rl@-le rl!-le
        !          9288: HC-enable-interrupt-list-processing
        !          9289: ENDOF
        !          9290: dup OF
        !          9291: saved-rw-ed ed>tdqhp l@-le (free-td-list)
        !          9292: saved-rw-ed free-ed
        !          9293: TRUE TO case-failed
        !          9294: ENDOF
        !          9295: ENDCASE
        !          9296: case-failed  IF
        !          9297: saved-rw-start-toggle FALSE ( toggle FALSE )
        !          9298: EXIT
        !          9299: THEN
        !          9300: TRUE                           ( TRUE )
        !          9301: ;
        !          9302: : (wait-td-retire) ( -- )
        !          9303: 0 TO num-rw-retired-tds
        !          9304: FALSE TO while-failed
        !          9305: BEGIN
        !          9306: num-rw-retired-tds num-rw-tds <           ( TRUE | FALSE )
        !          9307: while-failed FALSE =  and                 ( TRUE | FALSE )
        !          9308: WHILE
        !          9309: d# 5000 (wait-for-done-q)                  ( TD-list TRUE|FALSE )
        !          9310: IF
        !          9311: dup find-td-list-tail-and-size nip         ( td-list size )
        !          9312: num-rw-retired-tds + TO num-rw-retired-tds ( td-list )
        !          9313: dup (td-list-status)                   ( td-list failed-TD CC )
        !          9314: IF
        !          9315: dup 4 =
        !          9316: IF
        !          9317: saved-list-type
        !          9318: CASE
        !          9319: 0 OF
        !          9320: 0 0 control-std-clear-feature
        !          9321: s" clear feature " usb-debug-print
        !          9322: ENDOF
        !          9323: 1 OF                             \ clean bulk stalled
        !          9324: s" clear bulk when stalled " usb-debug-print
        !          9325: disable-bulk-list-processing   \ disable procesing
        !          9326: saved-rw-ed ed>eattr l@-le dup \ extract
        !          9327: 780 and 7 rshift 80 or         \ endpoint and
        !          9328: swap 7f and                    \ usb addr
        !          9329: control-std-clear-feature
        !          9330: ENDOF
        !          9331: 2 OF
        !          9332: 0 saved-rw-ed ed>eattr l@-le
        !          9333: control-std-clear-feature
        !          9334: ENDOF
        !          9335: dup OF
        !          9336: s" unknown status " usb-debug-print
        !          9337: ENDOF
        !          9338: ENDCASE
        !          9339: ELSE                             ( td-list failed-TD CC )
        !          9340: ."  TD failed  " 5b emit .s 5d emit cr
        !          9341: 5040 error" (USB) device transaction error (wait-td-retire)."
        !          9342: ABORT
        !          9343: THEN
        !          9344: 2drop drop
        !          9345: TRUE TO while-failed                \ transaction failed
        !          9346: NEXT-TD 0<>                         \ clean the TD if we
        !          9347: IF
        !          9348: NEXT-TD (free-td-list)           \ had a stalled
        !          9349: THEN
        !          9350: THEN
        !          9351: (free-td-list)
        !          9352: ELSE
        !          9353: drop                                   \ drop td-list pointer
        !          9354: scan-time? IF 2e emit THEN             \ show proceeding dots
        !          9355: TRUE TO while-failed
        !          9356: s" time out wait for done" usb-debug-print
        !          9357: 20 ms     \ wait for bad device
        !          9358: THEN
        !          9359: REPEAT
        !          9360: ;
        !          9361: : (process-retired-td)   ( -- TRUE | FALSE )
        !          9362: saved-list-type  CASE
        !          9363: 0 OF disable-control-list-processing ENDOF
        !          9364: 1 OF disable-bulk-list-processing ENDOF
        !          9365: 2 OF disable-interrupt-list-processing ENDOF
        !          9366: ENDCASE
        !          9367: saved-rw-ed ed>tdqhp l@-le 2 and 0<> IF 
        !          9368: 1 
        !          9369: s" retired 1" usb-debug-print
        !          9370: ELSE
        !          9371: 0 
        !          9372: s" retired 0" usb-debug-print
        !          9373: THEN
        !          9374: WHILE-failed   IF
        !          9375: FALSE           ( FALSE )
        !          9376: ELSE
        !          9377: TRUE            ( TRUE )
        !          9378: THEN
        !          9379: saved-rw-ed free-ed
        !          9380: ;
        !          9381: : (do-rw-endpoint)
        !          9382: 4 pick              ( pt ed-type toggle buffer length mps address toggle )
        !          9383: TO saved-rw-start-toggle ( pt ed-type toggle buffer length mps address )
        !          9384: (ed-prepare-rw)     ( FALSE | pt ed-type toggle buffer length mps )
        !          9385: invert IF FALSE EXIT THEN
        !          9386: (td-prepare-rw)     ( FALSE | pt ed-type toggle buffer length mps head )
        !          9387: invert IF FALSE EXIT THEN
        !          9388: (td-data-rw)        ( FALSE | pt et head )
        !          9389: invert IF FALSE EXIT THEN
        !          9390: saved-rw-ed ed>tdqhp l!-le ( pt et )
        !          9391: saved-rw-ed ed>tdqhp l@-le td>ntd l@-le TO NEXT-TD \ save for a stalled
        !          9392: (ed-ready-rw)
        !          9393: invert IF FALSE EXIT THEN
        !          9394: (wait-td-retire)
        !          9395: (process-retired-td)         ( TRUE | FALSE )
        !          9396: ;
        !          9397: 0 VALUE transfer-len
        !          9398: 0 VALUE mps-current
        !          9399: 0 VALUE addr-current
        !          9400: 0 VALUE usb-addr
        !          9401: 0 VALUE toggle-current
        !          9402: 0 VALUE type-current
        !          9403: 0 VALUE pt-current
        !          9404: 0 VALUE read-status
        !          9405: 0 VALUE counter
        !          9406: 0 VALUE residue
        !          9407: : rw-endpoint
        !          9408: 2 pick TO transfer-len  ( pt ed-type toggle buffer length mps address )
        !          9409: 1 pick TO mps-current   ( pt ed-type toggle buffer length mps address )
        !          9410: TRUE TO read-status     ( pt ed-type toggle buffer length mps address )
        !          9411: transfer-len mps-current num-free-tds * <=  IF
        !          9412: (do-rw-endpoint)     ( toggle TRUE | toggle FALSE )
        !          9413: TO read-status       ( toggle )
        !          9414: TO toggle-current
        !          9415: ELSE
        !          9416: TO usb-addr          ( pt ed-type toggle buffer length mps )
        !          9417: 2drop                ( pt ed-type toggle buffer )
        !          9418: TO addr-current      ( pt ed-type toggle )
        !          9419: TO toggle-current    ( pt ed-type )
        !          9420: TO type-current      ( pt )
        !          9421: TO pt-current
        !          9422: transfer-len mps-current num-free-tds * /mod  ( residue count )
        !          9423: TO counter           ( residue )
        !          9424: TO residue
        !          9425: mps-current num-free-tds * TO transfer-len   BEGIN
        !          9426: counter 0 >       ( TRUE | FALSE )
        !          9427: read-status TRUE = and   ( TRUE | FALSE )
        !          9428: WHILE
        !          9429: pt-current type-current toggle-current ( pt ed-type toggle )
        !          9430: addr-current transfer-len  ( pt ed-type toggle buffer length )
        !          9431: mps-current                ( pt ed-type toggle buffer length mps )
        !          9432: usb-addr (do-rw-endpoint)  ( toggle TRUE | toggle FALSE )
        !          9433: TO read-status             ( toggle )
        !          9434: TO toggle-current
        !          9435: addr-current transfer-len + TO addr-current
        !          9436: counter 1- TO counter
        !          9437: REPEAT
        !          9438: residue 0<>                    ( TRUE |FALSE )
        !          9439: read-status TRUE = and IF
        !          9440: residue TO transfer-len
        !          9441: pt-current type-current toggle-current ( pt ed-type toggle )
        !          9442: addr-current transfer-len   ( pt ed-type toggle buffer length )
        !          9443: mps-current                 ( pt ed-type toggle buffer length mps )
        !          9444: usb-addr (do-rw-endpoint)   ( toggle TRUE | toggle FALSE )
        !          9445: TO read-status
        !          9446: TO toggle-current
        !          9447: THEN
        !          9448: THEN
        !          9449: read-status invert  IF
        !          9450: THEN
        !          9451: toggle-current                    ( toggle )
        !          9452: read-status                       ( TRUE | FALSE )
        !          9453: ;
        !          9454: ����������0usb-hub.fss" hub" device-name
        !          9455: s" usb" device-type
        !          9456: 1 encode-int s" #address-cells" property
        !          9457: 0 encode-int s" #size-cells" property
        !          9458: : encode-unit ( port-addr -- unit-str unit-len )  1 hex-encode-unit ;
        !          9459: : decode-unit ( addr len -- port-addr ) 1 hex-decode-unit ;
        !          9460: 0 VALUE new-device-address
        !          9461: 0 VALUE port-number
        !          9462: 0 VALUE MPS-DCP
        !          9463: 0 VALUE mps
        !          9464: 0 VALUE my-usb-address
        !          9465: 00 value device-speed
        !          9466: : mps-property-set ( -- )
        !          9467: s"  HUB Compiling mps-property-set " usb-debug-print
        !          9468: s" USB-ADDRESS" get-my-property ( TRUE | prop-addr prop-len FALSE )
        !          9469: IF
        !          9470: s" notpossible" usb-debug-print
        !          9471: ELSE
        !          9472: decode-int nip nip to my-usb-address
        !          9473: THEN  
        !          9474: s" MPS-DCP" get-my-property ( TRUE | prop-addr prop-len FALSE )
        !          9475: IF 
        !          9476: s" MPS-DCP property not found Assuming 8 as MAX PACKET SIZE" ( str len )  
        !          9477: usb-debug-print
        !          9478: s" for the default control pipe"  usb-debug-print
        !          9479: 8 to MPS-DCP
        !          9480: ELSE
        !          9481: s" MPS-DCP property found!!" usb-debug-print ( prop-addr prop-len FALSE )
        !          9482: decode-int nip nip to MPS-DCP
        !          9483: THEN
        !          9484: ;
        !          9485: 2303080000000000 CONSTANT hppwr-set
        !          9486: 2301080000000000 CONSTANT hppwr-clear
        !          9487: 2303040000000000 CONSTANT hprst-set
        !          9488: A300000000000400 CONSTANT hpsta-get
        !          9489: 2303010000000000 CONSTANT hpena-set
        !          9490: A006002900000000 CONSTANT hubds-get
        !          9491: 8  CONSTANT DEFAULT-CONTROL-MPS
        !          9492: 12 CONSTANT DEVICE-DESCRIPTOR-LEN
        !          9493: 9  CONSTANT CONFIG-DESCRIPTOR-LEN
        !          9494: 20 CONSTANT BULK-CONFIG-DESCRIPTOR-LEN
        !          9495: 1 CONSTANT DEVICE-DESCRIPTOR-TYPE
        !          9496: 1 CONSTANT DEVICE-DESCRIPTOR-TYPE-OFFSET
        !          9497: 4 CONSTANT DEVICE-DESCRIPTOR-DEVCLASS-OFFSET
        !          9498: 7 CONSTANT DEVICE-DESCRIPTOR-MPS-OFFSET
        !          9499: 9 CONSTANT HUB-DEVICE-CLASS
        !          9500: 0 CONSTANT NO-CLASS
        !          9501: 00 VALUE temp1
        !          9502: 00 VALUE temp2
        !          9503: 00 VALUE temp3
        !          9504: 00 VALUE po2pg            \ Power On to Power Good
        !          9505: VARIABLE setup-packet     \ 8 bytes for setup packet
        !          9506: VARIABLE ch-buffer        \ 1 byte character buffer
        !          9507: INSTANCE VARIABLE dd-buffer
        !          9508: INSTANCE VARIABLE cd-buffer
        !          9509: 8 chars alloc-mem VALUE status-buffer
        !          9510: 9 chars alloc-mem VALUE hd-buffer
        !          9511: : (allocate-mem)  ( -- )
        !          9512: DEVICE-DESCRIPTOR-LEN chars alloc-mem dd-buffer !
        !          9513: BULK-CONFIG-DESCRIPTOR-LEN chars alloc-mem cd-buffer !
        !          9514: ;
        !          9515: : (de-allocate-mem)  ( -- )
        !          9516: dd-buffer @ ?dup IF
        !          9517: DEVICE-DESCRIPTOR-LEN free-mem
        !          9518: 0 dd-buffer !
        !          9519: THEN
        !          9520: cd-buffer @ ?dup IF
        !          9521: BULK-CONFIG-DESCRIPTOR-LEN free-mem
        !          9522: 0 cd-buffer !
        !          9523: THEN
        !          9524: ;
        !          9525: : open ( -- TRUE )
        !          9526: (allocate-mem)
        !          9527: TRUE
        !          9528: ;
        !          9529: : close ( -- )
        !          9530: (de-allocate-mem)
        !          9531: ;
        !          9532: : controlxfer ( dir addr dlen setup-packet MPS ep-fun -- TRUE|FALSE )
        !          9533: s" controlxfer" $call-parent 
        !          9534: ;
        !          9535: : control-std-set-address ( speedbit -- usb-address TRUE|FALSE )
        !          9536: s" control-std-set-address" $call-parent 
        !          9537: ; 
        !          9538: : control-std-get-device-descriptor 
        !          9539: s" control-std-get-device-descriptor" $call-parent 
        !          9540: ;
        !          9541: : control-std-get-configuration-descriptor 
        !          9542: s" control-std-get-configuration-descriptor" $call-parent 
        !          9543: ;
        !          9544: : control-std-get-maxlun
        !          9545: s" control-std-get-maxlun" $call-parent 
        !          9546: ;
        !          9547: : control-std-set-configuration 
        !          9548: s" control-std-set-configuration" $call-parent 
        !          9549: ;
        !          9550: : control-std-get-string-descriptor
        !          9551: s" control-std-get-string-descriptor" $call-parent 
        !          9552: ;
        !          9553: : rw-endpoint 
        !          9554: s" rw-endpoint" $call-parent 
        !          9555: ;
        !          9556: : debug-td ( -- )
        !          9557: s" debug-td" $call-parent
        !          9558: ;
        !          9559: : control-bulk-reset ( MPS fun-addr dir data-buff data-len -- TRUE | FALSE )
        !          9560: s" control-bulk-reset" $call-parent
        !          9561: ;
        !          9562: : control-hub-port-power-set  ( port# -- TRUE|FALSE )
        !          9563: hppwr-set setup-packet !       ( port#)
        !          9564: setup-packet 4 + c!
        !          9565: 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE | FALSE )
        !          9566: ;
        !          9567: : control-hub-port-power-clear ( port#-- TRUE|FALSE )
        !          9568: hppwr-clear setup-packet !     ( port#)
        !          9569: setup-packet 4 + c!
        !          9570: 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE )
        !          9571: ;
        !          9572: : control-hub-port-reset-set ( port# -- TRUE|FALSE )
        !          9573: hprst-set setup-packet !       ( port# )
        !          9574: setup-packet 4 + c!
        !          9575: 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE )
        !          9576: ;
        !          9577: : control-hub-port-enable ( port# -- TRUE|FALSE )
        !          9578: hpena-set setup-packet !       ( port# )
        !          9579: setup-packet 4 +  c!
        !          9580: 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE )
        !          9581: ;
        !          9582: : control-hub-port-status-get ( buffer port# -- TRUE|FALSE )
        !          9583: hpsta-get setup-packet !       ( buffer port# )
        !          9584: setup-packet 4 + c!            ( buffer )
        !          9585: 0 swap 4 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE )
        !          9586: ;
        !          9587: : control-get-hub-descriptor ( buffer buffer-length -- TRUE|FALSE )
        !          9588: hubds-get setup-packet ! 
        !          9589: dup setup-packet 6 + w!-le ( buffer buffer-length )
        !          9590: 0 -rot setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE )
        !          9591: ;
        !          9592: s" usb-enumerate.fs" INCLUDED
        !          9593: : hub-configure-port ( port# -- )
        !          9594: BEGIN                          ( port# )
        !          9595: status-buffer 4 erase             ( port# )
        !          9596: status-buffer over control-hub-port-status-get drop ( port# ) 
        !          9597: status-buffer w@-le 102 and 0=         ( port# TRUE|FALSE )
        !          9598: WHILE                          ( port# )
        !          9599: REPEAT                 ( port# )
        !          9600: po2pg 3 * ms    \ wait for bPwrOn2PwrGood*3 ms
        !          9601: dup control-hub-port-reset-set drop    ( port# )
        !          9602: BEGIN                          ( port# )
        !          9603: status-buffer 4 erase             ( port# )
        !          9604: status-buffer over control-hub-port-status-get drop ( port# ) 
        !          9605: status-buffer w@-le 10 and     ( port# TRUE|FALSE )
        !          9606: WHILE                          ( port# )
        !          9607: REPEAT                         ( port# )
        !          9608: status-buffer 4 erase                ( port# )
        !          9609: status-buffer over control-hub-port-status-get drop ( port# ) 
        !          9610: status-buffer w@-le    103 and    103 <>              ( port# TRUE|FALSE )
        !          9611: s" Port status bits: " status-buffer w@-le usb-debug-print-val
        !          9612: IF                                     ( port# ) 
        !          9613: drop                   
        !          9614: s" Connect status: No device connected "  usb-debug-print
        !          9615: EXIT 
        !          9616: THEN 
        !          9617: status-buffer w@-le 200 and 4 lshift \ get speed bit
        !          9618: dup to device-speed                  \ store speed bit
        !          9619: control-std-set-address        ( port# usb-addr TRUE|FALSE )
        !          9620: 50 ms                  ( port# usb-addr TRUE|FALSE )
        !          9621: debug-td                       ( port# usb-addr TRUE|FALSE )
        !          9622: IF                             ( port# usb-addr )
        !          9623: device-speed or           ( port# usb-addr+speedbit )
        !          9624: to new-device-address     ( port# )
        !          9625: to port-number
        !          9626: dd-buffer @ DEVICE-DESCRIPTOR-LEN erase
        !          9627: dd-buffer @ DEFAULT-CONTROL-MPS DEFAULT-CONTROL-MPS new-device-address
        !          9628: control-std-get-device-descriptor     ( TRUE|FALSE )
        !          9629: IF
        !          9630: dd-buffer @ DEVICE-DESCRIPTOR-TYPE-OFFSET + c@ ( descriptor-type )
        !          9631: DEVICE-DESCRIPTOR-TYPE <>          ( TRUE|FALSE )
        !          9632: IF 
        !          9633: s" HUB: ERROR!! Invalid Device Descriptor for the new device"
        !          9634: usb-debug-print
        !          9635: ELSE
        !          9636: dd-buffer @ DEVICE-DESCRIPTOR-MPS-OFFSET + c@ to mps
        !          9637: dd-buffer @ DEVICE-DESCRIPTOR-LEN erase
        !          9638: dd-buffer @ DEVICE-DESCRIPTOR-LEN mps new-device-address
        !          9639: control-std-get-device-descriptor invert
        !          9640: IF
        !          9641: s" ** reading dev-descriptor failed ** " usb-debug-print
        !          9642: THEN
        !          9643: create-usb-device-tree
        !          9644: THEN
        !          9645: ELSE
        !          9646: s" ERROR!! Failed to get device descriptor" usb-debug-print 
        !          9647: THEN
        !          9648: ELSE                                               ( port# )
        !          9649: s" USB Set Adddress failed!!" usb-debug-print ( port# )
        !          9650: s" Clearing Port Power..."  usb-debug-print   ( port# )
        !          9651: control-hub-port-power-clear               ( TRUE|FALSE )
        !          9652: IF 
        !          9653: s" Port power down " usb-debug-print
        !          9654: ELSE
        !          9655: s" Unable to clear port power!!!" usb-debug-print
        !          9656: THEN
        !          9657: THEN
        !          9658: ;
        !          9659: : hub-enumerate ( -- )
        !          9660: cd-buffer @ CONFIG-DESCRIPTOR-LEN erase
        !          9661: cd-buffer @ CONFIG-DESCRIPTOR-LEN MPS-DCP my-usb-address 
        !          9662: control-std-get-configuration-descriptor drop 
        !          9663: cd-buffer @ 1+ c@ 2 <>  IF
        !          9664: s" Unable to read configuration descriptor" usb-debug-print
        !          9665: EXIT 
        !          9666: THEN 
        !          9667: cd-buffer @ 4 + c@ 1 <> IF
        !          9668: s" Not a valid HUB config descriptor" usb-debug-print 
        !          9669: EXIT 
        !          9670: THEN 
        !          9671: cd-buffer @ 5 + c@ to temp1 \ Store the configuration in temp1
        !          9672: temp1 my-usb-address control-std-set-configuration drop
        !          9673: my-usb-address to temp1
        !          9674: hd-buffer 9 erase
        !          9675: hd-buffer 9 control-get-hub-descriptor drop
        !          9676: hd-buffer 2 + c@ to temp2     \ number of downstream ports
        !          9677: s" HUB: Found " usb-debug-print
        !          9678: s" number of downstream hub ports! : " temp2 usb-debug-print-val
        !          9679: hd-buffer 5 + c@ to po2pg     \ get bPwrOn2PwrGood
        !          9680: temp2 1+ 1 DO
        !          9681: i control-hub-port-power-set drop
        !          9682: d# 20 ms
        !          9683: LOOP
        !          9684: d# 200 ms      \ some devices need a long time (10s)
        !          9685: temp2 1+ 1 DO
        !          9686: s" hub-configure-port: " i usb-debug-print-val
        !          9687: i hub-configure-port
        !          9688: LOOP
        !          9689: ; 
        !          9690: (allocate-mem)
        !          9691: mps-property-set
        !          9692: hub-enumerate
        !          9693: (de-allocate-mem)
        !          9694: ��������X8usb-enumerate.fs: (hub-create) ( -- )
        !          9695: mps port-number new-device-address port-number 
        !          9696: new-device set-space                ( mps port-number usb-address )
        !          9697: encode-int s" USB-ADDRESS" property ( mps port-number )
        !          9698: s" Address Set"  usb-debug-print
        !          9699: encode-int s" reg" property         ( mps )
        !          9700: s" Port Number Set"   usb-debug-print 
        !          9701: encode-int s" MPS-DCP" property
        !          9702: s" MPS Set"   usb-debug-print
        !          9703: s" usb-hub.fs" INCLUDED
        !          9704: s" Driver Included"   usb-debug-print
        !          9705: finish-device
        !          9706: ;
        !          9707: : (atapi-scsi-property-set) ( -- )
        !          9708: dd-buffer @ e + c@     ( Manuf )
        !          9709: dd-buffer @ f + c@     ( Manuf Prod )
        !          9710: dd-buffer @ 10 + c@    ( Manuf Prod Serial-Num )
        !          9711: cd-buffer @ 16 + w@-le ( Manuf Prod Serial-Num ep-mps )
        !          9712: cd-buffer @ 14 + c@    ( Manuf Prod Serial-Num ep-mps ep-addr )
        !          9713: cd-buffer @ 1d + w@-le ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps )
        !          9714: cd-buffer @ 1b + c@    ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr )
        !          9715: mps port-number new-device-address port-number
        !          9716: ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr 
        !          9717: mps port-num usb-addr port-num )
        !          9718: new-device set-space
        !          9719: ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr
        !          9720: mps port-num usb-addr )
        !          9721: encode-int s" USB-ADDRESS" property
        !          9722: ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr
        !          9723: mps port-num )
        !          9724: encode-int s" reg" property
        !          9725: ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr 
        !          9726: mps )
        !          9727: encode-int s" MPS-DCP" property
        !          9728: 2 0  DO
        !          9729: dup 80 and IF
        !          9730: 7f and encode-int
        !          9731: s" BULK-IN-EP-ADDR" property
        !          9732: encode-int s" MPS-BULKIN" property
        !          9733: ELSE
        !          9734: encode-int s" BULK-OUT-EP-ADDR" property
        !          9735: encode-int s" MPS-BULKOUT" property
        !          9736: THEN
        !          9737: LOOP                                  ( Manuf Prod Serial-Num )
        !          9738: encode-int s" iSerialNumber" property ( Manuf Prod )
        !          9739: encode-int s" iProduct" property      ( Manuf )
        !          9740: encode-int s" iManufacturer" property
        !          9741: ;
        !          9742: : (device-classify) 
        !          9743: cd-buffer @ BULK-CONFIG-DESCRIPTOR-LEN erase
        !          9744: cd-buffer @ BULK-CONFIG-DESCRIPTOR-LEN mps new-device-address 
        !          9745: control-std-get-configuration-descriptor
        !          9746: IF
        !          9747: cd-buffer @ 1+ c@           ( Descriptor-type )
        !          9748: 2 =   IF
        !          9749: cd-buffer @ 10 + c@      ( protocol )
        !          9750: cd-buffer @ f + c@       ( protocol subclass )
        !          9751: cd-buffer @ e + c@       ( protocol subclass class )
        !          9752: TRUE
        !          9753: ELSE
        !          9754: s" Not a valid configuration descriptor!!" usb-debug-print
        !          9755: FALSE
        !          9756: THEN
        !          9757: ELSE
        !          9758: s" Unable to read configuration descriptor!!" usb-debug-print
        !          9759: FALSE
        !          9760: THEN
        !          9761: ;
        !          9762: : (atapi-8020-create) ( -- )
        !          9763: (atapi-scsi-property-set)
        !          9764: s" usb-storage.fs" INCLUDED
        !          9765: finish-device
        !          9766: ;
        !          9767: : (atapi-8070-create) ( -- )
        !          9768: (atapi-scsi-property-set)
        !          9769: s" usb-storage.fs" INCLUDED
        !          9770: finish-device
        !          9771: ;
        !          9772: : (scsi-create) ( -- )
        !          9773: s" SCSI-CREATE " usb-debug-print
        !          9774: dd-buffer @ 8 + w@-le 4b4 =         \ VendorID = CYPRESS ?
        !          9775: IF
        !          9776: dd-buffer @ a + w@-le 6830 =     \ Device = CY7C68300 ?
        !          9777: IF
        !          9778: d# 20 ms
        !          9779: mps new-device-address 0 0 0   ( MPS fun-addr dir data-buff data-len )
        !          9780: control-bulk-reset             ( TRUE|FALSE )
        !          9781: d# 100 ms
        !          9782: mps new-device-address 0 0 0   ( TRUE|FALSE MPS fun-addr dir data-buff data-len )
        !          9783: control-bulk-reset             ( TRUE|FALSE TRUE|FALSE )
        !          9784: and invert
        !          9785: IF
        !          9786: ."   ** BULK-RESET failed **" cr
        !          9787: THEN
        !          9788: d# 20 ms
        !          9789: THEN
        !          9790: THEN
        !          9791: 0 ch-buffer !                 \ preset a clean response
        !          9792: mps new-device-address 0 ch-buffer 1 control-std-get-maxlun ( TRUE|FALSE )
        !          9793: IF
        !          9794: ELSE
        !          9795: s" ERROR in GET-MAX-LUN " usb-debug-print
        !          9796: 0 ch-buffer !              \ clear invalid numbers
        !          9797: cd-buffer @ 5 + c@ to temp1
        !          9798: temp1 new-device-address control-std-set-configuration drop
        !          9799: THEN
        !          9800: 0                       ( counter )
        !          9801: begin
        !          9802: dup 8 <              ( counter flag )           \ max 8 * 500 ms
        !          9803: ch-buffer c@ f >     ( counter flag flag )      \ is MuxLUN above limit ?
        !          9804: AND                  ( counter flag )
        !          9805: while
        !          9806: d# 500 ms                     \ this device is not yet ready
        !          9807: 0 ch-buffer !                 \ preset a clean response
        !          9808: mps new-device-address 0 ch-buffer 1 control-std-get-maxlun ( TRUE|FALSE )
        !          9809: not
        !          9810: IF
        !          9811: s"  ** ERROR in GET-MAX-LUN ** " usb-debug-print
        !          9812: drop 10                    \ replace counter to force loop end
        !          9813: THEN
        !          9814: 1+                ( counter+1 )
        !          9815: repeat
        !          9816: drop
        !          9817: ch-buffer c@ dup 0= swap f > or IF   
        !          9818: s" + LUN: " ch-buffer c@  usb-debug-print-val
        !          9819: (atapi-scsi-property-set)
        !          9820: s" usb-storage.fs" INCLUDED
        !          9821: finish-device
        !          9822: ELSE
        !          9823: s" - LUN: " ch-buffer c@ usb-debug-print-val
        !          9824: (atapi-scsi-property-set)
        !          9825: s" usb-storage-wrapper.fs" INCLUDED
        !          9826: finish-device
        !          9827: THEN
        !          9828: ;
        !          9829: : (classify-storage)  ( interface-protocol interface-subclass -- )
        !          9830: s" USB: Mass Storage Device Found!" usb-debug-print
        !          9831: swap 50 <> IF
        !          9832: s" USB storage: Protocol is not 50." usb-debug-print
        !          9833: drop EXIT
        !          9834: THEN
        !          9835: CASE
        !          9836: 02 OF  (atapi-8020-create) s" ATAPI Interface " usb-debug-print ENDOF
        !          9837: 05 OF  (atapi-8070-create) s" ATAPI Interface " usb-debug-print ENDOF
        !          9838: 06 OF  (scsi-create) s" SCSI Interface " usb-debug-print ENDOF
        !          9839: dup OF  s" USB storage: Unsupported sub-class code." usb-debug-print ENDOF
        !          9840: ENDCASE
        !          9841: ;
        !          9842: : (keyboard-create) ( -- )
        !          9843: cd-buffer @ 1f + c@                 ( ep-mps )
        !          9844: cd-buffer @ 1d + c@                 ( ep-mps ep-addr )  
        !          9845: mps port-number new-device-address port-number
        !          9846: new-device set-space                 ( ep-mps ep-addr mps port-num usb-addr )
        !          9847: encode-int s" USB-ADDRESS" property  ( ep-mps ep-addr mps port-num )
        !          9848: encode-int s" reg" property          ( ep-mps ep-addr mps )
        !          9849: encode-int s" MPS-DCP" property      ( ep-mps ep-addr )
        !          9850: 7f and encode-int s" INT-IN-EP-ADDR" property
        !          9851: encode-int s" MPS-INTIN" property
        !          9852: new-device-address   \ device-speed
        !          9853: s" usb-keyboard.fs" INCLUDED
        !          9854: finish-device
        !          9855: ;
        !          9856: : (mouse-create) ( -- )
        !          9857: mps port-number new-device-address port-number
        !          9858: new-device set-space                 ( mps port-num usb-addr )
        !          9859: encode-int s" USB-ADDRESS" property  ( mps port-num )
        !          9860: encode-int s" reg" property          ( mps )
        !          9861: encode-int s" MPS-DCP" property
        !          9862: s" usb-mouse.fs" INCLUDED
        !          9863: finish-device
        !          9864: ;
        !          9865: : (classify-by-interface) ( -- )
        !          9866: (device-classify)  IF
        !          9867: CASE
        !          9868: 08 OF
        !          9869: (classify-storage)
        !          9870: ENDOF
        !          9871: 03 OF
        !          9872: s" USB: HID Found!" usb-debug-print
        !          9873: 01 =
        !          9874: IF
        !          9875: case
        !          9876: 01 of
        !          9877: s" USB keyboard!" usb-debug-print
        !          9878: (keyboard-create)
        !          9879: endof
        !          9880: 02 of
        !          9881: s" USB mouse!" usb-debug-print
        !          9882: (mouse-create)
        !          9883: endof
        !          9884: dup of
        !          9885: s" USB: unsupported HID!" usb-debug-print
        !          9886: endof
        !          9887: endcase
        !          9888: ELSE
        !          9889: s" USB: unsupported HID!" usb-debug-print
        !          9890: THEN
        !          9891: ENDOF
        !          9892: dup OF
        !          9893: s" USB: unsupported interface type." usb-debug-print
        !          9894: 2drop
        !          9895: ENDOF
        !          9896: ENDCASE
        !          9897: THEN
        !          9898: ;
        !          9899: : create-usb-device-tree ( -- )
        !          9900: dd-buffer @ DEVICE-DESCRIPTOR-DEVCLASS-OFFSET + c@    ( Device-class )
        !          9901: CASE
        !          9902: HUB-DEVICE-CLASS OF s" USB: HUB found"   usb-debug-print
        !          9903: (hub-create)
        !          9904: ENDOF
        !          9905: NO-CLASS  OF
        !          9906: (classify-by-interface)
        !          9907: ENDOF
        !          9908: DUP OF
        !          9909: s" USB: Unknown device found." usb-debug-print
        !          9910: ENDOF
        !          9911: ENDCASE
        !          9912: uDOC-present 0f and to uDOC-present \ remove uDOC processing flag
        !          9913: ;
        !          9914: ��������.�.M0usb-storage.fss" storage" device-name
        !          9915: s" block" device-type
        !          9916: 2 encode-int s" #address-cells" property
        !          9917: 0 encode-int s" #size-cells" property
        !          9918: 8 VALUE mps-bulk-out
        !          9919: 8 VALUE mps-bulk-in
        !          9920: 8 VALUE mps-dcp
        !          9921: 0 VALUE bulk-in-ep
        !          9922: 0 VALUE bulk-out-ep
        !          9923: 0 VALUE bulk-in-toggle
        !          9924: 0 VALUE bulk-out-toggle
        !          9925: 0 VALUE lun
        !          9926: 0 VALUE my-usb-address
        !          9927: 0  VALUE csw-buffer
        !          9928: 0e VALUE cfg-buffer
        !          9929: 0  VALUE response-buffer
        !          9930: 0  VALUE command-buffer
        !          9931: 0  VALUE resp-size
        !          9932: 0  VALUE resp-buffer
        !          9933: INSTANCE VARIABLE ihandle-bulk
        !          9934: INSTANCE VARIABLE ihandle-deblocker
        !          9935: INSTANCE VARIABLE flag
        !          9936: INSTANCE VARIABLE count
        !          9937: 0     VALUE max-transfer
        !          9938: 200   VALUE block-size           \ default (512 Bytes)
        !          9939: -1    VALUE max-block-num        \ highest reported block-number
        !          9940: 0f CONSTANT SCSI-COMMAND-OFFSET
        !          9941: s" usb-storage-support.fs" INCLUDED
        !          9942: 0 VALUE bulk-cnt
        !          9943: 0 VALUE bulk-cmd-len
        !          9944: 0 VALUE itest
        !          9945: : do-bulk-command ( resp-buffer resp-size -- TRUE | FALSE )
        !          9946: TO resp-size
        !          9947: TO resp-buffer
        !          9948: usb-debug-flag
        !          9949: IF
        !          9950: command-buffer 0E + c@ TO bulk-cmd-len 
        !          9951: s" cmd-length: " bulk-cmd-len usb-debug-print-val
        !          9952: command-buffer bulk-cmd-len 0E + dump cr
        !          9953: THEN
        !          9954: 6 TO bulk-cnt \ 2 old value
        !          9955: FALSE dup
        !          9956: BEGIN
        !          9957: 0=
        !          9958: WHILE
        !          9959: drop
        !          9960: 1 1 bulk-out-toggle command-buffer 1f mps-bulk-out
        !          9961: my-usb-address bulk-out-ep 7 lshift or
        !          9962: rw-endpoint swap                            ( TRUE toggle | FALSE toggle )
        !          9963: to bulk-out-toggle                ( TRUE | FALSE )
        !          9964: IF
        !          9965: s" resp-size : " resp-size usb-debug-print-val
        !          9966: resp-size 0<>
        !          9967: IF       \ do we need a response ?!
        !          9968: 0 1 bulk-in-toggle resp-buffer resp-size mps-bulk-in
        !          9969: my-usb-address bulk-in-ep 7 lshift or
        !          9970: rw-endpoint swap                       ( TRUE toggle | FALSE toggle )
        !          9971: to bulk-in-toggle                      ( TRUE | FALSE )
        !          9972: ELSE
        !          9973: TRUE
        !          9974: THEN
        !          9975: IF               \ read the bulk CSW
        !          9976: 0 1 bulk-in-toggle csw-buffer D mps-bulk-in
        !          9977: my-usb-address bulk-in-ep 7 lshift or
        !          9978: rw-endpoint swap                    ( TRUE toggle | FALSE toggle )
        !          9979: to bulk-in-toggle                   ( TRUE | FALSE )
        !          9980: IF
        !          9981: s" Command successful." usb-debug-print
        !          9982: TRUE dup
        !          9983: ELSE
        !          9984: s" Command failed in CSW stage" usb-debug-print
        !          9985: FALSE dup
        !          9986: THEN
        !          9987: ELSE
        !          9988: s" Command failed while receiving DATA... read CSW..." usb-debug-print
        !          9989: 0 1 bulk-in-toggle csw-buffer D mps-bulk-in
        !          9990: my-usb-address bulk-in-ep 7 lshift or
        !          9991: rw-endpoint swap                    ( TRUE toggle | FALSE toggle )
        !          9992: to bulk-in-toggle                   ( TRUE | FALSE )
        !          9993: IF
        !          9994: s" OK evaluate the CSW ..." usb-debug-print
        !          9995: csw-buffer c + c@ dup TO itest
        !          9996: s" CSW Status: " itest usb-debug-print-val
        !          9997: dup
        !          9998: 2 =
        !          9999: IF \ Phase Error
        !          10000: s" Phase error do a bulk reset-recovery ..." usb-debug-print
        !          10001: bulk-out-ep bulk-in-ep my-usb-address
        !          10002: bulk-reset-recovery-procedure
        !          10003: THEN
        !          10004: 1 =
        !          10005: IF \ Command failed
        !          10006: s" Command Failed do a bulk-reset-recovery" usb-debug-print
        !          10007: bulk-out-ep bulk-in-ep my-usb-address
        !          10008: bulk-reset-recovery-procedure
        !          10009: THEN
        !          10010: THEN
        !          10011: FALSE dup
        !          10012: THEN
        !          10013: ELSE
        !          10014: s" Command failed while Sending CBW ..." usb-debug-print
        !          10015: FALSE dup
        !          10016: THEN
        !          10017: bulk-cnt 1 - TO bulk-cnt
        !          10018: bulk-cnt 0=
        !          10019: IF
        !          10020: 2drop FALSE dup
        !          10021: THEN
        !          10022: REPEAT
        !          10023: ;
        !          10024: scsi-open
        !          10025: usb-debug-flag to scsi-param-debug  \ copy debug flag
        !          10026: 24 CONSTANT inquiry-length    \ was 20
        !          10027: : inquiry ( -- )
        !          10028: s" usb-storage: inquiry" usb-debug-print
        !          10029: command-buffer 1 inquiry-length 80 lun scsi-length-inquiry
        !          10030: build-cbw
        !          10031: inquiry-length command-buffer SCSI-COMMAND-OFFSET +   ( alloc-len address  )
        !          10032: scsi-build-inquiry
        !          10033: response-buffer inquiry-length erase      \ provide clean buffer
        !          10034: response-buffer inquiry-length do-bulk-command
        !          10035: IF
        !          10036: s" Successfully read INQUIRY data" usb-debug-print
        !          10037: 0d emit space space
        !          10038: response-buffer c@  \ get 'Peripheral Device Type' (PDT)
        !          10039: CASE
        !          10040: 0   OF ." BLOCK-DEV: " ENDOF  \ SCSI Block Device
        !          10041: 5   OF ." CD-ROM   : " ENDOF
        !          10042: 7   OF ." OPTICAL  : " ENDOF
        !          10043: e   OF ." RED-BLOCK: " ENDOF  \ SCSI Reduced Block Device
        !          10044: dup dup OF ." ? (" . 8 emit 29 emit 2 spaces ENDOF
        !          10045: ENDCASE
        !          10046: space
        !          10047: response-buffer 8 + 16 encode-string s" ident-str" property
        !          10048: response-buffer .inquiry-text
        !          10049: ELSE
        !          10050: 5040 error" (USB) Device transaction error. (inquiry)"
        !          10051: ABORT
        !          10052: THEN
        !          10053: ;
        !          10054: : read-capacity ( -- )
        !          10055: s" usb-storage: read-capacity" usb-debug-print
        !          10056: command-buffer 1 8  80 lun  scsi-length-read-cap-10
        !          10057: build-cbw 
        !          10058: command-buffer SCSI-COMMAND-OFFSET +      ( address )   
        !          10059: scsi-build-read-cap-10
        !          10060: lun 5 lshift
        !          10061: command-buffer SCSI-COMMAND-OFFSET +      ( address )
        !          10062: read-cap-10>reserved1 c!
        !          10063: response-buffer 8 erase          \ provide clean buffer
        !          10064: response-buffer 8 do-bulk-command
        !          10065: IF
        !          10066: s" Successfully read READ CAPACITY data" usb-debug-print
        !          10067: ELSE
        !          10068: 5040 error" (USB) Device transaction error. (capacity)"
        !          10069: ABORT
        !          10070: THEN
        !          10071: ;
        !          10072: : test-unit-ready ( -- TRUE | FALSE )
        !          10073: command-buffer 1 0 80 lun scsi-length-test-unit-ready    \ was: 0c
        !          10074: build-cbw
        !          10075: command-buffer SCSI-COMMAND-OFFSET +      ( address )
        !          10076: scsi-build-test-unit-ready                ( cdb -- )
        !          10077: response-buffer 0 do-bulk-command
        !          10078: IF
        !          10079: s" Successfully read test unit ready data" usb-debug-print
        !          10080: s" Test Unit STATUS availabe in csw-buffer" usb-debug-print
        !          10081: csw-buffer 0c + c@ 0=  IF
        !          10082: s" Test Unit Command Successfully Executed" usb-debug-print
        !          10083: TRUE                             ( TRUE )
        !          10084: ELSE
        !          10085: s" Test Unit Command Failed to execute" usb-debug-print
        !          10086: FALSE                            ( FALSE )
        !          10087: THEN
        !          10088: ELSE
        !          10089: 5040 error" (USB) Device transaction error. (test-unit-ready)"
        !          10090: ABORT
        !          10091: THEN
        !          10092: ;
        !          10093: : wait-for-unit-ready            ( -- TRUE|FALSE )
        !          10094: s" --> WAIT: test-unit-ready ... " usb-debug-print
        !          10095: d# 100                        ( count )   \ up to 10 seconds
        !          10096: BEGIN                         ( count )
        !          10097: dup 0>                     ( count flag )
        !          10098: test-unit-ready      \ dup IF 2b ELSE 2d THEN emit
        !          10099: not and    ( count flag )
        !          10100: WHILE
        !          10101: 1-                         ( count )
        !          10102: d# 100 wait-proceed        \ wait 100 ms
        !          10103: REPEAT                        ( count )
        !          10104: 0=
        !          10105: IF
        !          10106: s" **  Device not ready **  " usb-debug-print
        !          10107: FALSE
        !          10108: ELSE
        !          10109: TRUE
        !          10110: THEN
        !          10111: ;
        !          10112: : request-sense ( -- )
        !          10113: s" request-sense: Command ready." usb-debug-print
        !          10114: command-buffer 1 12 80 lun scsi-length-request-sense
        !          10115: build-cbw
        !          10116: 12 command-buffer SCSI-COMMAND-OFFSET +   ( alloc-len cdb )
        !          10117: scsi-build-request-sense                  ( alloc-len cdb -- )
        !          10118: response-buffer 12 do-bulk-command
        !          10119: IF
        !          10120: s" Read Sense data successfully" usb-debug-print
        !          10121: ELSE
        !          10122: 5040 error" (USB) Device transaction error. (request-sense)"
        !          10123: ABORT
        !          10124: THEN
        !          10125: ;
        !          10126: : start ( -- )
        !          10127: command-buffer 1 0 80 lun scsi-length-start-stop-unit
        !          10128: build-cbw
        !          10129: command-buffer SCSI-COMMAND-OFFSET +            ( cdb )
        !          10130: scsi-const-start scsi-build-start-stop-unit     ( state# cdb -- )
        !          10131: response-buffer 0 do-bulk-command
        !          10132: IF
        !          10133: s" Start successfully" usb-debug-print
        !          10134: ELSE
        !          10135: 5040 error" (USB) Device transaction error. (start)"
        !          10136: ABORT
        !          10137: THEN
        !          10138: ;
        !          10139: : stop ( -- )
        !          10140: command-buffer 1 0 80 lun scsi-length-start-stop-unit
        !          10141: build-cbw
        !          10142: command-buffer SCSI-COMMAND-OFFSET +         ( cdb )
        !          10143: scsi-const-stop scsi-build-start-stop-unit   ( state# cdb -- )
        !          10144: response-buffer 0 do-bulk-command
        !          10145: IF
        !          10146: s" Stop successfully" usb-debug-print
        !          10147: ELSE
        !          10148: 5040 error" (USB) Device transaction error. (stop)"
        !          10149: ABORT
        !          10150: THEN
        !          10151: ;
        !          10152: 0 VALUE temp1
        !          10153: 0 VALUE temp2
        !          10154: 0 VALUE temp3
        !          10155: : seek ( pos-lo pos-hi -- status )
        !          10156: 2dup lxjoin max-block-num block-size * >
        !          10157: IF
        !          10158: ." ** Seek Error: pos too large ("
        !          10159: dup . over . ." -> " max-block-num block-size * .
        !          10160: ." ) ** " cr
        !          10161: -1                   \ see spec-1275 page 183
        !          10162: ELSE
        !          10163: s" seek" ihandle-deblocker @ $call-method
        !          10164: THEN
        !          10165: ;
        !          10166: : read ( address length -- actual )
        !          10167: s" read" ihandle-deblocker @  $call-method
        !          10168: ;
        !          10169: : read-blocks ( address block# #blocks -- #read-blocks )
        !          10170: 2dup + max-block-num >
        !          10171: IF
        !          10172: ." ** Requested block too large "
        !          10173: 2dup + ." (" .d ." -> " max-block-num .d
        !          10174: bs emit ." ) ... read aborted **" cr
        !          10175: nip nip                       \ leave #blocks on stack
        !          10176: ELSE
        !          10177: block-size * command-buffer  ( address block# transfer-len command-buffer )
        !          10178: 1 2 pick 80 lun 0c build-cbw ( address block# transfer-len )
        !          10179: dup to temp1                 ( address block# transfer-len )
        !          10180: block-size /                 ( address block# #blocks )
        !          10181: command-buffer               ( address block# #blocks command-addr )
        !          10182: SCSI-COMMAND-OFFSET +        ( address block# #blocks cdb )
        !          10183: scsi-build-read?                     ( block# #blocks cdb -- length )
        !          10184: command-buffer 0e + c!       \ update bCBWCBLength-field with resulting CDB length
        !          10185: temp1                        ( address length )
        !          10186: do-bulk-command
        !          10187: IF
        !          10188: s" Read  data successfully" usb-debug-print
        !          10189: ELSE
        !          10190: 5040 error" (USB) Device transaction error. (read-blocks)"
        !          10191: ABORT
        !          10192: THEN
        !          10193: temp1 block-size /  ( #read-blocks )
        !          10194: THEN
        !          10195: ;
        !          10196: d# 800 CONSTANT media-ready-retry
        !          10197: : make-media-ready ( -- )
        !          10198: s" usb-storage: make-media-ready" usb-debug-print
        !          10199: 0  flag !
        !          10200: 0  count !
        !          10201: BEGIN
        !          10202: flag @  0=
        !          10203: WHILE
        !          10204: test-unit-ready IF
        !          10205: s" Media ready for access." usb-debug-print
        !          10206: 1  flag !
        !          10207: ELSE
        !          10208: count @  1 +  count !
        !          10209: count @ media-ready-retry = IF
        !          10210: 1 flag !
        !          10211: 5000 error" (USB) Media or drive not ready for this blade."
        !          10212: ABORT
        !          10213: THEN
        !          10214: request-sense
        !          10215: response-buffer scsi-get-sense-ID? ( addr -- false | sense-ID true )
        !          10216: IF
        !          10217: ffff00 AND     \ remaining: sense-key ASC
        !          10218: CASE
        !          10219: 023a00 OF   \ MEDIUM NOT PRESENT (02 3a 00)
        !          10220: 5010 error" (USB) No Media found! Check for the drawer/inserted media."
        !          10221: ABORT
        !          10222: ENDOF
        !          10223: 020400 OF   \ LOGICAL DRIVE NOT READY - INITIALIZATION REQUIRED
        !          10224: 5010 error" (USB) No Media found! Check for the drawer/inserted media."
        !          10225: ABORT
        !          10226: ENDOF
        !          10227: 033000 OF   \ CANNOT READ MEDIUM - UNKNOWN FORMAT
        !          10228: 5020 error" (USB) Unknown media format."
        !          10229: ABORT
        !          10230: ENDOF
        !          10231: ENDCASE
        !          10232: THEN
        !          10233: THEN
        !          10234: d# 10 ms             \ wait maximum 10ms * 800 (=8s)
        !          10235: REPEAT
        !          10236: usb-debug-flag IF
        !          10237: ." make-media-ready finished after "
        !          10238: count @ decimal . hex ." tries." cr
        !          10239: THEN
        !          10240: ;
        !          10241: : .showcap
        !          10242: space
        !          10243: test-unit-ready drop             \ initial command
        !          10244: request-sense
        !          10245: response-buffer scsi-get-sense-ID? ( addr -- false | sense-ID true )
        !          10246: IF
        !          10247: dup FFFF00 and 023a00 =       ( sense-id flag )
        !          10248: IF
        !          10249: uDOC-failure?
        !          10250: 023a02 =                   \ see sense-codes SPC-3 clause 4.5.6
        !          10251: IF
        !          10252: ."  Tray Open!"
        !          10253: ELSE
        !          10254: ."    No Media"
        !          10255: THEN
        !          10256: ELSE                          ( sense-id )
        !          10257: drop
        !          10258: wait-for-unit-ready
        !          10259: IF
        !          10260: read-capacity
        !          10261: response-buffer scsi-get-capacity-10 space .capacity-text
        !          10262: ELSE
        !          10263: request-sense
        !          10264: response-buffer scsi-get-sense-ID? ( addr -- false | sense-ID true )
        !          10265: IF
        !          10266: dup ff0000 and 040000 =       \ sense-code = 4 ?
        !          10267: IF
        !          10268: ." *HW-ERROR*"
        !          10269: uDOC-failure?
        !          10270: ELSE
        !          10271: dup FFFF00 and 023a00 = IF uDOC-failure? THEN
        !          10272: CASE              ( sense-ID )
        !          10273: 023a00 OF ."   No Media " ENDOF
        !          10274: 023a02 OF ." Tray Open! " ENDOF
        !          10275: dup    OF ."          ? " ENDOF
        !          10276: ENDCASE
        !          10277: THEN
        !          10278: THEN
        !          10279: THEN
        !          10280: THEN
        !          10281: ELSE
        !          10282: ."       ??   "
        !          10283: THEN
        !          10284: ;
        !          10285: : init-dev-ready
        !          10286: test-unit-ready drop
        !          10287: 4 >r                \ loop-counter
        !          10288: 0 0
        !          10289: BEGIN
        !          10290: 2drop
        !          10291: request-sense
        !          10292: response-buffer scsi-get-sense-data ( ascq asc sense-key )
        !          10293: 0<>  r> 1- dup >r 0<> AND          \ loop-counter or sense-key
        !          10294: WHILE
        !          10295: REPEAT
        !          10296: 2drop
        !          10297: r> drop
        !          10298: ;
        !          10299: scsi-close        \ no further scsi words required
        !          10300: : (init-block-size)
        !          10301: read-capacity
        !          10302: response-buffer l@ dup 0<>
        !          10303: IF
        !          10304: to max-block-num        \ highest block-number
        !          10305: ELSE
        !          10306: -1 to max-block-num     \ indeterminate
        !          10307: THEN
        !          10308: response-buffer 4 + 
        !          10309: l@ to block-size
        !          10310: s" usb-storage: block-size=" block-size usb-debug-print-val
        !          10311: ;
        !          10312: : open ( -- TRUE )
        !          10313: s" usb-storage: open" usb-debug-print
        !          10314: ihandle-bulk s" bulk" (open-package)
        !          10315: make-media-ready
        !          10316: (init-block-size)           \ Init block-size before opening the deblocker
        !          10317: ihandle-deblocker s" deblocker" (open-package)
        !          10318: s" disk-label" find-package IF  ( phandle )
        !          10319: usb-debug-flag IF ." my-args for disk-label = " my-args swap . . cr THEN
        !          10320: my-args rot interpose
        !          10321: THEN
        !          10322: TRUE                        ( TRUE )
        !          10323: ;
        !          10324: : close  ( -- )
        !          10325: ihandle-deblocker (close-package)
        !          10326: ihandle-bulk (close-package)
        !          10327: ;
        !          10328: : (init-device-name)  ( -- )
        !          10329: init-dev-ready
        !          10330: inquiry
        !          10331: response-buffer c@
        !          10332: CASE
        !          10333: 1  OF .showcap s" tape"    device-name ENDOF
        !          10334: 5  OF .showcap s" cdrom"   device-name s" CDROM found" usb-debug-print ENDOF
        !          10335: 0  OF .showcap s" sbc-dev" device-name s" SBC Direct access device" usb-debug-print ENDOF
        !          10336: 7  OF .showcap s" optical" device-name s" Optical memory found" usb-debug-print ENDOF
        !          10337: 0E OF .showcap s" rbc-dev" device-name s" RBC direct acces device found" usb-debug-print ENDOF
        !          10338: ENDCASE
        !          10339: ;
        !          10340: : (initial-setup)
        !          10341: ihandle-bulk s" bulk" (open-package)
        !          10342: device-init
        !          10343: (init-device-name)
        !          10344: set-drive-alias
        !          10345: 200 to block-size       \ Default block-size, will be overwritten in "open"
        !          10346: 10000 to max-transfer
        !          10347: ihandle-bulk (close-package)
        !          10348: ;
        !          10349: (initial-setup)
        !          10350: ��������8
        !          10351: �8usb-storage-support.fs: rw-endpoint
        !          10352: s" rw-endpoint" $call-parent
        !          10353: ;
        !          10354: : controlxfer ( dir addr dlen setup-packet MPS ep-fun --- TRUE|FALSE )
        !          10355: s" controlxfer" $call-parent
        !          10356: ;
        !          10357: : control-std-get-configuration-descriptor
        !          10358: s" control-std-get-configuration-descriptor" $call-parent
        !          10359: ;
        !          10360: : control-std-set-configuration ( configvalue FuncAddr -- TRUE | FALSE )
        !          10361: s" control-std-set-configuration" $call-parent   ( TRUE | FALSE )
        !          10362: ;
        !          10363: : bulk-reset-recovery-procedure ( bulk-out-endp bulk-in-endp usb-addr -- )
        !          10364: s" bulk-reset-recovery-procedure" $call-parent
        !          10365: ;
        !          10366: : build-cbw ( address tag transfer-len direction lun command-len -- )
        !          10367: s" build-cbw" ihandle-bulk @ $call-method
        !          10368: ;
        !          10369: : analyze-csw ( address -- residue tag TRUE | reason FALSE )
        !          10370: s" analyze-csw" ihandle-bulk @ $call-method
        !          10371: ;
        !          10372: : device-init ( -- )
        !          10373: s" Starting to initialize usb-storage device" usb-debug-print
        !          10374: s" USB-ADDRESS" get-my-property         ( TRUE | propaddr proplen FALSE )
        !          10375: IF
        !          10376: s" not possible" usb-debug-print
        !          10377: ELSE
        !          10378: decode-int nip nip to my-usb-address
        !          10379: THEN
        !          10380: s" MPS-BULKOUT" get-my-property         ( TRUE | propaddr proplen FALSE )
        !          10381: IF
        !          10382: s" not possible"   usb-debug-print
        !          10383: ELSE
        !          10384: decode-int nip nip to mps-bulk-out
        !          10385: THEN
        !          10386: s" MPS-BULKIN" get-my-property          ( TRUE | propaddr proplen FALSE )
        !          10387: IF
        !          10388: s" not possible" usb-debug-print
        !          10389: ELSE
        !          10390: decode-int nip nip to mps-bulk-in
        !          10391: THEN
        !          10392: s" BULK-IN-EP-ADDR" get-my-property     ( TRUE | propaddr proplen FALSE )
        !          10393: IF
        !          10394: s" not possible" usb-debug-print
        !          10395: ELSE
        !          10396: decode-int nip nip to bulk-in-ep
        !          10397: THEN
        !          10398: s" BULK-OUT-EP-ADDR" get-my-property    ( TRUE | propaddr proplen FALSE )
        !          10399: IF
        !          10400: s" not possible"  usb-debug-print
        !          10401: ELSE
        !          10402: decode-int nip nip to bulk-out-ep
        !          10403: THEN
        !          10404: s" MPS-DCP" get-my-property             ( TRUE | propaddr proplen FALSE )
        !          10405: IF
        !          10406: s" Not possible" usb-debug-print
        !          10407: ELSE
        !          10408: decode-int nip nip to mps-dcp
        !          10409: THEN
        !          10410: s" LUN" get-my-property                 ( TRUE | propaddr proplen FALSE )
        !          10411: IF
        !          10412: s" NOT Possible to extract LUN" usb-debug-print
        !          10413: ELSE
        !          10414: decode-int nip nip to lun
        !          10415: THEN
        !          10416: s" Extracted properties inherited from parent."  usb-debug-print
        !          10417: 40 alloc-mem to command-buffer
        !          10418: 80 alloc-mem to response-buffer
        !          10419: 10 alloc-mem to csw-buffer
        !          10420: 8 alloc-mem to cfg-buffer
        !          10421: s" Allocated buffers." usb-debug-print
        !          10422: cfg-buffer 8 mps-dcp my-usb-address      ( buffer len mps fun-addr )
        !          10423: control-std-get-configuration-descriptor ( TRUE | FALSE )
        !          10424: drop
        !          10425: s" Configuration descriptor extracted." usb-debug-print
        !          10426: cfg-buffer 5 + c@ my-usb-address         ( configvalue fun-addr )
        !          10427: control-std-set-configuration            ( TRUE | FALSE )
        !          10428: s" usb-storage: Set config returned: " rot usb-debug-print-val
        !          10429: ;
        !          10430: : (open-package)  ( ihandle-var name-str name-len -- )
        !          10431: find-package IF                 ( ihandle-var phandle )
        !          10432: 0 0 rot open-package         ( ihandle-var ihandle )
        !          10433: swap !
        !          10434: ELSE
        !          10435: s" Support package not found"  usb-debug-print
        !          10436: THEN
        !          10437: ;
        !          10438: : (close-package)  ( ihandle-var -- )
        !          10439: dup @ close-package
        !          10440: 0 swap !
        !          10441: ;
        !          10442: ��������x38usb-storage-wrapper.fss" scsi" device-name
        !          10443: s" block-type" device-type
        !          10444: 1 encode-int s" #address-cells" property
        !          10445: 0 encode-int s" #size-cells" property
        !          10446: : encode-unit   1 hex-encode-unit ;
        !          10447: : decode-unit   1 hex-decode-unit ;
        !          10448: 1 chars alloc-mem VALUE ch-buffer
        !          10449: 8 VALUE mps-dcp
        !          10450: 0 VALUE port-number
        !          10451: 0 VALUE my-usb-address
        !          10452: : control-std-get-maxlun
        !          10453: s" control-std-get-maxlun" $call-parent
        !          10454: ;
        !          10455: : control-std-get-configuration-descriptor
        !          10456: s" control-std-get-configuration-descriptor" $call-parent
        !          10457: ;
        !          10458: : rw-endpoint
        !          10459: s" rw-endpoint" $call-parent
        !          10460: ;
        !          10461: : controlxfer ( dir addr dlen setup-packet MPS ep-fun -- TRUE|FALSE )
        !          10462: s" controlxfer" $call-parent
        !          10463: ;
        !          10464: : control-std-set-configuration
        !          10465: s" control-std-set-configuration" $call-parent
        !          10466: ;
        !          10467: : extract-properties ( -- )
        !          10468: s" USB-ADDRESS" get-inherited-property ( prop-addr prop-len FALSE | TRUE )
        !          10469: IF
        !          10470: s" notpossible" usb-debug-print
        !          10471: ELSE
        !          10472: decode-int nip nip to my-usb-address
        !          10473: THEN
        !          10474: s" MPS-DCP" get-inherited-property  ( prop-addr prop-len FALSE | TRUE )
        !          10475: IF
        !          10476: s" MPS-DCP property not found.Assume 8 as MAX PACKET SIZE" usb-debug-print
        !          10477: s" for the default control pipe"  usb-debug-print
        !          10478: 8 to mps-dcp
        !          10479: ELSE
        !          10480: s" MPS-DCP property found!!"  usb-debug-print
        !          10481: decode-int nip nip to mps-dcp
        !          10482: THEN
        !          10483: s" reg" get-inherited-property   ( prop-addr prop-len FLASE | TRUE )
        !          10484: IF
        !          10485: s" notpossible" usb-debug-print
        !          10486: ELSE
        !          10487: decode-int nip nip to port-number
        !          10488: THEN
        !          10489: ;
        !          10490: : create-tree ( -- )
        !          10491: mps-dcp my-usb-address 0 ch-buffer 1 ( MPS fun-addr dir data-buff data-len )
        !          10492: control-std-get-maxlun     ( TRUE | FALSE )
        !          10493: IF
        !          10494: s" GET-MAX-LUN IS WORKING :" usb-debug-print
        !          10495: ELSE
        !          10496: s" ERROR in GET-MAX-LUN " usb-debug-print
        !          10497: THEN
        !          10498: ch-buffer c@ 1 +  0                              ( max-lun+1 0 )
        !          10499: DO
        !          10500: s" iManufacturer" get-inherited-property drop ( prop-addr prop-len TRUE )
        !          10501: decode-int nip nip                  ( iManu )
        !          10502: s" iProduct" get-inherited-property drop
        !          10503: decode-int nip nip                  ( iManu iProd )
        !          10504: s" iSerialNumber" get-inherited-property drop
        !          10505: decode-int nip nip                  ( iManu iProd iSerNum )
        !          10506: s" MPS-BULKOUT" get-inherited-property drop
        !          10507: decode-int nip nip                  ( iManu iProd iSerNum MPS-BULKOUT )
        !          10508: s" BULK-OUT-EP-ADDR" get-inherited-property drop
        !          10509: decode-int nip nip ( iManu iProd iSerNum MPS-BULKOUT BULK-OUT-EP-ADDR )
        !          10510: s" MPS-BULKIN" get-inherited-property drop
        !          10511: ( iManu iProd iSerNum MPS-BULKOUT BULK-OUT-EP-ADDR prop-addr prop-len
        !          10512: TRUE | FALSE )
        !          10513: decode-int nip nip
        !          10514: s" BULK-IN-EP-ADDR" get-inherited-property drop
        !          10515: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN prop-addr
        !          10516: prop-len TRUE | FALSE )
        !          10517: decode-int nip nip
        !          10518: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10519: BULKIN-EP-ADDR )
        !          10520: mps-dcp  port-number  my-usb-address I
        !          10521: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10522: BULKIN-EP-ADDR mps-dcp port-address my-usb-address lun-number )
        !          10523: new-device
        !          10524: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10525: BULKIN-EP-ADDR mps-dcp port-address my-usb-address lun-number )
        !          10526: set-space
        !          10527: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10528: BULKIN-EP-ADDR mps-dcp port-number my-usb-address )
        !          10529: encode-int s" USB-ADDRESS" property
        !          10530: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10531: BULKIN-EP-ADDR mps-dcp port-number )
        !          10532: encode-int s" reg" property
        !          10533: encode-int s" MPS-DCP" property
        !          10534: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10535: BULKIN-EP-ADDR )
        !          10536: I encode-int s" LUN" property
        !          10537: ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN
        !          10538: BULKIN-EP-ADDR )
        !          10539: encode-int s" BULK-IN-EP-ADDR" property
        !          10540: encode-int s" MPS-BULKIN" property
        !          10541: encode-int s" BULK-OUT-EP-ADDR" property
        !          10542: encode-int s" MPS-BULKOUT" property ( iManu iProd iSerNum )
        !          10543: encode-int s" iSerialNumber" property ( iManu iProd )
        !          10544: encode-int s" iProduct" property  ( iManu )
        !          10545: encode-int s" iManufacturer" property ( -- )
        !          10546: s" usb-storage.fs" INCLUDED
        !          10547: finish-device
        !          10548: LOOP
        !          10549: ;
        !          10550: extract-properties  \ Extract the properties from parent
        !          10551: create-tree       \ this method creates the node for every lun with properties
        !          10552: ��������*�*0usb-keyboard.fss" keyboard" device-name
        !          10553: s" keyboard" device-type
        !          10554: ."   USB Keyboard" cr
        !          10555: 3 encode-int s" assigned-addresses" property
        !          10556: 1 encode-int s" reg" property
        !          10557: 1 encode-int s" configuration#" property
        !          10558: s" EN" encode-string s" language" property
        !          10559: 1 constant NumLk
        !          10560: 2 constant CapsLk
        !          10561: 4 constant ScrLk
        !          10562: 00 value kbd-addr
        !          10563: to kbd-addr                                \ save speed bit
        !          10564: 8 value mps-dcp
        !          10565: 8 constant DEFAULT-CONTROL-MPS
        !          10566: 8 chars alloc-mem value setup-packet
        !          10567: 8 chars alloc-mem value kbd-report
        !          10568: 4 chars alloc-mem value multi-key
        !          10569: 0 value cfg-buffer
        !          10570: 0 value led-state
        !          10571: 0 value temp1
        !          10572: 0 value temp2
        !          10573: 0 value temp3
        !          10574: 0 value ret
        !          10575: 0 value scancode
        !          10576: 0 value kbd-shift
        !          10577: 0 value kbd-scan
        !          10578: 0 value key-old
        !          10579: 0 value expire-ms
        !          10580: 0 value mps-int-in
        !          10581: 0 value int-in-ep
        !          10582: 0 value int-in-toggle
        !          10583: kbd-addr                                    \ give speed bit to include file 
        !          10584: s" usb-kbd-device-support.fs" included
        !          10585: : control-cls-set-report ( reportvalue FuncAddr -- TRUE|FALSE )
        !          10586: to temp1
        !          10587: to temp2
        !          10588: 2109000200000100 setup-packet ! 
        !          10589: temp2 kbd-data l!-le  
        !          10590: 1 kbd-data 1 setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer  
        !          10591: ;
        !          10592: : control-cls-get-report ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE )
        !          10593: to temp1
        !          10594: to temp2
        !          10595: to temp3
        !          10596: a101000100000000 setup-packet ! 
        !          10597: temp3 setup-packet 6 + w!-le  
        !          10598: 0 swap temp3 setup-packet temp2 temp1 controlxfer  
        !          10599: ;
        !          10600: : int-get-report ( -- )                                           \ get report for interrupt transfer
        !          10601: 0 2 int-in-toggle kbd-report 8 mps-int-in
        !          10602: kbd-addr int-in-ep 7 lshift or rw-endpoint                    \ get report 
        !          10603: swap to int-in-toggle if
        !          10604: kbd-report @ ff00000000000000 and 38 rshift to kbd-shift  \ store shift status
        !          10605: kbd-report @ 0000ffffffffffff and to kbd-scan             \ store scan codes
        !          10606: else
        !          10607: 0 to kbd-shift                                            \ clear shift status 
        !          10608: 0 to kbd-scan                                             \ clear scan code buffer
        !          10609: then
        !          10610: ;
        !          10611: : ctl-get-report ( -- )                                           \ get report for control transfer      
        !          10612: kbd-report 8 8 kbd-addr control-cls-get-report if             \ get report 
        !          10613: kbd-report @ ff00000000000000 and 38 rshift to kbd-shift  \ store shift status
        !          10614: kbd-report @ 0000ffffffffffff and to kbd-scan             \ store scan codes 
        !          10615: else
        !          10616: 0 to kbd-shift                                            \ clear shift status 
        !          10617: 0 to kbd-scan                                             \ clear scan code buffer
        !          10618: then
        !          10619: ;
        !          10620: : set-led ( led -- ) 
        !          10621: dup to led-state  
        !          10622: kbd-addr control-cls-set-report drop
        !          10623: ;
        !          10624: : is-shift ( -- true|false )
        !          10625: kbd-shift 22 and if
        !          10626: true
        !          10627: else
        !          10628: false
        !          10629: then
        !          10630: ;
        !          10631: : is-alt ( -- true|false )
        !          10632: kbd-shift 44 and if
        !          10633: true
        !          10634: else
        !          10635: false
        !          10636: then
        !          10637: ;
        !          10638: : is-ctrl ( -- true|false )
        !          10639: kbd-shift 11 and if
        !          10640: true
        !          10641: else
        !          10642: false
        !          10643: then
        !          10644: ;
        !          10645: : ctrl_alt_del_key ( char -- )
        !          10646: is-ctrl if                                           \ ctrl is pressed?
        !          10647: is-alt if                                        \ alt is pressed?
        !          10648: 4c = if                                      \ del is pressed?
        !          10649: s" reboot.... " usb-debug-print 
        !          10650: drop false                               \ invalidate del key on top of stack
        !          10651: then
        !          10652: false                                        \ dummy for last drop
        !          10653: then
        !          10654: then
        !          10655: drop                                                 \ clear stack 
        !          10656: ;
        !          10657: : get-ukbd-char ( ScanCode -- char|false )
        !          10658: dup ctrl_alt_del_key                                 \ check ctrl+alt+del 
        !          10659: dup to scancode                                      \ store scan code
        !          10660: case                                                 \ translate scan code --> char
        !          10661: 04 of [char] a endof 
        !          10662: 05 of [char] b endof 
        !          10663: 06 of [char] c endof 
        !          10664: 07 of [char] d endof 
        !          10665: 08 of [char] e endof 
        !          10666: 09 of [char] f endof 
        !          10667: 0a of [char] g endof 
        !          10668: 0b of [char] h endof 
        !          10669: 0c of [char] i endof 
        !          10670: 0d of [char] j endof 
        !          10671: 0e of [char] k endof 
        !          10672: 0f of [char] l endof 
        !          10673: 10 of [char] m endof 
        !          10674: 11 of [char] n endof 
        !          10675: 12 of [char] o endof 
        !          10676: 13 of [char] p endof 
        !          10677: 14 of [char] q endof 
        !          10678: 15 of [char] r endof 
        !          10679: 16 of [char] s endof 
        !          10680: 17 of [char] t endof 
        !          10681: 18 of [char] u endof 
        !          10682: 19 of [char] v endof 
        !          10683: 1a of [char] w endof 
        !          10684: 1b of [char] x endof 
        !          10685: 1c of [char] y endof 
        !          10686: 1d of [char] z endof 
        !          10687: 1e of [char] 1 endof 
        !          10688: 1f of [char] 2 endof 
        !          10689: 20 of [char] 3 endof 
        !          10690: 21 of [char] 4 endof 
        !          10691: 22 of [char] 5 endof 
        !          10692: 23 of [char] 6 endof 
        !          10693: 24 of [char] 7 endof 
        !          10694: 25 of [char] 8 endof 
        !          10695: 26 of [char] 9 endof 
        !          10696: 27 of [char] 0 endof 
        !          10697: 28 of 0d endof                            \ Enter
        !          10698: 29 of 1b endof                            \ ESC 
        !          10699: 2a of 08 endof                            \ Backsace 
        !          10700: 2b of 09 endof                            \ Tab
        !          10701: 2c of 20 endof                            \ Space
        !          10702: 2d of [char] - endof 
        !          10703: 2e of [char] = endof 
        !          10704: 2f of [char] [ endof 
        !          10705: 30 of [char] ] endof 
        !          10706: 31 of [char] \ endof 
        !          10707: 33 of [char] ; endof 
        !          10708: 34 of [char] ' endof 
        !          10709: 35 of [char] ` endof 
        !          10710: 36 of [char] , endof 
        !          10711: 37 of [char] . endof 
        !          10712: 38 of [char] / endof
        !          10713: 39 of led-state CapsLk xor set-led false endof  \ CapsLk
        !          10714: 3a of 1b 7e31315b to multi-key endof      \ F1
        !          10715: 3b of 1b 7e32315b to multi-key endof      \ F2
        !          10716: 3c of 1b 7e33315b to multi-key endof      \ F3
        !          10717: 3d of 1b 7e34315b to multi-key endof      \ F4
        !          10718: 3e of 1b 7e35315b to multi-key endof      \ F5
        !          10719: 3f of 1b 7e37315b to multi-key endof      \ F6
        !          10720: 40 of 1b 7e38315b to multi-key endof      \ F7
        !          10721: 41 of 1b 7e39315b to multi-key endof      \ F8
        !          10722: 42 of 1b 7e30315b to multi-key endof      \ F9
        !          10723: 43 of 1b 7e31315b to multi-key endof      \ F10
        !          10724: 44 of 1b 7e33315b to multi-key endof      \ F11
        !          10725: 45 of 1b 7e34315b to multi-key endof      \ F12
        !          10726: 47 of led-state ScrLk xor set-led false endof   \ ScrLk
        !          10727: 49 of 1b 7e315b to multi-key endof        \ Ins
        !          10728: 4a of 1b 7e325b to multi-key endof        \ Home
        !          10729: 4b of 1b 7e335b to multi-key endof        \ PgUp
        !          10730: 4c of 1b 7e345b to multi-key endof        \ Del
        !          10731: 4d of 1b 7e355b to multi-key endof        \ End
        !          10732: 4e of 1b 7e365b to multi-key endof        \ PgDn
        !          10733: 4f of 1b 435b to multi-key endof          \ R-arrow
        !          10734: 50 of 1b 445b to multi-key endof          \ L-arrow
        !          10735: 51 of 1b 425b to multi-key endof          \ D-arrow
        !          10736: 52 of 1b 415b to multi-key endof          \ U-arrow
        !          10737: 53 of led-state NumLk xor set-led false endof   \ NumLk
        !          10738: 54 of [char] / endof                      \ keypad / 
        !          10739: 55 of [char] * endof                      \ keypad *
        !          10740: 56 of [char] - endof                      \ keypad -
        !          10741: 57 of [char] + endof                      \ keypad +
        !          10742: 58 of 0d endof                            \ keypad Enter
        !          10743: 89 of [char] \ endof                      \ japanese yen
        !          10744: dup of false endof                        \ other keys are false
        !          10745: endcase
        !          10746: to ret                                        \ store char
        !          10747: led-state CapsLk and 0 <> if                  \ if CapsLk is on
        !          10748: scancode 03 > if                          \ from a to z ?
        !          10749: scancode 1e < if
        !          10750: ret 20 - to ret                   \ to Upper case
        !          10751: then
        !          10752: then
        !          10753: then
        !          10754: is-shift if                                   \ if shift is on
        !          10755: scancode 03 > if                          \ from a to z ?
        !          10756: scancode 1e < if
        !          10757: ret 20 - to ret                   \ to Upper case
        !          10758: else
        !          10759: scancode
        !          10760: case                              \ translate scan code --> char
        !          10761: 1e of [char] ! endof
        !          10762: 1f of [char] @ endof
        !          10763: 20 of [char] # endof
        !          10764: 21 of [char] $ endof
        !          10765: 22 of [char] % endof
        !          10766: 23 of [char] ^ endof
        !          10767: 24 of [char] & endof
        !          10768: 25 of [char] * endof
        !          10769: 26 of [char] ( endof
        !          10770: 27 of [char] ) endof
        !          10771: 2d of [char] _ endof
        !          10772: 2e of [char] + endof
        !          10773: 2f of [char] { endof
        !          10774: 30 of [char] } endof
        !          10775: 31 of [char] | endof
        !          10776: 33 of [char] : endof
        !          10777: 34 of [char] " endof
        !          10778: 35 of [char] ~ endof
        !          10779: 36 of [char] < endof
        !          10780: 37 of [char] > endof
        !          10781: 38 of [char] ? endof
        !          10782: dup of ret endof              \ other keys are no change
        !          10783: endcase
        !          10784: to ret                            \ overwrite new char    
        !          10785: then
        !          10786: then
        !          10787: then
        !          10788: led-state NumLk and 0 <> if                   \ if NumLk is on
        !          10789: scancode 
        !          10790: case                                        \ translate scan code --> char
        !          10791: 59 of [char] 1 endof
        !          10792: 5a of [char] 2 endof
        !          10793: 5b of [char] 3 endof
        !          10794: 5c of [char] 4 endof
        !          10795: 5d of [char] 5 endof
        !          10796: 5e of [char] 6 endof
        !          10797: 5f of [char] 7 endof
        !          10798: 60 of [char] 8 endof
        !          10799: 61 of [char] 9 endof
        !          10800: 62 of [char] 0 endof
        !          10801: 63 of [char] . endof                      \ keypad .
        !          10802: dup of ret endof                          \ other keys are no change
        !          10803: endcase
        !          10804: to ret                                      \ overwirte new char
        !          10805: then
        !          10806: ret                                           \ return char
        !          10807: ;
        !          10808: : key-available? ( -- true|false )
        !          10809: multi-key 0 <> IF 
        !          10810: true \ multi scan code key was pressed... so key is available
        !          10811: EXIT \ done
        !          10812: THEN
        !          10813: kbd-scan 0 = IF \ if no kbd-scan code is currently available 
        !          10814: int-get-report \ check for one using int-get-report 
        !          10815: THEN
        !          10816: kbd-scan 0 <> \ if a kbd-scan is available, report true, else false
        !          10817: ;
        !          10818: : usb-kread ( -- char|false )                            \ usb key read for control transfer
        !          10819: multi-key 0 <> if                                    \ if multi scan code key is pressed
        !          10820: multi-key ff and                                 \ read one byte from buffer
        !          10821: multi-key 8 rshift to multi-key                  \ move to next byte 
        !          10822: else                                                 \ normal key check
        !          10823: kbd-scan 0 = IF
        !          10824: int-get-report                                   \ read report (interrupt transfer)
        !          10825: THEN
        !          10826: kbd-scan 0 <> if                                 \ scan code exist?
        !          10827: begin kbd-scan ff and dup 00 = while         \ get a last scancode in report buffer
        !          10828: kbd-scan 8 rshift to kbd-scan        \ This algorithm is wrong --> must be fixed!
        !          10829: drop                                 \ KBD doesn't set scancode in pressed order!!!
        !          10830: repeat
        !          10831: dup key-old <> if                            \ if the scancode is new
        !          10832: dup to key-old                           \ save current scan code
        !          10833: get-ukbd-char                            \ translate scan code --> char
        !          10834: milliseconds fa + to expire-ms           \ set typematic delay 250ms       
        !          10835: else                                         \ scan code is not changed
        !          10836: milliseconds expire-ms > if              \ if timer is expired ... should be considered timer carry over
        !          10837: get-ukbd-char                        \ translate scan code --> char
        !          10838: milliseconds 21 + to expire-ms       \ set typematic rate 30cps
        !          10839: else                                     \ timer is not expired 
        !          10840: drop false                           \ do nothing
        !          10841: then
        !          10842: then
        !          10843: kbd-scan 8 rshift to kbd-scan \ handled scan-code
        !          10844: else
        !          10845: 0 to key-old                                 \ clear privious key
        !          10846: false                                        \ no scan code --> return false
        !          10847: then
        !          10848: then
        !          10849: ;
        !          10850: : key-read ( -- char )
        !          10851: 0 begin drop usb-kread dup 0 <> until                \ read key input (Interrupt transfer)
        !          10852: ;
        !          10853: : read ( addr len -- actual )
        !          10854: 0= IF drop 0 EXIT THEN
        !          10855: usb-kread ?dup  IF  swap c! 1  ELSE  0 swap c! -2  THEN
        !          10856: ;
        !          10857: kbd-init                                                 \ keyboard initialize
        !          10858: milliseconds to expire-ms                                \ Timer initialize
        !          10859: 0 to multi-key                                           \ multi key buffer clear
        !          10860: 7 set-led                                                \ flash leds
        !          10861: 250 ms
        !          10862: 0 set-led
        !          10863: s" keyboard" get-node node>path set-alias
        !          10864: : open ( -- true )
        !          10865: 7 set-led
        !          10866: 100 ms
        !          10867: 3 set-led
        !          10868: 100 ms
        !          10869: 1 set-led
        !          10870: 100 ms
        !          10871: usb-kread drop
        !          10872: 0 set-led
        !          10873: true
        !          10874: ;
        !          10875: : close ;
        !          10876: ��������`@usb-kbd-device-support.fs00 value kbd-addr
        !          10877: to kbd-addr
        !          10878: 8 alloc-mem to kbd-report
        !          10879: 4 chars alloc-mem value kbd-data
        !          10880: : rw-endpoint
        !          10881: s" rw-endpoint" $call-parent ;
        !          10882: : controlxfer
        !          10883: s" controlxfer" $call-parent ;
        !          10884: : control-std-get-device-descriptor
        !          10885: s" control-std-get-device-descriptor" $call-parent ;
        !          10886: : control-std-get-configuration-descriptor
        !          10887: s" control-std-get-configuration-descriptor" $call-parent ;
        !          10888: : control-std-set-configuration
        !          10889: s" control-std-set-configuration" $call-parent ;
        !          10890: : control-cls-set-protocol ( reportvalue FuncAddr -- TRUE|FALSE )
        !          10891: to temp1
        !          10892: to temp2
        !          10893: 210b000000000100 setup-packet ! 
        !          10894: temp2 kbd-data l!-le
        !          10895: 1 kbd-data 1 setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer  
        !          10896: ;
        !          10897: : control-cls-set-idle ( reportvalue FuncAddr -- TRUE|FALSE )
        !          10898: to temp1
        !          10899: to temp2
        !          10900: 210a000000000000 setup-packet ! 
        !          10901: temp2 kbd-data l!-le
        !          10902: 0 kbd-data 0 setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer  
        !          10903: ;
        !          10904: : control-std-get-report-descriptor ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE )
        !          10905: to temp1
        !          10906: to temp2
        !          10907: to temp3
        !          10908: 8106002200000000 setup-packet ! 
        !          10909: temp3 setup-packet 6 + w!-le
        !          10910: 0 swap temp3 setup-packet temp2 temp1 controlxfer  
        !          10911: ;
        !          10912: : kbd-init
        !          10913: s" Starting to initialize keyboard" usb-debug-print
        !          10914: s" MPS-INTIN" get-my-property
        !          10915: if
        !          10916: s" not possible" usb-debug-print
        !          10917: else
        !          10918: decode-int nip nip to mps-int-in
        !          10919: then
        !          10920: s" INT-IN-EP-ADDR" get-my-property
        !          10921: if
        !          10922: s" not possible" usb-debug-print
        !          10923: else
        !          10924: decode-int nip nip to int-in-ep
        !          10925: then
        !          10926: 7f alloc-mem to cfg-buffer
        !          10927: s" Allocated buffers!!" usb-debug-print
        !          10928: cfg-buffer 12 8 kbd-addr                   \ get device descriptor
        !          10929: control-std-get-device-descriptor
        !          10930: drop
        !          10931: cfg-buffer 9 8 kbd-addr                    \ get config descriptor  
        !          10932: control-std-get-configuration-descriptor
        !          10933: drop
        !          10934: cfg-buffer 5 + c@ kbd-addr                 \ set configuration  
        !          10935: control-std-set-configuration
        !          10936: drop
        !          10937: s" KBDS: Set config returned" usb-debug-print 
        !          10938: 0 kbd-addr control-cls-set-idle drop       \ set idle  
        !          10939: s" KBDS: Set idle returned" usb-debug-print
        !          10940: cfg-buffer 40 8 kbd-addr                   \ get report descriptor
        !          10941: control-std-get-report-descriptor
        !          10942: drop
        !          10943: s" Finished initializing keyboard" usb-debug-print 
        !          10944: ;
        !          10945: ��������&`&'0usb-mouse.fss" mouse" device-name
        !          10946: s" mouse" device-type
        !          10947: ."   USB Mouse" cr
        !          10948: 1 encode-int s" configuration#" property
        !          10949: 2 encode-int s" #buttons" property
        !          10950: 4 encode-int s" assigned-addresses" property
        !          10951: 2 encode-int s" reg" property
        !          10952: : open true ;
        !          10953: : close ;
        !          10954: : get-event ( msec -- pos.x pos.y buttons true|false )
        !          10955: ;
        !          10956: ��������KHK       0scsi-support.fsvocabulary scsi-words                  \ create new word list named 'scsi-words'
        !          10957: also scsi-words  definitions           \ place next definitions into new list
        !          10958: false  value   scsi-param-debug        \ common debugging flag
        !          10959: d# 0   value   scsi-param-size         \ length of CDB processed last
        !          10960: h# 0   value   scsi-param-control      \ control word for CDBs as defined in SAM-4
        !          10961: d# 0   value   scsi-param-errors       \ counter for detected errors
        !          10962: : scsi-inc-errors
        !          10963: scsi-param-errors 1 + to scsi-param-errors
        !          10964: ;
        !          10965: 00 CONSTANT scsi-cmd-test-unit-ready
        !          10966: STRUCT
        !          10967: /c     FIELD test-unit-ready>operation-code     \ 00h
        !          10968: 4      FIELD test-unit-ready>reserved           \ unused
        !          10969: /c     FIELD test-unit-ready>control            \ control byte as specified in SAM-4
        !          10970: CONSTANT scsi-length-test-unit-ready
        !          10971: : scsi-build-test-unit-ready  ( cdb -- )
        !          10972: dup scsi-length-test-unit-ready erase  ( cdb )
        !          10973: scsi-param-control swap test-unit-ready>control c!  ( )
        !          10974: scsi-length-test-unit-ready to scsi-param-size   \ update CDB length
        !          10975: ;
        !          10976: 03 CONSTANT scsi-cmd-request-sense
        !          10977: STRUCT
        !          10978: /c     FIELD request-sense>operation-code     \ 03h
        !          10979: 3      FIELD request-sense>reserved           \ unused
        !          10980: /c     FIELD request-sense>allocation-length  \ buffer-length for data response
        !          10981: /c     FIELD request-sense>control            \ control byte as specified in SAM-4
        !          10982: CONSTANT scsi-length-request-sense
        !          10983: : scsi-build-request-sense    ( alloc-len cdb -- )
        !          10984: >r                         ( alloc-len )  ( R: -- cdb )
        !          10985: r@ scsi-length-request-sense erase  ( alloc-len )
        !          10986: scsi-cmd-request-sense r@           ( alloc-len cmd cdb )
        !          10987: request-sense>operation-code c!     ( alloc-len )
        !          10988: dup d# 252 >                        \ buffer length too big ?
        !          10989: IF
        !          10990: scsi-inc-errors
        !          10991: drop d# 252                      \ replace with 252
        !          10992: ELSE
        !          10993: dup d# 18 <                      \ allocated buffer too small ?
        !          10994: IF
        !          10995: scsi-inc-errors
        !          10996: drop 0                        \ reject return data
        !          10997: THEN
        !          10998: THEN                                      ( alloclen )
        !          10999: r@ request-sense>allocation-length c!     (  )
        !          11000: scsi-param-control r> request-sense>control c!  ( alloc-len cdb )  ( R: cdb -- )
        !          11001: scsi-length-request-sense to scsi-param-size  \ update CDB length
        !          11002: ;
        !          11003: 70 CONSTANT scsi-response(request-sense-0)
        !          11004: 71 CONSTANT scsi-response(request-sense-1)
        !          11005: STRUCT
        !          11006: /c FIELD sense-data>response-code   \ 70h (current errors) or 71h (deferred errors)
        !          11007: /c FIELD sense-data>obsolete
        !          11008: /c FIELD sense-data>sense-key       \ D3..D0 = sense key, D7 = EndOfMedium
        !          11009: /l FIELD sense-data>info
        !          11010: /c FIELD sense-data>alloc-length    \ <= 244 (for max size)
        !          11011: /l FIELD sense-data>command-info
        !          11012: /c FIELD sense-data>asc             \ additional sense key
        !          11013: /c FIELD sense-data>ascq            \ additional sense key qualifier
        !          11014: /c FIELD sense-data>unit-code
        !          11015: 3  FIELD sense-data>key-specific
        !          11016: /c FIELD sense-data>add-sense-bytes \ start of appended extra bytes
        !          11017: CONSTANT scsi-length-sense-data
        !          11018: : scsi-get-sense-data                  ( addr -- ascq asc sense-key )   
        !          11019: >r                                  ( R: -- addr )
        !          11020: r@ sense-data>response-code c@ 7f and 72 >= IF
        !          11021: r@ 3 + c@                           ( ascq )
        !          11022: r@ 2 + c@                           ( ascq asc ) 
        !          11023: r> 1 + c@ 0f and                    ( ascq asc sense-key )
        !          11024: ELSE
        !          11025: r@ sense-data>ASCQ c@               ( ascq )
        !          11026: r@ sense-data>ASC c@                ( ascq asc )
        !          11027: r> sense-data>sense-key c@ 0f and   ( ascq asc sense-key ) ( R: addr -- )
        !          11028: THEN
        !          11029: ;
        !          11030: : scsi-get-sense-data?                 ( addr -- false | ascq asc sense-key true )
        !          11031: dup
        !          11032: sense-data>response-code c@
        !          11033: 7e AND 70 =          \ Response code (some devices have MSB set)
        !          11034: IF
        !          11035: scsi-get-sense-data TRUE
        !          11036: ELSE
        !          11037: drop FALSE        \ drop addr
        !          11038: THEN
        !          11039: ;
        !          11040: : scsi-get-sense-ID?                 ( addr -- false | ascq asc sense-key true )
        !          11041: dup
        !          11042: sense-data>response-code c@
        !          11043: 7e AND 70 =          \ Response code (some devices have MSB set)
        !          11044: IF
        !          11045: scsi-get-sense-data        ( ascq asc sense-key )
        !          11046: 10 lshift                  ( ascq asc sense-key16 )
        !          11047: swap 8 lshift or           ( ascq sense-key+asc )
        !          11048: swap or                    \ 24-bit sense-ID ( sense-key+asc+ascq )
        !          11049: TRUE
        !          11050: ELSE
        !          11051: drop FALSE        \ drop addr
        !          11052: THEN
        !          11053: ;
        !          11054: 12 CONSTANT scsi-cmd-inquiry
        !          11055: STRUCT
        !          11056: /c     FIELD inquiry>operation-code     \ 0x12
        !          11057: /c     FIELD inquiry>reserved           \ + EVPD-Bit (vital product data)
        !          11058: /c     FIELD inquiry>page-code          \ page code for vital product data (if used)
        !          11059: /w     FIELD inquiry>allocation-length  \ length of Data-In-Buffer
        !          11060: /c     FIELD inquiry>control            \ control byte as specified in SAM-4
        !          11061: CONSTANT scsi-length-inquiry
        !          11062: : scsi-build-inquiry                   ( alloc-len cdb -- )
        !          11063: dup scsi-length-inquiry erase       \ 6 bytes CDB
        !          11064: scsi-cmd-inquiry over                             ( alloc-len cdb cmd cdb )
        !          11065: inquiry>operation-code c!               ( alloc-len cdb )
        !          11066: scsi-param-control over inquiry>control c! ( alloc-len cdb )
        !          11067: inquiry>allocation-length w!         \ size of Data-In Buffer
        !          11068: scsi-length-inquiry to scsi-param-size    \ update CDB length
        !          11069: ;
        !          11070: STRUCT
        !          11071: /c        FIELD inquiry-data>peripheral       \ qualifier and device type
        !          11072: /c        FIELD inquiry-data>reserved1
        !          11073: /c        FIELD inquiry-data>version          \ supported SCSI version (1,2,3)
        !          11074: /c        FIELD inquiry-data>data-format
        !          11075: /c        FIELD inquiry-data>add-length       \ total block length - 4
        !          11076: /c        FIELD inquiry-data>flags1
        !          11077: /c        FIELD inquiry-data>flags2
        !          11078: /c        FIELD inquiry-data>flags3
        !          11079: d# 8   FIELD inquiry-data>vendor-ident     \ vendor string
        !          11080: d# 16  FIELD inquiry-data>product-ident    \ device string
        !          11081: /l     FIELD inquiry-data>product-revision \ revision string
        !          11082: d# 20  FIELD inquiry-data>vendor-specific  \ optional params
        !          11083: CONSTANT scsi-length-inquiry-data
        !          11084: 25 CONSTANT scsi-cmd-read-capacity-10  \ command code
        !          11085: STRUCT                                 \ SCSI 10-byte CDB structure
        !          11086: /c     FIELD read-cap-10>operation-code
        !          11087: /c     FIELD read-cap-10>reserved1
        !          11088: /l     FIELD read-cap-10>lba
        !          11089: /w     FIELD read-cap-10>reserved2
        !          11090: /c     FIELD read-cap-10>reserved3
        !          11091: /c     FIELD read-cap-10>control
        !          11092: CONSTANT scsi-length-read-cap-10
        !          11093: : scsi-build-read-cap-10                     ( cdb -- )
        !          11094: dup scsi-length-read-cap-10 erase         ( cdb )
        !          11095: scsi-cmd-read-capacity-10 over            ( cdb cmd cdb )
        !          11096: read-cap-10>operation-code c!             ( cdb )
        !          11097: scsi-param-control swap read-cap-10>control c! ( )
        !          11098: scsi-length-read-cap-10 to scsi-param-size    \ update CDB length
        !          11099: ;
        !          11100: STRUCT
        !          11101: /l     FIELD read-cap-10-data>max-lba
        !          11102: /l     FIELD read-cap-10-data>block-size
        !          11103: CONSTANT scsi-length-read-cap-10-data
        !          11104: : scsi-get-capacity-10                 ( addr -- block-size #blocks )
        !          11105: >r                                  ( addr -- ) ( R: -- addr )
        !          11106: r@ read-cap-10-data>block-size l@   ( block-size )
        !          11107: r> read-cap-10-data>max-lba l@      ( block-size #blocks ) ( R: addr -- )
        !          11108: ;
        !          11109: 9e CONSTANT scsi-cmd-read-capacity-16        \ command code
        !          11110: STRUCT                                       \ SCSI 16-byte CDB structure
        !          11111: /c     FIELD read-cap-16>operation-code
        !          11112: /c     FIELD read-cap-16>service-action
        !          11113: /l     FIELD read-cap-16>lba-high
        !          11114: /l     FIELD read-cap-16>lba-low
        !          11115: /l     FIELD read-cap-16>allocation-length    \ should be 32
        !          11116: /c     FIELD read-cap-16>reserved
        !          11117: /c     FIELD read-cap-16>control
        !          11118: CONSTANT scsi-length-read-cap-16
        !          11119: : scsi-build-read-cap-16  ( cdb -- )
        !          11120: >r r@                                     ( R: -- cdb )
        !          11121: scsi-length-read-cap-16 erase             (  )
        !          11122: scsi-cmd-read-capacity-16                 ( code )
        !          11123: r@ read-cap-16>operation-code c!          (  )
        !          11124: 10 r@ read-cap-16>service-action c!
        !          11125: d# 32                                     \ response size 32 bytes
        !          11126: r@ read-cap-16>allocation-length l!       (  )
        !          11127: scsi-param-control r> read-cap-16>control c! ( R: cdb -- )
        !          11128: scsi-length-read-cap-16 to scsi-param-size \ update CDB length
        !          11129: ;
        !          11130: STRUCT
        !          11131: /l     FIELD read-cap-16-data>max-lba-high    \ upper quadlet of Max-LBA
        !          11132: /l     FIELD read-cap-16-data>max-lba-low     \ lower quadlet of Max-LBA
        !          11133: /l     FIELD read-cap-16-data>block-size      \ logical block length in bytes
        !          11134: /c     FIELD read-cap-16-data>protect         \ type of protection (4 bits)
        !          11135: /c     FIELD read-cap-16-data>exponent        \ logical blocks per physical blocks
        !          11136: /w     FIELD read-cap-16-data>lowest-aligned  \ first LBA of a phsy. block
        !          11137: 10 FIELD read-cap-16-data>reserved        \ 16 reserved bytes
        !          11138: CONSTANT scsi-length-read-cap-16-data        \ results in 32
        !          11139: : scsi-get-capacity-16                       ( addr -- block-size #blocks )
        !          11140: >r                                        ( R: -- addr )
        !          11141: r@ read-cap-16-data>block-size l@         ( block-size )
        !          11142: r@ read-cap-16-data>max-lba-high l@       ( block-size #blocks-high )
        !          11143: d# 32 lshift                              ( block-size #blocks-upper )
        !          11144: r> read-cap-16-data>max-lba-low l@ +      ( block-size #blocks ) ( R: addr -- )
        !          11145: ;
        !          11146: 5a CONSTANT scsi-cmd-mode-sense-10
        !          11147: STRUCT
        !          11148: /c     FIELD mode-sense-10>operation-code
        !          11149: /c     FIELD mode-sense-10>res-llbaa-dbd-res
        !          11150: /c     FIELD mode-sense-10>pc-page-code       \ page code + page control
        !          11151: /c     FIELD mode-sense-10>sub-page-code
        !          11152: 3      FIELD mode-sense-10>reserved2
        !          11153: /w     FIELD mode-sense-10>allocation-length
        !          11154: /c     FIELD mode-sense-10>control
        !          11155: CONSTANT scsi-length-mode-sense-10
        !          11156: : scsi-build-mode-sense-10                   ( alloc-len subpage page cdb -- )
        !          11157: >r                                        ( alloc-len subpage page ) ( R: -- cdb )
        !          11158: r@ scsi-length-mode-sense-10 erase        \ 10 bytes CDB
        !          11159: scsi-cmd-mode-sense-10                    ( alloc-len subpage page cmd )
        !          11160: r@  mode-sense-10>operation-code c!               ( alloc-len subpage page )
        !          11161: 10 r@ mode-sense-10>res-llbaa-dbd-res c!  \ long LBAs accepted
        !          11162: r@ mode-sense-10>pc-page-code c!                ( alloc-len subpage )
        !          11163: r@ mode-sense-10>sub-page-code c!            ( alloc-len )
        !          11164: r@ mode-sense-10>allocation-length w!     ( )
        !          11165: scsi-param-control r> mode-sense-10>control c!  ( R: cdb -- )
        !          11166: scsi-length-mode-sense-10 to scsi-param-size  \ update CDB length
        !          11167: ;
        !          11168: STRUCT
        !          11169: /w     FIELD mode-sense-10-data>head-length
        !          11170: /c     FIELD mode-sense-10-data>head-medium
        !          11171: /c     FIELD mode-sense-10-data>head-param
        !          11172: /c     FIELD mode-sense-10-data>head-longlba
        !          11173: /c     FIELD mode-sense-10-data>head-reserved
        !          11174: /w     FIELD mode-sense-10-data>head-descr-len
        !          11175: CONSTANT scsi-length-mode-sense-10-data
        !          11176: : .mode-sense-data   ( addr -- )
        !          11177: cr
        !          11178: dup mode-sense-10-data>head-length
        !          11179: w@ ." Mode Length: " .d space
        !          11180: dup mode-sense-10-data>head-medium
        !          11181: c@ ." / Medium Type: " .d space
        !          11182: dup mode-sense-10-data>head-longlba
        !          11183: c@ ." / Long LBA: " .d space
        !          11184: mode-sense-10-data>head-descr-len
        !          11185: w@ ." / Descr. Length: " .d
        !          11186: ;
        !          11187: 08 CONSTANT scsi-cmd-read-6
        !          11188: STRUCT
        !          11189: /c FIELD read-6>operation-code      \ 08h
        !          11190: /c FIELD read-6>block-address-msb   \ upper 5 bits
        !          11191: /w FIELD read-6>block-address       \ lower 16 bits
        !          11192: /c FIELD read-6>length              \ number of blocks to read
        !          11193: /c FIELD read-6>control             \ CDB control
        !          11194: CONSTANT scsi-length-read-6
        !          11195: : scsi-build-read-6                    ( block# #blocks cdb -- )
        !          11196: >r                                  ( block# #blocks ) ( R: -- cdb )
        !          11197: r@ scsi-length-read-6 erase         \ 6 bytes CDB
        !          11198: scsi-cmd-read-6 r@ read-6>operation-code c! ( block# #blocks )
        !          11199: dup d# 255 >                        \ #blocks exceeded limit ?
        !          11200: IF
        !          11201: scsi-inc-errors
        !          11202: drop 1                           \ replace with any valid number
        !          11203: THEN
        !          11204: r@ read-6>length c!                 \ set #blocks to read
        !          11205: dup 1fffff >                        \ check address upper limit
        !          11206: IF
        !          11207: scsi-inc-errors
        !          11208: drop                             \ remove original block#
        !          11209: 1fffff                           \ replace with any valid address
        !          11210: THEN
        !          11211: dup d# 16 rshift
        !          11212: r@ read-6>block-address-msb c!      \ set upper 5 bits
        !          11213: ffff and
        !          11214: r@ read-6>block-address w!                \ set lower 16 bits
        !          11215: scsi-param-control r> read-6>control c!   ( R: cdb -- )
        !          11216: scsi-length-read-6 to scsi-param-size     \ update CDB length
        !          11217: ;
        !          11218: 28 CONSTANT scsi-cmd-read-10
        !          11219: STRUCT
        !          11220: /c FIELD read-10>operation-code
        !          11221: /c FIELD read-10>protect
        !          11222: /l FIELD read-10>block-address      \ logical block address (32bits)
        !          11223: /c FIELD read-10>group
        !          11224: /w FIELD read-10>length             \ transfer length (16-bits)
        !          11225: /c FIELD read-10>control
        !          11226: CONSTANT scsi-length-read-10
        !          11227: : scsi-build-read-10                         ( block# #blocks cdb -- )
        !          11228: >r                                        ( block# #blocks )  ( R: -- cdb )
        !          11229: r@ scsi-length-read-10 erase             \ 10 bytes CDB
        !          11230: scsi-cmd-read-10 r@ read-10>operation-code c! ( block# #blocks )
        !          11231: r@ read-10>length w!                      ( block# )
        !          11232: r@ read-10>block-address l!               (  )
        !          11233: scsi-param-control r> read-10>control c!  ( R: cdb -- )
        !          11234: scsi-length-read-10 to scsi-param-size    \ update CDB length
        !          11235: ;
        !          11236: a8 CONSTANT scsi-cmd-read-12
        !          11237: STRUCT
        !          11238: /c FIELD read-12>operation-code     \ code: a8
        !          11239: /c FIELD read-12>protect            \ RDPROTECT, DPO, FUA, FUA_NV
        !          11240: /l FIELD read-12>block-address      \ lba
        !          11241: /l FIELD read-12>length             \ transfer length (32bits)
        !          11242: /c FIELD read-12>group              \ group number
        !          11243: /c FIELD read-12>control
        !          11244: CONSTANT scsi-length-read-12
        !          11245: : scsi-build-read-12                         ( block# #blocks cdb -- )
        !          11246: >r                                        ( block# #blocks )  ( R: -- cdb )
        !          11247: r@ scsi-length-read-12 erase             \ 12 bytes CDB
        !          11248: scsi-cmd-read-12 r@ read-12>operation-code c! ( block# #blocks )
        !          11249: r@ read-12>length l!                      ( block# )
        !          11250: r@ read-12>block-address l!               (  )
        !          11251: scsi-param-control r> read-12>control c!  ( R: cdb -- )
        !          11252: scsi-length-read-12 to scsi-param-size    \ update CDB length
        !          11253: ;
        !          11254: : scsi-build-read?   ( block# #blocks cdb -- length )
        !          11255: over              ( block# #blocks cdb #blocks )
        !          11256: fffe >            \ tx-length (#blocks) exceeds 16-bit limit ?
        !          11257: IF
        !          11258: scsi-build-read-12   ( block# #blocks cdb -- )
        !          11259: scsi-length-read-12  ( length )
        !          11260: ELSE                    ( block# #blocks cdb )
        !          11261: scsi-build-read-10   ( block# #blocks cdb -- )
        !          11262: scsi-length-read-10  ( length )
        !          11263: THEN
        !          11264: ;
        !          11265: 1b CONSTANT scsi-cmd-start-stop-unit
        !          11266: STRUCT
        !          11267: /c FIELD start-stop-unit>operation-code
        !          11268: /c FIELD start-stop-unit>immed
        !          11269: /w FIELD start-stop-unit>reserved
        !          11270: /c FIELD start-stop-unit>pow-condition
        !          11271: /c FIELD start-stop-unit>control
        !          11272: CONSTANT scsi-length-start-stop-unit
        !          11273: f1 CONSTANT scsi-const-active-power    \ param used for start-stop-unit
        !          11274: f2 CONSTANT scsi-const-idle-power      \ param used for start-stop-unit
        !          11275: f3 CONSTANT scsi-const-standby-power   \ param used for start-stop-unit
        !          11276: 3  CONSTANT scsi-const-load            \ param used for start-stop-unit
        !          11277: 2  CONSTANT scsi-const-eject           \ param used for start-stop-unit
        !          11278: 1  CONSTANT scsi-const-start
        !          11279: 0  CONSTANT scsi-const-stop
        !          11280: : scsi-build-start-stop-unit                 ( state# cdb -- )
        !          11281: >r                                        ( state# )  ( R: -- cdb )
        !          11282: r@ scsi-length-start-stop-unit erase      \ 6 bytes CDB
        !          11283: scsi-cmd-start-stop-unit r@ start-stop-unit>operation-code c!
        !          11284: dup 3 >
        !          11285: IF
        !          11286: 4 lshift                         \ shift to upper nibble
        !          11287: THEN                                ( state )
        !          11288: r@ start-stop-unit>pow-condition c!       (  )
        !          11289: scsi-param-control r> start-stop-unit>control c!  ( R: cdb -- )
        !          11290: scsi-length-start-stop-unit to scsi-param-size  \ update CDB length
        !          11291: ;
        !          11292: 2b CONSTANT scsi-cmd-seek
        !          11293: STRUCT
        !          11294: /c FIELD seek>operation-code
        !          11295: /c FIELD seek>reserved1
        !          11296: /l FIELD seek>lba
        !          11297: 3  FIELD seek>reserved2
        !          11298: /c FIELD seek>control
        !          11299: CONSTANT scsi-length-seek
        !          11300: : scsi-build-seek  ( lba cdb -- )
        !          11301: >r              ( lba )  ( R: -- cdb )
        !          11302: r@ scsi-length-seek erase           \ 10 bytes CDB
        !          11303: scsi-cmd-seek r@ seek>operation-code c!
        !          11304: r> seek>lba l!  (  )  ( R: cdb -- )
        !          11305: scsi-length-seek to scsi-param-size \ update CDB length
        !          11306: ;
        !          11307: STRUCT
        !          11308: /w FIELD media-event-data-len
        !          11309: /c FIELD media-event-nea-class
        !          11310: /c FIELD media-event-supp-class
        !          11311: /l FIELD media-event-data
        !          11312: CONSTANT scsi-length-media-event
        !          11313: : scsi-build-get-media-event                     ( cdb -- )
        !          11314: dup c erase                                     ( cdb )
        !          11315: 4a over c!                                      ( cdb )
        !          11316: 01 over 1 + c!
        !          11317: 10 over 4 + c!
        !          11318: 08 over 8 + c!
        !          11319: drop
        !          11320: ;
        !          11321: : .sense-text ( scode -- )
        !          11322: case
        !          11323: 0    OF s" OK"               ENDOF
        !          11324: 1    OF s" RECOVERED ERR"    ENDOF
        !          11325: 2    OF s" NOT READY"        ENDOF
        !          11326: 3    OF s" MEDIUM ERROR"     ENDOF
        !          11327: 4    OF s" HARDWARE ERR"     ENDOF
        !          11328: 5    OF s" ILLEGAL REQUEST"  ENDOF
        !          11329: 6    OF s" UNIT ATTENTION"   ENDOF
        !          11330: 7    OF s" DATA PROTECT"     ENDOF
        !          11331: 8    OF s" BLANK CHECK"      ENDOF
        !          11332: 9    OF s" VENDOR SPECIFIC"  ENDOF
        !          11333: a    OF s" COPY ABORTED"     ENDOF
        !          11334: b    OF s" ABORTED COMMAND"  ENDOF
        !          11335: d    OF s" VOLUME OVERFLOW"  ENDOF
        !          11336: e    OF s" MISCOMPARE"       ENDOF
        !          11337: dup  OF s" UNKNOWN"          ENDOF
        !          11338: endcase
        !          11339: 5b emit type 5d emit
        !          11340: ;
        !          11341: : .status-text  ( stat -- )
        !          11342: case
        !          11343: 00  OF s" GOOD"                  ENDOF
        !          11344: 02  OF s" CHECK CONDITION"       ENDOF
        !          11345: 04  OF s" CONDITION MET"         ENDOF
        !          11346: 08  OF s" BUSY"                  ENDOF
        !          11347: 18  OF s" RESERVATION CONFLICT"  ENDOF
        !          11348: 28  OF s" TASK SET FULL"         ENDOF
        !          11349: 30  OF s" ACA ACTIVE"            ENDOF
        !          11350: 40  OF s" TASK ABORTED"          ENDOF
        !          11351: dup OF s" UNKNOWN"               ENDOF
        !          11352: endcase
        !          11353: 5b emit type 5d emit
        !          11354: ;
        !          11355: : .dec3-2 ( prenum postnum -- )
        !          11356: swap
        !          11357: base @ >r                           \ save actual base setting
        !          11358: decimal                             \ show decimal values
        !          11359: 4 .r 2e emit
        !          11360: dup 9 <= IF 30 emit THEN .d         \ 3 pre-decimal, right aligned
        !          11361: r> base !                           \ restore base
        !          11362: ;
        !          11363: : .capacity-text  ( block-size #blocks -- )
        !          11364: scsi-param-debug                    \ debugging flag set ?
        !          11365: IF                                  \ show additional info
        !          11366: 2dup
        !          11367: cr
        !          11368: ." LBAs: " .d                    \ highest logical block number
        !          11369: ." / Block-Size: " .d
        !          11370: ." / Total Capacity: "
        !          11371: THEN
        !          11372: *                                   \ calculate total capacity
        !          11373: dup d# 1000000000000 >=             \ check terabyte limit
        !          11374: IF
        !          11375: d# 1000000000000 /mod
        !          11376: swap
        !          11377: d# 10000000000 /                 \ limit remainder to two digits
        !          11378: .dec3-2 ." TB"                   \ show terabytes as xxx.yy
        !          11379: ELSE
        !          11380: dup d# 1000000000 >=             \ check gigabyte limit
        !          11381: IF
        !          11382: d# 1000000000 /mod
        !          11383: swap
        !          11384: d# 10000000 /
        !          11385: .dec3-2 ." GB"                \ show gigabytes as xxx.yy
        !          11386: ELSE
        !          11387: dup d# 1000000 >=
        !          11388: IF
        !          11389: d# 1000000 /mod            \ check mega byte limit
        !          11390: swap
        !          11391: d# 10000 /
        !          11392: .dec3-2 ." MB"             \ show megabytes as xxx.yy
        !          11393: ELSE
        !          11394: dup d# 1000 >=             \ check kilo byte limit
        !          11395: IF
        !          11396: d# 1000 /mod
        !          11397: swap
        !          11398: d# 10 /
        !          11399: .dec3-2 ." kB"
        !          11400: ELSE
        !          11401: .d ."  Bytes"
        !          11402: THEN
        !          11403: THEN
        !          11404: THEN
        !          11405: THEN
        !          11406: ;
        !          11407: : .inquiry-text  ( addr -- )
        !          11408: 22 emit     \ enclose text with "
        !          11409: dup inquiry-data>vendor-ident      8 type space
        !          11410: dup inquiry-data>product-ident    10 type space
        !          11411: inquiry-data>product-revision  4 type
        !          11412: 22 emit
        !          11413: ;
        !          11414: : scsi-supp-init  ( -- )
        !          11415: false   to scsi-param-debug         \ no debug strings
        !          11416: h# 0   to scsi-param-size
        !          11417: h# 0   to scsi-param-control        \ common CDB control byte
        !          11418: d# 0   to scsi-param-errors         \ local errors (param limits)
        !          11419: ;
        !          11420: 0 VALUE scsi-context                   \ addr of word list on top
        !          11421: : scsi-init  ( -- )
        !          11422: also scsi-words                     \ append scsi word-list
        !          11423: context  to scsi-context            \ save for close process
        !          11424: scsi-supp-init                      \ preset all scsi-param-xxx values
        !          11425: scsi-param-debug
        !          11426: IF
        !          11427: space ." SCSI-SUPPORT OPENED" cr
        !          11428: .wordlists
        !          11429: THEN
        !          11430: ;
        !          11431: : scsi-close  ( -- )
        !          11432: scsi-param-debug
        !          11433: IF
        !          11434: space ." Closing SCSI-SUPPORT .. " cr
        !          11435: THEN
        !          11436: context scsi-context =              \ scsi word list still active ?
        !          11437: IF
        !          11438: scsi-param-errors 0<>          \ any errors occured ?
        !          11439: IF
        !          11440: cr ." ** WARNING: " scsi-param-errors .d
        !          11441: ." SCSI Errors occured ** " cr
        !          11442: THEN
        !          11443: previous                         \ remove scsi word list on top
        !          11444: 0 to scsi-context                \ prevent from being misinterpreted
        !          11445: ELSE
        !          11446: cr ." ** WARNING: Trying to close non-open SCSI-SUPPORT (1) ** " cr
        !          11447: THEN
        !          11448: scsi-param-debug
        !          11449: IF
        !          11450: .wordlists
        !          11451: THEN
        !          11452: ;
        !          11453: s" scsi-init" $find drop               \ return execution pointer, when included
        !          11454: previous                               \ remove scsi word list from search path
        !          11455: definitions                            \ place next definitions into previous list
        !          11456: ��������&p&80vio-hvterm.fs." Populating " pwd cr
        !          11457: : open true ;
        !          11458: : close ;
        !          11459: : write ( adr len -- actual )  tuck type ;
        !          11460: : read  ( adr len -- actual )
        !          11461: 0= IF drop 0 EXIT THEN
        !          11462: hvterm-key? 0= IF 0 swap c! -2 EXIT THEN
        !          11463: hvterm-key swap c! 1
        !          11464: ;
        !          11465: : setup-alias
        !          11466: " hvterm" find-alias 0= IF
        !          11467: " hvterm" get-node node>path set-alias
        !          11468: ELSE THEN 
        !          11469: ;
        !          11470: setup-alias
        !          11471: ��������,+�0vio-vscsi.fs." Populating " pwd
        !          11472: 0 CONSTANT vscsi-debug
        !          11473: 0 VALUE vscsi-unit
        !          11474: : l2dma ( laddr - dma_addr)      
        !          11475: ;
        !          11476: 0    VALUE     crq-base
        !          11477: 0    VALUE     crq-dma
        !          11478: 0    VALUE     crq-offset
        !          11479: 1000 CONSTANT  CRQ-SIZE
        !          11480: CREATE crq 10 allot
        !          11481: : crq-alloc ( -- )
        !          11482: CRQ-SIZE alloc-mem to crq-base 0 to crq-offset
        !          11483: crq-base l2dma to crq-dma
        !          11484: ;
        !          11485: : crq-free ( -- )
        !          11486: vscsi-unit hv-free-crq
        !          11487: crq-base CRQ-SIZE free-mem 0 to crq-base
        !          11488: ;
        !          11489: : crq-init ( -- res )
        !          11490: crq-alloc
        !          11491: vscsi-debug IF
        !          11492: ." VSCSI: allocated crq at " crq-base . cr
        !          11493: THEN
        !          11494: crq-base CRQ-SIZE erase
        !          11495: vscsi-unit crq-dma CRQ-SIZE hv-reg-crq
        !          11496: dup 0 <> IF
        !          11497: ." VSCSI: Error " . ."  registering CRQ !" cr
        !          11498: crq-free
        !          11499: THEN
        !          11500: ;
        !          11501: : crq-cleanup ( -- )
        !          11502: crq-base 0 = IF EXIT THEN
        !          11503: vscsi-debug IF
        !          11504: ." VSCSI: freeing crq at " crq-base . cr
        !          11505: THEN
        !          11506: crq-free
        !          11507: ;
        !          11508: : crq-send ( msgaddr -- true | false )
        !          11509: vscsi-unit swap hv-send-crq 0 =
        !          11510: ;
        !          11511: : crq-poll ( -- true | false)
        !          11512: crq-offset crq-base + dup
        !          11513: vscsi-debug IF
        !          11514: ." VSCSI: crq poll " dup .
        !          11515: THEN
        !          11516: c@
        !          11517: vscsi-debug IF
        !          11518: ."  value=" dup . cr
        !          11519: THEN
        !          11520: 80 and 0 <> IF
        !          11521: dup crq 10 move
        !          11522: 0 swap c!
        !          11523: crq-offset 10 + dup CRQ-SIZE >= IF drop 0 THEN to crq-offset
        !          11524: true
        !          11525: ELSE drop false THEN
        !          11526: ;
        !          11527: : crq-wait ( -- true | false)
        !          11528: 0 BEGIN drop crq-poll dup not WHILE d# 1 ms REPEAT
        !          11529: dup not IF
        !          11530: ." VSCSI: Timeout waiting response !" cr EXIT
        !          11531: ELSE
        !          11532: vscsi-debug IF
        !          11533: ." VSCSI: got crq: " crq dup l@ . ."  " 4 + dup l@ . ."  "
        !          11534: 4 + dup l@ . ."  " 4 + l@ . cr
        !          11535: THEN
        !          11536: THEN
        !          11537: ;
        !          11538: 01 CONSTANT VIOSRP_SRP_FORMAT
        !          11539: 02 CONSTANT VIOSRP_MAD_FORMAT
        !          11540: 03 CONSTANT VIOSRP_OS400_FORMAT
        !          11541: 04 CONSTANT VIOSRP_AIX_FORMAT
        !          11542: 06 CONSTANT VIOSRP_LINUX_FORMAT
        !          11543: 07 CONSTANT VIOSRP_INLINE_FORMAT
        !          11544: struct
        !          11545: 1 field >crq-valid
        !          11546: 1 field >crq-format
        !          11547: 1 field >crq-reserved
        !          11548: 1 field >crq-status
        !          11549: 2 field >crq-timeout
        !          11550: 2 field >crq-iu-len
        !          11551: 8 field >crq-iu-data-ptr
        !          11552: constant /crq
        !          11553: : srp-send-crq ( addr len -- )
        !          11554: 80                crq >crq-valid c!
        !          11555: VIOSRP_SRP_FORMAT crq >crq-format c!
        !          11556: 0                 crq >crq-reserved c!
        !          11557: 0                 crq >crq-status c!
        !          11558: 0                 crq >crq-timeout w!
        !          11559: ( len )           crq >crq-iu-len w!
        !          11560: ( addr ) l2dma    crq >crq-iu-data-ptr x!
        !          11561: crq crq-send
        !          11562: not IF
        !          11563: ." VSCSI: Error sending CRQ !" cr
        !          11564: THEN
        !          11565: ;
        !          11566: : srp-wait-crq ( -- [tag true] | false )
        !          11567: crq-wait not IF false EXIT THEN
        !          11568: crq >crq-format c@ VIOSRP_SRP_FORMAT <> IF
        !          11569: ." VSCSI: Unsupported SRP response: "
        !          11570: crq >crq-format c@ . cr
        !          11571: false EXIT
        !          11572: THEN
        !          11573: crq >crq-iu-data-ptr x@ true
        !          11574: ;
        !          11575: scsi-open
        !          11576: 0 VALUE >srp_opcode
        !          11577: 00 CONSTANT SRP_LOGIN_REQ
        !          11578: 01 CONSTANT SRP_TSK_MGMT
        !          11579: 02 CONSTANT SRP_CMD
        !          11580: 03 CONSTANT SRP_I_LOGOUT
        !          11581: c0 CONSTANT SRP_LOGIN_RSP
        !          11582: c1 CONSTANT SRP_RSP
        !          11583: c2 CONSTANT SRP_LOGIN_REJ
        !          11584: 80 CONSTANT SRP_T_LOGOUT
        !          11585: 81 CONSTANT SRP_CRED_REQ
        !          11586: 82 CONSTANT SRP_AER_REQ
        !          11587: 41 CONSTANT SRP_CRED_RSP
        !          11588: 42 CONSTANT SRP_AER_RSP
        !          11589: 02 CONSTANT SRP_BUF_FORMAT_DIRECT
        !          11590: 04 CONSTANT SRP_BUF_FORMAT_INDIRECT
        !          11591: struct
        !          11592: 1 field >srp-login-opcode
        !          11593: 3 +
        !          11594: 8 field >srp-login-tag
        !          11595: 4 field >srp-login-req-it-iu-len
        !          11596: 4 +
        !          11597: 2 field >srp-login-req-buf-fmt
        !          11598: 1 field >srp-login-req-flags
        !          11599: 5 +
        !          11600: 10 field >srp-login-init-port-ids
        !          11601: 10 field >srp-login-trgt-port-ids
        !          11602: constant /srp-login
        !          11603: struct
        !          11604: 1 field >srp-lresp-opcode
        !          11605: 3 +
        !          11606: 4 field >srp-lresp-req-lim-delta
        !          11607: 8 field >srp-lresp-tag
        !          11608: 4 field >srp-lresp-max-it-iu-len
        !          11609: 4 field >srp-lresp-max-ti-iu-len
        !          11610: 2 field >srp-lresp-buf-fmt
        !          11611: 1 field >srp-lresp-flags
        !          11612: constant /srp-login-resp
        !          11613: struct
        !          11614: 1 field >srp-lrej-opcode
        !          11615: 3 +
        !          11616: 4 field >srp-lrej-reason
        !          11617: 8 field >srp-lrej-tag
        !          11618: 8 +
        !          11619: 2 field >srp-lrej-buf-fmt
        !          11620: constant /srp-login-rej
        !          11621: 00 CONSTANT SRP_NO_DATA_DESC
        !          11622: 01 CONSTANT SRP_DATA_DESC_DIRECT
        !          11623: 02 CONSTANT SRP_DATA_DESC_INDIRECT
        !          11624: struct
        !          11625: 1 field >srp-cmd-opcode
        !          11626: 1 field >srp-cmd-sol-not
        !          11627: 3 +
        !          11628: 1 field >srp-cmd-buf-fmt
        !          11629: 1 field >srp-cmd-dout-desc-cnt
        !          11630: 1 field >srp-cmd-din-desc-cnt
        !          11631: 8 field >srp-cmd-tag
        !          11632: 4 +
        !          11633: 8 field >srp-cmd-lun
        !          11634: 1 +
        !          11635: 1 field >srp-cmd-task-attr
        !          11636: 1 +
        !          11637: 1 field >srp-cmd-add-cdb-len
        !          11638: 10 field >srp-cmd-cdb
        !          11639: 0 field >srp-cmd-cdb-add
        !          11640: constant /srp-cmd
        !          11641: struct
        !          11642: 1 field >srp-rsp-opcode
        !          11643: 1 field >srp-rsp-sol-not
        !          11644: 2 +
        !          11645: 4 field >srp-rsp-req-lim-delta
        !          11646: 8 field >srp-rsp-tag
        !          11647: 2 +
        !          11648: 1 field >srp-rsp-flags
        !          11649: 1 field >srp-rsp-status
        !          11650: 4 field >srp-rsp-dout-res-cnt
        !          11651: 4 field >srp-rsp-din-res-cnt
        !          11652: 4 field >srp-rsp-sense-len
        !          11653: 4 field >srp-rsp-resp-len
        !          11654: 0 field >srp-rsp-data
        !          11655: constant /srp-rsp
        !          11656: CREATE srp 100 allot
        !          11657: 0 VALUE srp-len
        !          11658: : srp-prep-cmd-nodata ( id lun -- )
        !          11659: srp /srp-cmd erase
        !          11660: SRP_CMD srp >srp-cmd-opcode c!
        !          11661: 1 srp >srp-cmd-tag x!
        !          11662: srp >srp-cmd-lun 1 + c!        \ lun
        !          11663: srp >srp-cmd-lun c!            \ id
        !          11664: /srp-cmd to srp-len   
        !          11665: ;
        !          11666: : srp-prep-cmd-io ( addr len id lun -- )
        !          11667: srp-prep-cmd-nodata            ( addr len )
        !          11668: swap l2dma                     ( len dmaaddr )
        !          11669: srp srp-len +                  ( len dmaaddr descaddr )
        !          11670: dup >r x! r> 8 +               ( len descaddr+8 )
        !          11671: dup 0 swap l! 4 +              ( len descaddr+c )
        !          11672: l!    
        !          11673: srp-len 10 + to srp-len
        !          11674: ;
        !          11675: : srp-prep-cmd-read ( addr len id lun -- )
        !          11676: srp-prep-cmd-io
        !          11677: 01 srp >srp-cmd-buf-fmt c!     \ in direct buffer
        !          11678: 1 srp >srp-cmd-din-desc-cnt c!
        !          11679: ;
        !          11680: : srp-prep-cmd-write ( addr len id lun -- )
        !          11681: srp-prep-cmd-io
        !          11682: 10 srp >srp-cmd-buf-fmt c!     \ out direct buffer
        !          11683: 1 srp >srp-cmd-dout-desc-cnt c!
        !          11684: ;
        !          11685: : srp-send-cmd ( -- )
        !          11686: vscsi-debug IF
        !          11687: ." VSCSI: Sending SCSI cmd " srp >srp-cmd-cdb c@ . cr
        !          11688: THEN
        !          11689: srp srp-len srp-send-crq
        !          11690: ;
        !          11691: : srp-rsp-find-sense ( -- addr )
        !          11692: srp >srp-rsp-data
        !          11693: ;
        !          11694: : srp-wait-rsp ( -- true | [ ascq asc sense-key false ] )
        !          11695: srp-wait-crq not IF false EXIT THEN
        !          11696: dup 1 <> IF
        !          11697: ." VSCSI: Invalid CRQ response tag, want 1 got " . cr
        !          11698: false EXIT
        !          11699: THEN drop
        !          11700: srp >srp-rsp-tag x@ dup 1 <> IF
        !          11701: ." VSCSI: Invalid SRP response tag, want 1 got " . cr
        !          11702: false EXIT
        !          11703: THEN drop
        !          11704: srp >srp-rsp-status c@
        !          11705: vscsi-debug IF
        !          11706: ." VSCSI: Got response status: "
        !          11707: dup .status-text cr
        !          11708: THEN
        !          11709: 0 <> IF
        !          11710: srp-rsp-find-sense
        !          11711: scsi-get-sense-data
        !          11712: vscsi-debug IF
        !          11713: ." VSCSI: Sense key: " dup .sense-text cr         
        !          11714: THEN
        !          11715: false EXIT
        !          11716: THEN
        !          11717: true
        !          11718: ;
        !          11719: CREATE sector d# 512 allot
        !          11720: 0 VALUE current-id
        !          11721: 0 VALUE current-lun
        !          11722: : test-unit-ready ( -- true | [ ascq asc sense-key false ] )
        !          11723: current-id current-lun srp-prep-cmd-nodata
        !          11724: srp >srp-cmd-cdb scsi-build-test-unit-ready
        !          11725: srp-send-cmd
        !          11726: srp-wait-rsp
        !          11727: ;
        !          11728: : inquiry ( -- true | false )
        !          11729: sector ff current-id current-lun srp-prep-cmd-read
        !          11730: ff srp >srp-cmd-cdb scsi-build-inquiry
        !          11731: srp-send-cmd
        !          11732: srp-wait-rsp
        !          11733: dup not IF nip nip nip EXIT THEN \ swallow sense
        !          11734: ;
        !          11735: : read-capacity ( -- true | false )
        !          11736: sector scsi-length-read-cap-10 current-id current-lun srp-prep-cmd-read
        !          11737: srp >srp-cmd-cdb scsi-build-read-cap-10
        !          11738: srp-send-cmd
        !          11739: srp-wait-rsp
        !          11740: dup not IF nip nip nip EXIT THEN \ swallow sense    
        !          11741: ;
        !          11742: : start-stop-unit ( state# -- true | false )
        !          11743: current-id current-lun srp-prep-cmd-nodata
        !          11744: srp >srp-cmd-cdb scsi-build-start-stop-unit
        !          11745: srp-send-cmd
        !          11746: srp-wait-rsp
        !          11747: dup not IF nip nip nip EXIT THEN \ swallow sense    
        !          11748: ;
        !          11749: : get-media-event ( -- true | false )
        !          11750: sector scsi-length-media-event current-id current-lun srp-prep-cmd-read
        !          11751: srp >srp-cmd-cdb scsi-build-get-media-event
        !          11752: srp-send-cmd
        !          11753: srp-wait-rsp
        !          11754: dup not IF nip nip nip EXIT THEN \ swallow sense    
        !          11755: ;
        !          11756: : read-blocks ( -- addr block# #blocks blksz -- [ #read-blocks true ] | false )
        !          11757: over *                                         ( addr block# #blocks len )    
        !          11758: >r rot r>                                      ( block# #blocks addr len )
        !          11759: 5 0 DO
        !          11760: 2dup current-id current-lun
        !          11761: srp-prep-cmd-read                       ( block# #blocks addr len )
        !          11762: 2swap                                  ( addr len block# #blocks )
        !          11763: 2dup srp >srp-cmd-cdb scsi-build-read-10 ( addr len block# #blocks )
        !          11764: 2swap                                   ( block# #blocks addr len )
        !          11765: srp-send-cmd
        !          11766: srp-wait-rsp
        !          11767: IF 2drop nip true UNLOOP EXIT THEN
        !          11768: srp >srp-rsp-status c@ 8 <> IF
        !          11769: nip nip nip 2drop 2drop false EXIT
        !          11770: THEN
        !          11771: 3drop
        !          11772: 100 ms
        !          11773: LOOP
        !          11774: 2drop 2drop false
        !          11775: ;
        !          11776: : vscsi-cleanup
        !          11777: ." VSCSI: Cleaning up" cr
        !          11778: crq-cleanup
        !          11779: vscsi-unit 0 rtas-set-tce-bypass
        !          11780: ;
        !          11781: : vscsi-init ( -- true | false )
        !          11782: ." VSCSI: Initializing" cr
        !          11783: " reg" get-node get-package-property IF
        !          11784: ." VSCSI: Not reg property !!!" 0
        !          11785: THEN
        !          11786: decode-int to vscsi-unit 2drop
        !          11787: vscsi-unit 1 rtas-set-tce-bypass
        !          11788: crq-init 0 <> IF false EXIT THEN
        !          11789: " "(C0 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00)" drop
        !          11790: crq-send not IF
        !          11791: ." VSCSI: Error sending init command"
        !          11792: crq-cleanup false EXIT
        !          11793: THEN
        !          11794: crq-wait not IF
        !          11795: crq-cleanup false EXIT
        !          11796: THEN
        !          11797: crq c@ c0 <> crq 1 + c@ 02 <> or IF
        !          11798: ." VSCSI: Initial handshake failed"
        !          11799: crq-cleanup false EXIT
        !          11800: THEN
        !          11801: ['] vscsi-cleanup add-quiesce-xt
        !          11802: true
        !          11803: ;
        !          11804: 0 INSTANCE VALUE target-id
        !          11805: 0 INSTANCE VALUE target-lun
        !          11806: : set-address ( lun id -- )
        !          11807: to target-id to target-lun 
        !          11808: ;
        !          11809: : dev-max-transfer ( -- n )
        !          11810: 10000 \ Larger value seem to have problems with some CDROMs
        !          11811: ;
        !          11812: : dev-get-capacity ( -- blocksize #blocks )
        !          11813: target-id to current-id target-lun to current-lun
        !          11814: read-capacity not IF 0 0 EXIT THEN
        !          11815: sector scsi-get-capacity-10
        !          11816: ;
        !          11817: : dev-read-blocks ( -- addr block# #blocks blksize -- #read-blocks )
        !          11818: target-id to current-id target-lun to current-lun
        !          11819: read-blocks    
        !          11820: ;
        !          11821: : initial-test-unit-ready ( -- true | [ ascq asc sense-key false ] )
        !          11822: 0 0 0 false
        !          11823: 3 0 DO
        !          11824: 2drop 2drop
        !          11825: test-unit-ready dup IF UNLOOP EXIT THEN
        !          11826: LOOP    
        !          11827: ;
        !          11828: : compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false )
        !          11829: 3 pick =           ( ascq asc key ascq2 asc2 keycmp )
        !          11830: swap 4 pick =   ( ascq asc key ascq2 keycmp asccmp )
        !          11831: rot 5 pick =    ( ascq asc key keycmp asccmp ascqcmp )
        !          11832: and and nip nip nip
        !          11833: ;
        !          11834: 0 CONSTANT CDROM-READY
        !          11835: 1 CONSTANT CDROM-NOT-READY
        !          11836: 2 CONSTANT CDROM-NO-DISK
        !          11837: 3 CONSTANT CDROM-TRAY-OPEN
        !          11838: 4 CONSTANT CDROM-INIT-REQUIRED
        !          11839: 5 CONSTANT CDROM-TRAY-MAYBE-OPEN
        !          11840: : cdrom-status ( -- status )
        !          11841: initial-test-unit-ready
        !          11842: IF CDROM-READY EXIT THEN
        !          11843: vscsi-debug IF
        !          11844: ." TestUnitReady sense: " 3dup . . . cr
        !          11845: THEN
        !          11846: 3dup 1 4 2 compare-sense IF
        !          11847: 3drop CDROM-NOT-READY EXIT
        !          11848: THEN
        !          11849: get-media-event IF
        !          11850: sector w@ 4 >= IF
        !          11851: sector 2 + c@ 04 = IF
        !          11852: sector 5 + c@
        !          11853: dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN
        !          11854: dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN
        !          11855: drop 3drop CDROM-NO-DISK EXIT
        !          11856: THEN
        !          11857: THEN
        !          11858: THEN
        !          11859: 3dup 2 4 2 compare-sense IF
        !          11860: 3drop CDROM-INIT-REQUIRED EXIT
        !          11861: THEN
        !          11862: over 4 = over 2 = and IF
        !          11863: 3drop CDROM-READY EXIT
        !          11864: THEN
        !          11865: over 3a = IF
        !          11866: 3drop CDROM-NO-DISK EXIT
        !          11867: THEN
        !          11868: 3drop CDROM-TRAY-MAYBE-OPEN    
        !          11869: ;
        !          11870: : cdrom-try-close-tray ( -- )
        !          11871: scsi-const-load start-stop-unit drop
        !          11872: ;
        !          11873: : cdrom-must-close-tray ( -- )
        !          11874: scsi-const-load start-stop-unit not IF
        !          11875: ." Tray open !" cr -65 throw
        !          11876: THEN
        !          11877: ;
        !          11878: : dev-prep-cdrom ( -- )
        !          11879: target-id to current-id target-lun to current-lun
        !          11880: 5 0 DO
        !          11881: cdrom-status CASE
        !          11882: CDROM-READY           OF UNLOOP EXIT ENDOF
        !          11883: CDROM-NO-DISK         OF ." No medium !" cr -65 THROW ENDOF
        !          11884: CDROM-TRAY-OPEN       OF cdrom-must-close-tray ENDOF
        !          11885: CDROM-INIT-REQUIRED   OF cdrom-try-close-tray ENDOF
        !          11886: CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF
        !          11887: ENDCASE
        !          11888: d# 1000 ms
        !          11889: LOOP
        !          11890: ." Drive not ready !" cr -65 THROW
        !          11891: ;
        !          11892: : dev-prep-disk ( -- )
        !          11893: ;
        !          11894: : vscsi-create-disk    ( lun id -- )
        !          11895: " disk" 0 " vio-vscsi-device.fs" included
        !          11896: ;
        !          11897: : vscsi-create-cdrom   ( lun id -- )
        !          11898: " cdrom" 1 " vio-vscsi-device.fs" included
        !          11899: ;
        !          11900: : wrapped-inquiry ( -- true | false )
        !          11901: inquiry not IF false EXIT THEN
        !          11902: sector inquiry-data>peripheral c@ e0 and 0 =
        !          11903: ;
        !          11904: 8 CONSTANT #dev
        !          11905: : vscsi-find-disks      ( -- )   
        !          11906: ." VSCSI: Looking for disks" cr
        !          11907: #dev 0 DO                                      \ check 8 devices (no LUNs)
        !          11908: i to current-id 0 to current-lun
        !          11909: wrapped-inquiry IF     
        !          11910: ."   SCSI ID " i .
        !          11911: sector inquiry-data>peripheral c@ CASE
        !          11912: 0   OF ." DISK     : " 0 i vscsi-create-disk  ENDOF
        !          11913: 5   OF ." CD-ROM   : " 0 i vscsi-create-cdrom ENDOF
        !          11914: 7   OF ." OPTICAL  : " 0 i vscsi-create-cdrom ENDOF
        !          11915: e   OF ." RED-BLOCK: " 0 i vscsi-create-disk  ENDOF
        !          11916: dup dup OF ." ? (" . 8 emit 29 emit 5 spaces ENDOF
        !          11917: ENDCASE
        !          11918: sector .inquiry-text cr
        !          11919: THEN
        !          11920: LOOP
        !          11921: ;
        !          11922: scsi-close
        !          11923: : setup-alias
        !          11924: " scsi" find-alias 0= IF
        !          11925: " scsi" get-node node>path set-alias
        !          11926: ELSE THEN 
        !          11927: ;
        !          11928: : vscsi-init-and-scan  ( -- )
        !          11929: vscsi-init IF
        !          11930: vscsi-find-disks
        !          11931: setup-alias
        !          11932: THEN
        !          11933: ;
        !          11934: vscsi-init-and-scan
        !          11935: ��������H8vio-vscsi-device.fsnew-device
        !          11936: VALUE is_cdrom
        !          11937: 2swap  ( $name lun id )
        !          11938: 2dup set-unit encode-phys " reg" property
        !          11939: 2dup device-name
        !          11940: 2dup find-alias 0= IF
        !          11941: get-node node>path set-alias
        !          11942: ELSE 2drop THEN 
        !          11943: s" block" device-type      
        !          11944: 0 INSTANCE VALUE block-size
        !          11945: 0 INSTANCE VALUE max-block-num
        !          11946: 0 INSTANCE VALUE max-transfer
        !          11947: : read-blocks ( addr block# #blocks -- #read )
        !          11948: block-size " dev-read-blocks" $call-parent
        !          11949: not IF
        !          11950: ." Read blocks failed !" cr -1 throw
        !          11951: THEN
        !          11952: ;    
        !          11953: INSTANCE VARIABLE deblocker
        !          11954: : open ( -- true | false )
        !          11955: my-unit " set-address" $call-parent
        !          11956: is_cdrom IF " dev-prep-cdrom" ELSE " dev-prep-disk" THEN $call-parent
        !          11957: " dev-get-capacity" $call-parent to max-block-num to block-size
        !          11958: " dev-max-transfer" $call-parent to max-transfer
        !          11959: 0 0 " deblocker" $open-package dup deblocker ! dup IF 
        !          11960: " disk-label" find-package IF
        !          11961: my-args rot interpose
        !          11962: THEN
        !          11963: THEN 0<>
        !          11964: ;
        !          11965: : close ( -- )
        !          11966: deblocker @ close-package ;
        !          11967: : seek ( pos.lo pos.hi -- status )
        !          11968: s" seek" deblocker @ $call-method ;
        !          11969: : read ( addr len -- actual )
        !          11970: s" read" deblocker @ $call-method ;
        !          11971: finish-device
        !          11972: ��������8&�0vio-veth.fs." Populating " pwd cr
        !          11973: " network" device-type
        !          11974: INSTANCE VARIABLE obp-tftp-package
        !          11975: : open  ( -- okay? )
        !          11976: my-unit 1 rtas-set-tce-bypass
        !          11977: my-args s" obp-tftp" $open-package obp-tftp-package ! true
        !          11978: ;
        !          11979: : close  ( -- )
        !          11980: s" close" obp-tftp-package @ $call-method
        !          11981: my-unit 0 rtas-set-tce-bypass
        !          11982: ;
        !          11983: : load  ( addr -- len )
        !          11984: s" load" obp-tftp-package @ $call-method 
        !          11985: ;
        !          11986: : ping  ( -- )
        !          11987: s" ping" obp-tftp-package @ $call-method
        !          11988: ;
        !          11989: : setup-alias
        !          11990: " net" find-alias 0= IF
        !          11991: " net" get-node node>path set-alias
        !          11992: ELSE THEN 
        !          11993: ;
        !          11994: setup-alias
        !          11995: ��������0build_info.imgprintf t[CC]t%sn build_info.img; gcc -m64
        !          11996: Using built-in specs.
        !          11997: Target: powerpc-linux-gnu
        !          11998: Configured with: ../src/configure -v --with-pkgversion='Debian 4.4.5-10' --with-bugurl=file:///usr/share/doc/gcc-4.4/README.Bugs --enable-languages=c,c++,fortran,objc,obj-c++ --prefix=/usr --program-suffix=-4.4 --enable-shared --enable-multiarch --enable-linker-build-id --with-system-zlib --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --with-gxx-include-dir=/usr/include/c++/4.4 --libdir=/usr/lib --enable-nls --enable-clocale=gnu --enable-libstdcxx-debug --enable-objc-gc --enable-secureplt --disable-softfloat --enable-targets=powerpc-linux,powerpc64-linux --with-cpu=default32 --with-long-double-128 --enable-checking=release --build=powerpc-linux-gnu --host=powerpc-linux-gnu --target=powerpc-linux-gnu
        !          11999: Thread model: posix
        !          12000: gcc version 4.4.5 (Debian 4.4.5-10) 
        !          12001: GNU ld (GNU Binutils for Debian) 2.20.1-system.20100303
        !          12002:   Supported emulations:
        !          12003:    elf32ppclinux
        !          12004:    elf32ppc
        !          12005:    elf32ppcsim
        !          12006:    elf64ppc
        !          12007:    elf32_spu
        !          12008: ���������۫�
unix.superglobalmegacorp.com

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