qemu/pc-bios/slof.bin - view

File: [Qemu by Fabrice Bellard] / qemu / pc-bios / slof.bin
Revision 1.1.1.3 (vendor branch): download - view: text, annotated - select for diffs
Tue Apr 24 19:52:46 2018 UTC (8 years, 3 months ago) by root
Branches: qemu, MAIN
CVS tags: qemu1101, HEAD

qemu 1.1.1

��(headermagic123 opdwgqemu0 21ȏ�(��Ð(stage1H?ޭ��?||C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��| �8�N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��| �8�N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��| �8�N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C�� `| �8 N� A@|C�| �|C�|�|C�� `| �8 N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C�� `| �8 N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C��`| �8N� A@|C�| �|C�|�|C�� `| �8 N� A@|C�| �|C�|�|C��!`| �8!N� A@|C�| �|C�|�|C��"`| �8"N� A@|C�| �|C�|�|C��#`| �8#N� A@|C�| �|C�|�|C��$`| �8$N� A@|C�| �|C�|�|C��%`| �8%N� A@|C�| �|C�|�|C��&`| �8&N� A@|C�| �|C�|�|C��'`| �8'N� A@|C�| �|C�|�|C��(`| �8(N� A@|C�| �|C�|�|C��)`| �8)N� A@|C�| �|C�|�|C��*`| �8*N� A@|C�| �|C�|�|C��+`| �8+N� A@|C�| �|C�|�|C��,`| �8,N� A@|C�| �|C�|�|C��-`| �8-N� A@|C�| �|C�|�|C��.`| �8.N� A@|C�| �|C�|�|C��/`| �8/N� A@|x}`�9��y��}kcx}`dL,8` HE8` H=8` H58`SH-8`LH%8`OH8`FHHq8`I|i�N�!xf��8`X8�8�D"N� git-d153364253548d6c�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 ��8}��@}��H}�� P}��A@�aH�P�X��`��h�p�!x�A��a��!��A��a��!��A�a�� (�!8|B�| �|B�|�|B�L$��`N� H�[0m[?25l ********************************************************************** [1mQEMU Starting [0m Build Date = Feb 17 2012 11:32:27 FW Version = git-d153364253548d6c |h�HAK��[1m[41m[37m E1001 - Boot ROM CRC failure [0m[1m[41m[37m E1002 - Memory could not be initialized [0m[1m[41m[37m E1003 - Firmware image incomplete[0m internal FLS1-FFS-0.[1m[41m[37m E1004 - Unspecified Internal Firmware Error[0m internal FLSX-SE-0.|x|�#x|�+x|�3x9@s� @�(��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�PB��~%�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, A�8c8c0H�y#F pc, A�8c8c0H�y#e pc, A�8c8c0H�y#� pc, A�8c8c0H�y#� pc, A�8c8c0Hey#� pc, A�8c8c0HIy#� pc, A�8c8c0H-y#"pc, A�8c8c0Hy#'pc, A�8c8c0H�y#Fpc, A�8c8c0H�y#epc, A�8c8c0H�y#�pc, A�8c8c0H�y#�pc, A�8c8c0H�y#�pc, A�8c8c0Hiy#�pc, A�8c8c0HMy#pc, A�8c8c0H1}�N� }�|ixK��}�|ixK��t}�|ixK��xf��8`X8�8�D"N� |jx8`T8�D"|�#yA�x�F �jN� <``cxc�dc`cp�<�`�x��d�`�R�T��A�8�|�� B��< `!x!�d!`!�8a�|��H58`��xH�< `!x!�d!`!�8!��a|h�N� <@`BxB�dB`BØ8B@8B@N� |fx8`8�<�`�DXK��|�8�Tc0T�0|� PT��|��|l|�|�|�L,8c�B��N� ``|`>p�"�|�x$|�*N� ```|��|�#y�a��|{x��!�A��?��8�{��<�@��x;��H�`�"� �b�(8� H�`�b�0��x��xK��`|dy@��!�낀@��x8��x�iK��m`/�A��b�H��xHq`�b�P��x��xK��A`|dy@� <��4�@�,��`�a�;�p8��xH�`�b�h肀p袀xH`�p�xL,|��A(�p<�eP��x��x`�AP�a�8��x| ��^N�!�A(L,|�8!��a��|��N� ��8`H�`�a�9 }kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L,9)�B��b�P��x��xK��%`|dyA��b�8H-`<��4�A��b�X��Hq`��K��b�H]`K��b�8H�`K��D�`|��"��|dx��!��x`��x$� �})*/�A�4� �A(| ��i�IN�!�A(8!��|�N� 9 /�� /�@�t�b��HY`|��b��|�#xx�"HA`|��b��|�#xx�"H)`|�B��b��|�#xx�"H`|�B��b��|�#xx�"H�`HK��`�K��|��!��|?x|`x��x |xK��`8?��|��N� �|��!�q|?x|ix��|�+x�?��p��/�A��/�A�8Hx8�xHT�p| x� x /� @�8` K��9�p| x� x �?p9)�?p|xK��x0�x�?x��@A��xx |x8?��|��N� �|��p��x|�#x��|`x�!��A��!�|x}CxK��`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��gK��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� |��!��cm`E/�LFA�8!p8`��|�N� �/�@��c8��T>+�A��Сc8��T>+�A��/�A�$/�@��HI`8!p�|�N� H�`8!p�|�N� �```|�=`E��|�#x��!��akLF;��XA�$8!��x��|�N� `�;��/�@��Ԡ;��0��T>+�A��;��0��T>+�A��/�A�8/�@��8�H�`8!��~��x��|�N� 8�H]`8!��~��x��|�N� �``|�= E�A��a��|�3x��a)LF|�#x��|�;x|�+x��!�a|x;��HA�48!��x��A��a��|��N� `�;��/�@��Ġ;��0��T>+�A��;��0��T>+�A��/�A�t/�@��H`E�xf�x��P��x��xH1`��x��x��Hi`8!��x��A��a��|��N� He`E�xf�x��P��x��xH�`8!��x��A��a��|��N� ��,}C|./�A�L�*9`}*BH ``� }*Kx})B/�A� 9k}k��8@��8`N� `�jN� ```|�}�&��.%-��|�3x�A��a��|�#x;`��|�+x|}x��!��;��!�A��H,```�,;��*A��/�@��/�A��?9��A�0��A(#�x| ��|�\N�!�A(/�@��|��#�xHy`��?8�|y|HPx H�`��/�A��XA��T��A(#�x;��| ��w�WN�!�A(�,��*@��4``8!��`��{c ��|��!��A��}� �a��}�� N� `�?�{�P{�K�� 8}C|./�A�L�69`}*BH ``� }*Kx})B/�A� 9k}k��8@��8`N� `�jN� ```|��!��A��a��|�#x��;��|x�!�Q�#(#�>�xH(```;��<;�@��A��/�@��>,�^(y)6d}9J{Z6dY�� x ��A�� /�A��_ ��8;��z��8|�2|�2|P.}_R/��A��``�69`}*BH� }*Kx})B/�A��9k}k��8@��|0*x�"y+.�y)$})XP�ex� |i+�@|�#}+J}`�})�@��b��Hm`� �8��`@��x@��_ ��z��8|�2|�2|P.}_R/��@��@```|0*�*�@@��\�b��H�`� K��```�B��x�d| �}@R}I�N� ��X��X��XdP��X��X��X��h��h��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��XD8��X,��X��X��h��X��X��h��h��h��h��X��X��X��X��X��h��h��X��X��X��h��hU):�+K��\�+K��T�|�� K��@y)� �+K��4y)"�+K��(�+� K��y �y)��| �K��y)��+K��``8!��!��A��a��|��N� �``|�}�&��.%-��|�3x�A��a��|�#x;`��|�+x|}x��!��;��!�A�� H,```�8;��6A��/�@��/�A��?9��A�0��A(#�x| ��(�|�\N�!�A(/�@��$|��#�xHy`� �?(8�|y|HPx H�`�(/�A��XA��T��A(#�x;��| ��w�WN�!�A(�8��6@��4``8!��}|{��|��!��A��}� �a��}�� N� ``�?�{�PK�� ,%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��!�q��Hm`��x|ex��xK��`肀�8�|~x�K��`8!��|�N� �|ix9`8`� /�M� ``� 9k}k�/�@��yc 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� 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��!��;aP;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| ��/�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��Xh��8�8� ~��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� 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� ~g�x9~��xc�xK��9c�x~D�x8� 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/� / ,� A��/� A��A��A��/�@��/�0A��8� /�A��8``8��9K��T>UJ>+� + 9)9K��|4@�$8��T>+�}@4@�M� 9k��}`4�(L� �$|c)҉i/�|`@��N� `/�@��|/�08�@��p� 9I/�x@��h9*�$�jK��P```8`N� � 9I/�x@��(9*�$�jK��8��K��P�PPERROR: Flatten device tree available! Press "s" to enter Open Firmware. bootinfo !!! roomfs lookup(bootinfo) = %d xvectCannot find romfs file %s ofw_mainERROR: Not enough memory for Open Firmware%s%s[0m[?25h exception %llx SRR0 = %08llx%08llx SRR1 = %08llx%08llx SPRG2 = %08llx%08llx SPRG3 = %08llx%08llx ELF relocation out of bounds! ERROR: Unhandled relocation (A) type %i 0123456789ABCDEF��@�C�I�C�J@C�JpC�L�C�M�C�NC�OC�R�C�SPC�T`C�VC�V�C�XPC�X�C�\�C�^PC�^�C�^�C�_�C�_�C�`�C�`�C�aPC�b�C�c�C�j0C�C��k��ll@lPlxl�l�l�n@l�l�l�Ðl�mm(m@mXmxZ�m�k�k�m�m��f8��?0?(xvect�`/�|i�8N� |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 N� |C�| �|C�|�|C��/�| �8N� |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��/�| �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��p0ofw_mainELF@�X@8@��?��c��?��c��?�c�a��?�c�0��|�|�<``c�c�`/�Hp|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��!�<@��0|��B�8L$|�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� ``|�8�Tc0T�0|� PT��|��|l|�|�|�L,8c�B��N� ``|��|�3x��| �N�!��|�N� `|��"��|wx��p��x��!��A��a��!��A��a��!�� /�@�<�B��(}+Kx9 8� 0� ��B� ��*8� �iz��A��B��j8� ��z��A��B��j8� ��z��@�|z��A�*X�B� �b�9);��j8� �+��:s�:�p:�u;v;`:;��:�x��;A�;�: ;!�>@```}��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�� `�+��9I�K� }��N� �b��B�h�� +� ��9I�K� }��N� �b��B�h�� +� ��9I�K� }��N� �b��B�p�� +� ��9I�K� }��N� �b��B�x�� +� ��9I�K� }��N� �b��B�� +� ��9I�K� }��N� �b��B�� +� ��9I�K� }��N� �b� �+8 ��;��}��N� �B� �b�8�*9 � ��+��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� ��}��N� �B��9>;��j9� ��}��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�� 0��x$|� }��N� �"� �b�� I�+��|PP9I|t0�K� }��N� �"�� B� ��i��8��0��x$|� }��N� �"��b� �� )�k�� x$|�|*� }��N� �"�� i��K��| �� 0�� }��N� �"�� i��K��|PP�� 0�� }��N� �"�� i��K��| �� 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� �� }��N� �"�� )��i�� }��N� �b�� +��9 ��I� �� }��N� �"�� )��i�� }��N� �b�� +��9 ��I� �� }��N� �"�� )��i�� }��N� �b�� +��9 ��I� �� }��N� �"�� )��i�� }��N� �b�� +��9 ��I� �� }��N� �"�� )��i��p� }��N� �B�� j��}i[x�k� ��p9)��x��*��}��N� �"�� i��+9I� �t� �� 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�� @�~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� �b� �+8 ��)�;��}��N� �"��i8�� }��N� �� h��9K��8��+�H8��k��J��}@[x|Kxx`/�A��/�A�</�@��P@A�|�J|�J�8@9A�H�|@*9)��|A*/�9��@��K��h�B��*9i��8�� j8��yE�|Cxx��|�x�)��k��}*[xyJ`/�A��/�A��/�A�D/�}+J}+HP})�@�`�9kB�� }��N� ��O9j��9�� 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�d/�@��P@A�|�J|�J�8@9A�H|@*9)��|A*/�9��@�� }��N� �� O�9j��9+�� o8��J��/�A��@�I��A��i��|x}��N� �b�� +��9I�K� }��N� �� /�8 ��/��)��A��8�ix��!��a�Ho]`��!�4��a�|x9)��|rx@��B��/xh| � }n[x}��N� �"�� i��9K��8 ��k�I�� H0�`}��N� �"�� oH0�`�o}��N� �"�� oH0�`�o}��N� �"�� 8`��i��9��8�� H/�`�o��}��N� �"�� 8`�i��8�� H/�`}��N� �"�� 8�� o��H09`�o��}��N� �� /��iHj�`�/8 ��i}��N� �� b��8�8�`��HlQ`}��N� �� o��9+��//�A�� 9)��/}��N� �"�� 8` �i��9��8�� H.�`�o��}��N� �"�� i��8��k� H<�`}��N� �"�� i��9��8�� o��H9)`�o��}��N� �"�� i��8��k� |c4H �`}��N� �"�� I��9j��9��i8�� k�� H �`}��N� �"�� i��9K��8 ��I�k�� H �`}��N� �"�� I��9j��9��i8�� k�� H �`}��N� �"�� i��9K��8 ��I�k�� H �`}��N� �"�� 8�� o��H M`1��||��}��N� �� H m`}��N� �� ~��x��袀��/��iH!`�/�x� �/8 ��i}��N� �� ~��x�‰��/��8 ��i��H!�`�/�x� �/8 ��i}��N� �"�� oHL�`�o}��N� �"�� oHM`�o}��N� �"�� oHM-`�o}��N� �"�� oHMU`�o}��N� �� /��iHLi`�0��}��N� �"�� 8`�i��9K��8 ��I�� H,!`}��N� �"�� oH,`�o}��N� �"�� 8�� o��H,)`�o��}��N� �"�� i��9��8�� o��H/9`�o��}��N� �"�� i��8��k� H4�`}��N� �"�� i��8��k� H4 `}��N� �"�� I��9j��9��j�i8�� H0�`�o��}��N� �"�� I��9j��9��i8�� o��H7�`0c��|c�o��}��N� �"�� 8`�i��9K��8 ��I�� H*Q`}��N� �"�� 8`��H*`�o}��N� �"�� 8`�i��9K��8 ��I�� H)�`}��N� �"�� 8`��H)�`�o}��N� �"�� 8`�i��9K��8 ��I�� H)�`}��N� �"�� 8`��H)5`�o}��N� �"�� 8`��H) `�o}��N� �� /��iHIQ`�0��}��N� �� /��iHIm`�0��}��N� �� /��iHI�`�0��}��N� �� C�x8��/��HOQ`�z�9++�@��/� �/8 ��i�/8 ��i}��N� �� x�/�9I��9j��Oy� ��o��Hd1` ��8�x� |}rHc�`8��C�xx� ��xHN�`�z�Z��9++�@��/|x8 ��I�/8 ��i�/8 ��i}��N� �� 8��x|��8��9H��9j��O8��8��o�J��H }}HP|P�� 8�9)|��B@��8A��)K�� o��9+��9I��k�/8 ��O��HO�`�//�8 �@��}��N� �� HU�`}��N� �� HI)`}��N� �� HJ�`}��N� �� x��/��9i��8��oy� ��HbM` ��8�x� |}rHa�`�/��x9i��8��o�i��HWm`|`yA� ��/9i�o� �/�!�8 �H` `�!��i�/8 ��}��N� �� #�x�/��9I��9j�� Ox ��o��Ha}`��8� ��|yx� Ha!`�/��x9I��9j�� Ox ��o��Ha1`��8� ��|}x� H`�`�/��x&�x9i��8��o�i��HX`,#A�<�/8 ��}��N� �� #�x�/�9I��9j��Oy� ��o��H`�` ��8�x� |yrH`5`�/%�x9I��9j��O�i��oH\�`��,#A��/|x8 ��}��N� �� /��9i��8��o�i��HGe`,#A�0�/8 ��}��N� �� x�/��9I��9j�� Ox ��o��H_�`��8� ��|}x� H_=`�/#�x9I��9j�� Ox ��o��H_M`��8� ��|yx� H^�`�/%�x��x9i��8��o�i��HX�`,#A� (�/8 ��}��N� �� /��9i��8��o�i��HN%`,#A� `�/8 ��}��N� �b�� +��8 ��i}��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��|�|��|��|��|��|��|��|��9k��i}��N� �b�� +��8 �|�� }��N� �"�� )�� |��|��L,�b�9)��+}��N� �b�� +��8 ��i}��N� �b�� +��8 ��i}��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��Y`�o}��N� H�"�� 8��i��9��8��o�� K�Ս�o��}��N� �"�� I��9j��9��8��o�� K��M�o��}��N� �B�� *��9 ��8��i� �)�� }kJ9kU)0Uk0}iXPUk��}i�|Hl|�|O�|�L,9)�B��}��N� �"�� i��|�9k��i}��N� �b�� +��8 �|�� }��N� �b�;�K��|��|��C�x��xHG�`��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��L})ZK��l�/9I�O�i�/9i�o� �/8 ��i}��N� �P@A�8} J�@@@�,}kJ9)})�9 H|H�|I�9)��B��K��9)| �})�B@��}*� 9J} Y�K��P@A��} J�@@@��}kJ9)})�9 H|H�|I�9)��B��K��T�/8 ��i}��N� �/8 ��i}��N� �/8 ��i}��N� �/|x8 ��i}��N� 9)})�9 B@��| �9)��} �}�K��/8 ��i}��N� �i}��N� �:K��9 K��`�/��9i�o� }��N� �/|x8 ��}��N� �/��}��N� | x��K��9 H`}i�9)��|jX��!��A��a�HT�`�a��|hx|dX��HT�`��!��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��|@.9)��|A./�9��@��K��P@A�|�J|�J�8@9A�49H|R.9)��|[.9/�@��K��H|B.9)��|C./�9��@��K��,8K��x8 �� }��N� 8 �� }��N� 9H| @*9)��|A*9/�@��K��t�P@A�|�J|�J�8@9A�49H| @.9)��|A.9/�@��K��4|@.9)��|A./�9��@��K��P@A�|�J|�J�8@9A�49H| B.9)��|C.9/�@��K��|B.9)��|C./�9��@��K�м�i| x�K�ޔ9k��iK��,�|�/��!��A�xc H!`8!p�|�N� �`|�8c��|�+x+��!�q@�,8!�8`��|�N� ``/�@��|�#x;�H,```;�H�`;��@�H�/� @��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�PB��~%�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, A�8c8c0K��}y#F pc, A�8c8c0K��ay#e pc, A�8c8c0K��Ey#� pc, A�8c8c0K��)y#� pc, A�8c8c0K�� y#� pc, A�8c8c0K��y#� pc, A�8c8c0K��y#"pc, A�8c8c0K��y#'pc, A�8c8c0K��y#Fpc, A�8c8c0K��y#epc, A�8c8c0K��ey#�pc, A�8c8c0K��Iy#�pc, A�8c8c0K��-y#�pc, A�8c8c0K��y#�pc, A�8c8c0K��y#pc, 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` K��8` K��}�cxK��}#KxK��8` K��}CSxK��8` 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� `|��!��cm`E/�LFA�8!p8`��|�N� �/�@��c8��T>+�A��Сc8��T>+�A��/�A�$/�@��HI`8!p�|�N� H�`8!p�|�N� �```|�=`E��|�#x��!��akLF;��XA�$8!��x��|�N� `�;��/�@��Ԡ;��0��T>+�A��;��0��T>+�A��/�A�8/�@��8�H�`8!��~��x��|�N� 8�H]`8!��~��x��|�N� �``|�= E�A��a��|�3x��a)LF|�#x��|�;x|�+x��!�a|x;��HA�48!��x��A��a��|��N� `�;��/�@��Ġ;��0��T>+�A��;��0��T>+�A��/�A�t/�@��H`E�xf�x��P��x��xH1`��x��x��Hi`8!��x��A��a��|��N� He`E�xf�x��P��x��xH�`8!��x��A��a��|��N� ��,}C|./�A�L�*9`}*BH ``� }*Kx})B/�A� 9k}k��8@��8`N� `�jN� ```|�}�&��.%-��|�3x�A��a��|�#x;`��|�+x|}x��!��;��!�A��H,```�,;��*A��/�@��/�A��?9��A�0��A(#�x| ��|�\N�!�A(/�@��|��#�xHE)`��?8�|y|HPx HDy`��/�A��XA��T��A(#�x;��| ��w�WN�!�A(�,��*@��4``8!��`��{c ��|��!��A��}� �a��}�� N� `�?�{�P{�K�� 8}C|./�A�L�69`}*BH ``� }*Kx})B/�A� 9k}k��8@��8`N� `�jN� ```|��!��A��a��|�#x��;��|x�!�Q�#(#�>�xH(```;��<;�@��A��/�@��>,�^(y)6d}9J{Z6dY�� x ��A�� /�A��_ ��8;��z��8|�2|�2|P.}_R/��A��``�69`}*BH� }*Kx})B/�A��9k}k��8@��|0*x�"y+.�y)$})XP�ex� |i+�@|�#}+J}`�})�@��b��HC�`� �8��`@��x@��_ ��z��8|�2|�2|P.}_R/��@��@```|0*�*�@@��\�b��HC]`� K��```�B��x�d| �}@R}I�N� ��X��X��XdP��X��X��X��h��h��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��XD8��X,��X��X��h��X��X��h��h��h��h��X��X��X��X��X��h��h��X��X��X��h��hU):�+K��\�+K��T�|�� K��@y)� �+K��4y)"�+K��(�+� K��y �y)��| �K��y)��+K��``8!��!��A��a��|��N� �``|�}�&��.%-��|�3x�A��a��|�#x;`��|�+x|}x��!��;��!�A�� H,```�8;��6A��/�@��/�A��?9��A�0��A(#�x| ��(�|�\N�!�A(/�@��$|��#�xH?)`� �?(8�|y|HPx H>y`�(/�A��XA��T��A(#�x;��| ��w�WN�!�A(�8��6@��4``8!��}|{��|��!��A��}� �a��}�� N� ``�?�{�PK�� `|��8�|�#x��!��|dx8`K��`��x8�8`K��`��xH;�`��x|dx8`K��`8`8�8�K��`8!�|c��|�N� �D"N� xf��8`X8�D"N� }H�H-}H�,M� = �a)��|dH�8��N� |dx8`��= �a)��|0@L� 8`TD"= �a)��8`�i(M� 8`��N� ��|dx8`D"N� 9`}*Kx} Cx|�;x|�3x|�+x|�#x|dx8` D"N� |�#x|dx8`<D",#|�#xM� 8`��N� |�+x|�#x|dx8`@D"N� ``xi&�89)�x(xc$| 8c�x�xc�|`N� ``��|x8`�/�@�Tx� �8`@T��>T�@.|�x8�x� 8�D"|��8`<8�8�D"/�8`��xc A��N� x� ��T�@.|c4T��>|c#xxc N� `��|x8`�/�@�|x� �8`@T��>T�@.|�x8�x� 8�D"|��8`<8�8�D"/�@�Dx� x x�U+�>U#@.|c[xT D.T�>} xTc�|cxxce��N� ``�b��N� ``|��|}x|�#x��!�qK��!��x|x��xK��q8!�xc&��|��|�N� �```|��|}x|�#x��!�qK��q��x|x��xK��8!�;��xcd��{��|�N� �`�/�L� �8�8`@8�8�D"N� ```�/�L� x� �8`@T��>T�@.|�x8�x� 8�D"N� ```�/�L� �x� 8`@8�8�D"N� ```�/�L� �x� 8`@8�8�D"N� ```��|ix|�#x��8`��/�@�0��/�;�A��A�,/�A��8`��```��N� /�A��/�@��8`<8�|��D";��/�{��@�x��8�8`<|�*8�D"/�x� A�8��x� |��x��N� |�"8`<8�D"/�x� A��h8`��xc K��\``|�"8`<8�D"/�x� A��88`��xc K��,``|�"8`<8�D"/�x� A��8`�K��|�3x��/�A�(;��x��N� ```/��@��9&��;�y) ��9)|�#x�!��``8`<8��xD"/�x� A�8��;�;��5 ��!��@��x��N� `|��|�3x|}x��8��|�#x��|�+x8��8��!��A��a��!�1�pK��}`8��|��@A�8��x8�K�� `8�xz ��xK��`8�|yx��xK��E`8�|xx��xK��`�"��|{x|wxT<}k��}KӖ}J��}jXP}k�99K}�Ӗ|�Ӗ�Ӗ}��|��_��}@Pyc&�y }GPPy�&�y_ |�}9*|�"{�&�}Y*9�!*�� ;��;��;��P��xx�W�H,��9ap}y)*=`��i9 �&�� |�8��x�88 �K��M`�W��@@�<= �a)�H```A� }i�|��9i��/)�@A��p��/�@�D8!��|��!��A��a��N� ``��p�b��H5�`8!�8`��|��!��A��a��N� `�b��H5�`8!�8`��|��!��A��a��N� � ```|��8��|x��!��K��9`��xK��`8!��|�N� �`|��8�|x��!��K��`��x8�K��`��x8�K�� `��x8�K��I`88��8��xK��`8!�8`��|�N� �```}�&|��9`|�+x��8�||x��a��"��!��p88��a��x9`��a��)�!x;�x;��K��Y`Tf>+�@�8�|��x8��xK��`��x��H�`|{yA�d�b�d�xH3Y`��xH�`8!pc�x��a��|��}� ��}�� N� ```��x;�pH�`8�|{y@��`��x8��xHE`/�|{xA�T�!p8�� /�@��;��xH�`-�|{x@��x8�H �`.#|x@�(��;�/�@�H�A��@@� |�(P|��x� ��x��xH�`/�|{x-�@��b�0d�xH2`HD```�b�d�xH1�`K��```�b� d�x;�H1�`��xH`��xH`@��l8!p��c�x��a��|��}� ��}�� N� �b�d�xH1i`K��```�b�(��x��xM�;�H1=`K��h;`-�K��\�``|��8��|x��!��K��)`��xK��`�"��8!�8�� |�N� �``|��"��8��|}x��|�#x|�+x�!�q��/�@��8�K��`��x8�K��`��x8�K��`8��xK��`88�|ix��x� ��K��M`�b�8��x��x��xH�`88!�|x��|��N� �``|��|�;x��!��|yx�A��a��|�3x��|�#x8��!�1|�+xK��`8�x{ #�xK��]`8�|xx#�xK�� `8�|zx#�xK��e`8��||x|vxT <})��}iۖ}k��}+HP}+�9+yg&�|�ۖ�9*}@ۖ|��j��}&HP}X:y& x�&�}8B��9@�A*�I9@�I}[PyJ�}ZR�j�� |��:#�x8�8 �K��a`�V��@@�H= �})�a)�| �`��| �H}i�B@$|��9i��P@A��/�8`��A�H��wx x�U*D.U)�>}IKxT D.T�>}@xU)�} x|��@@�P�8`8!��|��!��A��a��N� ``}`[x8`�K��`�"�@��iN� ```|��@8�8� ��!��H+A`�8�8� H+-`�"�H�8!�� |�N� �``|��!��8��@�b�H�?�C�k�/�@�,8!P|x��|�N� ```/�@�,8!P8��|x��|�N� ``��/�A��+� 8��A��}dXP8��ye �P@A��x� |'x�TD.T�>}`x|��T��Gp�� A(| ��i�IN�!�A(8��/�@��0�?�8�� KU�>UG�>U@.UJ@.}3x}J;x}4}J4�P@��/�kA�(�)9)} x|�|�p|�x�BxK��;�t8�8��xH)i`��T �>T@.|Kxx� +��@�8��8� ��xH(�`�b�P��xH+`8��K��`�``|��|x��!��K��8�"�H��x�i9K�I9@|�K��ix x�UGD.UJ�>|�SxTD.T�>|�xUJ�}@x99@�� KK��,#@��"�@�)9i*�x x"x yh UD.UGD.x�yk�U�>UJ�>|�Cx|�SxUfD.TD.Uk�>T�>|�x|�[xU�U@�}[x|;xyk�x }`x�� 8!��|�N� �|��a��|�3x��|�#x��|�+x|x�!�a�K��-�<8 ��@@�|x�"�H{f"{h {� �i8� 8t�8�x� y TD.y�xƄT�>|�xUD.U�>UdD.T�D.Uk�>T��>{� |�3x|�[xT�UD.U�>|�Cx|�+x�iT��_xx� |��x8�y@ yJ�TD.T�>{��TD.T�>U_D.|�xcxU�UJ�>|+x�SxTc�x��|jSx|�3x�98��K�� xK��|yA�88!��x��a��|��N� ```�"�@��x x�U?D.U)�>�KxT D.T�>} xW��x��{� �(@@�;��K��`��x8�H&`K��l�|��|�#x��|x�!�q��K��=�"�H8s�_��x�i9K�I9@p�K��i�8�x ��UHD.x��UJ�>} SxTD.T�>}xUJ�}@x9@��K�i8� K��),#@�<�"�@�)� x x�U+D.U)�>}iKxTD.T�>}`xU)�} x�8!��|�N� �```|��|�3x��8��|vx��|�+x|�#x��!��A��a��!�1�/�A��K��H{� {� U'D.U)�>{��{ބ�w|�KxW�D.W��>9K}�x�W9@nT��KT D.T�>}JxW�D.W��>|�xUJ�|�Cx}Jx8�8�~��x~��x;`~��x�78� �� I�/�A� `/�/@� ``�/�/A��/�A�,��xH`A�0�/�// @��P��x{� �b�X��x��x}�xH!�`/�A��@�7�v9I�|PP|��X@A��;��W�:W� 6}J@P}J�8 �X@A��|�P��xx ��xT�>T@.|[x��P� 8 �|xH"�`�/��A��x��x�/�@��}�x/�A�|{` ��@}�xT @.})4T�>} xx ��~óx�8� K��M|`y@��x~��x�T�>T@.|[xyk ��A�9k��}k�/��A�h```� /�/@�`� /�/A��/�}5Kx@�H`A��/�// @��9k��~��x}k�/��@�� |�x�8!�|x��|��!��A��a��N� ��x��x;�K��`��P��x{� K��;��/�/A��x}�xK��4K��l8K��~��xHa`8��/�@��X��@8K��`|��|�#x��!�q�apK��I�"�H{� {��T D.T�>}@xW�D.W��>�iT�}_�x9|�x� 9x8��i�ap8!�8� 8��|�K��@�|��|x��A��a��!�a�cHe`|~x�HU`��;��@@�<8!�8`��A��a��|��N� ```K��1�H;��>8 �8h� 8� ��x x�U+D.U)�>}iKxTD.��T�>}`xU)�} x9 ��<8�H�`�~xc ;{T`�>Tc@.|cx�~�|��xH]`��x|exc�xH`��^H9`||x�|��H!`�~xc ;{T`�>Tc@.|cx�~|z�.��xH�`��x|exc�xH�`��H�`8!�}<�.��x8 �A��a��|��K��,�```|��|}x��!�qK��H�`��x�?8 �8d� 8� ��9|x x�U*D.U)�>}IKxT D.�T�>}@xU)�} x9 ��<�H�`�?xc T`�>Tc@.|cx�|;��x��H�`��x|ex��xHq`��x��H�`|��x�K��|yA�48!��x��|��N� ```�"�@�}��$y y)�T D.T�>}@xU*D.U)�>}IKxT�|Kx�X@@�}`[x��8� �b�hTD.T�>|�xx� H-`/�@��`;��K��X�``+��8A��"�p| �|xN� ``+��M� �"�p|��N� +��8A��"�p| .|xN� ``+��M� �"�p|�.N� +��8A��"�p| .|xN� ``+��M� �"�p|�.N� +��8A��"�p| *|xN� ``+��M� �"�p|�*N� <�@�8`N� ```�b�p<c�/�@��8��8cN� �"�p8=)� N� ��p8�8``��<�}Cx``x` }(�/�M� 9#8�y) �(A�|�H�8�}h�8x� | �|�;x+��9I8A�|H�}`ZyI yk B��U`�>}`ZUk>�XL� +��M� |:./�M� T 6|`|c�� @��dN� ||��L� 9#9`�}#Py) })�A�<= ��HA�0``x` 8c+��A��"�p}i�|c�B��N� 8| �K��`<�B�p9 | �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�p}K�})�B��8`N� 8| �K��|`y8`M� | �|�J|�� @�Tx 9@8}k Pyk � }i�A�<<��A�0`y 9)+��A��b�p}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�p}j�y= x c�xHm`+��@A��9+��y 9 @��8| �```+��9~8A��B�p| �} Jy~ y) B��+��@��8!�;9��9��:C�x��!��A��|��a��N� ```�"�p})��K��d`�"�p�&p��.K��```�"�p��;�{� +��A��K��`�b�pU �>} J}+A�K��P```8!�8��C�x�A��!��|��a��N� �`|��!��K��8�袁x8�`��|�0P8ap|��K��ap8!�0��|`�|�N� �``}�&|��.$|�+x��!��; |xx�A��a��|�#xc9��?`-%��;�-��!�A��p?�:�;�88�x ��A�|��{� 98y | �}8�} Cx``+��9I8A�|H�}`ZyI yk B��U`�>}`ZUk>�X@��+��;�A��B.A��/�A�t@�|A��|�P9>| �y) ��x+��9I8A�|H��yI 9kB��x~�x8�H�`/�A�4W� 6��@��89 ��H(|8��@��K��|9=��8U) 6|�})�8!��8�x��|��!��}� �A��a��}� ��}�� N� � ```|�� |}x��|�#x|�+x�!�a@�(8!�8`��|�N� `8�8ap8�K��x�p/��A��}>�P�A��{� {� 9d��}>�}k�})��HA��|� P9x� |��`y` 9k+��A��B�p} �}k�B��{� �8P|J|��@�L9i9@�}iPyk }i�A��=`��XA��y 9)+��A��b�p}K�})�B��;��{� +��A��"�p��.K��I8!�8`��|�N� `|iXP<|c��A��袁p=��/�@��8 9L�X| XPx }HSx| �}'KxA��<��A��``x� 8�+��|��8A�|0��9B��|� P9x� |��``y` 9k+��A�}�}k�B��{� }g�yk |cZ}k�|c��@�<|kPxc |i�``y` 9k� +��}k�A�}�9JB��8�K��H8| �K��88| �K��l�```|��!��8+�8@�px� `��}$y) }+��A�h}jX�}$HP=J9)��8 y) x | �``y` 9k+��9I+��}k�9A��p}�A��p}I�yI B��89 `��a)��|�P|��H@�H89d`��H|P9`x | �A��x� 8�+��A��"�p}i�|��B��8ap8�8�K��%�ap�!|9k��8 }i�|J|��@�Pyk 9K}kP�yk }i�9@A�X=`��XA�Ly 9)+��A��b�p}K�})�B��K��Q88!�|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�p}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��Q`|�P��A��8!��x��|�N� �|��A��a��9 9`��<��| ��!�A��p��x`y 9)})�}�B��;�p;��?�ib��x�tc�m,8�Q��x8��pK��a��x��x8�Q8��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��;��xH```{� ;�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;9A��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@@��i8�/�@��܈}`XP}c�N� �9`K��|ix/�A�4/�M� |��HB@p� 8��9)x� �/�@��/�M� 8��9ix� 88�|��H```9k� }i[xB��N� ```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� ```8��+�M� 8c |c�N� ```8��+�M� 8c��|c�N� ```|�|�+x��!��|�#x8��|xx�`H�`8!p�|�N� �```|��!��|`x�b��|x��!��A�8��H�`8!p�|�N� �`|��|~x��!�q�⁰�K��`��x|ex��xK��`肁�8�|~x�K��`8!��|�N� �```|��|�+x|~x��|�#x8�@�!�1;�p��xH�`��x|}x�~{� K��I`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� 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��!��;aP;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| ��/�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��Xh��8�8� ~��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� 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� ~g�x9~��xc�xK��9c�x~D�x8� 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/� / ,� A��/� A��A��A��/�@��/�0A��8� /�A��8``8��9K��T>UJ>+� + 9)9K��|4@�$8��T>+�}@4@�M� 9k��}`4�(L� �$|c)҉i/�|`@��N� `/�@��|/�08�@��p� 9I/�x@��h9*�$�jK��P```8`N� � 9I/�x@��(9*�$�jK��8��K��P��6P�6��7��=��>p�?��A �A��Cp�C��G��Ip�K0�Kp�L�L��M@�M��M��N@�N��N��P �P��S��T@�T��X�X`�YP�[��[��\0�^ �_`�a`�b��f`�g�i �j��k�k0�k`�k��k��k��l�l �lp�l��m`�m��n0�n��o`�op�q��r�t�v��x��y��z@�{��|��~�� `��`��p��`�� p�� 1)��a0A ��`E��(� �(�H�`�x��0��0��P��X��CPU0logCPU1log��(��p��0�8��h ELF relocation out of bounds! ERROR: Unhandled relocation (A) type %i elf-claim-segmentvirtioblk_read: Access beyond end of device!virtioblk_read failed! status = %i slofVersion check failed, rc = %d Attach failed, rc = %d Walk failed, rc = %d Stat failed, rc = %d Open failed, rc = %d Read failed, rc = %d Error: %s .9P2000.uunknownfree spaceCreating common NVRAM partition common 0123456789ABCDEF��0FORTH-WORDLIST ��H*LASTWORD ��EVALUATE ��0�P��P�(�H��`��((�@�X* �p8��8��(��BP �� SEMICOLON�� 0 �(RDEPTH! ��8DUP��@LITT�`=8�`0BRANCH ��HSWAPP�xDROP0��BRANCH ��CLIENTINTERFACE ��PRINT-STATUS ��((��H�p�p8��0��(0�H��pP��(8�P�p��X�p��QUIT ��H��>��(P��H��`��(��x�p��H�� INTERPRET ��(P��p�(� �p��p��SAVE-SOURCE ��(��p��p��p��*�-1 ��DOTO ��p�� SOURCE-ID 0�#IB ��`!��SPAN ��IB 0��DOTICK��8CATCH ��P�p��8�P��x��P��X��RESTORE-SOURCE ��P��P�(��PTHROW ��(`�P�p��P��@��X��NOOP ��0BOOT-EXCEPTION-HANDLER ��EMIT ��h((FIND)) ��(x��@�x�(�� p�p��p��`(FIND) ��2DROP ��X�X��(REVEAL) ��OVER��8-X�PEXITx��RDEPTH x�H BREAKPOINT,�p0<��PICK��EPAPR-IMA-SIZE T+JUMP-CLIENT/l��PRINT-EXCEPTION ��(8�H��X� ��(�X� ��SPACE ��P��0=t�`PRINT-STACK ��((��OK-STRok�`ABORTED-STRAborted�xCOUNT ��@��xTYPE ��P(�h��8 ABORT"-STR ��@��CR ��' ��( ��@�@�h��[ ��TERMINAL ��P�(�(�p��P��DEPTH �(. ��p��REFILL ��(8��@� ��0��(�� e��INTERPRET-WORD ��P�((�X��x� ��( ��>IN �° PARSE-WORD ��Pè��xSTATE ��COMPILE-WORD ��P�(P��( ��x� �0�� ( ��H��0�0��H?LEAVE ��H�h�0�(�p*��(��0��R>��0>Rx�XCELLS+ �Ɛ��CELL+ ��ACCEPT ��#TIB ��0CATCHER ��hEXECUTE��h?DUP ��(��DEPTH! H��STRING, �*��Ƞ��(DUMBER ��8�p�X��8�p��ɨLINEFEED ��2DUP ��xR@�� LINK>NAME �� NAME>STRING ��P STRING=CID��3DROP ��X�X�X��0FALSE ʸ2OVER ��(LATEST ��+$�(DO?LEAVE,�HU<��`EPAPR-MAGIC (˘UNKNOWN-STRUndefined word��HW-EXCEPTION-HANDLER ��LL-CR �ɸ��0BL ��NOSHOWSTACK ��P��SHOW-STACK? 0�.S ��p�(�X� ��P@��h��h��SPACES ��P��ưCHAR+ �̘��C@H̸BOUNDS ��H�@��DO?DO��I ��@��@DOLOOP8�`XOR��xSET-UNDEFINED-WORD �Ͱ��H͐��Ƞ��@�x��Ƞ�H�@��H��X�x��8$FIND ��P�(0�X��@�p��΀TRUE ��ΨDOABORT" ��@�((�P��X��OFF ��@��TIB`��RPICK ��(U.) ��Hπ��(.) ��H�� h��EXPECT ��SOURCE ��(��p��($FIND) ��(0��@��@��NIP ��@�X��X$NUMBER ��( �X�X�@� ��-��(x��h��((�X�X�X�@� ��p��(8�X�@�(Ӱ�� X�X�X�@��ØSKIPWS ��(��p��p��(p��p�H��P��((�H��p�p��`�X�X��XPARSE ��(��p�H��p��p��p�(0��H�H�p��p��x\ ��p�h��è��ո IMMEDIATE? ��ŸCOMPILE, ��8��hLEAVE ��H�@�0�(�p*��(��0��ָ?COMP ��p�(� ��z��LEAVES ��0 HASH-TABLE��PCHARS+ �׈��רNA+ ��H��NA1+ ��H�H��XKEY? ��ABORT ��0��xERASE ��@SLITERAL ��H��PLACE ��X��@��PH��h�X��H��P��X��X1+ ��H�H��ـCHARS ��ALLOT �*��H�P*��DAAR ��C!l��+! ��p�H�@��@CARRET ��TUCK ��@��`CONTEXT 0ڀ�LINK> ��REVEAL ��(�p��@��(�pۈ��3DUP �۸��۸��۸��ۨ3 �8DOLEAVE��<�� ROMFS-BASE��ICBI/0�x EXCEPTION-STRException #�� SHOWSTACK ��0�P�� .H �܈�p�@ܨ��܈��Ȑ1- ��H��ƀCA1+ ��H��EVEN �Ƞ�0��DODO�� ALIGNED ��H�h�H�HӰ��OR��h UNDEFINED-STRundefined word ݨPOCKET ��p��H��p�H�H��(�X��`MOVE��NOT ��EVAL ��`COMP�pU#> ��X�H��p��x<# ��H��U#S ��(�p��X#> ��H��p��ӠABS ��p�(Ӱ��(#S ��8��p�(�p��xSIGN ��p�(��-߈��(FIND-ORDER) ��x��(��p��p�x��((��X� ��ِ�p��@��NAME> ��Ƞ�h� ��>NUMBER ��(� ��܈�p��(��@��@��܈�p�h�@܈�p� ��H��h�p��X��NEGATE ��@��> ��@�X��h<= ��1 �FINDCHAR ��@��P��h�H��P��(��p��(0�h��@� ��@�X�X��( ��)è�� 'IMMEDIATE �@AND\�X0<> ��, �*��H��+LOOP ��H�P�0� ��] ��pREPEAT ��0 CLEAN-HASH��CELLS ��CA+ ��H��HXA+ ��H��x/N* ��H��XA1+ ��H��/N ��KEY �ذBLANK �� pFILL|��ALIGN �*��H�h��( ��@�p��DO+LOOP��pU* ��CELL- ��H��/C* ��CRASH/��0UNLOOP ��BS �xSEARCH-ORDER ��HEADER ��*�ۈ�p�8�(��@��LAST ��82 ��UNALIGNED-L!D� FDT-START��(PMC1@/�@.D �܈�p�@��܈��BASE ��HEX �� ܈��0/C �P2- �۸��XBFLIP ��0�@�0�x��PABORT" ��H�h�0��WHICHPOCKET ��POCKETS��*��PINVERT ��0��xPAD �*��H��MU/MOD ��H��@��`U# �܈�p�H�@��߈��а# �܈�pވ��߈��8HOLD ��H��p�h��@��X��U>= ��DIGIT ��H��A��Z��(��0��@��( ��@�p�X��UM* ��@��X��@ROT ��@��@��pD+ ��H��D2/ ��`��?��p��U> ��@�� IMMEDIATE �ۈ�p��p�@�X��CHAR ��X��ASHIFT(�0<= ��<> ��LOOP ��H��0� ��RESOLVE-LOOP ��(�p��(P��p�@*��@��p��*��0�(��P-COMP ��0��p��p�(� �� X�p�P*��x��WHILE ��@��0AGAIN ��H�p�0�x��THEN ��HASH��(LA+ ��h�H��X/X* ��LA1+ ��H��/X �8LCC ��A��Z��(�� H��XLFLIPS ��P@�h�h��h��P��X, �*��(C, �*��X��MIN ��(�@�X��CHAR- ��8CELL �P FLUSHCACHE0�XJ ��@��@��@��@BELL ��CURRENT 0��pUNALIGNED-L@��HEAP-END��MMCR0!.��U.R ��@�8��X�((��p�X��xDECIMAL ��@܈��XH#10 �xD#10 �X2+ �۸�H��BXJOIN ��x��0XLSPLIT ��@��pLBFLIP ��@��@��8LXJOIN ��p��pC" ��"è�Hǀ�0��@��P(�h��@��>>A ��P��ܘOCTAL ��h܈��8TODIGIT �� (��'�H��0�H��U/MOD ��@��UM/MOD ��@��X�@��hU<= ��x��? ��p��UPC ��a��z��(�� BETWEEN ��H�H��WITHIN ��(�� (�� @��*' ��p��@��(��-ROT ��@��@��CLEAR ��M+ ��@��H��@��0UD2/ ��`��?��p��`��U2/ ��H��LSHIFT��P2/ ��H�P��͠WORD �Ͱ��è��X��P8��h��X��X��RSHIFT��>= ��X��?DO ��`�(�p�H�P�0*�*��(��0��H+COMP ��p�H��p�(� *��X��P*�� pCOMPILE ��p�0��THERE ��COMP-BUFFER(�UNTIL ��H�(�0�x��IF ��`�H�(�0*��0��`BEGIN ��`*��(RESOLVE-DEST �*��0��RESOLVE-ORIG �*��@��h HASH-SIZE �xWA+ ��H��/L* ��̈WA1+ ��H��/L �XWFLIPS ��P@�h�h��h��P��PX@8�hXLFLIP ��@�x��XX!\hL, �*�`��MAX ��X�(�@�X�� START-RTAS/��UNALIGNED-W!�� HEAP-STARTxDEC!0|.R ��@�p��X�((��p�X��P8 p H#FFFFFFFF ��XWFLIP ��@��@��(BLJOIN �p��p��8��LWSPLIT ��@� ��H#20 ��LBSPLIT ��H��2SWAP ��LWFLIP ��H�@8��(; ��H��0�`��>> ��FM/MOD ��p��(0�h�@��H�@� ��X��h/' ��p��@��p�(0��H�p��0>= ��PACK ��Ƞ�@��X�x��D- �8��D2* ��p�� DABS ��p�(8��2* ��H��DO ��`�(�p*��H��0��(��.( ��)è��(CISTACK��AHEAD ��`�H�p�0*��0��@ENDOF �� 8ZCOUNT�ٰ/W* ��/W PXBFLIPS ��P@�h�h�0�h��P�� L!�0W, �*� �� CALL-C/��UNALIGNED-W@��hPAFLOF-STARTP @DEC@0� `U. ��8��4 �H#FFFF �� WXJOIN �8��8��x��XWSPLIT ��H��H��`WLJOIN �� p�� BWJOIN ��h��p�� WBSPLIT �� @�h��WBFLIP ��@p��(:NONAME ��*��H ��0��<< ��pSM/REM �� p�(Ӱ��p�( Ӱ�@Ӱ�@��M* �� p�(8��0> ��xDNEGATE ��Ӱ��@��?PICK�." ��p�((p�H��0� ��"è�� (CIREGS� @OF ��Ƞ��H��0�H��0��H�X�0��ELSE ��H�p�0*��0�@��hRMOVE� �LBFLIPS ��P@�h ��0�h`��P�� L@�PW!�+0WRITE-LOG-BYTE-ENTRY �+P�p��hHSPRG1!.��S. ��H#FF ��XBSPLIT ��*/ ��: ��H ��0��S>D ��p��2R@ ��@��`Z" �p��H��@�X�X��S" ��p�((��H��0� ��"è��Ͱ��@�x��EREGS�ENDCASE ��H�X�0��((�h�@��p��HLWFLIPS ��P@�h ��H�h`��P��HW@��HSPRG1@.��*/MOD ��x��2R> ��@��CASE ��`��hWBFLIPS ��P@�h`�h ��P��HSPRG0!.0�MOD ��X��H2>R ��@��2! ��`HSPRG0@.X/ ��8/MOD ��x-ROLL ��(H��@��H��p��(0��@�H��p��02@ ��p�@�p��SPRG3!-��ROLL ��(0��H��p��(0��H��p��<W@ �`��(��@SPRG3@.��2ROT ��ON ��@�@��XSPRG2!-�pSPRG2@-��SPRG1!-@�SPRG1@-h�SPRG0!,��SPRG0@-�HIOR!,�HIOR@,�DABR!,H0DABR@,tHTBU@, `TBL@+�xPIR@+��PVR@+��SDR1!*$�SDR1@+��MSR!)��MSR@)�HID5@)� HID5!)|8HID4@)TPHID4!) hHID1@(��HID1!*��HID0@*��HID0!*t�get-mbx-base*P�get-flash-size+8get-flash-base+0get-nvram-size+\Pget-nvram-base(�xinternal-set-env'��internal-del-env&��internal-add-env%��internal-get-env$�delete-nvram-partition(�@erase-nvram-partition'Dpincrease-nvram-partition$<�new-nvram-partition#��get-named-nvram-partition"��get-nvram-partition"� wipe-nvram$�0nvram-debug$�Xinternal-reset-nvram$�xnvram-x!"`�nvram-x@h�nvram-l!",�nvram-l@@�nvram-w!!�nvram-w@8nvram-c!�Xnvram-c@��ELF-LOAD-FILE-TO-ADDR�� ELF-LOAD-FILEL�bootmsg-checklevel��bootmsg-nvupdate4bootmsg-setlevel�@bootmsg-debugcpx` bootmsg-error@�bootmsg-warning�� bootmsg-cp��virtio-fs-load��virtio-fs-shutdown`virtio-fs-init @8virtio-blk-read�`virtio-blk-shutdown��virtio-blk-init��virtio-get-config\�virtio-get-qsize(virtio-vring-sizeRX!�0RX@!8HRL! �`RL@ �xRW! ��RW@!��RB!!d�RB@!�� hv-put-tcehv-send-crqP hv-free-crq @ hv-reg-crq�` hv-haschar�� hv-getchar�� hv-putcharTo# ��܈�p��܈��ph# ��܈�p��ܨ��܈��d# ��܈�p��܈�� RECURSE ��(�p�0�0�� P RECURSIVE ��`�� BODY> �۸�`�� >BODY �۸�`�H�� BEHAVIOR ��p��!xTO ��p�((�H�P�0�0� ��"FIND ��P�(H��X�@�@��(Ӱ� �� "`['] ��H�H�0�0��"�[CHAR] ��#��#�POSTPONE ��P��( ��@�@�h��(0�H�H�0�0�H�0�0��#�LITERAL ��H��0�0��#h [COMPILE] ��0��$PFIELD ��H X�0��8�H�`��$� END-STRUCT ��X��$�STRUCT ��%ALIAS ��H ��0��0�`��%pDEFER ��H ��0�H��0�`��%�BUFFER: ��H ��0��`��&8VARIABLE ��H ��0��0�`��&�VALUE ��H 0�0�0�`��&�CONSTANT ��H �0�0�`��'(DOES> ��H'@�0��'�DODOES> ��(�p�0��'�CREATE ��'��(($CREATE ��H ��0�H�@��0�`��(`INCLUDE ��(x��)�INCLUDED �)��P��@��@��p�(��Ƞ�P��X��)��)� WRITE-FILE ��MAP-FILE �)� UNMAP-FILE ��PNICEINIT ��H�X�P��H��P�x�H��P��+��n��H��`�p��8HERE 0��ˀCLIENT-ENTRY-POINT ��+`.WRITE-LOG-BYTE-ENTRY �x�xROMFS-LOOKUP-ENTRY 98hex ' ll-cr to cr get-flash-base VALUE flash-addr get-nvram-base CONSTANT nvram-base get-nvram-size CONSTANT nvram-size ff8f9000 CONSTANT sec-nvram-base \ save area from phype.... not really known 2000 CONSTANT sec-nvram-size nvram-base 20000 + CONSTANT nvram-log-be1-base 0 CONSTANT default-hvtermno : hvterm-emit default-hvtermno SWAP hv-putchar ; : hvterm-key? default-hvtermno hv-haschar ; : hvterm-key BEGIN hvterm-key? UNTIL default-hvtermno hv-getchar ; ' hvterm-emit to emit ' hvterm-key to key ' hvterm-key? to key? : serial-emit hvterm-emit ; : serial-key? hvterm-key? ; : serial-key hvterm-key ; clean-hash : hash-find ( str len head -- 0 | link ) >r 2dup 2dup hash ( str len str len hash R: head ) dup >r @ dup ( str len str len *hash *hash R: head hash ) IF ( str len str len *hash R: head hash ) link>name name>string string=ci ( str len true|false R: head hash ) dup 0= IF THEN ELSE nip nip ( str len 0 R: head hash ) THEN IF \ hash found 2drop r> @ r> drop ( *hash R: ) exit THEN \ hash not found r> r> swap >r ((find)) ( str len head R: hash=0 ) dup IF dup r> ! ( link R: ) ELSE r> drop ( 0 R: ) THEN ; : hash-reveal hash off ; ' hash-reveal to (reveal) ' hash-find to (find) : >name ( xt -- nfa ) \ note: still has the "immediate" field! BEGIN char- dup c@ UNTIL ( @lastchar ) dup dup aligned - cell+ char- ( @lastchar lenmodcell ) dup >r - BEGIN dup c@ r@ <> WHILE cell- r> cell+ >r REPEAT r> drop char- ; VARIABLE mask -1 mask ! VARIABLE huge-tftp-load 1 huge-tftp-load ! : sms-get-tftp-blocksize 598 ; : default-hw-exception s" Exception #" type . ; ' default-hw-exception to hw-exception-handler : diagnostic-mode? false ; \ 2B DOTICK'D later in envvar.fs : memory-test-suite ( addr len -- fail? ) diagnostic-mode? IF ." Memory test mask value: " mask @ . cr ." No memory test suite currently implemented! " cr THEN false ; : 0.r 0 swap <# 0 ?DO # LOOP #> type ; : cnt-bits ( 64-bit-value -- #bits=1 ) dup IF 41 1 DO dup 1- and dup 0= IF drop i LEAVE THEN LOOP THEN ; : bcd-to-bin ( bcd -- bin ) dup f and swap 4 rshift a * + ; : 2log ( n -- lb{n} ) 8 cells 0 DO 1 rshift dup 0= IF drop i LEAVE THEN LOOP ; : log2 ( n -- log2-n ) 1- 2log 1+ ; CREATE $catpad 100 allot : $cat ( str1 len1 str2 len2 -- str3 len3 ) >r >r dup >r $catpad swap move r> dup $catpad + r> swap r@ move r> + $catpad swap ; : $cat-comma ( str2 len2 str1 len1 -- "str1, str2" len1+len2+2 ) 2dup + s" , " rot swap move 2+ 2swap $cat ; : $cat-space ( str2 len2 str1 len1 -- "str1 str2" len1+len2+1 ) 2dup + bl swap c! 1+ 2swap $cat ; : $cathex ( str len val -- str len' ) (u.) $cat ; : 2CONSTANT CREATE , , DOES> [ here ] 2@ ; CONSTANT <2constant> : $2CONSTANT $CREATE , , DOES> 2@ ; : 2VARIABLE CREATE 0 , 0 , DOES> ; : (is-user-word) ( name-str name-len xt -- ) -rot $CREATE , DOES> @ execute ; : zplace ( str len buf -- ) 2dup + 0 swap c! swap move ; : rzplace ( str len buf -- ) 2dup + 0 swap rb! swap rmove ; : strdup ( str len -- dupstr len ) here over allot swap 2dup 2>r move 2r> ; : str= ( str1 len1 str2 len2 -- equal? ) rot over <> IF 3drop false ELSE comp 0= THEN ; : test-string ( param len -- true | false ) 0 ?DO dup i + c@ \ Get character / byte at current index dup 20 < swap 7e > OR IF \ Is it out of range 32 to 126 (=ASCII) drop FALSE UNLOOP EXIT \ FALSE means: No ASCII string THEN LOOP drop TRUE \ Only ASCII found --> it is a string ; : #aligned ( adr alignment -- adr' ) negate swap negate and negate ; : #join ( lo hi #bits -- x ) lshift or ; : #split ( x #bits -- lo hi ) 2dup rshift dup >r swap lshift xor r> ; : /string ( str len u -- str' len' ) >r swap r@ chars + swap r> - ; : skip ( str len c -- str' len' ) >r BEGIN dup WHILE over c@ r@ = WHILE 1 /string REPEAT THEN r> drop ; : scan ( str len c -- str' len' ) >r BEGIN dup WHILE over c@ r@ <> WHILE 1 /string REPEAT THEN r> drop ; : split ( str len char -- left len right len ) >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; : rfindchar ( str len char -- offs true | false ) swap 1 - 0 swap do over i + c@ over dup bl = if <= else = then if 2drop i dup dup leave then -1 +loop = ; : rsplit ( str len char -- left len right len ) >r 2dup r> rfindchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; : left-parse-string ( str len char -- R-str R-len L-str L-len ) split 2swap ; : replace-char ( str len chout chin -- ) >r -rot BEGIN 2dup 4 pick findchar WHILE tuck - -rot + r@ over c! swap REPEAT r> 2drop 2drop ; : \-to-/ ( str len -- str' len ) strdup 2dup [char] \ [char] / replace-char ; : isdigit ( char -- true | false ) 30 39 between ; : // dup >r 1- + r> / ; \ division, round up : c@+ ( adr -- c adr' ) dup c@ swap char+ ; : 2c@ ( adr -- c1 c2 ) c@+ c@ ; : 4c@ ( adr -- c1 c2 c3 c4 ) c@+ c@+ c@+ c@ ; : 8c@ ( adr -- c1 c2 c3 c4 c5 c6 c7 c8 ) c@+ c@+ c@+ c@+ c@+ c@+ c@+ c@ ; : 4dup ( n1 n2 n3 n4 -- n1 n2 n3 n4 n1 n2 n3 n4 ) 2over 2over ; : 4drop ( n1 n2 n3 n4 -- ) 2drop 2drop ; : 6dup ( 1 2 3 4 5 6 -- 1 2 3 4 5 6 1 2 3 4 5 6 ) 5 pick 5 pick 5 pick 5 pick 5 pick 5 pick ; : signed ( n1 -- n2 ) dup 80000000 and IF FFFFFFFF00000000 or THEN ; : <l@ ( addr -- x ) l@ signed ; : -leading BEGIN dup WHILE over c@ bl <= WHILE 1 /string REPEAT THEN ; : (parse-line) skipws 0 parse ; : hex-byte ( char0 char1 -- value true|false ) 10 digit IF swap 10 digit IF 4 lshift or true EXIT ELSE 2drop 0 THEN ELSE drop THEN false EXIT ; : parse-hexstring ( dst-adr -- dst-adr' ) [char] ) parse cr ( dst-adr str len ) bounds ?DO ( dst-adr ) i c@ i 1+ c@ hex-byte IF ( dst-adr hex-byte ) >r dup r> swap c! 1+ 2 ( dst-adr+1 2 ) ELSE drop 1 ( dst-adr 1 ) THEN +LOOP ; : add-specialchar ( dst-adr special -- dst-adr' ) over c! 1+ ( dst-adr' ) 1 >in +! \ advance input-index ; : parse-" ( dst-adr -- dst-adr' ) [char] " parse dup 3 pick + >r ( dst-adr str len R: dst-adr' ) >r swap r> move r> ( dst-adr' ) ; : (") ( dst-adr -- dst-adr' ) begin ( dst-adr ) parse-" ( dst-adr' ) >in @ dup span @ >= IF ( dst-adr' >in-@ ) drop EXIT THEN ib + c@ CASE [char] ( OF parse-hexstring ENDOF [char] " OF [char] " add-specialchar ENDOF dup OF EXIT ENDOF ENDCASE again ; CREATE "pad 100 allot : " ( [text<">< >] -- text-str text-len ) state @ IF \ compile sliteral, pstr into dict "pad dup (") over - ( str len ) ['] sliteral compile, dup c, ( str len ) bounds ?DO i c@ c, LOOP align ['] count compile, ELSE pocket dup (") over - \ Interpretation, put string THEN \ in temp buffer ; immediate : (cr carret emit ; : $forget ( str len -- ) 2dup last @ ( str len str len last-bc ) BEGIN dup >r ( str len str len last-bc R: last-bc ) cell+ char+ count ( str len str len found-str found-len R: last-bc ) string=ci IF ( str len R: last-bc ) r> @ last ! 2drop clean-hash EXIT ( -- ) THEN 2dup r> @ dup 0= ( str len str len next-bc next-bc ) UNTIL drop 2drop 2drop \ clean hash table ; : forget ( "old-name<>" -- ) parse-word $forget ; : linked ( var -- ) here over @ , swap ! ; HEX VARIABLE wordlists forth-wordlist wordlists ! : wordlist ( -- wid ) here wordlists linked 0 , ; 10 CONSTANT max-in-search-order \ should define elsewhere : also ( -- ) clean-hash context dup cell+ dup to context >r @ r> ! ; : previous ( -- ) clean-hash context cell- to context ; : only ( -- ) clean-hash search-order to context ( minimal-wordlist search-order ! ) ; : seal ( -- ) clean-hash context @ search-order dup to context ! ; : get-order ( -- wid_n .. wid_1 n ) context >r search-order BEGIN dup r@ u<= WHILE dup @ swap cell+ REPEAT r> drop search-order - cell / ; : set-order ( wid_n .. wid_1 n -- ) \ XXX: special cases for 0, -1 clean-hash 1- cells search-order + dup to context BEGIN dup search-order u>= WHILE dup >r ! r> cell- REPEAT drop ; : get-current ( -- wid ) current ; : set-current ( wid -- ) to current ; : definitions ( -- ) context @ set-current ; : VOCABULARY ( C: "name" -- ) ( -- ) CREATE wordlist drop DOES> clean-hash context ! ; : FORTH ( -- ) clean-hash forth-wordlist context ! ; : .voc ( wid -- ) \ display name for wid \ needs work ( body> or something like that ) dup cell- @ ['] vocabulary ['] forth within IF 2 cells - >name name>string type ELSE u. THEN space ; : vocs ( -- ) \ display all wordlist names cr wordlists BEGIN @ dup WHILE dup .voc REPEAT drop ; : order ( -- ) cr ." context: " get-order 0 ?DO .voc LOOP cr ." current: " get-current .voc ; : voc-find ( wid -- 0 | link ) clean-hash cell+ @ (find) clean-hash ; : (function) ; defer (defer) 0 value (value) 0 constant (constant) variable (variable) create (create) alias (alias) (function) cell buffer: (buffer:) ' (function) @ \ ( <colon> ) ' (function) cell + @ \ ( ... <semicolon> ) ' (defer) @ \ ( ... <defer> ) ' (value) @ \ ( ... <value> ) ' (constant) @ \ ( ... <constant> ) ' (variable) @ \ ( ... <variable> ) ' (create) @ \ ( ... <create> ) ' (alias) @ \ ( ... <alias> ) ' (buffer:) @ \ ( ... <buffer:> ) forget (function) constant <buffer:> constant <alias> constant <create> constant <variable> constant <constant> constant <value> constant <defer> constant <semicolon> constant <colon> ' lit constant <lit> ' sliteral constant <sliteral> ' 0branch constant <0branch> ' branch constant <branch> ' doloop constant <doloop> ' dotick constant <dotick> ' doto constant <doto> ' do?do constant <do?do> ' do+loop constant <do+loop> ' do constant <do> ' exit constant <exit> ' doleave constant <doleave> ' do?leave constant <do?leave> 500 CONSTANT AVAILABLE-SIZE 4000 CONSTANT MIN-RAM-RESERVE \ prevent from using first pages : MIN-RAM-SIZE \ Initially available memory size epapr-ima-size IF epapr-ima-size ELSE 20000000 \ assumed minimal memory size THEN ; MIN-RAM-SIZE CONSTANT MIN-RAM-SIZE STRUCT cell field available>address cell field available>size CONSTANT /available CREATE available AVAILABLE-SIZE /available * allot available AVAILABLE-SIZE /available * erase VARIABLE mem-pre-released 0 mem-pre-released ! : available>size@ available>size @ ; : available>address@ available>address @ ; : available>size! available>size ! ; : available>address! available>address ! ; : available! ( addr size available-ptr -- ) dup -rot available>size! available>address! ; : available@ ( available-ptr -- addr size ) dup available>address@ swap available>size@ ; : (?available-segment<) ( start1 end1 start2 end2 -- true/false ) drop < nip ; : (?available-segment>) ( start1 end1 start2 end2 -- true/false ) -rot 2drop > ; : (?available-segment-#) ( start1 end1 start2 end2 -- true/false ) 2dup 5 roll -rot ( e1 s2 e2 s1 s2 e2 ) between >r between r> and not ; : (find-available) ( addr addr+size-1 a-ptr a-size -- a-ptr' found ) ?dup 0= IF -rot 2drop false EXIT THEN \ Not Found 2dup 2/ dup >r /available * + dup available>size@ 0= IF 2drop r> RECURSE EXIT THEN dup >r available@ over + 1- 2>r 2swap 2dup 2r@ (?available-segment>) IF 2swap 2r> 2drop r> /available + -rot r> - 1- nip RECURSE EXIT \ Look Right THEN 2dup 2r@ (?available-segment<) IF 2swap 2r> 2drop r> 2drop r> RECURSE EXIT \ Look Left THEN 2dup 2r@ (?available-segment-#) IF \ Conflict - segments overlap 2r> 2r> 3drop 3drop 2drop 1212 throw THEN 2r> 3drop 3drop r> r> drop ( a-ptr' -- ) dup available>size@ 0<> ( a-ptr' found -- ) ; : (find-available) ( addr size -- seg-ptr found ) over + 1- available AVAILABLE-SIZE ['] (find-available) catch IF 2drop 2drop 0 false THEN ; : dump-available ( available-ptr -- ) cr dup available - /available / AVAILABLE-SIZE swap - 0 ?DO dup available@ ?dup 0= IF 2drop UNLOOP EXIT THEN swap . . cr /available + LOOP dup ; : .available available dump-available ; : (drop-available) ( available-ptr -- ) dup available - /available / \ current element index AVAILABLE-SIZE swap - \ # of remaining elements ( first nelements ) 1- 0 ?DO dup /available + dup available@ ( current next next>address next>size ) ?dup 0= IF 2drop LEAVE \ NULL element - goto last copy THEN 3 roll available! ( next ) LOOP 0 0 rot available! ; : (stick-to-previous-available) ( addr size available-ptr -- naddr nsize nptr success ) dup available = IF false EXIT \ This was the first available segment THEN dup /available - dup available@ + 4 pick = IF nip \ Drop available-ptr since we are going to previous one rot drop \ Drop start addr, we take the previous one dup available@ 3 roll + rot true ELSE drop false THEN ; : (insert-available) ( available-ptr -- available-ptr ) dup \ current element dup available - /available / \ current element index AVAILABLE-SIZE swap - \ # of remaining elements dup 0<= 3 pick available>size@ 0= or IF drop drop EXIT THEN over available@ rot ( first first/=current/ first>address first>size nelements ) 1- 0 ?DO 2>r /available + dup available@ 2r> 4 pick available! dup 0= IF rot /available + available! UNLOOP EXIT THEN LOOP ( first next/=last/ last[0]>address last[0]>size ) ?dup 0<> IF cr ." release error: available map overflow" cr ." Dumping available property" .available cr ." No space for one before last entry:" cr swap . . cr ." Dying ..." cr 123 throw THEN 2drop ; : insert-available ( addr size available-ptr -- addr size available-ptr ) dup available>address@ 0<> IF dup available>address@ rot dup -rot - 3 pick = IF \ if (available>address@ - size == addr) over available>size@ + swap (stick-to-previous-available) IF dup /available + (drop-available) THEN ELSE swap (stick-to-previous-available) not IF (insert-available) THEN THEN ELSE (stick-to-previous-available) drop THEN ; defer release : drop-available ( addr size available-ptr -- addr ) dup >r available@ over 4 pick swap - ?dup 0<> IF dup 3 roll swap r> available! - over - ?dup 0= IF drop ELSE swap 2 pick + swap release THEN ELSE nip ( req_addr req_size segment_size ) over - ?dup 0= IF drop r> (drop-available) ELSE -rot over + rot r> available! THEN THEN ; : pwr2roundup ( value -- pwr2value ) dup CASE 0 OF EXIT ENDOF 1 OF EXIT ENDOF ENDCASE dup 1 DO drop i dup +LOOP dup + ; : (claim-best-fit) ( len align -- len base ) pwr2roundup 1- -1 -1 available AVAILABLE-SIZE /available * + available DO i \ Must be saved now, before we use Return stack -rot >r >r swap >r available@ ?dup 0= IF drop r> r> r> LEAVE THEN \ EOL 2 pick - dup 0< IF 2drop \ Can't Fit: Too Small ELSE dup 2 pick r@ and - 0< IF 2drop \ Can't Fit When Aligned ELSE r> -rot dup r@ U< IF 2r> 2drop swap 2 pick + 2 pick invert and >r >r >r ELSE 2drop >r THEN THEN THEN r> r> r> /available +LOOP -rot 2drop ( len best-fit-base/or -1 if none found/ ) ; : (adjust-release0) ( 0 size -- addr' size' ) 2dup MIN-RAM-SIZE dup 3 roll + -rot - dup 0< IF 2drop ELSE 2swap 2drop 0 mem-pre-released ! THEN ; : claim ( [ addr ] len align -- base ) ?dup 0<> IF (claim-best-fit) dup -1 = IF 2drop cr ." claim error : aligned allocation failed" cr ." available:" cr .available 321 throw EXIT THEN swap THEN 2dup (find-available) not IF drop 2drop 321 throw EXIT THEN ( req_addr req_size available-ptr ) drop-available ; : .release ( addr len -- ) over 0= mem-pre-released @ and IF (adjust-release0) THEN 2dup (find-available) IF drop swap cr ." release error: region " . ." , " . ." already released" cr ELSE ?dup 0= IF swap cr ." release error: Bad/conflicting region " . ." , " . ." or available list full " cr ELSE ( addr size available-ptr ) insert-available ( addr size available-ptr ) available! THEN THEN ; ' .release to release 0 MIN-RAM-SIZE release 1 mem-pre-released ! 0 MIN-RAM-RESERVE 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop paflof-start ffff not and 1f00000 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop heap-end heap-start - log2 1+ CONSTANT (max-heads#) CREATE heads (max-heads#) cells allot heads (max-heads#) cells erase : size>head ( size -- headptr ) log2 3 max cells heads + ; : alloc-mem ( len -- a-addr ) dup 0= IF EXIT THEN 1 over log2 3 max ( len 1 log_len ) dup (max-heads#) >= IF cr ." Out of internal memory." cr 3drop 0 EXIT THEN lshift >r ( len R: 1<<log_len ) size>head dup @ IF dup @ dup >r @ swap ! r> r> drop EXIT THEN ( headptr R: 1<<log_len) r@ 2* recurse dup ( headptr a-addr2 a-addr2 R: 1<<log_len) dup 0= IF r> 2drop 2drop 0 EXIT THEN r> + >r 0 over ! swap ! r> ; : free-mem ( a-addr len -- ) dup 0= IF 2drop EXIT THEN size>head 2dup @ swap ! ! ; : #links ( a -- n ) @ 0 BEGIN over WHILE 1+ swap @ swap REPEAT nip ; : .free ( -- ) 0 (max-heads#) 0 DO heads i cells + #links dup IF cr dup . ." * " 1 i lshift dup . ." = " * dup . THEN + LOOP cr ." Total " . ; heap-start heap-end heap-start - free-mem VARIABLE device-tree VARIABLE current-node : get-node current-node @ dup 0= ABORT" No active device tree node" ; STRUCT cell FIELD node>peer cell FIELD node>parent cell FIELD node>child cell FIELD node>properties cell FIELD node>words cell FIELD node>instance-template cell FIELD node>instance-size cell FIELD node>space? cell FIELD node>space cell FIELD node>addr1 cell FIELD node>addr2 cell FIELD node>addr3 END-STRUCT : find-method ( str len phandle -- false | xt true ) node>words @ voc-find dup IF link> true THEN ; 0 VALUE my-self 400 CONSTANT max-instance-size STRUCT /n FIELD instance>node /n FIELD instance>parent /n FIELD instance>args /n FIELD instance>args-len /n FIELD instance>size /n FIELD instance>#units /n FIELD instance>unit1 \ For instance-specific "my-unit" /n FIELD instance>unit2 /n FIELD instance>unit3 /n FIELD instance>unit4 CONSTANT /instance-header : >instance ( offset -- myself+offset ) my-self 0= ABORT" No instance!" dup my-self instance>size @ >= ABORT" Instance access out of bounds!" my-self + ; : (create-instance-var) ( initial-value -- ) get-node dup node>instance-size @ cell+ max-instance-size >= ABORT" Instance is bigger than max-instance-size!" dup node>instance-template @ ( iv phandle tmp-ih ) swap node>instance-size dup @ ( iv tmp-ih *instance-size instance-size ) dup , \ compile current instance ptr swap 1 cells swap +! ( iv tmp-ih instance-size ) + ! ; : create-instance-var ( "name" initial-value -- ) CREATE (create-instance-var) PREVIOUS ; : (create-instance-buf) ( buffersize -- ) aligned \ align size to multiples of cells dup get-node node>instance-size @ + ( buffersize' newinstancesize ) max-instance-size > ABORT" Instance is bigger than max-instance-size!" get-node node>instance-template @ get-node node>instance-size @ + over erase \ clear according to IEEE 1275 get-node node>instance-size @ ( buffersize' old-instance-size ) dup , \ compile current instance ptr + get-node node>instance-size ! \ store new size ; : create-instance-buf ( "name" buffersize -- ) CREATE (create-instance-buf) PREVIOUS ; VOCABULARY instance-words ALSO instance-words DEFINITIONS : VARIABLE 0 create-instance-var DOES> [ here ] @ >instance ; : VALUE create-instance-var DOES> [ here ] @ >instance @ ; : DEFER 0 create-instance-var DOES> [ here ] @ >instance @ execute ; : BUFFER: create-instance-buf DOES> [ here ] @ >instance ; PREVIOUS DEFINITIONS CONSTANT <instancebuffer> CONSTANT <instancedefer> CONSTANT <instancevalue> CONSTANT <instancevariable> : (instance?) ( xt -- xt true|false ) dup @ <create> = IF dup cell+ @ cell+ @ ['] >instance = ELSE false THEN ; : (doito) ( value R:*CFA -- ) r> cell+ dup >r @ cell+ cell+ @ >instance ! ; ' (doito) CONSTANT <(doito)> : to ( value wordname<> -- ) ' (instance?) state @ IF IF ['] (doito) ELSE ['] DOTO THEN , , EXIT THEN IF cell+ cell+ @ >instance ! \ interp mode instance value ELSE cell+ ! \ interp mode normal value THEN ; IMMEDIATE : behavior ( defer-xt -- contents-xt ) dup cell+ @ <instancedefer> = IF \ Is defer-xt an INSTANCE DEFER ? 2 cells + @ >instance @ ELSE behavior THEN ; : INSTANCE ALSO instance-words ; : my-parent my-self instance>parent @ ; : my-args my-self instance>args 2@ swap ; : set-my-args ( old-addr len -- ) dup IF \ IF len > 0 ( old-addr len ) dup alloc-mem \ | allocate space for new args ( old-addr len new-addr ) 2dup my-self instance>args 2! \ | write into instance struct ( old-addr len new-addr ) swap move \ | and copy the args ( ) ELSE \ ELSE ( old-addr len ) my-self instance>args 2! \ | set new args to zero, too ( ) THEN \ FI ; : create-instance-data ( -- instance ) get-node dup node>instance-template @ ( phandle instance-template ) swap node>instance-size @ ( instance-template instance-size ) dup >r dup alloc-mem dup >r swap move r> ( instance ) dup instance>size r> swap ! \ Store size for destroy-instance dup instance>#units 0 swap ! \ Use node unit by default ; : create-instance ( -- ) my-self create-instance-data dup to my-self instance>parent ! get-node my-self instance>node ! ; : destroy-instance ( instance -- ) dup instance>args @ ?dup IF \ Free instance args? over instance>args-len @ free-mem THEN dup instance>size @ free-mem ; : ihandle>phandle ( ihandle -- phandle ) dup 0= ABORT" no current instance" instance>node @ ; : push-my-self ( ihandle -- ) r> my-self >r >r to my-self ; : pop-my-self ( -- ) r> r> to my-self >r ; : call-package push-my-self execute pop-my-self ; : $call-static ( ... str len node -- ??? ) find-method IF execute ELSE -1 throw THEN ; : $call-my-method ( str len -- ) my-self ihandle>phandle $call-static ; : $call-method ( str len ihandle -- ) push-my-self ['] $call-my-method CATCH ?dup IF pop-my-self THROW THEN pop-my-self ; 0 VALUE calling-child : $call-parent my-self ihandle>phandle TO calling-child my-parent $call-method 0 TO calling-child ; : create-node ( parent -- new ) max-instance-size alloc-mem ( parent instance-mem ) dup max-instance-size erase >r ( parent R: instance-mem ) align wordlist >r wordlist >r ( parent R: instance-mem wl wl ) here ( parent new R: instance-mem wl wl ) 0 , swap , 0 , \ Set node>peer, node>parent & node>child r> , r> , \ Set node>properties & node>words to wl r> , /instance-header , \ Set instance-template & instance-size FALSE , 0 , \ Set node>space? and node>space 0 , 0 , 0 , \ Set node>addr* ; : peer node>peer @ ; : parent node>parent @ ; : child node>child @ ; : peer dup IF peer ELSE drop device-tree @ THEN ; : link ( new head -- ) \ link a new node at the end of a linked list BEGIN dup @ WHILE @ REPEAT ! ; : link-node ( parent child -- ) swap dup IF node>child link ELSE drop device-tree ! THEN ; : set-node ( phandle -- ) current-node @ IF previous THEN dup current-node ! ?dup IF node>words @ also context ! THEN definitions ; : get-parent get-node parent ; : new-node ( -- phandle ) \ active node becomes new node's parent; current-node @ dup create-node tuck link-node dup set-node ; : finish-node ( -- ) get-node parent set-node ; : device-end ( -- ) 0 set-node ; CREATE $indent 100 allot VARIABLE indent 0 indent ! true value encode-first? : decode-int over >r 4 /string r> 4c@ swap 2swap swap bljoin ; : decode-64 decode-int -rot decode-int -rot 2swap swap lxjoin ; : decode-string ( prop-addr1 prop-len1 -- prop-addr2 prop-len2 str len ) dup 0= IF 2dup EXIT THEN \ string properties with zero lenght over BEGIN dup c@ 0= IF 1+ -rot swap 2 pick over - rot over - -rot 1- EXIT THEN 1+ AGAIN ; : (prune) ( name len head -- ) dup >r (find) ?dup IF r> BEGIN dup @ WHILE 2dup @ = IF >r @ r> ! EXIT THEN @ REPEAT 2drop ELSE r> drop THEN ; : prune ( name len -- ) last (prune) ; : set-property ( data dlen name nlen phandle -- ) true to encode-first? get-current >r node>properties @ set-current 2dup prune $2CONSTANT r> set-current ; : delete-property ( name nlen -- ) get-node get-current >r node>properties @ set-current prune r> set-current ; : property ( data dlen name nlen -- ) get-node set-property ; : get-property ( str len phandle -- true | data dlen false ) ?dup 0= IF cr cr cr ." get-property for " type ." on zero phandle" cr cr true EXIT THEN node>properties @ voc-find dup IF link> execute false ELSE drop true THEN ; : get-package-property ( str len phandle -- true | data dlen false ) get-property ; : get-my-property ( str len -- true | data dlen false ) my-self ihandle>phandle get-property ; : get-parent-property ( str len -- true | data dlen false ) my-parent ihandle>phandle get-property ; : get-inherited-property ( str len -- true | data dlen false ) my-self ihandle>phandle BEGIN 3dup get-property 0= IF rot drop rot drop rot drop false EXIT THEN parent dup 0= IF 3drop true EXIT THEN AGAIN ; 20 CONSTANT indent-prop : .prop-int ( str len -- ) space 400 min 0 ?DO i over + dup ( str act-addr act-addr ) c@ 2 0.r 1+ dup c@ 2 0.r 1+ dup c@ 2 0.r 1+ c@ 2 0.r ( str ) i c and c = IF \ check for multipleof 16 bytes cr indent @ indent-prop + 1+ 0 \ linefeed + indent DO space \ print spaces LOOP ELSE space space \ print two spaces THEN 4 +LOOP drop ; : .prop-bytes ( str len -- ) 2dup -4 and .prop-int ( str len ) dup 3 and dup IF ( str len len%4 ) >r -4 and + r> ( str' len%4 ) bounds ( str' str'+len%4 ) DO i c@ 2 0.r \ Print last 3 bytes LOOP ELSE 3drop THEN ; : .prop-string ( str len ) 2dup space type cr indent @ indent-prop + 0 DO space LOOP \ Linefeed .prop-bytes ; : .propbytes ( xt -- ) execute dup IF over cell- @ execute ELSE 2drop THEN ; : .property ( lfa -- ) cr indent @ 0 ?DO space LOOP link> dup >name name>string 2dup type nip ( len ) indent-prop swap - ( xt 20-len ) dup 0< IF drop 0 THEN 0 ( xt number-of-space 0 ) ?DO space LOOP .propbytes ; : (.properties) ( phandle -- ) node>properties @ cell+ @ BEGIN dup WHILE dup .property @ REPEAT drop ; : .properties ( -- ) get-node (.properties) ; : next-property ( str len phandle -- false | str' len' true ) ?dup 0= IF device-tree @ THEN \ XXX: is this line required? node>properties @ >r 2dup 0= swap 0= or IF 2drop r> cell+ ELSE r> voc-find THEN @ dup IF link>name name>string true THEN ; : encode-start ( -- prop 0 ) ['] .prop-int compile, false to encode-first? here 0 ; : encode-int ( val -- prop prop-len ) encode-first? IF ['] .prop-int compile, \ Execution token for print false to encode-first? THEN here swap lbsplit c, c, c, c, /l ; : encode-bytes ( str len -- prop-addr prop-len ) encode-first? IF ['] .prop-bytes compile, \ Execution token for print false to encode-first? THEN here over 2dup 2>r allot swap move 2r> ; : encode-string ( str len -- prop-addr prop-len ) encode-first? IF ['] .prop-string compile, \ Execution token for print false to encode-first? THEN encode-bytes 0 c, char+ ; : encode+ ( prop1-addr prop1-len prop2-addr prop2-len -- prop-addr prop-len ) nip + ; : encode-int+ encode-int encode+ ; : encode-64 xlsplit encode-int rot encode-int+ ; : encode-64+ encode-64 encode+ ; : device-name encode-string s" name" property ; : device-type encode-string s" device_type" property ; : model encode-string s" model" property ; : compatible encode-string s" compatible" property ; : #address-cells s" #address-cells" rot parent get-property ABORT" parent doesn't have a #address-cells property!" decode-int nip nip ; : my-#address-cells ( -- #address-cells ) get-node #address-cells ; : child-#address-cells ( -- #address-cells ) s" #address-cells" get-node get-property ABORT" node doesn't have a #address-cells property!" decode-int nip nip ; : child-#size-cells ( -- #address-cells ) s" #size-cells" get-node get-property ABORT" node doesn't have a #size-cells property!" decode-int nip nip ; : encode-phys ( phys.hi ... phys.low -- prop len ) encode-first? IF encode-start ELSE here 0 THEN my-#address-cells 0 ?DO rot encode-int+ LOOP ; : encode-child-phys ( phys.hi ... phys.low -- prop len ) encode-first? IF encode-start ELSE here 0 THEN child-#address-cells 0 ?DO rot encode-int+ LOOP ; : encode-child-size ( size.hi ... size.low -- prop len ) encode-first? IF encode-start ELSE here 0 THEN child-#size-cells 0 ?DO rot encode-int+ LOOP ; : decode-phys my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT drop my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ; : decode-phys-and-drop my-#address-cells BEGIN dup WHILE 1- >r decode-int r> swap >r REPEAT 3drop my-#address-cells BEGIN dup WHILE 1- r> swap REPEAT drop ; : reg >r encode-phys r> encode-int+ s" reg" property ; : >space node>space @ ; : >space? node>space? @ ; : >address dup >r #address-cells dup 3 > IF r@ node>addr3 @ swap THEN dup 2 > IF r@ node>addr2 @ swap THEN 1 > IF r@ node>addr1 @ THEN r> drop ; : >unit dup >r >address r> >space ; : (my-phandle) ( -- phandle ) my-self ?dup IF ihandle>phandle ELSE get-node dup 0= ABORT" no active node" THEN ; : my-space ( -- phys.hi ) (my-phandle) >space ; : my-address (my-phandle) >address ; : my-unit my-self instance>#units @ IF 0 my-self instance>#units @ 1- DO my-self instance>unit1 i cells + @ -1 +LOOP ELSE my-self ihandle>phandle >unit THEN ; : my-unit-64 ( -- phys.lo+1|phys.lo ) my-unit ( phys.lo ... phys.hi ) (my-phandle) #address-cells ( phys.lo ... phys.hi #ad-cells ) CASE 1 OF EXIT ENDOF 2 OF lxjoin EXIT ENDOF 3 OF drop lxjoin EXIT ENDOF dup OF 2drop lxjoin EXIT ENDOF ENDCASE ; : set-space get-node dup >r node>space ! true r> node>space? ! ; : set-address my-#address-cells 1 ?DO get-node node>space i cells + ! LOOP ; : set-unit set-space set-address ; : set-unit-64 ( phys.lo|phys.hi -- ) my-#address-cells 2 <> IF ." set-unit-64: #address-cells <> 2 " abort THEN xlsplit set-unit ; : set-args ( arg-str len unit-str len -- ) s" decode-unit" get-parent $call-static set-unit set-my-args ; : $cat-unit dup parent 0= IF drop EXIT THEN dup >space? not IF drop EXIT THEN dup >r >unit s" encode-unit" r> parent $call-static dup IF dup >r here swap move s" @" $cat here r> $cat ELSE 2drop THEN ; : node>name dup >r s" name" rot get-property IF r> (u.) ELSE 1- r> drop THEN ; : node>qname dup node>name rot ['] $cat-unit CATCH IF drop THEN ; : node>path here 0 rot BEGIN dup WHILE dup parent REPEAT 2drop dup 0= IF [char] / c, THEN BEGIN dup WHILE [char] / c, node>qname here over allot swap move REPEAT drop here 2dup - allot over - ; : interposed? ( ihandle -- flag ) dup instance>parent @ dup 0= IF 2drop false EXIT THEN ihandle>phandle swap ihandle>phandle parent <> ; : instance>qname dup >r interposed? IF s" %" ELSE 0 0 THEN r@ ihandle>phandle node>qname $cat r> instance>args 2@ dup IF 2>r s" :" $cat 2r> $cat ELSE 2drop THEN ; : instance>qpath \ With interposed nodes. here 0 rot BEGIN dup WHILE dup instance>parent @ REPEAT 2drop dup 0= IF [char] / c, THEN BEGIN dup WHILE [char] / c, instance>qname here over allot swap move REPEAT drop here 2dup - allot over - ; : instance>path \ Without interposed nodes. here 0 rot BEGIN dup WHILE dup interposed? 0= IF dup THEN instance>parent @ REPEAT 2drop dup 0= IF [char] / c, THEN BEGIN dup WHILE [char] / c, instance>qname here over allot swap move REPEAT drop here 2dup - allot over - ; : .node node>path type ; : pwd get-node .node ; : .instance instance>qpath type ; : .chain dup instance>parent @ ?dup IF recurse THEN cr dup . instance>qname type ; defer find-node : set-alias ( alias-name len device-name len -- ) encode-string 2swap s" /aliases" find-node ?dup IF set-property ELSE 4drop THEN ; : find-alias ( alias-name len -- false | dev-path len ) s" /aliases" find-node dup IF get-property 0= IF 1- dup 0= IF nip THEN ELSE false THEN THEN ; : .alias ( alias-name len -- ) find-alias dup IF type ELSE ." no alias available" THEN ; : (.print-alias) ( lfa -- ) link> dup >name name>string 2dup s" name" string=ci IF 2drop drop ELSE cr type space ." : " execute type THEN ; : (.list-alias) ( phandle -- ) node>properties @ cell+ @ BEGIN dup WHILE dup (.print-alias) @ REPEAT drop ; : list-alias ( -- ) s" /aliases" find-node dup IF (.list-alias) THEN ; : devalias ( "{alias-name}<>{device-specifier}<cr>" -- ) parse-word parse-word dup IF set-alias ELSE 2drop dup IF .alias ELSE 2drop list-alias THEN THEN ; : sub-alias ( arg-str arg-len -- arg' len' | false ) 2dup 2dup [char] / findchar ?dup IF ELSE 2dup [char] : findchar THEN ( a l a l [p] -1|0 ) IF nip dup ELSE 2drop 0 THEN >r find-alias ?dup IF ( a l a' p' -- R:p | a' l' -- R:0 ) r@ IF 2swap r@ - swap r> + swap $cat strdup ( a" l-p+p' -- ) ELSE ( a' l' -- R:0 ) r> drop ( a' l' -- ) THEN ELSE ( a l -- R:p | -- R:0 ) r> IF 2drop THEN false ( 0 -- ) THEN ; : de-alias ( arg-str arg-len -- arg' len' ) BEGIN over c@ [char] / <> dup IF drop 2dup sub-alias ?dup THEN WHILE 2swap 2drop REPEAT ; : +indent ( not-last? -- ) IF s" | " ELSE s" " THEN $indent indent @ + swap move 4 indent +! ; : -indent ( -- ) -4 indent +! ; : ls-phandle ( node -- ) . ." : " ; : ls-node ( node -- ) cr dup ls-phandle $indent indent @ type dup peer IF ." |-- " ELSE ." +-- " THEN node>qname type ; : (ls) ( node -- ) child BEGIN dup WHILE dup ls-node dup child IF dup peer +indent dup recurse -indent THEN peer REPEAT drop ; : ls ( -- ) get-node cr dup ls-phandle dup node>path type (ls) 0 indent ! ; : show-devs ( {device-specifier}<eol> -- ) skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN ( str len ) find-node dup 0= ABORT" No such device path" (ls) ; VARIABLE interpose-node 2VARIABLE interpose-args : interpose ( arg len phandle -- ) interpose-node ! interpose-args 2! ; 0 VALUE user-instance-#units CREATE user-instance-units 4 cells allot : copy-instance-unit ( -- ) user-instance-#units IF user-instance-#units my-self instance>#units ! user-instance-units my-self instance>unit1 user-instance-#units cells move 0 to user-instance-#units THEN ; : open-node ( arg len phandle -- ihandle|0 ) current-node @ >r my-self >r \ Save current node and instance set-node create-instance set-my-args copy-instance-unit s" open" get-node find-method IF execute ELSE TRUE THEN 0= IF my-self destroy-instance 0 to my-self THEN my-self ( ihandle|0 ) r> to my-self r> set-node \ Restore current node and instance interpose-node @ IF my-self >r to my-self interpose-args 2@ interpose-node @ interpose-node off recurse r> to my-self THEN ; : close-node ( ihandle -- ) my-self >r to my-self s" close" ['] $call-my-method CATCH IF 2drop THEN my-self destroy-instance r> to my-self ; : close-dev ( ihandle -- ) my-self >r to my-self BEGIN my-self WHILE my-parent my-self close-node to my-self REPEAT r> to my-self ; : new-device ( -- ) my-self new-node ( parent-ihandle phandle ) node>instance-template @ ( parent-ihandle ihandle ) dup to my-self ( parent-ihanlde ihandle ) instance>parent ! get-node my-self instance>node ! max-instance-size my-self instance>size ! ; : finish-device ( -- ) get-node >space? 0= IF s" reg" get-node get-property 0= IF decode-int set-space 2drop THEN THEN finish-node my-parent to my-self ; : extend-device ( phandle -- ) my-self >r dup set-node node>instance-template @ dup to my-self r> swap instance>parent ! ; : split ( str len char -- left len right len ) >r 2dup r> findchar IF >r over r@ 2swap r> 1+ /string ELSE 0 0 THEN ; : generic-decode-unit ( str len ncells -- addr.lo ... addr.hi ) dup >r -rot BEGIN r@ WHILE r> 1- >r [char] , split 2swap $number IF 0 THEN r> swap >r >r REPEAT r> 3drop BEGIN dup WHILE 1- r> swap REPEAT drop ; : generic-encode-unit ( addr.lo ... addr.hi ncells -- str len ) 0 0 rot ?dup IF 0 ?DO rot (u.) $cat s" ," $cat LOOP 1- THEN ; : hex-decode-unit ( str len ncells -- addr.lo ... addr.hi ) base @ >r hex generic-decode-unit r> base ! ; : hex-encode-unit ( addr.lo ... addr.hi ncells -- str len ) base @ >r hex generic-encode-unit r> base ! ; : handle-leading-/ ( path len -- path' len' ) dup IF over c@ [char] / = IF 1 /string device-tree @ set-node THEN THEN ; : match-name ( name len node -- match? ) over 0= IF 3drop true EXIT THEN s" name" rot get-property IF 2drop false EXIT THEN 1- string=ci ; \ XXX should use decode-string 0 VALUE #search-unit CREATE search-unit 4 cells allot : match-unit ( node -- match? ) node>space search-unit #search-unit 0 ?DO 2dup @ swap @ <> IF 2drop false UNLOOP EXIT THEN cell+ swap cell+ swap LOOP 2drop true ; : match-node ( name len node -- match? ) dup >r match-name r> match-unit and ; \ XXX e3d : find-kid ( name len -- node|0 ) dup -1 = IF \ are we supposed to stay in the same node? -> resolve-relatives 2drop get-node ELSE get-node child >r BEGIN r@ WHILE 2dup r@ match-node IF 2drop r> EXIT THEN r> peer >r REPEAT r> 3drop false THEN ; : set-search-unit ( unit len -- ) 0 to #search-unit 0 to user-instance-#units dup 0= IF 2drop EXIT THEN s" #address-cells" get-node get-property THROW decode-int to #search-unit 2drop s" decode-unit" get-node $call-static #search-unit 0 ?DO search-unit i cells + ! LOOP ; : resolve-relatives ( path len -- path' len' ) 2dup 2 = swap s" .." comp 0= and IF get-node parent ?dup IF set-node drop -1 ELSE s" Already in root node." type THEN THEN 2dup 1 = swap c@ [CHAR] . = and IF drop -1 THEN ; : set-instance-unit ( unitaddr len -- ) dup 0= IF 2drop 0 to user-instance-#units EXIT THEN 2dup 0 -rot bounds ?DO i c@ [char] , = IF 1+ THEN \ Count the commas LOOP 1+ dup to user-instance-#units hex-decode-unit user-instance-#units 0 ?DO user-instance-units i cells + ! LOOP ; : split-component ( path. -- path'. args. name. unit. ) [char] / split 2swap ( path'. component. ) [char] : split 2swap ( path'. args. name@unit. ) [char] @ split ( path'. args. name. unit. ) ; : find-component ( path len -- path' len' args len node|0 ) split-component ( path'. args. name. unit. ) ['] set-search-unit CATCH IF set-instance-unit THEN resolve-relatives find-kid ( path' len' args len node|0 ) dup IF dup >space? user-instance-#units 0 > AND IF cr ." find-component with unit mismatch!" .s cr drop 0 THEN THEN ; : .find-node ( path len -- phandle|0 ) current-node @ >r handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN BEGIN dup WHILE \ handle one component: find-component ( path len args len node ) dup 0= IF 3drop 2drop r> set-node 0 EXIT THEN set-node 2drop REPEAT 2drop get-node r> set-node ; ' .find-node to find-node : find-node ( path len -- phandle|0 ) de-alias find-node ; : delete-node ( phandle -- ) dup node>instance-template @ max-instance-size free-mem dup node>parent @ node>child @ ( phandle 1st peer ) 2dup = IF node>peer @ swap node>parent @ node>child ! EXIT THEN dup node>peer @ BEGIN 2 pick 2dup <> WHILE drop nip dup node>peer @ dup 0= IF 2drop drop unloop EXIT THEN REPEAT drop node>peer @ swap node>peer ! drop ; : open-dev ( path len -- ihandle|0 ) 0 to user-instance-#units de-alias current-node @ >r handle-leading-/ current-node @ 0= IF 2drop r> set-node 0 EXIT THEN my-self >r 0 to my-self 0 0 >r >r BEGIN dup WHILE \ handle one component: ( arg len ) r> r> get-node open-node to my-self find-component ( path len args len node ) dup 0= IF 3drop 2drop my-self close-dev r> to my-self r> set-node 0 EXIT THEN set-node >r >r REPEAT 2drop r> r> get-node open-node to my-self my-self r> to my-self r> set-node ; : select-dev open-dev dup to my-self ihandle>phandle set-node ; : unselect-dev my-self close-dev 0 to my-self device-end ; : find-device ( str len -- ) \ set as active node find-node dup 0= ABORT" No such device path" set-node ; : dev parse-word find-device ; : (lsprop) ( node --) dup cr $indent indent @ type ." node: " node>qname type false +indent (.properties) cr -indent ; : (show-children) ( node -- ) child BEGIN dup WHILE dup (lsprop) dup child IF false +indent dup recurse -indent THEN peer REPEAT drop ; : lsprop ( {device-specifier}<eol> -- ) skipws 0 parse dup IF de-alias ELSE 2drop s" /" THEN find-device get-node dup dup cr ." node: " node>path type (.properties) cr (show-children) 0 indent ! ; : (node>path) node>path ; : node>path ( phandle -- str len ) node>path dup allot ; 0 VALUE packages : find-package ( name len -- false | phandle true ) dup 0 <= IF 2drop FALSE EXIT THEN over c@ [char] / = IF find-node dup IF TRUE THEN EXIT THEN 0 >r packages child BEGIN dup WHILE dup >r node>name 2over string=ci r> swap IF r> drop dup >r THEN peer REPEAT 3drop r> dup IF true THEN ; : open-package ( arg len phandle -- ihandle | 0 ) open-node ; : close-package ( ihandle -- ) close-node ; : $open-package ( arg len name len -- ihandle | 0 ) find-package IF open-package ELSE 2drop false THEN ; : pci-address-type ( node address prop_type -- type ) -rot 2 pick ( prop_type node address prop_type ) 0= IF swap s" reg" rot get-property ( prop_type address data dlen false ) ELSE swap s" assigned-addresses" rot get-property ( prop_type address data dlen false ) THEN IF 2drop -1 EXIT THEN 4 / 5 / 0 DO dup l@ FF AND 0<> ( prop_type address data cfgspace_offset? ) 3 pick 0= ( prop_type address data cfgspace_offset? reg_prop? ) AND NOT IF 2dup 8 + ( prop_type address data address data' ) 2dup l@ 2 pick 8 + l@ + <= -rot l@ >= and IF l@ 03000000 and 18 rshift nip dup 3 = IF 1- THEN swap drop ( type ) UNLOOP EXIT THEN THEN 4 5 * + LOOP 3drop -1 ; : (range-read-cells) ( range-addr #cells -- range-value ) 1 = IF l@ ELSE @ THEN ; : (map-one-range) ( type range pnac nsc nac address -- address true | address false ) over 3 = 5 pick l@ 3000000 and 18 rshift 7 pick <> and IF >r 2drop 3drop r> false EXIT THEN 4 pick 4 pick 3 pick + 4 * + 3 pick (range-read-cells) 5 pick 3 pick 3 = IF 4 + THEN 3 pick (range-read-cells) dup >r dup 3 pick > >r + over <= r> or IF >r 2drop 3drop r> r> drop false EXIT THEN dup r> - 5 pick 5 pick 3 = IF 4 + THEN 3 pick 4 * + 5 pick (range-read-cells) + >r 3drop 3drop r> true ; : translate-address ( node address -- address ) 2dup 1 pci-address-type ( node address type ) dup -1 = IF drop 2dup 0 pci-address-type ( node address type ) THEN rot parent BEGIN dup parent 0= IF 2drop EXIT THEN s" #address-cells" 2 pick get-property 2drop l@ >r \ nac s" #size-cells" 2 pick get-property 2drop l@ >r \ nsc s" #address-cells" 2 pick parent get-property 2drop l@ >r \ pnac -rot ( node address type ) s" ranges" 4 pick get-property IF 3drop ABORT" no ranges property; not translatable" THEN r> r> r> 3 roll 4 / >r 3dup + + >r 5 roll r> r> swap / 0 ?DO 6dup (map-one-range) IF nip leave THEN nip 4 roll 4 pick 4 pick 4 pick + + 4 * + 4 -roll LOOP >r 2drop 2drop r> ( node type address ) swap rot parent ( address type node ) dup 0= UNTIL ; : translate-my-address ( address -- address' ) get-node swap translate-address ; : find-substr ( basestr-ptr basestr-len substr-ptr substr-len -- pos ) dup 0 = IF 2drop 2drop 0 exit THEN dup 3 pick <= IF 2 pick over - 1+ 0 DO dup 0 DO over i + c@ 4 pick j + i + c@ = IF dup i 1+ = IF 2drop 2drop j unloop unloop exit THEN ELSE leave THEN LOOP LOOP THEN 2drop nip ; : find-isubstr ( basestr-ptr basestr-len substr-ptr substr-len -- pos ) dup 0 = IF 2drop 2drop 0 exit THEN dup 3 pick <= IF 2 pick over - 1+ 0 DO dup 0 DO over i + c@ lcc 4 pick j + i + c@ lcc = IF dup i 1+ = IF 2drop 2drop j unloop unloop exit THEN ELSE leave THEN LOOP LOOP THEN 2drop nip ; : find-nextline ( str-ptr str-len -- pos ) dup 0 ?DO over i + c@ CASE 0a OF dup 1- i = IF 2drop i 1+ unloop exit THEN over i 1+ + c@ 0d = IF 2drop i 2+ ELSE 2drop i 1+ THEN unloop exit ENDOF 0d OF dup 1- i = IF 2drop i 1+ unloop exit THEN over i 1+ + c@ 0a = IF 2drop i 2+ ELSE 2drop i 1+ THEN unloop exit ENDOF ENDCASE LOOP nip ; : string-at ( str1-ptr str1-len pos -- str2-ptr str2-len ) -rot 2 pick - -rot swap chars + swap ; : string-cat ( addr1 len1 addr2 len2 -- addr1 len1+len2 ) rot dup >r over + -rot 3 pick r> chars + -rot 0 ?DO 2dup c@ swap c! char+ swap char+ swap LOOP 2drop ; : char-cat ( addr len character -- addr len+1 ) -rot 2dup >r >r 1+ rot r> r> chars + c! ; : overlap ( src dest size -- true|false ) 3dup over + within IF 3drop true ELSE rot tuck + within THEN ; : parse-2int ( str len -- val.lo val.hi ) [char] , split ?dup IF eval ELSE drop 0 THEN -rot ?dup IF eval ELSE drop 0 THEN ; : cpeek ( addr -- false | byte true ) c@ true ; : cpoke ( byte addr -- success? ) c! true ; : wpeek ( addr -- false | word true ) w@ true ; : wpoke ( word addr -- success? ) w! true ; : lpeek ( addr -- false | lword true ) l@ true ; : lpoke ( lword addr -- success? ) l! true ; defer reboot ( -- ) defer halt ( -- ) defer disable-watchdog ( -- ) defer reset-watchdog ( -- ) defer set-watchdog ( +n -- ) defer set-led ( type instance state -- status ) defer get-flashside ( -- side ) defer set-flashside ( side -- status ) defer read-bootlist ( -- ) defer furnish-boot-file ( -- adr len ) defer set-boot-file ( adr len -- ) defer mfg-mode? ( -- flag ) defer of-prompt? ( -- flag ) defer debug-boot? ( -- flag ) defer bmc-version ( -- adr len ) defer cursor-on ( -- ) defer cursor-off ( -- ) : nop-reboot ( -- ) ." reboot not available" abort ; : nop-halt ( -- ) ." halt not available" abort ; : nop-disable-watchdog ( -- ) ; : nop-reset-watchdog ( -- ) ; : nop-set-watchdog ( +n -- ) drop ; : nop-set-led ( type instance state -- status ) drop drop drop ; : nop-get-flashside ( -- side ) ." Cannot get flashside" cr ABORT ; : nop-set-flashside ( side -- status ) ." Cannot set flashside" cr ABORT ; : nop-read-bootlist ( -- ) ; : nop-furnish-bootfile ( -- adr len ) s" net:" ; : nop-set-boot-file ( adr len -- ) 2drop ; : nop-mfg-mode? ( -- flag ) false ; : nop-of-prompt? ( -- flag ) false ; : nop-debug-boot? ( -- flag ) false ; : nop-bmc-version ( -- adr len ) s" XXXXX" ; : nop-cursor-on ( -- ) ; : nop-cursor-off ( -- ) ; ' nop-reboot to reboot ' nop-halt to halt ' nop-disable-watchdog to disable-watchdog ' nop-reset-watchdog to reset-watchdog ' nop-set-watchdog to set-watchdog ' nop-set-led to set-led ' nop-get-flashside to get-flashside ' nop-set-flashside to set-flashside ' nop-read-bootlist to read-bootlist ' nop-furnish-bootfile to furnish-boot-file ' nop-set-boot-file to set-boot-file ' nop-mfg-mode? to mfg-mode? ' nop-of-prompt? to of-prompt? ' nop-debug-boot? to debug-boot? ' nop-bmc-version to bmc-version ' nop-cursor-on to cursor-on ' nop-cursor-off to cursor-off : reset-all reboot ; 10000000 value load-base 2000000 value flash-load-base : xt>name ( xt -- str len ) BEGIN cell - dup c@ 0 2 within IF dup 2+ swap 1+ c@ exit THEN AGAIN ; cell -1 * CONSTANT -cell : cell- ( n -- n-cell-size ) [ cell -1 * ] LITERAL + ; : find-xt-addr ( addr -- xt ) BEGIN dup @ <colon> = IF EXIT THEN cell- AGAIN ; : (.immediate) ( xt -- ) xt>name drop 2 - c@ \ skip len and flags immediate? IF ." IMMEDIATE" THEN ; : (.xt) ( xt -- ) xt>name type ; : trace-back ( ) 1 BEGIN cr dup dup . ." : " rpick dup . ." : " ['] tib here within IF dup rpick find-xt-addr (.xt) THEN 1+ dup rdepth 5 - >= IF cr drop EXIT THEN AGAIN ; VARIABLE see-my-type-column : (see-my-type) ( indent limit xt str len -- indent limit xt ) dup see-my-type-column @ + dup 50 >= IF -rot over " " comp 0= IF 2drop see-my-type-column ! ELSE rot drop ( indent limit xt str len ) pocket swap 2dup >r >r ( indent limit xt str pk len R: len pk ) move r> r> ( indent limit xt pk len ) 2 pick (u.) dup -rot cr type ( indent limit xt pk len xt-len ) " :" type 1+ ( indent limit xt pk len prefix-len ) 5 pick dup spaces + ( indent limit xt pk len prefix-len ) over + see-my-type-column ! ( indent limit xt pk len ) type THEN ( indent limit xt ) ELSE see-my-type-column ! type ( indent limit xt ) THEN ; : (see-my-type-init) ( -- ) ffff see-my-type-column ! \ just enforce a new line ; : (see-colon-body) ( indent limit xt -- indent limit xt ) (see-my-type-init) \ enforce new line BEGIN ( indent limit xt ) cell+ 2dup <> over @ dup <semicolon> <> rot and ( indent limit xt @xt flag ) WHILE ( indent limit xt @xt ) xt>name (see-my-type) " " (see-my-type) dup @ ( indent limit xt @xt) CASE <0branch> OF cell+ dup @ over + cell+ dup >r (u.) (see-my-type) r> ( indent limit xt target) 2dup < IF over 4 pick 3 + -rot recurse nip nip nip cell- ( indent limit xt ) ELSE drop ( indent limit xt ) THEN (see-my-type-init) ENDOF \ enforce new line <branch> OF cell+ dup @ over + cell+ (u.) (see-my-type) " " (see-my-type) ENDOF <do?do> OF cell+ dup @ (u.) (see-my-type) " " (see-my-type) ENDOF <lit> OF cell+ dup @ (u.) (see-my-type) " " (see-my-type) ENDOF <dotick> OF cell+ dup @ xt>name (see-my-type) " " (see-my-type) ENDOF <doloop> OF cell+ dup @ (u.) (see-my-type) " " (see-my-type) ENDOF <do+loop> OF cell+ dup @ (u.) (see-my-type) " " (see-my-type) ENDOF <doleave> OF cell+ dup @ over + cell+ (u.) (see-my-type) " " (see-my-type) ENDOF <do?leave> OF cell+ dup @ over + cell+ (u.) (see-my-type) " " (see-my-type) ENDOF <sliteral> OF cell+ " """ (see-my-type) dup count dup >r (see-my-type) " """ (see-my-type) " " (see-my-type) r> -cell and + ENDOF ENDCASE REPEAT drop ; : (see-colon) ( xt -- ) (see-my-type-init) 1 swap 0 swap ( indent limit xt ) " : " (see-my-type) dup xt>name (see-my-type) rot drop 4 -rot (see-colon-body) ( indent limit xt ) rot drop 1 -rot (see-my-type-init) " ;" (see-my-type) 3drop ; : (see-create) ( xt -- ) dup cell+ @ CASE <2constant> OF dup cell+ cell+ dup @ swap cell+ @ . . ." 2CONSTANT " ENDOF <instancevalue> OF dup cell+ cell+ @ . ." INSTANCE VALUE " ENDOF <instancevariable> OF ." INSTANCE VARIABLE " ENDOF dup OF ." CREATE " ENDOF ENDCASE (.xt) ; : (see) ( xt -- ) cr dup dup @ CASE <variable> OF ." VARIABLE " (.xt) ENDOF <value> OF dup execute . ." VALUE " (.xt) ENDOF <constant> OF dup execute . ." CONSTANT " (.xt) ENDOF <defer> OF dup cell+ @ swap ." DEFER " (.xt) ." is " (.xt) ENDOF <alias> OF dup cell+ @ swap ." ALIAS " (.xt) ." " (.xt) ENDOF <buffer:> OF ." BUFFER: " (.xt) ENDOF <create> OF (see-create) ENDOF <colon> OF (see-colon) ENDOF dup OF ." ??? PRIM " (.xt) ENDOF ENDCASE (.immediate) cr ; : see ( "old-name<>" -- ) ' (see) ; 0 value forth-ip true value trace>stepping? true value trace>print? true value trace>up? 0 value trace>depth 0 value trace>rdepth 0 value trace>recurse : trace-depth+ ( -- ) trace>depth 1+ to trace>depth ; : trace-depth- ( -- ) trace>depth 1- to trace>depth ; : stepping ( -- ) true to trace>stepping? ; : tracing ( -- ) false to trace>stepping? ; : trace-print-on ( -- ) true to trace>print? ; : trace-print-off ( -- ) false to trace>print? ; : fip-add ( n -- ) forth-ip + to forth-ip ; 0 value debug-last-xt 0 value debug-last-xt-content : trace-print ( -- ) forth-ip cr u. ." : " forth-ip @ dup ['] breakpoint = IF drop debug-last-xt-content THEN xt>name type ." " ." ( " .s ." ) | " ; : trace-interpret ( -- ) rdepth 1- to trace>rdepth BEGIN depth . [char] > dup emit emit space source expect ( str len ) ['] interpret catch print-status AGAIN ; : trace-xt ( xt -- ) trace>recurse IF r> drop \ Drop return of 'trace-xt call cell+ \ Step over ":" ELSE debug-last-xt-content <colon> = IF ['] breakpoint @ debug-last-xt ! \ Re-arm break point r> drop \ Drop return of 'trace-xt call cell+ \ Step over ":" ELSE ['] breakpoint debug-last-xt ! \ Re-arm break point 2r> 2drop THEN THEN to forth-ip true to trace>print? BEGIN trace>print? IF trace-print THEN forth-ip ( ip ) trace>stepping? IF BEGIN key CASE [char] d OF dup @ @ <colon> = IF \ recurse only into colon definitions trace-depth+ 1 to trace>recurse dup >r @ recurse THEN true ENDOF [char] u OF trace>depth IF tracing trace-print-off true ELSE false THEN ENDOF [char] f OF drop cr trace-interpret ENDOF \ quit trace and start interpreter FIXME rstack [char] c OF tracing true ENDOF [char] t OF trace-back false ENDOF [char] q OF drop cr quit ENDOF 20 OF true ENDOF dup OF cr ." Press d: Down into current word" cr ." Press u: Up to caller" cr ." Press f: Switch to forth interpreter, 'resume' will continue tracing" cr ." Press c: Switch to tracing" cr ." Press <space>: Execute current word" cr ." Press q: Abort execution, switch to interpreter" cr false ENDOF ENDCASE UNTIL THEN ( ip' ) dup to forth-ip @ ( xt ) dup ['] breakpoint = IF drop debug-last-xt-content THEN dup ( xt xt ) CASE <sliteral> OF drop forth-ip cell+ dup dup c@ + -cell and to forth-ip ENDOF <dotick> OF drop forth-ip cell+ @ cell fip-add ENDOF <lit> OF drop forth-ip cell+ @ cell fip-add ENDOF <doto> OF drop forth-ip cell+ @ cell+ ! cell fip-add ENDOF <(doito)> OF drop forth-ip cell+ @ cell+ cell+ @ >instance ! cell fip-add ENDOF <0branch> OF drop IF cell fip-add ELSE forth-ip cell+ @ cell+ fip-add THEN ENDOF <do?do> OF drop 2dup <> IF swap >r >r cell fip-add ELSE forth-ip cell+ @ cell+ fip-add 2drop THEN ENDOF <branch> OF drop forth-ip cell+ @ cell+ fip-add ENDOF <doleave> OF drop r> r> 2drop forth-ip cell+ @ cell+ fip-add ENDOF <do?leave> OF drop IF r> r> 2drop forth-ip cell+ @ cell+ fip-add ELSE cell fip-add THEN ENDOF <doloop> OF drop r> 1+ r> 2dup = IF 2drop cell fip-add ELSE >r >r forth-ip cell+ @ cell+ fip-add THEN ENDOF <do+loop> OF drop r> + r> 2dup >= IF 2drop cell fip-add ELSE >r >r forth-ip cell+ @ cell+ fip-add THEN ENDOF <semicolon> OF trace>depth 0> IF trace-depth- 1 to trace>recurse stepping drop r> recurse ELSE drop exit THEN ENDOF <exit> OF trace>depth 0> IF trace-depth- stepping drop r> recurse ELSE drop exit THEN ENDOF dup OF execute ENDOF ENDCASE forth-ip cell+ to forth-ip AGAIN ; : resume ( -- ) trace>rdepth rdepth! forth-ip cell - trace-xt ; : debug-off ( -- ) debug-last-xt IF debug-last-xt-content debug-last-xt ! \ Restore overwriten token 0 to debug-last-xt THEN ; : (break-entry) ( -- ) debug-last-xt dup @ ['] breakpoint <> swap ( debug-addr? debug-last-xt ) debug-last-xt-content swap ! \ Restore overwriten token r> drop \ Don't return to bp, but to caller debug-last-xt-content <colon> <> and IF \ Execute non colon definition debug-last-xt cr u. ." : " debug-last-xt xt>name type ." " ." ( " .s ." ) | " key drop debug-last-xt execute ELSE debug-last-xt 0 to trace>depth 0 to trace>recurse trace-xt \ Trace colon definition THEN ; ' (break-entry) to BP : debug-address ( addr -- ) debug-off ( xt ) \ Remove active breakpoint dup to debug-last-xt ( xt ) \ Save token for later debug dup @ to debug-last-xt-content ( xt ) \ Save old value ['] breakpoint swap ! ; : (debug ( xt -- ) debug-off ( xt ) \ Remove active breakpoint dup to debug-last-xt ( xt ) \ Save token for later debug dup @ to debug-last-xt-content ( xt ) \ Save old value ['] breakpoint @ swap ! ; : debug ( "old-name<>" -- ) parse-word $find IF \ Get xt for old-name (debug ELSE ." undefined word " type cr THEN ; : words last @ BEGIN ?dup WHILE dup cell+ char+ count type space @ REPEAT ; : .calls ( xt -- ) current-node @ >r 0 set-node \ only search commands, according too IEEE1275 last BEGIN @ ?dup WHILE ( xt currxt ) dup cell+ char+ ( xt currxt name* ) dup dup c@ + 1+ aligned ( xt currxt name* CFA ) dup @ <colon> = IF ( xt currxt name* CFA ) BEGIN cell+ dup @ ['] semicolon <> WHILE ( xt currxt *name pos ) dup @ 4 pick = IF ( xt currxt *name pos ) over count type space BEGIN cell+ dup @ ['] semicolon = UNTIL cell - \ eat up other occurences THEN REPEAT THEN 2drop ( xt currxt ) REPEAT drop r> set-node \ restore node ; 0 value #sift-count false value sift-compl-only : $inner-sift ( text-addr text-len LFA -- ... word-addr word-len true | false ) dup cell+ char+ count \ get word name 2dup 6 pick 6 pick find-isubstr \ is there a partly match? sift-compl-only IF 0= ELSE over < THEN IF #sift-count 1+ to #sift-count \ count completions true ELSE 2drop false THEN ; : $sift ( text-addr text-len -- ) current-node @ >r 0 set-node \ only search commands, according too IEEE1275 sift-compl-only >r false to sift-compl-only \ all substrings, not only compl. last BEGIN @ ?dup WHILE \ walk the whole dictionary $inner-sift IF type space THEN REPEAT 2drop 0 to #sift-count \ we don't need completions here. r> to sift-compl-only \ restore previous sifting mode r> set-node \ restore node ; : sifting ( "text< >" -- ) parse-word $sift ; defer '(r@) defer '(r!) 1 VALUE /(r) : (rfill) ( addr size pattern 'r! /r -- ) to /(r) to '(r!) ff and dup 8 lshift or dup 10 lshift or dup 20 lshift or -rot bounds ?do dup i '(r!) /(r) +loop drop ; : (fwrmove) ( src dest size -- ) >r 0 -rot r> bounds ?do + dup '(r@) i '(r!) /(r) dup +loop 2drop ; : mrmove ( src dest size -- ) 3dup or or 7 AND CASE 0 OF ['] x@ ['] rx! /x ENDOF 4 OF ['] l@ ['] rl! /l ENDOF 2 OF ['] w@ ['] rw! /w ENDOF dup OF ['] c@ ['] rb! /c ENDOF ENDCASE to /(r) to '(r!) to '(r@) (fwrmove) ; : rfill ( addr size pattern -- ) 3dup drop or 7 AND CASE 0 OF ['] rx! /x ENDOF 4 OF ['] rl! /l ENDOF 2 OF ['] rw! /w ENDOF dup OF ['] rb! /c ENDOF ENDCASE (rfill) ; : ([IF]) BEGIN BEGIN parse-word dup 0= WHILE 2drop refill REPEAT 2dup s" [IF]" str= IF 1 throw THEN 2dup s" [ELSE]" str= IF 2 throw THEN 2dup s" [THEN]" str= IF 3 throw THEN s" \" str= IF linefeed parse 2drop THEN AGAIN ; : [IF] ( flag -- ) IF exit THEN 1 BEGIN ['] ([IF]) catch CASE 1 OF 1+ ENDOF 2 OF dup 1 = if 1- then ENDOF 3 OF 1- ENDOF ENDCASE dup 0 <= UNTIL drop ; immediate : [ELSE] 0 [COMPILE] [IF] ; immediate : [THEN] ; immediate : $dnumber base @ >r decimal $number r> base ! ; : (.d) base @ >r decimal (.) r> base ! ; : (ipaddr) ( "a.b.c.d" -- FALSE | n1 n2 n3 n4 TRUE ) base @ >r decimal over s" 000.000.000.000" comp 0= IF 2drop false r> base ! EXIT THEN [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot [char] . left-parse-string $number IF 2drop false r> base ! EXIT THEN -rot $number IF false r> base ! EXIT THEN true r> base ! ; : (ipformat) ( n1 n2 n3 n4 -- str len ) base @ >r decimal 0 <# # # # [char] . hold drop # # # [char] . hold drop # # # [char] . hold drop # # #s #> r> base ! ; : ipformat ( n1 n2 n3 n4 -- ) (ipformat) type ; paflof-start 1 rshift fff not and to load-base deadbeef here l! here c@ de = CONSTANT ?bigendian here c@ ef = CONSTANT ?littleendian ?bigendian [IF] : l!-le >r lbflip r> l! ; : l@-le l@ lbflip ; : w!-le >r wbflip r> w! ; : w@-le w@ wbflip ; : rx!-le >r xbflip r> rx! ; : rx@-le rx@ xbflip ; : rl!-le >r lbflip r> rl! ; : rl@-le rl@ lbflip ; : rw!-le >r wbflip r> rw! ; : rw@-le rw@ wbflip ; : l!-be l! ; : l@-be l@ ; : w!-be w! ; : w@-be w@ ; : rl!-be rl! ; : rl@-be rl@ ; : rw!-be rw! ; : rw@-be rw@ ; [ELSE] : l!-le l! ; : l@-le l@ ; : w!-le w! ; : w@-le w@ ; : rx!-le rx! ; : rx@-le rx@ ; : rl!-le rl! ; : rl@-le rl@ ; : rw!-le rw! ; : rw@-le rw@ ; : l!-be >r lbflip r> l! ; : l@-be l@ lbflip ; : w!-be >r wbflip r> w! ; : w@-be w@ wbflip ; : rl!-be >r lbflip r> rl! ; : rl@-be rl@ lbflip ; : rw!-be >r wbflip r> rw! ; : rw@-be rw@ wbflip ; [THEN] : #join ( lo hi #bits -- x ) lshift or ; : #split ( x #bits -- lo hi ) 2dup rshift dup >r swap lshift xor r> ; : blink ; : reset-dual-emit ; : console-clean-fifo ; : bootmsg-nvupdate ; : asm-cout 2drop drop ; defer nvramlog-write-byte : .nvramlog-write-byte ( byte -- ) drop ; ' .nvramlog-write-byte to nvramlog-write-byte : nvramlog-write-string ( str len -- ) dup 0> IF 0 DO dup c@ nvramlog-write-byte char+ LOOP ELSE drop THEN drop ; : nvramlog-write-number ( number format -- ) 0 swap <# 0 ?DO # LOOP #> nvramlog-write-string ; : nvramlog-write-string-cr ( str len -- ) nvramlog-write-string a nvramlog-write-byte d nvramlog-write-byte ; : log-string ( str len -- ) type ; : log-string 2drop ; create debugstr 255 allot 0 VALUE debuglen : cp ( checkpoint -- ) bootmsg-cp ; : (warning) ( id level ptr len -- ) dup TO debuglen debugstr swap move \ copy into buffer 0 debuglen debugstr + c! \ terminate '\0' debugstr bootmsg-warning ; : warning" ( id level [text<">] -- ) postpone s" state @ IF ['] (warning) compile, ELSE (warning) THEN ; immediate : (debug-cp) ( id level ptr len -- ) dup TO debuglen debugstr swap move \ copy into buffer 0 debuglen debugstr + c! \ terminate '\0' debugstr bootmsg-debugcp ; : debug-cp" ( id level [text<">] -- ) postpone s" state @ IF ['] (debug-cp) compile, ELSE (debug-cp) THEN ; immediate : (error) ( id ptr len -- ) dup TO debuglen debugstr swap move \ copy into buffer 0 debuglen debugstr + c! \ terminate '\0' debugstr bootmsg-error ; : error" ( id level [text<">] -- ) postpone s" state @ IF ['] (error) compile, ELSE (error) THEN ; immediate bootmsg-nvupdate 000 cp STRUCT cell FIELD >r0 cell FIELD >r1 cell FIELD >r2 cell FIELD >r3 cell FIELD >r4 cell FIELD >r5 cell FIELD >r6 cell FIELD >r7 cell FIELD >r8 cell FIELD >r9 cell FIELD >r10 cell FIELD >r11 cell FIELD >r12 cell FIELD >r13 cell FIELD >r14 cell FIELD >r15 cell FIELD >r16 cell FIELD >r17 cell FIELD >r18 cell FIELD >r19 cell FIELD >r20 cell FIELD >r21 cell FIELD >r22 cell FIELD >r23 cell FIELD >r24 cell FIELD >r25 cell FIELD >r26 cell FIELD >r27 cell FIELD >r28 cell FIELD >r29 cell FIELD >r30 cell FIELD >r31 cell FIELD >cr cell FIELD >xer cell FIELD >lr cell FIELD >ctr cell FIELD >srr0 cell FIELD >srr1 cell FIELD >dar cell FIELD >dsisr CONSTANT ciregs-size : .16 10 0.r 3 spaces ; : .8 8 spaces 8 0.r 3 spaces ; : .4regs cr 4 0 DO dup @ .16 8 cells+ LOOP drop ; : .fixed-regs cr ." R0 .. R7 R8 .. R15 R16 .. R23 R24 .. R31" dup 8 0 DO dup .4regs cell+ LOOP drop ; : .special-regs cr ." CR / XER LR / CTR SRR0 / SRR1 DAR / DSISR" cr dup >cr @ .8 dup >lr @ .16 dup >srr0 @ .16 dup >dar @ .16 cr dup >xer @ .16 dup >ctr @ .16 dup >srr1 @ .16 >dsisr @ .8 ; : .regs cr .fixed-regs cr .special-regs cr cr ; : .hw-exception ( reason-code exception-nr -- ) ." ( " dup . ." ) " CASE 200 OF ." Machine Check" ENDOF 300 OF ." Data Storage" ENDOF 380 OF ." Data Segment" ENDOF 400 OF ." Intruction Storage" ENDOF 480 OF ." Instruction Segment" ENDOF 500 OF ." External" ENDOF 600 OF ." Alignment" ENDOF 700 OF ." Program" ENDOF 800 OF ." Floating-point unavailable" ENDOF 900 OF ." Decrementer" ENDOF 980 OF ." Hypervisor Decrementer" ENDOF C00 OF ." System Call" ENDOF D00 OF ." Trace" ENDOF F00 OF ." Performance Monitor" ENDOF F20 OF ." VMX Unavailable" ENDOF 1200 OF ." System Error" ENDOF 1600 OF ." Maintenance" ENDOF 1800 OF ." Thermal" ENDOF dup OF ." Unknown" ENDOF ENDCASE ." Exception [ " . ." ]" ; : .sw-exception ( exception-nr -- ) ." Exception [ " . ." ] triggered by boot firmware." ; : be-hw-exception ( [reason-code] exception-nr -- ) cr cr dup 0> IF .hw-exception ELSE .sw-exception THEN cr eregs .regs ; ' be-hw-exception to hw-exception-handler : (boot-exception-handler) ( x1...xn exception-nr -- x1...xn) dup IF dup 0 > IF negate cp 9 emit ." : " type ELSE CASE -6d OF cr ." W3411: Client application returned." cr ENDOF -6c OF cr ." E3400: It was not possible to boot from any device " ." specified in the VPD." cr ENDOF -6b OF cr ." E3410: Boot list successfully read from VPD " ." but no useful information received." cr ENDOF -6a OF cr ." E3420: Boot list could not be read from VPD." cr ENDOF -69 OF cr ." E3406: Client application returned an error" abort"-str @ count dup IF ." : " type cr ELSE ." ." cr 2drop THEN ENDOF -68 OF cr ." E3405: No such device" cr ENDOF -67 OF cr ." E3404: Not a bootable device!" cr ENDOF -66 OF cr ." E3408: Failed to claim memory for the executable" cr ENDOF -65 OF cr ." E3407: Load failed" cr ENDOF -64 OF cr ." E3403: Bad executable: " abort"-str @ count type cr ENDOF -63 OF cr ." E3409: Unknown FORTH Word" cr ENDOF -2 OF cr ." E3401: Aborting boot, " abort"-str @ count type cr ENDOF dup OF ." E3402: Aborting boot, internal error" cr ENDOF ENDCASE THEN ELSE drop THEN ; ' (boot-exception-handler) to boot-exception-handler : throw-error ( error-code "error-string" -- ) skipws 0a parse rot throw ; : enable-ext-int ( -- ) msr@ 8000 or msr! ; : disable-ext-int ( -- ) msr@ 8000 not and msr! ; : gen-ext-int ( -- ) 7fffffff dec! \ Reset decrementer enable-ext-int \ Enable interrupt FF 20000508418 rx! \ Interrupt priority mask 10 20000508410 rx! \ Interrupt priority ; : mm-log-warning 2drop ; : write-mm-log ( data length type -- status ) 3drop 0 ; 100 cp : beep bell emit ; : TABLE-EXECUTE CREATE DOES> swap cells+ @ ?dup IF execute ELSE beep THEN ; 0 VALUE accept-adr 0 VALUE accept-max 0 VALUE accept-len 0 VALUE accept-cur : esc 1b emit ; : csi esc 5b emit ; : move-cursor ( -- ) esc ." 8" accept-cur IF csi base @ decimal accept-cur 0 .r base ! ." C" THEN ; : redraw-line ( -- ) accept-cur accept-len = IF EXIT THEN move-cursor accept-adr accept-len accept-cur /string type csi ." K" move-cursor ; : full-redraw-line ( -- ) accept-cur 0 to accept-cur move-cursor accept-adr accept-len type csi ." K" to accept-cur move-cursor ; : redraw-prompt ( -- ) cr depth . [char] > emit ; : insert-char ( char -- ) accept-len accept-max = IF drop beep EXIT THEN accept-cur accept-len <> IF csi ." @" dup emit accept-adr accept-cur + dup 1+ accept-len accept-cur - move ELSE dup emit THEN accept-adr accept-cur + c! accept-cur 1+ to accept-cur accept-len 1+ to accept-len redraw-line ; : delete-char ( -- ) accept-cur accept-len = IF beep EXIT THEN accept-len 1- to accept-len accept-adr accept-cur + dup 1+ swap accept-len accept-cur - move csi ." P" redraw-line ; STRUCT cell FIELD his>next cell FIELD his>prev cell FIELD his>len 0 FIELD his>buf CONSTANT /his 0 VALUE his-head 0 VALUE his-tail 0 VALUE his-cur : add-history ( -- ) accept-len 0= IF EXIT THEN /his accept-len + alloc-mem his-tail IF dup his-tail his>next ! ELSE dup to his-head THEN his-tail over his>prev ! 0 over his>next ! dup to his-tail accept-len over his>len ! accept-adr swap his>buf accept-len move ; : history ( -- ) his-head BEGIN dup WHILE cr dup his>buf over his>len @ type his>next @ REPEAT drop ; : select-history ( his -- ) dup to his-cur dup IF dup his>len @ accept-max min dup to accept-len to accept-cur his>buf accept-adr accept-len move ELSE drop 0 to accept-len 0 to accept-cur THEN full-redraw-line ; 0 value ?tab-pressed 0 value tab-last-adr 0 value tab-last-len : $same-string ( addr-1 len-1 addr-2 len-2 -- addr-1 len-1' ) dup 0= IF \ The second parameter is not a string. 2drop EXIT \ bail out THEN rot min 0 0 -rot ( addr1 addr2 0 len' 0 ) DO ( addr1 addr2 len-1' ) 2 pick i + c@ lcc 2 pick i + c@ lcc = IF 1 + ELSE leave THEN LOOP nip ; : $tab-sift-words ( text-addr text-len -- sift-count ) sift-compl-only >r true to sift-compl-only \ save sifting mode last BEGIN @ ?dup WHILE \ loop over all words $inner-sift IF \ any completions possible? 2dup bounds DO I c@ lcc I c! LOOP ?tab-pressed IF 2dup type space THEN \ <tab><tab> prints possibilities tab-last-adr tab-last-len $same-string \ find matching substring ... to tab-last-len to tab-last-adr \ ... and save it THEN repeat 2drop #sift-count 0 to #sift-count \ how many words were found? r> to sift-compl-only \ restore sifting completion mode ; 0 value current-stack : new-stack ( cells <>name -- ) create >r here ( here R: cells ) dup r@ 2 + cells ( here here bytes R: cells ) dup allot erase ( here R: cells) cell+ r> ( here+1cell cells ) swap ! ( ) DOES> to current-stack ; : reset-stack ( -- ) 0 current-stack ! ; : stack-depth ( -- depth ) current-stack @ ; : push ( value -- ) current-stack @ current-stack cell+ @ over <= ABORT" Stack overflow" cells 1 current-stack +! current-stack 2 cells + + ! ; : pop ( -- value ) current-stack @ 0= ABORT" Stack underflow" current-stack @ cells current-stack + cell+ @ -1 current-stack +! ; 10 new-stack device-stack : (next-dev) ( node -- node' addr len ) device-stack dup (node>path) rot dup child IF dup push child -rot EXIT THEN dup peer IF peer -rot EXIT THEN drop BEGIN stack-depth WHILE pop peer ?dup IF -rot EXIT THEN REPEAT 0 -rot ; : $inner-sift-nodes ( text-addr text-len node -- ... path-addr path-len true | false ) (next-dev) ( text-addr text-len node' path-addr path-len ) dup 0= IF drop false EXIT THEN 2dup 6 pick 6 pick find-isubstr ( text-addr text-len node' path-addr path-len pos ) 0= IF #sift-count 1+ to #sift-count \ count completions true ELSE 2drop false THEN ; : .nodes ( -- ) s" /" find-node BEGIN dup WHILE (next-dev) type cr REPEAT drop reset-stack ; create sift-node-buffer 1000 allot 0 value sift-node-num : sift-node-buffer sift-node-buffer sift-node-num 100 * + sift-node-num 1+ dup 10 = IF drop 0 THEN to sift-node-num ; : $tab-sift-nodes ( text-addr text-len -- sift-count ) s" /" find-node BEGIN dup WHILE $inner-sift-nodes IF \ any completions possible? sift-node-buffer swap 2>r 2r@ move 2r> \ make an almost permanent copy without strdup ?tab-pressed IF 2dup type space THEN \ <tab><tab> prints possibilities tab-last-adr tab-last-len $same-string \ find matching substring ... to tab-last-len to tab-last-adr \ ... and save it THEN REPEAT 2drop drop #sift-count 0 to #sift-count \ how many words were found? reset-stack ; : $tab-sift ( text-addr text-len -- sift-count ) ?tab-pressed IF beep space THEN \ cosmetical fix for <tab><tab> dup IF bl rsplit dup IF 2swap THEN ELSE 0 0 THEN >r >r 0 dup to tab-last-len to tab-last-adr \ reset last possible match current-node @ IF \ if we are in a node? 2dup 2>r \ save text $tab-sift-words to #sift-count \ search in current node first 2r> \ fetch text to complete, again THEN 2dup 2>r current-node @ >r 0 set-node \ now search in global words $tab-sift-words to #sift-count r> set-node 2r> $tab-sift-nodes r> r> dup IF s" " $cat THEN tab-last-adr tab-last-len $cat to tab-last-len to tab-last-adr \ ... and save the whole string ; : handle-^A 0 to accept-cur move-cursor ; : handle-^B accept-cur ?dup IF 1- to accept-cur ( csi ." D" ) move-cursor THEN ; : handle-^D delete-char ( redraw-line ) ; : handle-^E accept-len to accept-cur move-cursor ; : handle-^F accept-cur accept-len <> IF accept-cur 1+ to accept-cur csi ." C" THEN ; : handle-^H accept-cur 0= IF beep EXIT THEN handle-^B delete-char ; : handle-^I accept-adr accept-len $tab-sift 0 > IF ?tab-pressed IF redraw-prompt full-redraw-line false to ?tab-pressed ELSE tab-last-adr accept-adr tab-last-len move \ copy matching substring tab-last-len dup to accept-len to accept-cur \ len and cursor position full-redraw-line \ redraw new string true to ?tab-pressed \ second tab will print possible matches THEN THEN ; : handle-^K BEGIN accept-cur accept-len <> WHILE delete-char REPEAT ; : handle-^L history redraw-prompt full-redraw-line ; : handle-^N his-cur IF his-cur his>next @ ELSE his-head THEN dup to his-cur select-history ; : handle-^P his-cur IF his-cur his>prev @ ELSE his-tail THEN dup to his-cur select-history ; : handle-^Q \ Does not handle terminal formatting yet. key insert-char ; : handle-^R full-redraw-line ; : handle-^U 0 to accept-len 0 to accept-cur full-redraw-line ; : handle-fn key drop beep ; TABLE-EXECUTE handle-CSI 0 , ' handle-^P , ' handle-^N , ' handle-^F , ' handle-^B , 0 , 0 , 0 , ' handle-^A , 0 , 0 , ' handle-^E , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , TABLE-EXECUTE handle-meta 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , ' handle-fn , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , 0 , ' handle-CSI , 0 , 0 , 0 , 0 , : handle-ESC-O key dup 48 = IF handle-^A ELSE dup 46 = IF handle-^E THEN THEN drop ; : handle-ESC-5b key dup 31 = IF \ HOME key drop ( drops closing 7e ) handle-^A ELSE dup 33 = IF \ DEL key drop handle-^D ELSE dup 34 = IF \ END key drop handle-^E ELSE dup 1f and handle-CSI THEN THEN THEN drop ; : handle-ESC key dup 5b = IF handle-ESC-5b ELSE dup 4f = IF handle-ESC-O ELSE dup 1f and handle-meta THEN THEN drop ; TABLE-EXECUTE handle-control 0 , \ ^@: ' handle-^A , ' handle-^B , 0 , \ ^C: ' handle-^D , ' handle-^E , ' handle-^F , 0 , \ ^G: ' handle-^H , ' handle-^I , \ tab 0 , \ ^J: ' handle-^K , ' handle-^L , 0 , \ ^M: enter: handled in main loop ' handle-^N , 0 , \ ^O: ' handle-^P , ' handle-^Q , ' handle-^R , 0 , \ ^S: 0 , \ ^T: ' handle-^U , 0 , \ ^V: 0 , \ ^W: 0 , \ ^X: 0 , \ ^Y: insert save buffer 0 , \ ^Z: ' handle-ESC , 0 , \ ^\: 0 , \ ^]: 0 , \ ^^: 0 , \ ^_: : (accept) ( adr len -- len' ) cursor-on to accept-max to accept-adr 0 to accept-len 0 to accept-cur 0 to his-cur 1b emit 37 emit BEGIN key dup 0d <> WHILE dup 9 <> IF 0 to ?tab-pressed THEN \ reset state machine dup 7f = IF drop 8 THEN \ Handle DEL as if it was BS. ??? bogus dup bl < IF handle-control ELSE dup 80 and IF dup a0 < IF 7f and handle-meta ELSE drop beep THEN ELSE insert-char THEN THEN REPEAT drop add-history accept-len to accept-cur move-cursor space accept-len cursor-off ; ' (accept) to accept 120 cp 1 VALUE /dump ' c@ VALUE 'dump 0 VALUE dump-first 0 VALUE dump-last 0 VALUE dump-cur : .char ( c -- ) dup bl 7f within 0= IF drop [char] . THEN emit ; : dump-line ( -- ) cr dump-cur dup 8 0.r [char] : emit 10 /dump / 0 DO space dump-cur dump-first dump-last within IF dump-cur 'dump execute /dump 2* 0.r ELSE /dump 2* spaces THEN dump-cur /dump + to dump-cur LOOP /dump 1 <> IF drop EXIT THEN to dump-cur 2 spaces 10 0 DO dump-cur dump-first dump-last within IF dump-cur 'dump execute .char ELSE space THEN dump-cur 1+ to dump-cur LOOP ; : (dump) ( addr len reader size -- ) to /dump to 'dump bounds /dump negate and to dump-first to dump-last dump-first f invert and to dump-cur base @ hex BEGIN dump-line dump-cur dump-last >= UNTIL base ! ; : du ( -- ) dump-last 100 'dump /dump (dump) ; : dump ['] c@ 1 (dump) ; : wdump ['] w@ 2 (dump) ; : ldump ['] l@ 4 (dump) ; : xdump ['] x@ 8 (dump) ; : rdump ['] rb@ 1 (dump) ; cistack ciregs >r1 ! \ kernel wants a stack :-) 140 cp STRUCT cell field romfs>file-header cell field romfs>data cell field romfs>data-size cell field romfs>flags CONSTANT /romfs-lookup-control-block CREATE romfs-lookup-cb /romfs-lookup-control-block allot romfs-lookup-cb /romfs-lookup-control-block erase : create-filename ( string -- string\0 ) here >r dup 8 + allot r@ over 8 + erase r@ zplace r> ; : romfs-lookup ( fn-str fn-len -- data size | false ) create-filename romfs-base romfs-lookup-cb romfs-lookup-entry call-c 0= IF romfs-lookup-cb dup romfs>data @ swap romfs>data-size @ ELSE false THEN ; : ibm,romfs-lookup ( fn-str fn-len -- data-high data-low size | 0 0 false ) romfs-lookup dup 0= if drop 0 0 false else swap dup 20 rshift swap ffffffff and then ; : romfs-lookup-client ibm,romfs-lookup ; STRUCT cell field romfs>next-off cell field romfs>size cell field romfs>flags cell field romfs>data-off cell field romfs>name CONSTANT /romfs-cb : romfs-map-file ( fn-str fn-len -- file-addr file-size ) romfs-base >r BEGIN 2dup r@ romfs>name zcount string=ci not WHILE ( fn-str fn-len ) ( R: rom-cb-file-addr ) r> romfs>next-off dup @ dup 0= IF 1 THROW THEN + >r REPEAT ( fn-str fn-len ) ( R: rom-cb-file-addr ) 2drop r@ romfs>data-off @ r@ + r> romfs>size @ ; : flash-header ( -- address | false ) get-flash-base 28 + \ prepare flash header file address dup rx@ \ fetch "magic123" 6d61676963313233 <> IF \ IF flash is not valid drop \ | forget address false \ | return false THEN \ FI ; CREATE bdate-str 10 allot : bdate2human ( -- addr len ) flash-header 40 + rx@ (.) drop dup 0 + bdate-str 6 + 4 move dup 4 + bdate-str 0 + 2 move dup 6 + bdate-str 3 + 2 move dup 8 + bdate-str b + 2 move a + bdate-str e + 2 move 2d bdate-str 2 + c! 2d bdate-str 5 + c! 20 bdate-str a + c! 3a bdate-str d + c! bdate-str 10 ; : included ( fn fn-len -- ) 2dup >r >r romfs-lookup dup IF r> drop r> drop evaluate ELSE drop ." Cannot open file : " r> r> type cr THEN ; : include ( " fn " -- ) parse-word included ; : ?include ( flag " fn " -- ) parse-word rot IF included ELSE 2drop THEN ; : include? ( nargs flag " fn " -- ) parse-word rot IF rot drop included ELSE 2drop 0 ?DO drop LOOP THEN ; : (print-romfs-file-info) ( file-addr -- ) 9 emit dup b 0.r 2 spaces dup 8 + @ 6 0.r 2 spaces 20 + zcount type cr ; : romfs-list ( -- ) romfs-base 0 cr BEGIN + dup (print-romfs-file-info) dup @ dup 0= UNTIL 2drop ; 200 cp : .slof-logo cr ." ..`. .. ....... .. ...... ......." cr ." ..`...`''.`'. .''``````..''. .`''```''`. `''``````" cr ." .`` .:' ': `''..... .''. ''` .''..''......." cr ." ``.':.';. ``````''`.''. .''. ''``''`````'`" cr ." ``.':':` .....`''.`'`...... `'`.....`''.`'` " cr ." .`.`'`` .'`'`````. ``'''''' ``''`'''`. `'` " ; 201 cp : banner cr ." Type 'boot' and press return to continue booting the system." s" /packages/sms" find-node IF cr ." Type 'sms-start' and press return to enter the configuration menu." THEN cr ." Type 'reset-all' and press return to reboot the system." cr cr ; : .banner banner console-clean-fifo ; : .banner .slof-logo .banner ; 220 cp DEFER find-boot-sector ( -- ) 240 cp d# 512000000 VALUE tb-frequency \ default value - needed for "ms" to work -1 VALUE cpu-frequency : slof-build-id ( -- str len ) flash-header 10 + a ; : slof-revision s" 001" ; : read-version-and-date flash-header 0= IF s" " encode-string ELSE flash-header 10 + 10 here swap rmove here 10 s" , " $cat bdate2human $cat encode-string THEN ; : from-cstring ( addr - len ) dup dup BEGIN c@ 0 <> WHILE 1 + dup REPEAT swap - ; 260 cp : tb@ ( -- tb ) BEGIN tbu@ tbl@ tbu@ rot over <> WHILE 2drop REPEAT 20 lshift swap ffffffff and or ; : milliseconds ( -- ms ) tb@ d# 1000 * tb-frequency / ; : microseconds ( -- us ) tb@ d# 1000000 * tb-frequency / ; : ms ( ms-to-wait -- ) milliseconds + BEGIN milliseconds over >= UNTIL drop ; : get-msecs ( -- n ) milliseconds ; : us ( us-to-wait -- ) microseconds + BEGIN microseconds over >= UNTIL drop ; 270 cp variable ip variable fcode-end variable fcode-num 1 value fcode-spread 2 value fcode-offset false value eva-debug? true value fcode-debug? defer fcode-rb@ defer fcode@ ' c@ to fcode-rb@ create token-table 2000 cells allot \ 1000h = 4096d : ?offset16 ( -- true|false ) fcode-offset 2 = ; : ?arch64 ( -- true|false ) cell 8 = ; : ?bigendian ( -- true|false ) deadbeef fcode-num ! fcode-num ?arch64 IF 4 + THEN c@ de = ; : reset-fcode-end ( -- ) false fcode-end ! ; : get-ip ( -- n ) ip @ ; : set-ip ( n -- ) ip ! ; : next-ip ( -- ) get-ip 1+ set-ip ; : jump-n-ip ( n -- ) get-ip + set-ip ; : read-byte ( -- n ) get-ip fcode-rb@ ; : ?compile-mode ( -- on|off ) state @ ; : save-evaluator-state get-ip eva-debug? IF ." saved ip " dup . cr THEN fcode-end @ eva-debug? IF ." saved fcode-end " dup . cr THEN fcode-offset eva-debug? IF ." saved fcode-offset " dup . cr THEN fcode-spread eva-debug? IF ." saved fcode-spread " dup . cr THEN ['] fcode@ behavior eva-debug? IF ." saved fcode@ " dup . cr THEN ; : restore-evaluator-state eva-debug? IF ." restored fcode@ " dup . cr THEN to fcode@ eva-debug? IF ." restored fcode-spread " dup . cr THEN to fcode-spread eva-debug? IF ." restored fcode-offset " dup . cr THEN to fcode-offset eva-debug? IF ." restored fcode-end " dup . cr THEN fcode-end ! eva-debug? IF ." restored ip " dup . cr THEN set-ip ; : token-table-index ( fcode# -- addr ) cells token-table + ; : join-immediate ( xt immediate? addr -- xt+immediate? addr ) -rot + swap ; : split-immediate ( xt+immediate? -- xt immediate? ) dup 1 and 2dup - rot drop swap ; : literal, ( n -- ) postpone literal ; : fc-string, postpone sliteral dup c, bounds ?do i c@ c, loop ; : set-token ( xt immediate? fcode# -- ) token-table-index join-immediate ! ; : get-token ( fcode# -- xt immediate? ) token-table-index @ split-immediate ; ?bigendian [IF] \ Big endian access functions first : read-fcode-num16 ( -- n ) 0 fcode-num ! ?arch64 IF read-byte fcode-num 6 + C! next-ip read-byte fcode-num 7 + C! ELSE read-byte fcode-num 2 + C! next-ip read-byte fcode-num 3 + C! THEN fcode-num @ ; : read-fcode-num32 ( -- n ) 0 fcode-num ! ?arch64 IF read-byte fcode-num 4 + C! next-ip read-byte fcode-num 5 + C! next-ip read-byte fcode-num 6 + C! next-ip read-byte fcode-num 7 + C! ELSE read-byte fcode-num 0 + C! next-ip read-byte fcode-num 1 + C! next-ip read-byte fcode-num 2 + C! next-ip read-byte fcode-num 3 + C! THEN fcode-num @ ; [ELSE] \ Now the little endian access functions : read-fcode-num16 ( -- n ) 0 fcode-num ! ?arch64 IF read-byte fcode-num 7 + C! next-ip read-byte fcode-num 6 + C! ELSE read-byte fcode-num 1 + C! next-ip read-byte fcode-num 0 + C! THEN fcode-num @ ; : read-fcode-num32 ( adr -- n ) 0 fcode-num ! ?arch64 IF read-byte fcode-num 7 + C! next-ip read-byte fcode-num 6 + C! next-ip read-byte fcode-num 5 + C! next-ip read-byte fcode-num 4 + C! ELSE read-byte fcode-num 3 + C! next-ip read-byte fcode-num 2 + C! next-ip read-byte fcode-num 1 + C! next-ip read-byte fcode-num 0 + C! THEN fcode-num @ ; [THEN] : read-fcode# ( -- FCode# ) read-byte dup 01 0F between IF drop read-fcode-num16 THEN ; : read-header ( adr -- ) next-ip read-byte drop next-ip read-fcode-num16 drop next-ip read-fcode-num32 drop ; : read-fcode-string ( -- str len ) read-byte \ get string length ( -- len ) next-ip get-ip \ get string addr ( -- len str ) swap \ type needs the parameters swapped ( -- str len ) dup 1- jump-n-ip \ jump to the end of the string in FCode ; -1 VALUE break-fcode-addr 0 VALUE break-fcode-steps : evaluate-fcode ( -- ) BEGIN get-ip break-fcode-addr = IF TRUE fcode-end ! THEN fcode-end @ 0= WHILE fcode@ ( fcode# ) eva-debug? IF dup get-ip 8 u.r ." : " ." [" 3 u.r ." ] " THEN get-token 0= ?compile-mode AND IF ( xt ) compile, ELSE \ immediate or "interpretation" mode eva-debug? IF dup xt>name type space THEN execute THEN eva-debug? IF .s cr THEN break-fcode-steps IF break-fcode-steps 1- TO break-fcode-steps break-fcode-steps 0= IF TRUE fcode-end ! THEN THEN next-ip REPEAT ; : steps-fcode ( n -- ) to break-fcode-steps break-fcode-addr >r -1 to break-fcode-addr reset-fcode-end evaluate-fcode r> to break-fcode-addr ; : step-fcode ( -- ) 1 steps-fcode ; : fcode-revision ( -- n ) 00030000 \ major * 65536 + minor ; : b(lit) ( -- n ) next-ip read-fcode-num32 ?compile-mode IF literal, THEN ; : b(") next-ip read-fcode-string ?compile-mode IF fc-string, align postpone count THEN ; : b(') next-ip read-fcode# get-token drop ?compile-mode IF literal, THEN ; : ?jump-direction ( n -- ) dup 8000 >= IF 10000 - \ Create cell-sized negative value THEN fcode-offset - \ IP is already behind offset, so substract offset size ; : ?negative 8000 and ; : dest-on-top 0 >r BEGIN dup @ 0= WHILE >r REPEAT BEGIN r> dup WHILE swap REPEAT drop ; : read-fcode-offset next-ip ?offset16 IF read-fcode-num16 ELSE read-byte dup 80 and IF FF00 or THEN \ Fake 16-bit signed offset THEN ; : b?branch ( flag -- ) ?compile-mode IF read-fcode-offset ?negative IF dest-on-top postpone until ELSE postpone if THEN ELSE ( flag ) IF fcode-offset jump-n-ip \ Skip over offset value ELSE read-fcode-offset ?jump-direction jump-n-ip THEN THEN ; immediate : bbranch ( -- ) ?compile-mode IF read-fcode-offset ?negative IF dest-on-top postpone again ELSE postpone else get-ip next-ip fcode@ B2 = IF drop ELSE set-ip THEN THEN ELSE read-fcode-offset ?jump-direction jump-n-ip THEN ; immediate : b(<mark) ( -- ) ?compile-mode IF postpone begin THEN ; immediate : b(>resolve) ( -- ) ?compile-mode IF postpone then THEN ; immediate : b(;) <semicolon> compile, reveal postpone [ ; immediate : b(:) ( -- ) <colon> compile, ] ; immediate : b(case) ( sel -- sel ) postpone case ; immediate : b(endcase) postpone endcase ; immediate : b(of) postpone of read-fcode-offset drop \ read and discard offset ; immediate : b(endof) postpone endof read-fcode-offset drop ; immediate : b(do) postpone do read-fcode-offset drop ; immediate : b(?do) postpone ?do read-fcode-offset drop ; immediate : b(loop) postpone loop read-fcode-offset drop ; immediate : b(+loop) postpone +loop read-fcode-offset drop ; immediate : b(leave) postpone leave ; immediate 0 VALUE fc-instance? : fc-instance ( -- ) \ Mark next defining word as instance-specific. TRUE TO fc-instance? ; : new-token \ unnamed local fcode function align here next-ip read-fcode# 0 swap set-token ; : external-token ( -- ) \ named local fcode function next-ip read-fcode-string header ( str len -- ) \ create a header in the current dictionary entry new-token ; : new-token eva-debug? IF s" x" get-ip >r next-ip read-fcode# r> set-ip (u.) $cat strdup header THEN new-token ; : named-token fcode-debug? IF external-token ELSE next-ip read-fcode-string 2drop \ Forget about the name new-token THEN ; : b(to) ( val -- ) next-ip read-fcode# get-token drop ( val xt ) dup @ ( val xt @xt ) dup <value> = over <defer> = OR IF drop >body cell - ?compile-mode IF literal, postpone ! ELSE ! THEN ELSE <create> <> IF ( val xt ) TRUE ABORT" Invalid destination for FCODE b(to)" THEN dup cell+ @ ( val xt @xt+1cell ) dup <instancevalue> <> swap <instancedefer> <> AND IF TRUE ABORT" Invalid destination for FCODE b(to)" THEN >body @ ( val instance-offset ) ?compile-mode IF literal, postpone >instance postpone ! ELSE >instance ! THEN ELSE THEN ; immediate : b(value) fc-instance? IF <create> , \ Needed for "(instance?)" for example <instancevalue> , (create-instance-var) FALSE TO fc-instance? ELSE <value> , , THEN reveal ; : b(variable) fc-instance? IF <create> , \ Needed for "(instance?)" <instancevariable> , 0 (create-instance-var) FALSE TO fc-instance? ELSE <variable> , 0 , THEN reveal ; : b(constant) <constant> , , reveal ; : undefined-defer cr cr ." Uninitialized defer word has been executed!" cr cr true fcode-end ! ; : b(defer) fc-instance? IF <create> , \ Needed for "(instance?)" <instancedefer> , ['] undefined-defer (create-instance-var) reveal FALSE TO fc-instance? ELSE <defer> , reveal postpone undefined-defer THEN ; : b(create) <variable> , postpone noop reveal ; : b(field) ( E: addr -- addr+offset ) ( F: offset size -- offset+size ) <colon> , over literal, postpone + <semicolon> compile, reveal + ; : b(buffer:) ( E: -- a-addr) ( F: size -- ) fc-instance? IF <create> , \ Needed for "(instance?)" <instancebuffer> , (create-instance-buf) FALSE TO fc-instance? ELSE <buffer:> , allot THEN reveal ; : suspend-fcode ( -- ) noop \ has to be implemented more efficiently ;-) ; : offset16 ( -- ) 2 to fcode-offset ; : version1 ( -- ) 1 to fcode-spread 1 to fcode-offset read-header ; : start0 ( -- ) 0 to fcode-spread offset16 read-header ; : start1 ( -- ) 1 to fcode-spread offset16 read-header ; : start2 ( -- ) 2 to fcode-spread offset16 read-header ; : start4 ( -- ) 4 to fcode-spread offset16 read-header ; : end0 ( -- ) true fcode-end ! ; : end1 ( -- ) end0 ; : ferror ( -- ) clear end0 cr ." FCode# " fcode-num @ . ." not assigned!" cr ." FCode evaluation aborted." cr ." ( -- S:" depth . ." R:" rdepth . ." ) " .s cr abort ; : reset-local-fcodes FFF 800 DO ['] ferror 0 i set-token LOOP ; : byte-load ( addr xt -- ) >r >r save-evaluator-state r> r> reset-fcode-end 1 to fcode-spread dup 1 = IF drop ['] rb@ THEN to fcode-rb@ set-ip reset-local-fcodes depth >r evaluate-fcode r> depth 1- <> IF clear end0 cr ." Ambiguous stack depth after byte-load!" cr ." FCode evaluation aborted." cr cr ELSE restore-evaluator-state THEN ['] c@ to fcode-rb@ ; : fc-c@ ( addr -- byte ) dup MIN-RAM-SIZE > IF rb@ ELSE c@ THEN ; : fc-w@ ( addr -- word ) dup MIN-RAM-SIZE > IF rw@ ELSE w@ THEN ; : fc-<w@ ( addr -- word ) fc-w@ dup 8000 >= IF 10000 - THEN ; : fc-l@ ( addr -- long ) dup MIN-RAM-SIZE > IF rl@ ELSE l@ THEN ; : fc-<l@ ( addr -- long ) fc-l@ signed ; : fc-x@ ( addr -- dlong ) dup MIN-RAM-SIZE > IF rx@ ELSE x@ THEN ; : fc-c! ( byte addr -- ) dup MIN-RAM-SIZE > IF rb! ELSE c! THEN ; : fc-w! ( word addr -- ) dup MIN-RAM-SIZE > IF rw! ELSE w! THEN ; : fc-l! ( long addr -- ) dup MIN-RAM-SIZE > IF rl! ELSE l! THEN ; : fc-x! ( dlong addr -- ) dup MIN-RAM-SIZE > IF rx! ELSE x! THEN ; : fc-fill ( add len byte -- ) 2 pick MIN-RAM-SIZE > IF rfill ELSE fill THEN ; : fc-move ( src dst len -- ) 2 pick MIN-RAM-SIZE > \ Check src 2 pick MIN-RAM-SIZE > \ Check dst OR IF rmove ELSE move THEN ; : free-virtual ( virt size -- ) s" map-out" $call-parent ; : map-low ( phys.lo ... size -- virt ) my-space swap s" map-in" $call-parent ; : mac-address ( -- mac-str mac-len ) s" local-mac-address" get-my-property IF 0 0 THEN ; VARIABLE #line 0 #line ! VARIABLE #out 0 #out ! : display-status ( n -- ) ." Device status: " . cr ; VARIABLE group-code 0 group-code ! : dma-alloc ( byte -- virtual ) s" dma-alloc" $call-parent ; : my-params ( -- addr len ) s" params" get-my-property IF 0 0 THEN ; : sbus-intr>cpu ( sbus-intr# -- cpu-intr# ) ; : intr ( interrupt# vector -- ) >r sbus-intr>cpu encode-int r> encode-int+ s" intr" property ; : driver ( addr len -- ) encode-string s" name" property ; : processor-type ( -- cpu-type ) 0 ; : firmware-version ( -- n ) 10000 \ Just a dummy value ; : fcode-version ( -- n ) fcode-revision ; : fc-abort ." FCode called abort: IP " get-ip . ( ." STACK: " .s ) depth dup 0< IF abort THEN . rdepth . cr abort ; : fc-0 ." 0(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 0 ; : fc-1 ." 1(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 1 ; : parse-1hex 1 hex-decode-unit ; : fc-set-pci-mmio-tokens ( -- ) ['] rw@-le 0 232 set-token ['] rw!-le 0 233 set-token ['] rl@-le 0 234 set-token ['] rl!-le 0 235 set-token ['] rx@-le 0 22E set-token ['] rx!-le 0 22F set-token ; : fc-set-normal-mmio-tokens ( -- ) ['] rw@ 0 232 set-token ['] rw! 0 233 set-token ['] rl@ 0 234 set-token ['] rl! 0 235 set-token ['] rx@ 0 22E set-token ['] rx! 0 22F set-token ; : reset-token-table FFF 0 DO ['] ferror 0 i set-token LOOP ; reset-token-table ' end0 0 00 set-token ' b(lit) 1 10 set-token ' b(') 1 11 set-token ' b(") 1 12 set-token ' bbranch 1 13 set-token ' b?branch 1 14 set-token ' b(loop) 1 15 set-token ' b(+loop) 1 16 set-token ' b(do) 1 17 set-token ' b(?do) 1 18 set-token ' i 0 19 set-token ' j 0 1A set-token ' b(leave) 1 1B set-token ' b(of) 1 1C set-token ' execute 0 1D set-token ' + 0 1E set-token ' - 0 1F set-token ' * 0 20 set-token ' / 0 21 set-token ' mod 0 22 set-token ' and 0 23 set-token ' or 0 24 set-token ' xor 0 25 set-token ' invert 0 26 set-token ' lshift 0 27 set-token ' rshift 0 28 set-token ' >>a 0 29 set-token ' /mod 0 2A set-token ' u/mod 0 2B set-token ' negate 0 2C set-token ' abs 0 2D set-token ' min 0 2E set-token ' max 0 2F set-token ' >r 0 30 set-token ' r> 0 31 set-token ' r@ 0 32 set-token ' exit 0 33 set-token ' 0= 0 34 set-token ' 0<> 0 35 set-token ' 0< 0 36 set-token ' 0<= 0 37 set-token ' 0> 0 38 set-token ' 0>= 0 39 set-token ' < 0 3A set-token ' > 0 3B set-token ' = 0 3C set-token ' <> 0 3D set-token ' u> 0 3E set-token ' u<= 0 3F set-token ' u< 0 40 set-token ' u>= 0 41 set-token ' >= 0 42 set-token ' <= 0 43 set-token ' between 0 44 set-token ' within 0 45 set-token ' DROP 0 46 set-token ' DUP 0 47 set-token ' OVER 0 48 set-token ' SWAP 0 49 set-token ' ROT 0 4A set-token ' -ROT 0 4B set-token ' TUCK 0 4C set-token ' nip 0 4D set-token ' pick 0 4E set-token ' roll 0 4F set-token ' ?dup 0 50 set-token ' depth 0 51 set-token ' 2drop 0 52 set-token ' 2dup 0 53 set-token ' 2over 0 54 set-token ' 2swap 0 55 set-token ' 2rot 0 56 set-token ' 2/ 0 57 set-token ' u2/ 0 58 set-token ' 2* 0 59 set-token ' /c 0 5A set-token ' /w 0 5B set-token ' /l 0 5C set-token ' /n 0 5D set-token ' ca+ 0 5E set-token ' wa+ 0 5F set-token ' la+ 0 60 set-token ' na+ 0 61 set-token ' char+ 0 62 set-token ' wa1+ 0 63 set-token ' la1+ 0 64 set-token ' cell+ 0 65 set-token ' chars 0 66 set-token ' /w* 0 67 set-token ' /l* 0 68 set-token ' cells 0 69 set-token ' on 0 6A set-token ' off 0 6B set-token ' +! 0 6C set-token ' @ 0 6D set-token ' fc-l@ 0 6E set-token ' fc-w@ 0 6F set-token ' fc-<w@ 0 70 set-token ' fc-c@ 0 71 set-token ' ! 0 72 set-token ' fc-l! 0 73 set-token ' fc-w! 0 74 set-token ' fc-c! 0 75 set-token ' 2@ 0 76 set-token ' 2! 0 77 set-token ' fc-move 0 78 set-token ' fc-fill 0 79 set-token ' comp 0 7A set-token ' noop 0 7B set-token ' lwsplit 0 7C set-token ' wljoin 0 7D set-token ' lbsplit 0 7E set-token ' bljoin 0 7F set-token ' wbflip 0 80 set-token ' upc 0 81 set-token ' lcc 0 82 set-token ' pack 0 83 set-token ' count 0 84 set-token ' body> 0 85 set-token ' >body 0 86 set-token ' fcode-revision 0 87 set-token ' span 0 88 set-token ' unloop 0 89 set-token ' expect 0 8A set-token ' alloc-mem 0 8B set-token ' free-mem 0 8C set-token ' key? 0 8D set-token ' key 0 8E set-token ' emit 0 8F set-token ' type 0 90 set-token ' (cr 0 91 set-token ' cr 0 92 set-token ' #out 0 93 set-token ' #line 0 94 set-token ' hold 0 95 set-token ' <# 0 96 set-token ' u#> 0 97 set-token ' sign 0 98 set-token ' u# 0 99 set-token ' u#s 0 9A set-token ' u. 0 9B set-token ' u.r 0 9C set-token ' . 0 9D set-token ' .r 0 9E set-token ' .s 0 9F set-token ' base 0 A0 set-token ' $number 0 A2 set-token ' digit 0 A3 set-token ' -1 0 A4 set-token ' 0 0 A5 set-token ' 1 0 A6 set-token ' 2 0 A7 set-token ' 3 0 A8 set-token ' bl 0 A9 set-token ' bs 0 AA set-token ' bell 0 AB set-token ' bounds 0 AC set-token ' here 0 AD set-token ' aligned 0 AE set-token ' wbsplit 0 AF set-token ' bwjoin 0 B0 set-token ' b(<mark) 1 B1 set-token ' b(>resolve) 1 B2 set-token ' new-token 0 B5 set-token ' named-token 0 B6 set-token ' b(:) 1 B7 set-token ' b(value) 1 B8 set-token ' b(variable) 1 B9 set-token ' b(constant) 1 BA set-token ' b(create) 1 BB set-token ' b(defer) 1 BC set-token ' b(buffer:) 1 BD set-token ' b(field) 1 BE set-token ' fc-instance 1 C0 set-token ' b(;) 1 C2 set-token ' b(to) 1 C3 set-token ' b(case) 1 C4 set-token ' b(endcase) 1 C5 set-token ' b(endof) 1 C6 set-token ' # 0 C7 set-token ' #s 0 C8 set-token ' #> 0 C9 set-token ' external-token 0 CA set-token ' $find 0 CB set-token ' offset16 0 CC set-token ' evaluate 0 CD set-token ' c, 0 D0 set-token ' w, 0 D1 set-token ' l, 0 D2 set-token ' , 0 D3 set-token ' um* 0 D4 set-token ' um/mod 0 D5 set-token ' d+ 0 D8 set-token ' d- 0 D9 set-token ' get-token 0 DA set-token ' set-token 0 DB set-token ' state 0 DC set-token \ possibly broken ' compile, 0 DD set-token ' behavior 0 DE set-token ' start0 0 F0 set-token ' start1 0 F1 set-token ' start2 0 F2 set-token ' start4 0 F3 set-token ' ferror 0 FC set-token ' version1 0 FD set-token ' end1 0 FF set-token ' dma-alloc 0 101 set-token \ Obsolete ' my-address 0 102 set-token ' my-space 0 103 set-token ' free-virtual 0 105 set-token ' my-params 0 10f set-token \ Obsolete ' property 0 110 set-token ' encode-int 0 111 set-token ' encode+ 0 112 set-token ' encode-phys 0 113 set-token ' encode-string 0 114 set-token ' encode-bytes 0 115 set-token ' reg 0 116 set-token ' intr 0 117 set-token \ Obsolete ' driver 0 118 set-token \ Obsolete ' model 0 119 set-token ' device-type 0 11A set-token ' parse-2int 0 11B set-token ' new-device 0 11F set-token ' diagnostic-mode? 0 120 set-token ' display-status 0 121 set-token \ Maybe obsolete ' memory-test-suite 0 122 set-token ' group-code 0 123 set-token \ Obsolete ' mask 0 124 set-token ' get-msecs 0 125 set-token ' ms 0 126 set-token ' finish-device 0 127 set-token ' decode-phys 0 128 set-token ' interpose 0 12B set-token \ Recommended practice: Interposition ' map-low 0 130 set-token ' sbus-intr>cpu 0 131 set-token \ Obsolete ' mac-address 0 1A4 set-token ' device-name 0 201 set-token ' my-args 0 202 set-token ' my-self 0 203 set-token ' find-package 0 204 set-token ' open-package 0 205 set-token ' close-package 0 206 set-token ' find-method 0 207 set-token ' call-package 0 208 set-token ' $call-parent 0 209 set-token ' my-parent 0 20A set-token ' ihandle>phandle 0 20B set-token ' my-unit 0 20D set-token ' $call-method 0 20E set-token ' $open-package 0 20F set-token ' processor-type 0 210 set-token \ Obsolete ' firmware-version 0 211 set-token \ Obsolete ' fcode-version 0 212 set-token \ Obsolete ' (is-user-word) 0 214 set-token ' suspend-fcode 0 215 set-token ' fc-abort 0 216 set-token ' catch 0 217 set-token ' throw 0 218 set-token ' get-my-property 0 21A set-token ' decode-int 0 21B set-token ' decode-string 0 21C set-token ' get-inherited-property 0 21D set-token ' delete-property 0 21E set-token ' get-package-property 0 21F set-token ' cpeek 0 220 set-token ' wpeek 0 221 set-token ' lpeek 0 222 set-token ' cpoke 0 223 set-token ' wpoke 0 224 set-token ' lpoke 0 225 set-token ' lwflip 0 226 set-token ' lbflip 0 227 set-token ' lbflips 0 228 set-token ' rb@ 0 230 set-token ' rb! 0 231 set-token fc-set-normal-mmio-tokens \ Set rw@, rw!, rl@, rl!, rx@ and rx! ' wbflips 0 236 set-token ' lwflips 0 237 set-token ' child 0 23B set-token ' peer 0 23C set-token ' next-property 0 23D set-token ' byte-load 0 23E set-token ' set-args 0 23F set-token ' left-parse-string 0 240 set-token ' bxjoin 0 241 set-token ' fc-<l@ 0 242 set-token ' lxjoin 0 243 set-token ' wxjoin 0 244 set-token ' x, 0 245 set-token ' fc-x@ 0 246 set-token ' fc-x! 0 247 set-token ' /x 0 248 set-token ' /x* 0 249 set-token ' xa+ 0 24A set-token ' xa1+ 0 24B set-token ' xbflip 0 24C set-token ' xbflips 0 24D set-token ' xbsplit 0 24E set-token ' xlflip 0 24F set-token ' xlflips 0 250 set-token ' xlsplit 0 251 set-token ' xwflip 0 252 set-token ' xwflips 0 253 set-token ' xwsplit 0 254 set-token 80 cells CONSTANT LOCALS-STACK-SIZE LOCALS-STACK-SIZE BUFFER: localsstackbuf localsstackbuf VALUE localsstack : fc-local@ ( n -- val ) cells localsstack swap - @ ; : fc-local-1-@ 1 fc-local@ ; : fc-local-2-@ 2 fc-local@ ; : fc-local-3-@ 3 fc-local@ ; : fc-local-4-@ 4 fc-local@ ; : fc-local-5-@ 5 fc-local@ ; : fc-local-6-@ 6 fc-local@ ; : fc-local-7-@ 7 fc-local@ ; : fc-local-8-@ 8 fc-local@ ; : fc-local! ( val n -- ) cells localsstack swap - ! ; : fc-local-1-! 1 fc-local! ; : fc-local-2-! 2 fc-local! ; : fc-local-3-! 3 fc-local! ; : fc-local-4-! 4 fc-local! ; : fc-local-5-! 5 fc-local! ; : fc-local-6-! 6 fc-local! ; : fc-local-7-! 7 fc-local! ; : fc-local-8-! 8 fc-local! ; 0 VALUE uses-locals? : (fc-push-locals) ( ... n -- ) 8 cells localsstack + TO localsstack localsstack localsstackbuf - LOCALS-STACK-SIZE > ABORT" Locals stack exceeded!" ?dup IF ( ... n ) 1 swap DO i fc-local! \ Store pre-initialized locals -1 +LOOP THEN ; : fc-push-locals ( n -- ) uses-locals? ABORT" Definition pushes locals multiple times!" true TO uses-locals? ( n ) ['] literal execute ['] (fc-push-locals) compile, ; : fc-push-0-locals 0 fc-push-locals ; : fc-push-1-locals 1 fc-push-locals ; : fc-push-2-locals 2 fc-push-locals ; : fc-push-3-locals 3 fc-push-locals ; : fc-push-4-locals 4 fc-push-locals ; : fc-push-5-locals 5 fc-push-locals ; : fc-push-6-locals 6 fc-push-locals ; : fc-push-7-locals 7 fc-push-locals ; : fc-push-8-locals 8 fc-push-locals ; : fc-pop-locals ( -- ) localsstack 8 cells - TO localsstack localsstack localsstackbuf - 0 < ABORT" Locals stack undeflow!" ; : fc-locals-exit uses-locals? IF ['] fc-pop-locals compile, THEN ['] exit compile, ; : fc-locals-b(;) uses-locals? IF ['] fc-pop-locals compile, THEN false TO uses-locals? ['] b(;) execute ; : fc-set-locals-tokens ( -- ) ['] fc-push-0-locals 1 407 set-token ['] fc-push-1-locals 1 408 set-token ['] fc-push-2-locals 1 409 set-token ['] fc-push-3-locals 1 40a set-token ['] fc-push-4-locals 1 40b set-token ['] fc-push-5-locals 1 40c set-token ['] fc-push-6-locals 1 40d set-token ['] fc-push-7-locals 1 40e set-token ['] fc-push-8-locals 1 40f set-token ['] fc-local-1-@ 0 410 set-token ['] fc-local-2-@ 0 411 set-token ['] fc-local-3-@ 0 412 set-token ['] fc-local-4-@ 0 413 set-token ['] fc-local-5-@ 0 414 set-token ['] fc-local-6-@ 0 415 set-token ['] fc-local-7-@ 0 416 set-token ['] fc-local-8-@ 0 417 set-token ['] fc-local-1-! 0 418 set-token ['] fc-local-2-! 0 419 set-token ['] fc-local-3-! 0 41a set-token ['] fc-local-4-! 0 41b set-token ['] fc-local-5-! 0 41c set-token ['] fc-local-6-! 0 41d set-token ['] fc-local-7-! 0 41e set-token ['] fc-local-8-! 0 41f set-token ['] fc-locals-exit 1 33 set-token ['] fc-locals-b(;) 1 c2 set-token ; fc-set-locals-tokens 0 value buff 0 value buff-size ' read-fcode# to fcode@ : execute-rom-fcode ( addr len | false -- ) reset-fcode-end ?dup IF diagnostic-mode? IF ." , executing ..." cr THEN dup >r r@ alloc-mem dup >r swap rmove r@ set-ip evaluate-fcode diagnostic-mode? IF ." Done." cr THEN r> r> free-mem THEN ; : rom-code-ignored ( image-addr name len -- image-addr ) diagnostic-mode? IF type ." code found in image " dup . ." , ignoring ..." cr ELSE 2drop THEN ; : pci-find-rom ( baseaddr -- addr ) dup IF dup rw@-le aa55 = IF diagnostic-mode? IF ." Device ROM header found at " dup . cr THEN ELSE drop 0 THEN THEN ; : pci-find-fcode ( baseaddr -- addr len | false ) BEGIN 1ff NOT and \ Image must start at 512 byte boundary pci-find-rom dup WHILE dup 18 + rw@-le + ( pcir-addr ) dup rw@-le 4350 ( 'PC' ) <> ( pcir-addr hasPC? ) over 2+ rw@-le 5249 ( 'IR' ) <> OR IF diagnostic-mode? IF ." Invalid PCI Data structure, ignoring ROM contents" cr THEN drop false EXIT THEN ( pcir-addr ) dup 14 + rb@ CASE \ Get image code type 0 OF s" Intel x86 BIOS" rom-code-ignored ENDOF 1 OF diagnostic-mode? IF ." Open Firmware FCode found in image at " dup . cr THEN dup 1ff NOT AND \ Back to the ROM image header dup 2+ rw@-le + \ Pointer to FCODE (PCI bus binding ch.9) swap 10 + rw@-le 200 * \ Image length EXIT ENDOF 2 OF s" HP PA RISC" rom-code-ignored ENDOF 3 OF s" EFI" rom-code-ignored ENDOF dup OF s" Unknown type" rom-code-ignored ENDOF ENDCASE dup 15 + rb@ 80 and IF \ End of last image? drop false EXIT THEN dup 10 + rw@-le 200 * + \ Next image start REPEAT ; : pci-execute-fcode ( baseaddr -- ) pci-find-fcode dup 0= IF 2drop EXIT THEN ( addr len ) fc-set-pci-mmio-tokens \ Prepare PCI access functions ['] execute-rom-fcode CATCH IF cr ." FCODE failed!" cr 2drop THEN fc-set-normal-mmio-tokens \ Restore normal MMIO access functions ; 2e0 cp 10 CONSTANT quiesce-xt# CREATE quiesce-xts quiesce-xt# cells allot quiesce-xts quiesce-xt# cells erase : add-quiesce-xt ( xt -- ) quiesce-xt# 0 DO quiesce-xts I cells + ( xt arrayptr ) dup @ 0= ( xt arrayptr true|false ) IF ! UNLOOP EXIT ELSE ( xt arrayptr ) over swap ( xt xt arrayptr ) @ = \ xt already stored ? IF drop UNLOOP EXIT THEN ( xt ) THEN LOOP drop ( xt -- ) ." Warning: quiesce xt list is full." cr ; : quiesce ( -- ) quiesce-xt# 0 DO quiesce-xts I cells + ( arrayptr ) @ dup IF ( xt ) EXECUTE ELSE drop UNLOOP EXIT THEN LOOP ; 300 cp 0 VALUE usb-debug-flag false VALUE scan-time? VARIABLE ihandle-bulk-tran : usb-debug-print ( str len -- ) usb-debug-flag IF type cr ELSE 2drop THEN ; : usb-debug-print-val ( str len val -- ) usb-debug-flag IF -ROT type . cr ELSE drop 2drop THEN ; 0 VALUE proceed-char : show-proceed ( -- ) scan-time? \ are we on usb-scan ? IF proceed-char CASE 0 OF 2d ENDOF \ show '-' 1 OF 5c ENDOF \ show '\' 2 OF 7c ENDOF \ show '|' dup OF 2f ENDOF \ show '/' ENDCASE emit 8 emit proceed-char 1 + 3 AND to proceed-char THEN ; : wait-proceed ( nl -- ) show-proceed BEGIN dup d# 100 > ( nl true|false ) WHILE 100 - show-proceed 100 ms \ do it in steps of 100ms REPEAT ms \ rest delay ; : do-alias-setting ( num name-str name-len ) rot $cathex strdup \ create alias name get-node node>path \ get path string set-alias \ and set the alias ; 0 VALUE ohci-alias-num : set-ohci-alias ( -- ) ohci-alias-num dup 1+ TO ohci-alias-num ( num ) s" ohci" do-alias-setting ; 0 VALUE cdrom-alias-num 0 VALUE disk-alias-num \ shall start with: pci-disk-num FALSE VALUE ext-disk-alias \ first external disk: not yet assigned : set-drive-alias ( -- ) space 5b emit s" cdrom" drop ( name-str ) get-node node>name comp 0= ( true|false ) IF \ is this a cdrom ? cdrom-alias-num dup 1+ TO cdrom-alias-num ( num ) s" cdrom" \ yes, alias = cdrom ELSE s" sbc-dev" drop \ is this a scsi-block-device? get-node node>name comp 0= ( true|false ) IF disk-alias-num dup 1 + to disk-alias-num s" disk" \ all block devices will be named "disk" ext-disk-alias not \ flag for first ext. disk already assigned IF TRUE to ext-disk-alias 2 s" hdd" \ add extra alias hdd2 for first USB disk 2dup type 2 pick . 8 emit 2f emit do-alias-setting THEN ELSE 0 s" ??? " \ unknown device THEN THEN ( num name-str name-len ) 2dup type 2 pick . 8 emit 5d emit cr do-alias-setting ; : usb-create-alias-name ( num -- str len ) >r s" ohciX" 2dup + 1- ( str len last-char-ptr R: num ) r> [char] 0 + swap c! ( str len R: ) ; : ohci-scan-node ( str len -- ) 2dup find-node ?dup IF dup set-node dup child ?dup IF delete-node s" Deleting node" usb-debug-print THEN s" enumerate" rot find-method IF drop open-dev dup to my-self s" enumerate" 2 pick $call-method \ Scan host controller close-dev 0 to my-self 0 set-node ELSE 2drop get-node dup parent node>path select-dev \ Open parent extend-device s" usb-ohci.fs" included s" open" $call-my-method 0= ABORT" OHCI open failed" s" enumerate" $call-my-method s" close" $call-my-method finish-device unselect-dev THEN ( str len R: num ) ELSE 2drop THEN ; : ohci-scan space ." Scan USB... " cr true to scan-time? \ show proceeding signs 0 to disk-alias-num \ start with disk0 s" pci-disk-num" $find \ previously detected disks ? IF execute to disk-alias-num \ overwrite start number ELSE 2drop THEN 0 >r \ Counter for alias BEGIN r@ usb-create-alias-name find-alias ?dup ( false | str len len R: num ) WHILE usb-debug-flag IF ." * Scanning hub " 2dup type ." ..." cr THEN ohci-scan-node ( R: num ) r> 1+ >r ( R: num+1 ) REPEAT r> drop 0 TO ohci-alias-num 0 TO cdrom-alias-num s" cdrom0" find-alias ( false | dev-path len ) dup IF s" cdrom" 2swap ( alias-name len' dev-path len ) set-alias ( -- ) ELSE drop ( -- ) THEN false to scan-time? \ suppress proceeding signs ; : usb-scan s" ohci0" find-alias IF drop ohci-scan THEN ; 320 cp : .ansi-attr-off 1b emit ." [0m" ; \ ESC Sequence: all terminal atributes off : .ansi-blue 1b emit ." [34m" ; \ ESC Sequence: foreground-color = blue : .ansi-green 1b emit ." [32m" ; \ ESC Sequence: foreground-color = green : .ansi-red 1b emit ." [31m" ; \ ESC Sequence: foreground-color = green : .ansi-bold 1b emit ." [1m" ; \ ESC Sequence: foreground-color bold false VALUE scsi-supp-present? : scsi-xt-err ." SCSI-ERROR (Intern) " ; ' scsi-xt-err VALUE scsi-open-xt \ preset with an invalid token : .wordlists ( -- ) .ansi-red get-order ( -- wid1 .. widn n ) dup space 28 emit .d ." word lists : " 0 DO . 08 emit 2c emit LOOP 08 emit \ 'bs' 29 emit \ ')' cr space 28 emit ." Context: " context dup . @ 5b emit . 8 emit 5d emit space ." / Current: " current . .ansi-attr-off cr ; : .context ( num -- ) .ansi-red space 5b emit 23 emit . 3a emit context @ . 8 emit 5d emit space .ansi-attr-off ; : scsi-open ( -- ) scsi-supp-present? NOT IF s" scsi-support.fs" included ( xt-open ) to scsi-open-xt ( ) true to scsi-supp-present? THEN scsi-open-xt execute ; 360 cp 0 VALUE fdt-debug fdt-start 0 = IF -1 throw THEN struct 4 field >fdth_magic 4 field >fdth_tsize 4 field >fdth_struct_off 4 field >fdth_string_off 4 field >fdth_rsvmap_off 4 field >fdth_version 4 field >fdth_compat_vers 4 field >fdth_boot_cpu 4 field >fdth_string_size 4 field >fdth_struct_size drop h# d00dfeed constant OF_DT_HEADER h# 1 constant OF_DT_BEGIN_NODE h# 2 constant OF_DT_END_NODE h# 3 constant OF_DT_PROP h# 4 constant OF_DT_NOP h# 9 constant OF_DT_END fdt-start dup dup >fdth_struct_off l@ + value fdt-struct dup dup >fdth_string_off l@ + value fdt-strings drop : fdt-check-header ( -- ) fdt-start dup 0 = IF ." No flat device tree !" cr drop -1 throw EXIT THEN hex fdt-debug IF ." Flat device tree header at 0x" dup . s" :" type cr ." magic : 0x" dup >fdth_magic l@ . cr ." total size : 0x" dup >fdth_tsize l@ . cr ." offset to struct : 0x" dup >fdth_struct_off l@ . cr ." offset to strings: 0x" dup >fdth_string_off l@ . cr ." offset to rsvmap : 0x" dup >fdth_rsvmap_off l@ . cr ." version : " dup >fdth_version l@ decimal . hex cr ." last compat vers : " dup >fdth_compat_vers l@ decimal . hex cr dup >fdth_version l@ 2 >= IF ." boot CPU : 0x" dup >fdth_boot_cpu l@ . cr THEN dup >fdth_version l@ 3 >= IF ." strings size : 0x" dup >fdth_string_size l@ . cr THEN dup >fdth_version l@ 17 >= IF ." struct size : 0x" dup >fdth_struct_size l@ . cr THEN THEN dup >fdth_magic l@ OF_DT_HEADER <> IF ." Flat device tree has incorrect magic value !" cr drop -1 throw EXIT THEN dup >fdth_version l@ 10 < IF ." Flat device tree has usupported version !" cr drop -1 throw EXIT THEN drop ; fdt-check-header : fdt-next-tag ( addr -- nextaddr tag ) 0 ( dummy tag on stack for loop ) BEGIN drop ( drop previous tag ) dup l@ ( read new tag ) swap 4 + swap ( increment addr ) dup OF_DT_NOP <> UNTIL ( loop until not nop ) ; : fdt-fetch-unit ( addr -- addr $name ) dup from-cstring \ get string size 2dup + 1 + 3 + fffffffc and -rot ; : fdt-reg-unit ( prop-addr prop-len -- ) s" #address-cells" get-parent get-package-property IF 2drop ELSE decode-int nip nip ( prop-addr prop-len #addr-cells ) 3 <> IF 2drop EXIT THEN decode-phys ( prop-addr' prop-len' phys.lo ... phys.hi ) set-unit ( prop-addr' prop-len' ) 2drop THEN ; : fdt-fetch-string ( index -- str-addr str-len ) fdt-strings + dup from-cstring ; : fdt-create-dec s" decode-unit" $CREATE , DOES> @ hex-decode-unit ; : fdt-create-enc s" encode-unit" $CREATE , DOES> @ hex-encode-unit ; : fdt-prop-is-string? ( addr len -- string? ) dup 1 < IF 2drop FALSE EXIT THEN \ Check for valid length 1- 2dup + c@ 0<> IF 2drop FALSE EXIT THEN \ Check zero-termination test-string ; : fdt-encode-prop ( addr len -- ) 2dup fdt-prop-is-string? IF 1- encode-string ELSE encode-bytes THEN ; : fdt-unflatten-node ( start -- end ) recursive fdt-next-tag dup OF_DT_BEGIN_NODE <> IF s" Weird tag 0x" type . " at start of node" type cr -1 throw THEN drop new-device fdt-fetch-unit dup 0 = IF drop drop " /" THEN 40 left-parse-string device-name dup IF " #address-cells" get-parent get-package-property IF 2drop ELSE decode-int nip nip hex-decode-unit set-unit THEN ELSE 2drop THEN BEGIN fdt-next-tag dup OF_DT_END_NODE <> WHILE dup OF_DT_PROP = IF drop dup ( drop tag, dup addr : a1 a1 ) dup l@ dup rot 4 + ( fetch size, stack is : a1 s s a2) dup l@ swap 4 + ( fetch nameid, stack is : a1 s s i a3 ) rot ( we now have: a1 s i a3 s ) fdt-encode-prop rot ( a1 s pa ps i) fdt-fetch-string ( a1 s pa ps na ns ) 2dup s" reg" str= IF 2swap 2dup fdt-reg-unit 2swap THEN property + 8 + 3 + fffffffc and ELSE dup OF_DT_BEGIN_NODE = IF drop ( drop tag ) 4 - fdt-unflatten-node ELSE drop -1 throw THEN THEN REPEAT drop \ drop tag " #address-cells" get-node get-package-property IF ELSE decode-int dup fdt-create-dec fdt-create-enc 2drop THEN finish-device ; : fdt-unflatten-tree fdt-debug IF ." Unflattening device tree..." cr THEN fdt-struct fdt-unflatten-node drop fdt-debug IF ." Done !" cr THEN ; fdt-unflatten-tree : fdt-parse-memory " /memory" find-device " reg" get-node get-package-property IF throw -1 THEN decode-phys 2drop decode-phys my-#address-cells 1 > IF 20 << or THEN fdt-debug IF dup ." Memory size: " . cr THEN MIN-RAM-SIZE swap MIN-RAM-SIZE - release 2drop device-end ; fdt-parse-memory : fdt-claim-reserve fdt-start dup dup >fdth_tsize l@ 0 claim drop dup >fdth_rsvmap_off l@ + BEGIN dup dup x@ swap 8 + x@ dup 0 <> WHILE fdt-debug IF 2dup swap ." Reserve map entry: " . ." : " . cr THEN 0 claim drop 10 + REPEAT drop drop drop ; fdt-claim-reserve 0 VALUE (fdt-phandle-replaced) : fdt-replace-interrupt-map ( old new prop-addr prop-len -- old new ) BEGIN dup ( old new prop-addr prop-len prop-len ) WHILE swap dup 10 + ( old new prop-len prop-addr prop-addr+10 ) dup l@ 5 pick = IF 3 pick swap l! TRUE TO (fdt-phandle-replaced) ELSE drop THEN 1c + swap 1c - REPEAT 2drop ; : fdt-replace-all-phandles ( old new node -- ) >r s" interrupt-map" r@ get-property 0= IF fdt-replace-interrupt-map THEN s" interrupt-parent" r@ get-property 0= IF decode-int -rot 2drop ( old new val R: node ) 2 pick = IF ( old new R: node ) dup encode-int s" interrupt-parent" r@ set-property TRUE TO (fdt-phandle-replaced) THEN THEN r> child BEGIN dup WHILE 3dup RECURSE PEER REPEAT 3drop ; : fdt-fix-node-phandle ( node -- ) >r FALSE TO (fdt-phandle-replaced) s" phandle" r@ get-property 0= IF decode-int ( p-addr2 p-len2 val ) r@ s" /" find-node ( p-addr2 p-len2 val node root ) fdt-replace-all-phandles ( p-addr2 p-len2 ) 2drop (fdt-phandle-replaced) IF r@ set-node s" phandle" delete-property s" linux,phandle" delete-property ELSE diagnostic-mode? IF cr ." Warning: Did not replace phandle in " r@ node>path type cr THEN THEN THEN r> drop ; : fdt-fix-phandles ( node -- ) dup fdt-fix-node-phandle child BEGIN dup WHILE dup RECURSE PEER REPEAT drop device-end ; s" /" find-node fdt-fix-phandles defer (client-exec) defer client-exec defer callback defer continue-client : set-chosen ( prop len name len -- ) s" /chosen" find-node set-property ; : get-chosen ( name len -- [ prop len ] success ) s" /chosen" find-node get-property 0= ; " /" find-device new-device s" aliases" device-name finish-device new-device s" options" device-name finish-device new-device s" openprom" device-name s" BootROM" device-type finish-device new-device s" packages" device-name get-node to packages new-device s" deblocker" device-name INSTANCE VARIABLE offset INSTANCE VARIABLE block-size INSTANCE VARIABLE max-transfer INSTANCE VARIABLE my-block INSTANCE VARIABLE adr INSTANCE VARIABLE len : open s" block-size" ['] $call-parent CATCH IF 2drop false EXIT THEN block-size ! s" max-transfer" ['] $call-parent CATCH IF 2drop false EXIT THEN max-transfer ! block-size @ alloc-mem my-block ! 0 offset ! true ; : close my-block @ block-size @ free-mem ; : seek ( lo hi -- status ) \ XXX: perhaps we should fail if the underlying lxjoin offset ! 0 ; : block+remainder ( -- block# remainder ) offset @ block-size @ u/mod swap ; : read-blocks ( addr block# #blocks -- actual ) s" read-blocks" $call-parent ; : read ( addr len -- actual ) dup >r len ! adr ! block+remainder dup IF ( block# offset-in-block ) >r my-block @ swap 1 read-blocks drop my-block @ r@ + adr @ block-size @ r> - len @ min dup >r move r> dup negate len +! dup adr +! offset +! ELSE 2drop THEN BEGIN len @ block-size @ >= WHILE adr @ block+remainder drop len @ max-transfer @ min block-size @ / read-blocks block-size @ * dup negate len +! dup adr +! offset +! REPEAT len @ IF my-block @ block+remainder drop 1 read-blocks drop my-block @ adr @ len @ move THEN r> ; finish-device new-device false VALUE debug-disk-label? d# 16384 value max-prep-partition-blocks s" disk-label" device-name 0 INSTANCE VALUE partition 0 INSTANCE VALUE part-offset 0 INSTANCE VALUE part-start 0 INSTANCE VALUE lpart-start 0 INSTANCE VALUE part-size 0 INSTANCE VALUE dos-logical-partitions 0 INSTANCE VALUE block-size 0 INSTANCE VALUE block 0 INSTANCE VALUE args 0 INSTANCE VALUE args-len INSTANCE VARIABLE block# \ variable to store logical sector# INSTANCE VARIABLE hit# \ partition counter INSTANCE VARIABLE success-flag 0ff constant END-OF-DESC 3 constant PARTITION-ID 48 constant VOL-PART-LOC STRUCT 1b8 field mbr>boot-loader /l field mbr>disk-signature /w field mbr>null 40 field mbr>partition-table /w field mbr>magic CONSTANT /mbr STRUCT /c field part-entry>active /c field part-entry>start-head /c field part-entry>start-sect /c field part-entry>start-cyl /c field part-entry>id /c field part-entry>end-head /c field part-entry>end-sect /c field part-entry>end-cyl /l field part-entry>sector-offset /l field part-entry>sector-count CONSTANT /partition-entry : offset ( d.rel -- d.abs ) part-offset xlsplit d+ ; : seek ( pos.lo pos.hi -- status ) offset debug-disk-label? IF 2dup ." seek-parent: pos.hi=0x" u. ." pos.lo=0x" u. THEN s" seek" $call-parent debug-disk-label? IF dup ." status=" . cr THEN ; : read ( addr len -- actual ) debug-disk-label? IF 2dup swap ." read-parent: addr=0x" u. ." len=" .d THEN s" read" $call-parent debug-disk-label? IF dup ." actual=" .d cr THEN ; : read-sector ( sector-number -- ) block-size * 0 seek drop \ seek to sector block block-size read drop \ read sector ; : (.part-entry) ( part-entry ) cr ." part-entry>active: " dup part-entry>active c@ .d cr ." part-entry>start-head: " dup part-entry>start-head c@ .d cr ." part-entry>start-sect: " dup part-entry>start-sect c@ .d cr ." part-entry>start-cyl: " dup part-entry>start-cyl c@ .d cr ." part-entry>id: " dup part-entry>id c@ .d cr ." part-entry>end-head: " dup part-entry>end-head c@ .d cr ." part-entry>end-sect: " dup part-entry>end-sect c@ .d cr ." part-entry>end-cyl: " dup part-entry>end-cyl c@ .d cr ." part-entry>sector-offset: " dup part-entry>sector-offset l@-le .d cr ." part-entry>sector-count: " dup part-entry>sector-count l@-le .d cr ; : (.name) r@ begin cell - dup @ <colon> = UNTIL xt>name cr type space ; : init-block ( -- ) s" block-size" ['] $call-parent CATCH IF ABORT" parent has no block-size." THEN to block-size d# 2048 alloc-mem dup d# 2048 erase to block debug-disk-label? IF ." init-block: block-size=" block-size .d ." block=0x" block u. cr THEN ; : no-mbr? ( -- true|false ) 0 read-sector block mbr>magic w@-le aa55 <> ; : pc-extended-partition? ( part-entry-addr -- true|false ) part-entry>id c@ ( id ) dup 5 = swap ( true|false id ) dup f = swap ( true|false true|false id ) 85 = ( true|false true|false true|false ) or or ( true|false ) ; : partition>part-entry ( partition -- part-entry ) 1- /partition-entry * block mbr>partition-table + ; : partition>start-sector ( partition -- sector-offset ) partition>part-entry part-entry>sector-offset l@-le ; : count-dos-logical-partitions ( -- #logical-partitions ) no-mbr? IF 0 EXIT THEN 0 5 1 DO ( current ) i partition>part-entry ( current part-entry ) dup pc-extended-partition? IF part-entry>sector-offset l@-le ( current sector ) dup to part-start to lpart-start ( current ) BEGIN part-start read-sector \ read EBR 1 partition>start-sector IF 1+ THEN \ another logical partition 2 partition>start-sector ?dup IF lpart-start + to part-start false ELSE true THEN UNTIL ELSE drop THEN LOOP ; : (get-dos-partition-params) ( ext-part-start part-entry -- offset count active? id ) dup part-entry>sector-offset l@-le rot + swap ( offset part-entry ) dup part-entry>sector-count l@-le swap ( offset count part-entry ) dup part-entry>active c@ 80 = swap ( offset count active? part-entry ) part-entry>id c@ ( offset count active? id ) ; : find-dos-partition ( partition# -- false | offset count active? id true ) to partition 0 to part-start 0 to part-offset partition 0<= IF 0 to partition false EXIT THEN no-mbr? IF 0 to partition false EXIT THEN partition 4 <= IF \ Is this a primary partition? 0 partition partition>part-entry (get-dos-partition-params) true EXIT ELSE partition 4 - 0 5 1 DO ( logical-partition current ) i partition>part-entry ( log-part current part-entry ) dup pc-extended-partition? IF part-entry>sector-offset l@-le ( log-part current sector ) dup to part-start to lpart-start ( log-part current ) BEGIN part-start read-sector \ read EBR 1 partition>start-sector IF \ first partition entry 1+ 2dup = IF ( log-part current ) 2drop part-start 1 partition>part-entry (get-dos-partition-params) true UNLOOP EXIT THEN 2 partition>start-sector ?dup IF lpart-start + to part-start false ELSE true THEN ELSE true THEN UNTIL ELSE drop THEN LOOP 2drop false THEN ; : try-dos-partition ( -- okay? ) no-mbr? IF cr ." No DOS disk-label found." cr false EXIT THEN count-dos-logical-partitions TO dos-logical-partitions debug-disk-label? IF ." Found " dos-logical-partitions .d ." logical partitions" cr ." Partition = " partition .d cr THEN partition 1 5 dos-logical-partitions + within 0= IF cr ." Partition # not 1-" 4 dos-logical-partitions + . cr false EXIT THEN partition find-dos-partition IF 2drop to part-size block-size * to part-offset true ELSE false THEN ; : has-iso9660-filesystem ( -- TRUE|FALSE ) 10 800 * 0 seek drop \ seek to sector block 800 read drop \ read sector block c@ 1 = block 1+ 5 s" CD001" str= and dup IF 800 to block-size THEN ; : load-from-dos-boot-partition ( addr -- size ) no-mbr? IF FALSE EXIT THEN \ read MBR and check for DOS disk-label magic count-dos-logical-partitions TO dos-logical-partitions debug-disk-label? IF ." Found " dos-logical-partitions .d ." logical partitions" cr ." Partition = " partition .d cr THEN 5 dos-logical-partitions + 1 DO i find-dos-partition IF ( addr offset count active? id ) 41 = and ( addr offset count prep-boot-part? ) IF ( addr offset count ) max-prep-partition-blocks min \ reduce load size swap ( addr count offset ) block-size * to part-offset 0 0 seek drop ( addr offset ) block-size * read ( size ) UNLOOP EXIT ELSE 2drop ( addr ) THEN THEN LOOP drop 0 ; : load-from-boot-partition ( addr -- size ) load-from-dos-boot-partition ; : parse-bootinfo-txt ( addr len -- str len ) 2dup s" <boot-script>" find-substr ( addr len pos1 ) 2dup = IF 3drop 0 0 EXIT THEN dup >r - swap r> + swap ( addr1 len1 ) 2dup [char] \ findchar drop ( addr1 len1 pos2 ) dup >r - swap r> + swap ( addr2 len2 ) 2dup s" </boot-script>" find-substr nip ( addr2 len3 ) ; : load-chrp-boot-file ( addr -- size ) my-self parent ihandle>phandle node>path s" :\ppc\bootinfo.txt" $cat strdup ( addr str len ) open-dev dup 0= IF 2drop 0 EXIT THEN >r dup ( addr addr R:ihandle ) dup s" load" r@ $call-method ( addr addr size R:ihandle ) r> close-dev ( addr addr size ) parse-bootinfo-txt ( addr fnstr fnlen ) dup 0= IF 3drop 0 EXIT THEN my-self parent ihandle>phandle node>path ( addr fnstr fnlen nstr nlen ) s" :" $cat 2swap $cat strdup ( addr str len ) 2dup encode-string s" bootpath" set-chosen open-dev dup 0= IF ." failed to load CHRP boot loader." 2drop 0 EXIT THEN >r s" load" r@ $call-method ( size R:ihandle ) r> close-dev ( size ) ; : parse-partition ( -- okay? ) 0 to partition 0 to part-offset 0 to part-size my-args to args-len to args debug-disk-label? IF cr ." disk-label parse-partition: my-args=" my-args type cr THEN args-len 0 = IF true EXIT THEN my-args [char] , findchar 0= IF \ no comma? args c@ isdigit not IF \ ... and not a partition number? true EXIT \ ... then it's not a partition we can parse THEN ELSE drop THEN my-args [char] , split to args-len to args dup 0= IF 2drop true EXIT THEN \ no first argument base @ >r decimal $number r> base ! IF cr ." Not a partition #" false EXIT THEN to partition true ; : (interpose-filesystem) ( str len -- ) find-package IF args args-len rot interpose THEN ; : try-dos-files ( -- found? ) no-mbr? IF false EXIT THEN block c@ e9 <> IF block c@ eb <> block 2+ c@ 90 <> or IF false EXIT THEN THEN s" fat-files" (interpose-filesystem) true ; : try-ext2-files ( -- found? ) 2 read-sector \ read first superblock block d# 56 + w@-le \ fetch s_magic ef53 <> IF false EXIT THEN \ s_magic found? s" ext2-files" (interpose-filesystem) true ; : try-iso9660-files has-iso9660-filesystem 0= IF false exit THEN s" iso-9660" (interpose-filesystem) true ; : try-files ( -- found? ) args-len 0= IF true EXIT THEN try-dos-files IF true EXIT THEN try-ext2-files IF true EXIT THEN try-iso9660-files IF true EXIT THEN false ; : try-partitions ( -- found? ) try-dos-partition IF try-files EXIT THEN false ; : close ( -- ) debug-disk-label? IF ." Closing disk-label: block=0x" block u. ." block-size=" block-size .d cr THEN block d# 2048 free-mem ; : open ( -- true|false ) init-block parse-partition 0= IF close false EXIT THEN partition IF try-partitions ELSE try-files THEN dup 0= IF debug-disk-label? IF ." not found." cr THEN close THEN \ free memory again ; : load ( addr -- size ) debug-disk-label? IF ." load: " dup u. cr THEN args-len IF TRUE ABORT" Load done w/o filesystem" ELSE partition IF 0 0 seek drop part-size IF part-size max-prep-partition-blocks min \ Load size ELSE max-prep-partition-blocks THEN 200 * read ELSE has-iso9660-filesystem IF dup load-chrp-boot-file ?dup 0 > IF nip EXIT THEN THEN load-from-boot-partition dup 0= ABORT" No boot partition found" THEN THEN ; finish-device new-device s" fat-files" device-name INSTANCE VARIABLE bytes/sector INSTANCE VARIABLE sectors/cluster INSTANCE VARIABLE #reserved-sectors INSTANCE VARIABLE #fats INSTANCE VARIABLE #root-entries INSTANCE VARIABLE total-#sectors INSTANCE VARIABLE media-descriptor INSTANCE VARIABLE sectors/fat INSTANCE VARIABLE sectors/track INSTANCE VARIABLE #heads INSTANCE VARIABLE #hidden-sectors INSTANCE VARIABLE fat-type INSTANCE VARIABLE bytes/cluster INSTANCE VARIABLE fat-offset INSTANCE VARIABLE root-offset INSTANCE VARIABLE cluster-offset INSTANCE VARIABLE #clusters : seek s" seek" $call-parent ; : read s" read" $call-parent ; INSTANCE VARIABLE data INSTANCE VARIABLE #data : free-data data @ ?dup IF #data @ free-mem 0 data ! THEN ; : read-data ( offset size -- ) free-data dup #data ! alloc-mem data ! xlsplit seek -2 and ABORT" fat-files read-data: seek failed" data @ #data @ read #data @ <> ABORT" fat-files read-data: read failed" ; CREATE fat-buf 8 allot : read-fat ( cluster# -- data ) fat-buf 8 erase 1 #split fat-type @ * 2/ 2/ fat-offset @ + xlsplit seek -2 and ABORT" fat-files read-fat: seek failed" fat-buf 8 read 8 <> ABORT" fat-files read-fat: read failed" fat-buf 8c@ bxjoin fat-type @ dup >r 2* #split drop r> #split rot IF swap THEN drop ; INSTANCE VARIABLE next-cluster : read-cluster ( cluster# -- ) dup bytes/cluster @ * cluster-offset @ + bytes/cluster @ read-data read-fat dup #clusters @ >= IF drop 0 THEN next-cluster ! ; : read-dir ( cluster# -- ) ?dup 0= IF root-offset @ #root-entries @ 20 * read-data 0 next-cluster ! ELSE read-cluster THEN ; : .time ( x -- ) base @ >r decimal b #split 2 0.r [char] : emit 5 #split 2 0.r [char] : emit 2* 2 0.r r> base ! ; : .date ( x -- ) base @ >r decimal 9 #split 7bc + 4 0.r [char] - emit 5 #split 2 0.r [char] - emit 2 0.r r> base ! ; : .attr ( attr -- ) 6 0 DO dup 1 and IF s" RHSLDA" drop i + c@ ELSE bl THEN emit u2/ LOOP drop ; : .dir-entry ( adr -- ) dup 0b + c@ 8 and IF drop EXIT THEN \ volume label, not a file dup c@ e5 = IF drop EXIT THEN \ deleted file cr dup 1a + 2c@ bwjoin [char] # emit 4 0.r space \ starting cluster dup 18 + 2c@ bwjoin .date space dup 16 + 2c@ bwjoin .time space dup 1c + 4c@ bljoin base @ decimal swap a .r base ! space \ size in bytes dup 0b + c@ .attr space dup 8 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT type dup 8 + 3 BEGIN 2dup 1- + c@ 20 = over and WHILE 1- REPEAT dup IF [char] . emit type ELSE 2drop THEN drop ; : .dir-entries ( adr n -- ) 0 ?DO dup i 20 * + dup c@ 0= IF drop LEAVE THEN .dir-entry LOOP drop ; : .dir ( cluster# -- ) read-dir BEGIN data @ #data @ 20 / .dir-entries next-cluster @ WHILE next-cluster @ read-cluster REPEAT ; : str-upper ( str len adr -- ) \ Copy string to adr, uppercase -rot bounds ?DO i c@ upc over c! char+ LOOP drop ; CREATE dos-name b allot : make-dos-name ( str len -- ) dos-name b bl fill 2dup [char] . findchar IF 3dup 1+ /string 3 min dos-name 8 + str-upper nip THEN 8 min dos-name str-upper ; : (find-file) ( -- cluster file-len is-dir? true | false ) data @ BEGIN dup data @ #data @ + < WHILE dup dos-name b comp WHILE 20 + REPEAT dup 1a + 2c@ bwjoin swap dup 1c + 4c@ bljoin swap 0b + c@ 10 and 0<> true ELSE drop false THEN ; : find-file ( dir-cluster name len -- cluster file-len is-dir? true | false ) make-dos-name read-dir BEGIN (find-file) 0= WHILE next-cluster @ WHILE next-cluster @ read-cluster REPEAT false ELSE true THEN ; : find-path ( dir-cluster name len -- cluster file-len true | false ) dup 0= IF 3drop false ." empty name " EXIT THEN over c@ [char] \ = IF 1 /string ." slash " RECURSE EXIT THEN [char] \ split 2>r find-file 0= IF 2r> 2drop false ." not found " EXIT THEN r@ 0<> <> IF 2drop 2r> 2drop false ." no dir<->file match " EXIT THEN r@ 0<> IF drop 2r> ." more... " RECURSE EXIT THEN 2r> 2drop true ." got it " ; : do-super ( -- ) 0 200 read-data data @ 0b + 2c@ bwjoin bytes/sector ! data @ 0d + c@ sectors/cluster ! bytes/sector @ sectors/cluster @ * bytes/cluster ! data @ 0e + 2c@ bwjoin #reserved-sectors ! data @ 10 + c@ #fats ! data @ 11 + 2c@ bwjoin #root-entries ! data @ 13 + 2c@ bwjoin total-#sectors ! data @ 15 + c@ media-descriptor ! data @ 16 + 2c@ bwjoin sectors/fat ! data @ 18 + 2c@ bwjoin sectors/track ! data @ 1a + 2c@ bwjoin #heads ! data @ 1c + 2c@ bwjoin #hidden-sectors ! total-#sectors @ 0= IF data @ 20 + 4c@ bljoin total-#sectors ! THEN sectors/fat @ 0= IF data @ 24 + 4c@ bljoin sectors/fat ! THEN total-#sectors @ #reserved-sectors @ - sectors/fat @ #fats @ * - #root-entries @ 20 * bytes/sector @ // - sectors/cluster @ / dup #clusters ! dup ff5 < IF drop c ELSE fff5 < IF 10 ELSE 20 THEN THEN fat-type ! cr ." FAT" base @ decimal fat-type @ . base ! #reserved-sectors @ bytes/sector @ * fat-offset ! #fats @ sectors/fat @ * bytes/sector @ * fat-offset @ + root-offset ! #root-entries @ 20 * bytes/sector @ tuck // * root-offset @ + bytes/cluster @ 2* - cluster-offset ! ; INSTANCE VARIABLE file-cluster INSTANCE VARIABLE file-len INSTANCE VARIABLE current-pos INSTANCE VARIABLE pos-in-data : seek ( lo hi -- status ) lxjoin dup current-pos ! file-cluster @ read-cluster BEGIN dup #data @ >= WHILE #data @ - next-cluster @ dup 0= IF 2drop true EXIT THEN read-cluster REPEAT pos-in-data ! false ; : read ( adr len -- actual ) file-len @ current-pos @ - min \ can't go past end of file #data @ pos-in-data @ - min >r \ length for this transfer data @ pos-in-data @ + swap r@ move \ move the data r@ pos-in-data +! r@ current-pos +! pos-in-data @ #data @ = IF next-cluster @ ?dup IF read-cluster 0 pos-in-data ! THEN THEN r> ; : read ( adr len -- actual ) dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" fat-files: read failed" /string ( tuck - >r + r> ) REPEAT 2drop r> ; : load ( adr -- len ) file-len @ read dup file-len @ <> ABORT" fat-files: failed loading file" ; : close free-data ; : open do-super 0 my-args find-path 0= IF close false EXIT THEN file-len ! file-cluster ! 0 0 seek 0= ; finish-device new-device s" rom-files" device-name INSTANCE VARIABLE length INSTANCE VARIABLE next-file INSTANCE VARIABLE buffer INSTANCE VARIABLE buffer-size INSTANCE VARIABLE file INSTANCE VARIABLE file-size INSTANCE VARIABLE found : open true 100 dup buffer-size ! alloc-mem buffer ! false found ! ; : close buffer @ buffer-size @ free-mem ; : read ( addr len -- actual ) s" read" $call-parent ; : seek ( lo hi -- status ) s" seek" $call-parent ; : .read-file-name ( offset -- str len ) 0 seek drop buffer @ buffer-size @ read drop buffer-size @ 1 - buffer @ + 0 swap c! buffer @ zcount ; : .print-info ( offset -- ) dup 2 spaces 6 0.r 2 spaces dup 8 + 0 seek drop length 8 read drop 6 length @ swap 0.r 2 spaces 20 + .read-file-name type cr ; : .list-header cr s" --offset---size-----file-name----" type cr ; : list .list-header 0 0 BEGIN + dup .print-info dup 0 seek drop next-file 8 read drop next-file @ dup 0= UNTIL 2drop ; : (find-file) ( name len -- offset | -1 ) 0 0 seek drop false found ! file-size ! file ! 0 0 BEGIN + dup 20 + .read-file-name file @ file-size @ str= IF true found ! THEN dup 0 seek drop next-file 8 read drop next-file @ dup 0= found @ or UNTIL drop found @ 0= IF drop -1 THEN ; : load ( addr -- size ) my-parent instance>args 2@ [char] \ left-parse-string 2drop (find-file) dup -1 = IF 2drop 0 ELSE 0 0 seek drop dup 8 + 0 seek drop here 8 read drop here @ ( dest-addr offset file-size ) over 18 + 0 seek drop here 8 read drop here @ ( dest-addr offset file-size data-offset ) rot + 0 seek drop ( dest-addr file-size ) read THEN ; finish-device new-device s" ext2-files" device-name INSTANCE VARIABLE first-block INSTANCE VARIABLE inode-size INSTANCE VARIABLE block-size INSTANCE VARIABLE inodes/group INSTANCE VARIABLE group-desc-size INSTANCE VARIABLE group-descriptors : seek s" seek" $call-parent ; : read s" read" $call-parent ; INSTANCE VARIABLE data INSTANCE VARIABLE #data INSTANCE VARIABLE indirect-block INSTANCE VARIABLE dindirect-block : free-data data @ ?dup IF #data @ free-mem 0 data ! THEN ; : read-data ( offset size -- ) free-data dup #data ! alloc-mem data ! xlsplit seek -2 and ABORT" ext2-files read-data: seek failed" data @ #data @ read #data @ <> ABORT" ext2-files read-data: read failed" ; : read-block ( block# -- ) block-size @ * block-size @ read-data ; INSTANCE VARIABLE inode INSTANCE VARIABLE file-len INSTANCE VARIABLE blocks INSTANCE VARIABLE #blocks INSTANCE VARIABLE ^blocks INSTANCE VARIABLE #blocks-left : blocks-read ( n -- ) dup negate #blocks-left +! 4 * ^blocks +! ; : read-indirect-blocks ( indirect-block# -- ) read-block data @ data off dup #blocks-left @ 4 * block-size @ min dup >r ^blocks @ swap move r> 2 rshift blocks-read block-size @ free-mem ; : read-double-indirect-blocks ( double-indirect-block# -- ) read-block data @ indirect-block ! data off BEGIN indirect-block @ l@-le dup 0 <> WHILE read-indirect-blocks 4 indirect-block +! \ point to next indirect block REPEAT drop \ drop 0, the invalid block number ; : read-triple-indirect-blocks ( triple-indirect-block# -- ) read-block data @ dindirect-block ! data off BEGIN dindirect-block @ l@-le dup 0 <> WHILE read-double-indirect-blocks 4 dindirect-block +! \ point to next double indirect block REPEAT drop \ drop 0, the invalid block number ; : read-block#s ( -- ) blocks @ ?dup IF #blocks @ 4 * free-mem THEN inode @ 4 + l@-le file-len ! file-len @ block-size @ // #blocks ! #blocks @ 4 * alloc-mem blocks ! blocks @ ^blocks ! #blocks @ #blocks-left ! #blocks-left @ c min \ # direct blocks inode @ 28 + over 4 * ^blocks @ swap move blocks-read #blocks-left @ IF inode @ 58 + l@-le read-indirect-blocks THEN #blocks-left @ IF inode @ 5c + l@-le read-double-indirect-blocks THEN #blocks-left @ IF inode @ 60 + l@-le read-triple-indirect-blocks THEN ; : read-inode ( inode# -- ) 1- inodes/group @ u/mod \ # in group, group # 20 * group-descriptors @ + 8 + l@-le block-size @ * \ # in group, inode table swap inode-size @ * + xlsplit seek drop inode @ inode-size @ read drop ; : .rwx ( bits last-char-if-special special? -- ) rot dup 4 and IF ." r" ELSE ." -" THEN dup 2 and IF ." w" ELSE ." -" THEN swap IF 1 and 0= IF upc THEN emit ELSE 1 and IF ." x" ELSE ." -" THEN drop THEN ; CREATE mode-chars 10 allot s" ?pc?d?b?-?l?s???" mode-chars swap move : .mode ( mode -- ) dup c rshift f and mode-chars + c@ emit dup 6 rshift 7 and over 800 and 73 swap .rwx dup 3 rshift 7 and over 400 and 73 swap .rwx dup 7 and swap 200 and 74 swap .rwx ; : .inode ( -- ) base @ >r decimal inode @ w@-le .mode \ file mode inode @ 1a + w@-le 5 .r \ link count inode @ 02 + w@-le 9 .r \ uid inode @ 18 + w@-le 9 .r \ gid inode @ 04 + l@-le 9 .r \ size r> base ! ; : do-super ( -- ) 400 400 read-data data @ 14 + l@-le first-block ! 400 data @ 18 + l@-le lshift block-size ! data @ 28 + l@-le inodes/group ! data @ 4c + l@-le 0= IF 80 inode-size ! ELSE data @ 58 + w@-le inode-size ! THEN data @ 20 + l@-le group-desc-size ! first-block @ 1+ block-size @ * group-desc-size @ read-data data @ group-descriptors ! data off ; INSTANCE VARIABLE current-pos : read ( adr len -- actual ) file-len @ current-pos @ - min \ can't go past end of file current-pos @ block-size @ u/mod 4 * blocks @ + l@-le read-block block-size @ over - rot min >r ( adr off r: len ) data @ + swap r@ move r> dup current-pos +! ; : read ( adr len -- actual ) dup >r BEGIN dup WHILE 2dup read dup 0= ABORT" ext2-files: read failed" /string REPEAT 2drop r> ; : seek ( lo hi -- status ) lxjoin dup file-len @ > IF drop true EXIT THEN current-pos ! false ; : load ( adr -- len ) file-len @ read dup file-len @ <> ABORT" ext2-files: failed loading file" ; : .name ( adr -- ) dup 8 + swap 6 + c@ type ; : read-dir ( inode# -- adr ) read-inode read-block#s file-len @ alloc-mem 0 0 seek ABORT" ext2-files read-dir: seek failed" dup file-len @ read file-len @ <> ABORT" ext2-files read-dir: read failed" ; : .dir ( inode# -- ) read-dir dup BEGIN 2dup file-len @ - > over l@-le tuck and WHILE cr dup 8 0.r space read-inode .inode space space dup .name dup 4 + w@-le + REPEAT 2drop file-len @ free-mem ; : (find-file) ( adr name len -- inode#|0 ) 2>r dup BEGIN 2dup file-len @ - > over l@-le and WHILE dup 8 + over 6 + c@ 2r@ str= IF 2r> 2drop nip l@-le EXIT THEN dup 4 + w@-le + REPEAT 2drop 2r> 2drop 0 ; : find-file ( inode# name len -- inode#|0 ) 2>r read-dir dup 2r> (find-file) swap file-len @ free-mem ; : find-path ( inode# name len -- inode#|0 ) dup 0= IF 3drop 0 ." empty name " EXIT THEN over c@ [char] \ = IF 1 /string ." slash " RECURSE EXIT THEN [char] \ split 2>r find-file ?dup 0= IF 2r> 2drop false ." not found " EXIT THEN r@ 0<> IF 2r> ." more... " RECURSE EXIT THEN 2r> 2drop ." got it " ; : close inode @ inode-size @ free-mem group-descriptors @ group-desc-size @ free-mem free-data blocks @ ?dup IF #blocks @ 4 * free-mem THEN ; : open 0 data ! 0 blocks ! 0 #blocks ! do-super inode-size @ alloc-mem inode ! my-args nip 0= IF 0 0 ELSE 2 my-args find-path ?dup 0= IF close false EXIT THEN THEN read-inode read-block#s 0 0 seek 0= ; finish-device new-device s" obp-tftp" device-name INSTANCE VARIABLE ciregs-buffer : open ( -- okay? ) ciregs-size alloc-mem ciregs-buffer ! true ; : load ( addr -- size ) ciregs ciregs-buffer @ ciregs-size move s" bootargs" get-chosen 0= IF 0 0 THEN >r >r s" bootpath" get-chosen 0= IF 0 0 THEN >r >r my-parent ihandle>phandle node>path encode-string s" bootpath" set-chosen (u.) s" netboot " 2swap $cat s" 60000000 " $cat 6B8 alloc-mem dup >r (u.) $cat s" " $cat huge-tftp-load @ IF s" 1 " ELSE s" 0 " THEN $cat s" 1432 " $cat my-args $cat (client-exec) dup 0< IF drop 0 THEN ciregs-buffer @ ciregs ciregs-size move r> r> r> over IF s" bootpath" set-chosen ELSE 2drop THEN r> r> over IF s" bootargs" set-chosen ELSE 2drop THEN dup 6B8 encode-bytes s" bootp-response" s" /chosen" find-node set-property 6B8 free-mem ; : close ( -- ) ciregs-buffer @ ciregs-size free-mem ; : ping ( -- ) s" ping " my-args $cat (client-exec) ; finish-device new-device s" iso-9660" device-name 0 VALUE iso-debug-flag : iso-debug-print ( str len -- ) iso-debug-flag IF type cr ELSE 2drop THEN ; 0 VALUE path-tbl-size 0 VALUE path-tbl-addr 0 VALUE root-dir-size 0 VALUE vol-size 0 VALUE logical-blk-size 0 VALUE path-table 0 VALUE count INSTANCE VARIABLE dir-addr INSTANCE VARIABLE data-buff INSTANCE VARIABLE #data INSTANCE VARIABLE ptable INSTANCE VARIABLE file-loc INSTANCE VARIABLE file-size INSTANCE VARIABLE cur-file-offset INSTANCE VARIABLE self INSTANCE VARIABLE index : seek ( pos.lo pos.hi -- status ) s" seek" $call-parent ; : read ( addr len -- actual ) s" read" $call-parent ; : free-data ( -- ) data-buff @ ( data-buff ) ?DUP IF #data @ free-mem 0 data-buff ! THEN ; : read-data ( offset size -- ) free-data DUP ( offset size size ) #data ! alloc-mem data-buff ! ( offset ) xlsplit ( pos.lo pos.hi ) seek -2 and ABORT" seek failed." data-buff @ #data @ read ( actual ) #data @ <> ABORT" read failed." ; : extract-vol-info ( -- ) 10 800 * 800 read-data data-buff @ 88 + l@-be to path-tbl-size \ read path table size data-buff @ 94 + l@-be to path-tbl-addr \ read big-endian path table data-buff @ a2 + l@-be dir-addr ! \ gather of root directory info data-buff @ 0aa + l@-be to root-dir-size \ get volume info data-buff @ 54 + l@-be to vol-size \ size in blocks data-buff @ 82 + l@-be to logical-blk-size path-tbl-size alloc-mem dup TO path-table path-tbl-size erase path-tbl-addr 800 * xlsplit seek drop path-table path-tbl-size read drop \ pathtable in-system-memory copy ; : file-name ( str len -- str' len' ) 2dup [char] ; findchar IF nip \ Omit the trailing ";1" revision of ISO9660 file name 2dup + 1- ( str newlen endptr ) c@ [CHAR] . = IF 1- ( str len' ) \ Remove trailing dot THEN THEN ; : dup3 ( num -- num num num ) dup dup dup ; : get-next-record ( rec-addr -- next-rec-offset ) dup3 ( rec-addr rec-addr rec-addr rec-addr ) self @ 1 + self ! ( rec-addr rec-addr rec-addr rec-addr ) c@ 1 AND IF ( rec-addr rec-addr rec-addr ) c@ + 9 ( rec-addr rec-addr' rec-len ) ELSE c@ + 8 ( rec-addr rec-addr' rec-len ) THEN + swap - ( next-rec-offset ) ; : path-table-search ( str len -- TRUE | FALSE ) path-table path-tbl-size + path-table ptable @ + DO ( str len ) 2dup I 6 + w@-be index @ = ( str len str len ) -rot I 8 + I c@ string=ci and IF ( str len ) s" Directory Matched!! " iso-debug-print ( str len ) self @ index ! ( str len ) I 2 + l@-be dir-addr ! I dup ( str len rec-addr ) get-next-record + path-table - ptable ! ( str len ) 2drop TRUE UNLOOP EXIT ( TRUE ) THEN I get-next-record ( str len next-rec-offset ) +LOOP 2drop FALSE ( FALSE ) s" Invalid path / directory " iso-debug-print ; : search-file-dir ( str len -- TRUE | FALSE ) dir-addr @ 800 * dir-addr ! ( str len ) dir-addr @ 100 read-data ( str len ) data-buff @ 0e + l@-be dup >r ( str len rec-len ) 100 > IF ( str len ) s" size dir record" iso-debug-print ( str len ) dir-addr @ r@ read-data ( str len ) THEN r> data-buff @ + data-buff @ DO ( str len ) I 19 + c@ 2 and 0= IF ( str len ) 2dup ( str len str len ) I 21 + I 20 + c@ ( str len str len str' len' ) file-name string=ci IF ( str len ) s" File found!" iso-debug-print ( str len ) I 6 + l@-be 800 * ( str len file-loc ) file-loc ! ( str len ) I 0e + l@-be file-size ! ( str len ) 2drop TRUE ( TRUE ) UNLOOP EXIT THEN THEN I c@ dup 0= IF ( str len len ) s" file not found" iso-debug-print drop 2drop FALSE ( FALSE ) UNLOOP EXIT THEN +LOOP 2drop FALSE ( FALSE ) s" file not found" iso-debug-print ; : search-path ( str len -- FALSE|TRUE ) 0 ptable ! 1 self ! 1 index ! dup ( str len len ) 0= IF 3drop FALSE ( FALSE ) s" Empty path name " iso-debug-print EXIT ( FALSE ) THEN OVER c@ ( str len char ) [char] \ = IF ( str len ) swap 1 + swap 1 - BEGIN ( str len ) [char] \ split ( str len str' len ' ) dup 0 = IF ( str len str' len ' ) 2drop search-file-dir EXIT ( TRUE | FALSE ) ELSE 2swap path-table-search invert IF ( str' len ' ) 2drop FALSE EXIT ( FALSE ) THEN THEN AGAIN ELSE BEGIN [char] \ split dup 0 = IF ( str len str' len' ) 2drop search-file-dir EXIT ( TRUE | FALSE ) ELSE 2swap path-table-search invert IF ( str' len ' ) 2drop FALSE EXIT ( FALSE ) THEN THEN AGAIN THEN ; 0 VALUE loc : load ( addr -- len ) dup to loc ( addr ) file-loc @ xlsplit seek drop file-size @ read ( file-size ) iso-debug-flag IF s" Bytes returned from read:" type dup . cr THEN dup file-size @ <> ABORT" read failed!" ; : close ( -- ) free-data count 1 - dup to count 0 = IF path-table path-tbl-size free-mem 0 TO path-table THEN ; : open ( -- TRUE | FALSE ) 0 data-buff ! 0 #data ! 0 ptable ! 0 file-loc ! 0 file-size ! 0 cur-file-offset ! 1 self ! 1 index ! count 0 = IF s" extract-vol-info called " iso-debug-print extract-vol-info THEN count 1 + to count my-args search-path IF file-loc @ xlsplit seek drop TRUE ( TRUE ) ELSE close FALSE ( FALSE ) THEN 0 cur-file-offset ! s" opened ISO9660 package" iso-debug-print ; : seek ( pos.lo pos.hi -- status ) lxjoin dup cur-file-offset ! ( offset ) file-loc @ + xlsplit ( pos.lo pos.hi ) s" seek" $call-parent ( status ) ; : read ( addr len -- actual ) file-size @ cur-file-offset @ - ( addr len remainder-of-file ) min ( addr len|remainder-of-file ) s" read" $call-parent ( actual ) dup cur-file-offset @ + cur-file-offset ! ( actual ) cur-file-offset @ ( offset actual ) xlsplit seek drop ( actual ) ; finish-device new-device s" bulk" device-name : open true ; : close ; 8 chars alloc-mem VALUE setup-packet 0 VALUE cbw-addr : build-cbw ( address tag transfer-len direction lun command-len -- ) 5 pick TO cbw-addr ( address tag transfer-len direction lun command-len ) cbw-addr 0f erase ( address tag transfer-len direction lun command-len ) cbw-addr e + c! ( address tag transfer-len direction lun ) cbw-addr d + c! ( address tag transfer-len direction ) cbw-addr c + c! ( address tag transfer-len ) cbw-addr 8 + l!-le ( address tag ) cbw-addr 4 + l!-le ( address ) 43425355 cbw-addr l!-le ( address ) drop ; 0 VALUE csw-addr : analyze-csw ( address -- residue tag true|reason false ) TO csw-addr csw-addr l@-le 53425355 = IF csw-addr c + c@ dup 0= IF ( reason ) drop csw-addr 8 + l@-le ( residue ) csw-addr 4 + l@-le ( residue tag ) \ command block tag TRUE ( residue tag TRUE ) ELSE FALSE ( reason FALSE ) THEN ELSE FALSE ( FALSE ) THEN csw-addr 0c erase ; : bulk-reset-recovery-procedure ( bulk-out-endp bulk-in-endp usb-addr -- ) s" bulk-reset-recovery-procedure" $call-parent ; finish-device finish-device : open true ; : close ; device-end 370 cp 4d0 cp STRUCT /l field rtas>token /l field rtas>nargs /l field rtas>nret /l field rtas>args0 /l field rtas>args1 /l field rtas>args2 /l field rtas>args3 /l field rtas>args4 /l field rtas>args5 /l field rtas>args6 /l field rtas>args7 /l C * field rtas>args /l field rtas>bla CONSTANT /rtas-control-block CREATE rtas-cb /rtas-control-block allot rtas-cb /rtas-control-block erase 0 VALUE rtas-base 0 VALUE rtas-size 0 VALUE rtas-entry 0 VALUE rtas-node 4d1 cp : find-qemu-rtas ( -- ) " /rtas" find-device get-node to rtas-node " linux,rtas-base" rtas-node get-package-property IF device-end EXIT THEN drop l@ to rtas-base " linux,rtas-base" delete-property " rtas-size" rtas-node get-package-property IF device-end EXIT THEN drop l@ to rtas-size " linux,rtas-entry" rtas-node get-package-property IF rtas-base to rtas-entry ELSE drop l@ to rtas-entry " linux,rtas-entry" delete-property THEN device-end ; find-qemu-rtas 4d2 cp : enter-rtas ( -- ) rtas-cb rtas-base 0 rtas-entry call-c drop ; : rtas-get-token ( str len -- token | 0 ) rtas-node get-package-property IF 0 ELSE drop l@ THEN ; : rtas-start-cpu ( pid loc r3 -- status ) " start-cpu" rtas-get-token rtas-cb rtas>token l! 3 rtas-cb rtas>nargs l! 1 rtas-cb rtas>nret l! rtas-cb rtas>args2 l! rtas-cb rtas>args1 l! rtas-cb rtas>args0 l! 0 rtas-cb rtas>args3 l! enter-rtas rtas-cb rtas>args3 l@ ; : rtas-set-tce-bypass ( unit enable -- ) " ibm,set-tce-bypass" rtas-get-token rtas-cb rtas>token l! 2 rtas-cb rtas>nargs l! 0 rtas-cb rtas>nret l! rtas-cb rtas>args1 l! rtas-cb rtas>args0 l! enter-rtas ; : rtas-quiesce ( -- ) " quiesce" rtas-get-token rtas-cb rtas>token l! 0 rtas-cb rtas>nargs l! 0 rtas-cb rtas>nret l! enter-rtas ; 0 value puid : rtas-do-config-@ ( config-addr size -- value) " ibm,read-pci-config" rtas-get-token rtas-cb rtas>token l! 4 rtas-cb rtas>nargs l! 2 rtas-cb rtas>nret l! ( addr size ) rtas-cb rtas>args3 l! puid ffffffff and rtas-cb rtas>args2 l! puid 20 rshift rtas-cb rtas>args1 l! ( addr ) rtas-cb rtas>args0 l! enter-rtas rtas-cb rtas>args4 l@ dup IF drop ffffffff ELSE drop rtas-cb rtas>args5 l@ THEN ; : rtas-do-config-! ( value config-addr size ) " ibm,write-pci-config" rtas-get-token rtas-cb rtas>token l! 5 rtas-cb rtas>nargs l! 1 rtas-cb rtas>nret l! ( value addr size ) rtas-cb rtas>args3 l! puid ffffffff and rtas-cb rtas>args2 l! puid 20 rshift rtas-cb rtas>args1 l! ( value addr ) rtas-cb rtas>args0 l! ( value ) rtas-cb rtas>args4 l! enter-rtas rtas-cb rtas>args5 l@ dup IF ." RTAS write config err " . cr ELSE drop THEN ; : rtas-config-b@ ( config-addr -- value ) 1 rtas-do-config-@ ff and ; : rtas-config-b! ( value config-addr -- ) 1 rtas-do-config-! ; : rtas-config-w@ ( config-addr -- value ) 2 rtas-do-config-@ ffff and ; : rtas-config-w! ( value config-addr -- ) 2 rtas-do-config-! ; : rtas-config-l@ ( config-addr -- value ) 4 rtas-do-config-@ ffffffff and ; : rtas-config-l! ( value config-addr -- ) 4 rtas-do-config-! ; : of-start-cpu rtas-start-cpu ; rtas-node set-node : open true ; : close ; : instantiate-rtas ( adr -- entry ) dup rtas-base swap rtas-size move rtas-entry rtas-base - + ; device-end 4d8 cp 390 cp STRUCT /n FIELD vd>base /l FIELD vd>type CONSTANT /vd-len : virtio-setup-vd ( vdstruct -- ) >r s" class-code" get-node get-property 0= IF 2drop s" 10 config-l@ translate-my-address 3 not AND" evaluate ( io-base ) r@ vd>base ! 0 r@ vd>type l! ELSE ." unsupported virtio interface!" cr 1 r@ vd>type l! THEN r> drop ; 3f0 cp : strequal ( str1 len1 str2 len2 -- flag ) rot dup rot = IF comp 0= ELSE 2drop drop 0 THEN ; 400 cp " /" find-device 480 cp new-device s" mmu" 2dup device-name device-type 0 0 s" translations" property : open true ; : close ; finish-device device-end 4c0 cp : fixup-tbfreq " /cpus/@0" find-device " timebase-frequency" get-node get-package-property IF 2drop ELSE decode-int to tb-frequency 2drop THEN device-end ; fixup-tbfreq 4d0 cp include fbuffer.fs 500 cp : populate-vios ( -- ) ." Populating /vdevice methods" cr " /vdevice" find-device get-node child BEGIN dup 0 <> WHILE dup set-node dup " compatible" rot get-package-property 0 = IF drop dup from-cstring 2dup " hvterm1" strequal IF " vio-hvterm.fs" included THEN 2dup " IBM,v-scsi" strequal IF " vio-vscsi.fs" included THEN 2dup " IBM,l-lan" strequal IF " vio-veth.fs" included THEN 2drop THEN peer REPEAT drop device-end ; populate-vios 580 cp 5a0 cp VARIABLE pci-next-mem \ prefetchable memory mapped VARIABLE pci-max-mem VARIABLE pci-next-mmio \ non-prefetchable memory VARIABLE pci-max-mmio VARIABLE pci-next-io \ I/O space VARIABLE pci-max-io 0 VALUE pci-bus-number 0 VALUE pci-device-number 0 VALUE pci-device-slots here 100 allot CONSTANT pci-device-vec 0 VALUE pci-device-vec-len : next-pci-mem ( addr -- addr ) pci-next-mem ; : next-pci-mmio ( addr -- addr ) pci-next-mmio ; : next-pci-io ( addr -- addr ) pci-next-io ; : int2str ( int len -- str len ) swap s>d rot <# 0 ?DO # LOOP #> ; : pci-addr2bus ( addr -- busnr ) 10 rshift FF and ; : pci-addr2dev ( addr -- dev ) B rshift 1F and ; : pci-addr2fn ( addr -- dev ) 8 rshift 7 and ; : pci-bus2addr ( busnr devnr -- addr ) B lshift swap 10 lshift + ; : pci-addr-out ( addr -- ) dup pci-addr2bus 2 0.r space FFFF and 4 0.r ; : pci-dump ( addr -- ) 10 0 DO dup cr i 4 * + dup pci-addr-out space rtas-config-l@ 8 0.r LOOP drop cr ; : pci-vendor@ ( addr -- id ) rtas-config-l@ FFFF and ; : pci-device@ ( addr -- id ) rtas-config-l@ 10 rshift ; : pci-status@ ( addr -- status ) 4 + rtas-config-l@ 10 rshift ; : pci-revision@ ( addr -- id ) 8 + rtas-config-b@ ; : pci-class@ ( addr -- class ) 8 + rtas-config-l@ 8 rshift ; : pci-cache@ ( addr -- size ) C + rtas-config-b@ ; : pci-htype@ ( addr -- type ) E + rtas-config-b@ ; : pci-sub-vendor@ ( addr -- sub-id ) 2C + rtas-config-l@ FFFF and ; : pci-sub-device@ ( addr -- sub-id ) 2C + rtas-config-l@ 10 rshift FFFF and ; : pci-interrupt@ ( addr -- interrupt ) 3D + rtas-config-b@ ; : pci-min-grant@ ( addr -- min-gnt ) 3E + rtas-config-b@ ; : pci-max-lat@ ( addr -- max-lat ) 3F + rtas-config-b@ ; : pci-capabilities? ( addr -- 0|1 ) pci-status@ 4 rshift 1 and ; : pci-cap-next ( cap-addr -- next-cap-off ) rtas-config-b@ FC and ; : pci-cap-next-addr ( cap-addr -- next-cap-addr ) 1+ dup pci-cap-next dup IF swap -100 and + ELSE nip THEN ; : pci-cap-dump ( addr -- ) cr dup pci-capabilities? IF 33 + BEGIN pci-cap-next-addr dup 0<> WHILE dup pci-addr-out s" : " type dup rtas-config-b@ 2 0.r cr REPEAT s" end found " ELSE s" capabilities not enabled!" THEN type cr drop ; : pci-cap-find ( addr id -- capp-addr|0 ) swap dup pci-capabilities? IF 33 + BEGIN pci-cap-next-addr dup 0<> IF dup rtas-config-b@ 2 pick = ELSE true THEN UNTIL nip ELSE 2drop 0 THEN ; : pci-express? ( addr -- 0|1 ) 10 pci-cap-find 0<> ; : pci-x? ( addr -- 0|1 ) 07 pci-cap-find 0<> ; : pci-config-ext? ( addr -- 0|1 ) pci-express? ; : pci-device-disable ( -- ) my-space 4 + dup rtas-config-l@ 7 invert and swap rtas-config-l! ; : pci-master-enable ( -- ) my-space 4 + dup rtas-config-l@ 4 or swap rtas-config-l! ; : pci-master-disable ( -- ) my-space 4 + dup rtas-config-l@ 4 invert and swap rtas-config-l! ; : pci-mem-enable ( -- ) my-space 4 + dup rtas-config-w@ 2 or swap rtas-config-w! ; : pci-io-enable ( -- ) my-space 4 + dup rtas-config-w@ 1 or swap rtas-config-w! ; : pci-enable ( -- ) my-space 4 + dup rtas-config-w@ 7 or swap rtas-config-w! ; : pci-error-enable ( -- ) my-space 4 + dup rtas-config-w@ 140 or swap rtas-config-w! ; : pci-out ( addr char -- ) 15 spaces over pci-addr-out s" (" type emit s" ) : " type dup pci-vendor@ 4 0.r space pci-device@ 4 0.r 4 spaces ; : pci-irq-line@ ( addr -- irq-pin ) 3C + rtas-config-b@ ; : pci-irq-line! ( pin addr -- ) 3C + rtas-config-b! ; : pci-bus-prim! ( nr addr -- ) 18 + dup rtas-config-l@ FFFFFF00 and rot + swap rtas-config-l! ; : pci-bus-prim@ ( addr -- nr ) 18 + rtas-config-l@ FF and ; : pci-bus-scnd! ( nr addr -- ) 18 + dup rtas-config-l@ FFFF00FF and rot 8 lshift + swap rtas-config-l! ; : pci-bus-scnd@ ( addr -- nr ) 18 + rtas-config-l@ 8 rshift FF and ; : pci-bus-subo! ( nr addr -- ) 18 + dup rtas-config-l@ FF00FFFF and rot 10 lshift + swap rtas-config-l! ; : pci-bus-subo@ ( addr -- nr ) 18 + rtas-config-l@ 10 rshift FF and ; : pci-bus! ( subo scnd prim addr -- ) swap rot 8 lshift + rot 10 lshift + swap 18 + dup rtas-config-l@ FF000000 and rot + swap rtas-config-l! ; : pci-bus@ ( addr -- subo scnd prim ) 18 + rtas-config-l@ dup 10 rshift FF and swap dup 8 rshift FF and swap FF and ; : pci-reset-2nd ( addr -- ) 1C + dup rtas-config-l@ FFFF0000 or swap rtas-config-l! ; : pci-vec ( -- ) cr s" device-vec(" type pci-device-vec-len dup 2 0.r s" ):" type 1+ 0 DO pci-device-vec i + c@ space 2 0.r LOOP cr ; : pci-var-out ( -- ) s" mem:" type pci-next-mem @ 16 0.r cr s" mmio:" type pci-next-mmio @ 16 0.r cr s" io:" type pci-next-io @ 16 0.r cr ; : pci-set-slot ( addr -- ) pci-addr2dev dup \ calc slot number pci-device-vec-len \ the end of the vector pci-device-vec + c! \ and update the vector 80000000 swap rshift \ calc bit position of the device slot pci-device-slots or \ set this bit TO pci-device-slots \ and write it back ; : pci-bridge-set-mmio-base ( addr -- ) pci-next-mmio @ 100000 #aligned \ read the current Value and align to 1MB boundary dup pci-next-mmio ! \ and write it back 10 rshift \ mmio-base reg is only the upper 16 bits pci-max-mmio @ FFFF0000 and or \ and Insert mmio Limit (set it to max) swap 20 + rtas-config-l! \ and write it into the bridge ; : pci-bridge-set-mmio-limit ( addr -- ) pci-next-mmio @ 100000 #aligned \ fetch current value and align to 1MB dup pci-next-mmio ! \ and write it back 1- FFFF0000 and \ make it one less and keep upper 16 bits over 20 + rtas-config-l@ 0000FFFF and \ fetch original value or swap 20 + rtas-config-l! \ and write it into the Reg ; : pci-bridge-set-mem-base ( addr -- ) pci-next-mem @ 100000 #aligned \ read the current Value and align to 1MB boundary dup pci-next-mem ! \ and write it back over 24 + rtas-config-w@ \ check if 64bit support 1 and IF \ IF 64 bit support 2dup 20 rshift \ | keep upper 32 bits swap 28 + rtas-config-l! \ | and write it into the Base-Upper32-bits pci-max-mem @ 20 rshift \ | fetch max Limit address and keep upper 32 bits 2 pick 2C + rtas-config-l! \ | and set the Limit THEN \ FI 10 rshift \ keep upper 16 bits pci-max-mem @ FFFF0000 and or \ and Insert mmem Limit (set it to max) swap 24 + rtas-config-l! \ and write it into the bridge ; : pci-bridge-set-mem-limit ( addr -- ) pci-next-mem @ 100000 #aligned \ read the current Value and align to 1MB boundary dup pci-next-mem ! \ and write it back 1- \ make limit one less than boundary over 24 + rtas-config-w@ \ check if 64bit support 1 and IF \ IF 64 bit support 2dup 20 rshift \ | keep upper 32 bits swap 2C + rtas-config-l! \ | and write it into the Limit-Upper32-bits THEN \ FI FFFF0000 and \ keep upper 16 bits over 24 + rtas-config-l@ 0000FFFF and \ fetch original Value or swap 24 + rtas-config-l! \ and write it into the bridge ; : pci-bridge-set-io-base ( addr -- ) pci-next-io @ 1000 #aligned \ read the current Value and align to 4KB boundary dup pci-next-io ! \ and write it back over 1C + rtas-config-l@ \ check if 32bit support 1 and IF \ IF 32 bit support 2dup 10 rshift \ | keep upper 16 bits pci-max-io @ FFFF0000 and or \ | insert upper 16 bits of Max-Limit swap 30 + rtas-config-l! \ | and write it into the Base-Upper16-bits THEN \ FI 8 rshift 000000FF and \ keep upper 8 bits pci-max-io @ 0000FF00 and or \ insert upper 8 bits of Max-Limit over rtas-config-l@ FFFF0000 and \ fetch original Value or swap 1C + rtas-config-l! \ and write it into the bridge ; : pci-bridge-set-io-limit ( addr -- ) pci-next-io @ 1000 #aligned \ read the current Value and align to 4KB boundary dup pci-next-io ! \ and write it back 1- \ make limit one less than boundary over 1D + rtas-config-b@ \ check if 32bit support 1 and IF \ IF 32 bit support 2dup FFFF0000 and \ | keep upper 16 bits over 30 + rtas-config-l@ \ | fetch original Value or swap 30 + rtas-config-l! \ | and write it into the Limit-Upper16-bits THEN \ FI 0000FF00 and \ keep upper 8 bits over 1C + rtas-config-l@ FFFF00FF and \ fetch original Value or swap 1C + rtas-config-l! \ and write it into the bridge ; : pci-bridge-set-bases ( addr -- ) dup pci-bridge-set-mmio-base dup pci-bridge-set-mem-base pci-bridge-set-io-base ; : pci-bridge-set-limits ( addr -- ) dup pci-bridge-set-mmio-limit dup pci-bridge-set-mem-limit pci-bridge-set-io-limit ; DEFER func-pci-probe-bus : pci-bridge-probe ( addr -- ) dup pci-bridge-set-bases \ SetUp all Base Registers pci-bus-number 1+ TO pci-bus-number \ increase number of busses found pci-device-vec-len 1+ TO pci-device-vec-len \ increase the device-slot vector depth dup \ stack config-addr for pci-bus! FF swap \ Subordinate Bus Number ( for now to max to open all subbusses ) pci-bus-number swap \ Secondary Bus Number ( the new busnumber ) dup pci-addr2bus swap \ Primary Bus Number ( the current bus ) pci-bus! \ and set them into the bridge pci-enable \ enable mem/IO transactions dup pci-bus-scnd@ func-pci-probe-bus \ and probe the secondary bus dup pci-bus-number swap pci-bus-subo! \ set SubOrdinate Bus Number to current number of busses pci-device-vec-len 1- TO pci-device-vec-len \ decrease the device-slot vector depth dup pci-bridge-set-limits \ SetUp all Limit Registers drop \ forget the config-addr ; : pci-device-setup ( addr -- ) drop \ since the config-addr is coded in my-space, drop it here s" pci-device.fs" included \ and setup the device as node in the device tree ; : pci-bridge-setup ( addr -- ) drop \ since the config-addr is coded in my-space, drop it here s" pci-bridge.fs" included \ and setup the bridge as node in the device tree ; : pci-add-device ( addr -- ) new-device \ create a new device-tree node dup set-space \ set the config addr for this device tree entry dup pci-set-slot \ set the slot bit dup pci-htype@ \ read HEADER-Type 1 and IF \ IF BRIDGE pci-bridge-setup \ | set up the bridge ELSE \ ELSE pci-device-setup \ | set up the device THEN \ FI finish-device \ and close the device-tree node ; : pci-setup-device ( addr -- ) dup pci-htype@ \ read HEADER-Type 80 and IF 8 ELSE 1 THEN \ check for multifunction 0 DO \ LOOP over all possible functions (either 8 or only 1) dup i 8 lshift + \ calc device-function-config-addr dup pci-vendor@ \ check if valid function FFFF = IF drop \ non-valid so forget the address ELSE pci-device-number 1+ \ increase the number of devices TO pci-device-number \ and store it pci-add-device \ and add the device to the device tree and set it up THEN LOOP \ next function drop \ forget the device-addr ; : pci-probe-device ( busnr devicenr -- ) pci-bus2addr \ calc pci-address dup pci-vendor@ \ fetch Vendor-ID FFFF = IF \ check if valid drop \ if not forget it ELSE pci-setup-device \ if valid setup the device THEN ; : pci-probe-bus ( busnr -- ) 0 TO pci-device-slots \ reset slot array to unpoppulated 20 0 DO dup i pci-probe-device LOOP drop ; ' pci-probe-bus TO func-pci-probe-bus : pci-probe-all ( bus-max bus-min -- ) \ Check all busses from bus-min up to bus-max if needed 0 TO pci-device-vec-len \ reset the device-slot vector DO i TO pci-bus-number \ set current Busnumber 0 TO pci-device-number \ reset Device Number pci-bus-number pci-probe-bus \ and probe this bus pci-device-number 0 > IF LEAVE THEN \ if we found a device we're done LOOP \ else next bus ; : (probe-pci-host-bridge) ( bus-max bus-min -- ) 0d emit ." Adapters on " puid 10 0.r cr \ print the puid we're looking at ( bus-max bus-min ) pci-probe-all \ and walk the bus pci-device-number 0= IF \ IF no devices found 15 spaces \ | indent the output ." None" cr \ | tell the world our result THEN \ FI ; : probe-pci-host-bridge ( bus-max bus-min mmio-max mmio-base mem-max mem-base io-max io-base my-puid -- ) puid >r TO puid \ save puid and set the new pci-next-io ! \ save the next io-base address pci-max-io ! \ save the max io-space address pci-next-mem ! \ save the next mem-base address pci-max-mem ! \ save the max mem-space address pci-next-mmio ! \ save the next mmio-base address pci-max-mmio ! \ save the max mmio-space address (probe-pci-host-bridge) r> TO puid \ restore puid ; 0 VALUE pci-net-num 0 VALUE pci-disk-num 0 VALUE pci-cdrom-num : pci-set-alias ( str-addr str-len num -- ) $cathex strdup \ create alias name get-node node>path \ get path string set-alias \ and set the alias ; : unknown-enet ( -- pci-net-num ) pci-net-num dup 1+ TO pci-net-num ; : pci-alias-net ( config-addr -- ) drop \ forget the config address pci-net-num dup 1+ TO pci-net-num \ increase the pci-net-num s" net" rot pci-set-alias \ create the alias ; : pci-alias-disk ( config-addr -- ) drop \ forget the config address pci-disk-num dup 1+ TO pci-disk-num \ increase the pci-disk-num s" disk" rot pci-set-alias \ create the alias ; : pci-alias-cdrom ( config-addr -- ) drop \ forget the config address pci-cdrom-num dup 1+ TO pci-cdrom-num \ increase the pci-cdrom-num s" cdrom" rot pci-set-alias \ create the alias ; : pci-alias ( config-addr -- ) dup pci-class@ 10 rshift CASE 01 OF pci-alias-disk ENDOF 02 OF pci-alias-net ENDOF dup OF drop ENDOF ENDCASE ; : pci-gen-irq-entry ( prop-addr prop-len config-addr -- prop-addr prop-len ) ." SHOULD NOT GET THERE !" cr drop ; : pci-set-irq-line ( config-addr -- ) drop ; : pci-set-capabilities ( config-addr -- ) drop ; : pci-class-name-00 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 01 OF s" display" ENDOF dup OF s" unknown-legacy-device" ENDOF ENDCASE ; : pci-class-name-01 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" scsi" ENDOF 01 OF s" ide" ENDOF 02 OF s" fdc" ENDOF 03 OF s" ipi" ENDOF 04 OF s" raid" ENDOF 05 OF s" ata" ENDOF 06 OF s" sata" ENDOF 07 OF s" sas" ENDOF dup OF s" mass-storage" ENDOF ENDCASE ; : pci-class-name-02 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" ethernet" ENDOF 01 OF s" token-ring" ENDOF 02 OF s" fddi" ENDOF 03 OF s" atm" ENDOF 04 OF s" isdn" ENDOF 05 OF s" worldfip" ENDOF 05 OF s" picmg" ENDOF dup OF s" network" ENDOF ENDCASE ; : pci-class-name-03 ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" vga" ENDOF 0001 OF s" 8514-compatible" ENDOF 0100 OF s" xga" ENDOF 0200 OF s" 3d-controller" ENDOF dup OF s" display" ENDOF ENDCASE ; : pci-class-name-04 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" video" ENDOF 01 OF s" sound" ENDOF 02 OF s" telephony" ENDOF dup OF s" multimedia-device" ENDOF ENDCASE ; : pci-class-name-05 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" memory" ENDOF 01 OF s" flash" ENDOF dup OF s" memory-controller" ENDOF ENDCASE ; : pci-class-name-06 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" host" ENDOF 01 OF s" isa" ENDOF 02 OF s" eisa" ENDOF 03 OF s" mca" ENDOF 04 OF s" pci" ENDOF 05 OF s" pcmcia" ENDOF 06 OF s" nubus" ENDOF 07 OF s" cardbus" ENDOF 08 OF s" raceway" ENDOF 09 OF s" semi-transparent-pci" ENDOF 0A OF s" infiniband" ENDOF dup OF s" unkown-bridge" ENDOF ENDCASE ; : pci-class-name-07 ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" serial" ENDOF 0001 OF s" 16450-serial" ENDOF 0002 OF s" 16550-serial" ENDOF 0003 OF s" 16650-serial" ENDOF 0004 OF s" 16750-serial" ENDOF 0005 OF s" 16850-serial" ENDOF 0006 OF s" 16950-serial" ENDOF 0100 OF s" parallel" ENDOF 0101 OF s" bi-directional-parallel" ENDOF 0102 OF s" ecp-1.x-parallel" ENDOF 0103 OF s" ieee1284-controller" ENDOF 01FE OF s" ieee1284-device" ENDOF 0200 OF s" multiport-serial" ENDOF 0300 OF s" modem" ENDOF 0301 OF s" 16450-modem" ENDOF 0302 OF s" 16550-modem" ENDOF 0303 OF s" 16650-modem" ENDOF 0304 OF s" 16750-modem" ENDOF 0400 OF s" gpib" ENDOF 0500 OF s" smart-card" ENDOF dup OF s" communication-controller" ENDOF ENDCASE ; : pci-class-name-08 ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" interrupt-controller" ENDOF 0001 OF s" isa-pic" ENDOF 0002 OF s" eisa-pic" ENDOF 0010 OF s" io-apic" ENDOF 0020 OF s" iox-apic" ENDOF 0100 OF s" dma-controller" ENDOF 0101 OF s" isa-dma" ENDOF 0102 OF s" eisa-dma" ENDOF 0200 OF s" timer" ENDOF 0201 OF s" isa-system-timer" ENDOF 0202 OF s" eisa-system-timer" ENDOF 0300 OF s" rtc" ENDOF 0301 OF s" isa-rtc" ENDOF 0400 OF s" hot-plug-controller" ENDOF 0500 OF s" sd-host-conrtoller" ENDOF dup OF s" system-periphal" ENDOF ENDCASE ; : pci-class-name-09 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" keyboard" ENDOF 01 OF s" pen" ENDOF 02 OF s" mouse" ENDOF 03 OF s" scanner" ENDOF 04 OF s" gameport" ENDOF dup OF s" input-controller" ENDOF ENDCASE ; : pci-class-name-0A ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" dock" ENDOF dup OF s" docking-station" ENDOF ENDCASE ; : pci-class-name-0B ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" 386" ENDOF 01 OF s" 486" ENDOF 02 OF s" pentium" ENDOF 10 OF s" alpha" ENDOF 20 OF s" powerpc" ENDOF 30 OF s" mips" ENDOF 40 OF s" co-processor" ENDOF dup OF s" cpu" ENDOF ENDCASE ; : pci-class-name-0C ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" firewire" ENDOF 0100 OF s" access-bus" ENDOF 0200 OF s" ssa" ENDOF 0300 OF s" usb-uhci" ENDOF 0310 OF s" usb-ohci" ENDOF 0320 OF s" usb-ehci" ENDOF 0380 OF s" usb" ENDOF 03FE OF s" usb-device" ENDOF 0400 OF s" fibre-channel" ENDOF 0500 OF s" smb" ENDOF 0600 OF s" infiniband" ENDOF 0700 OF s" ipmi-smic" ENDOF 0701 OF s" ipmi-kbrd" ENDOF 0702 OF s" ipmi-bltr" ENDOF 0800 OF s" sercos" ENDOF 0900 OF s" canbus" ENDOF dup OF s" serial-bus" ENDOF ENDCASE ; : pci-class-name-0D ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" irda" ENDOF 01 OF s" consumer-ir" ENDOF 10 OF s" rf-controller" ENDOF 11 OF s" bluetooth" ENDOF 12 OF s" broadband" ENDOF 20 OF s" enet-802.11a" ENDOF 21 OF s" enet-802.11b" ENDOF dup OF s" wireless-controller" ENDOF ENDCASE ; : pci-class-name-0E ( addr -- str len ) pci-class@ 8 rshift FF and CASE dup OF s" intelligent-io" ENDOF ENDCASE ; : pci-class-name-0F ( addr -- str len ) pci-class@ 8 rshift FF and CASE 01 OF s" satelite-tv" ENDOF 02 OF s" satelite-audio" ENDOF 03 OF s" satelite-voice" ENDOF 04 OF s" satelite-data" ENDOF dup OF s" satelite-devoce" ENDOF ENDCASE ; : pci-class-name-10 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" network-encryption" ENDOF 01 OF s" entertainment-encryption" ENDOF dup OF s" encryption" ENDOF ENDCASE ; : pci-class-name-11 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" dpio" ENDOF 01 OF s" counter" ENDOF 10 OF s" measurement" ENDOF 20 OF s" managment-card" ENDOF dup OF s" data-processing-controller" ENDOF ENDCASE ; : pci-class-name ( addr -- str len ) dup pci-class@ 10 rshift CASE 00 OF pci-class-name-00 ENDOF 01 OF pci-class-name-01 ENDOF 02 OF pci-class-name-02 ENDOF 03 OF pci-class-name-03 ENDOF 04 OF pci-class-name-04 ENDOF 05 OF pci-class-name-05 ENDOF 06 OF pci-class-name-06 ENDOF 07 OF pci-class-name-07 ENDOF 08 OF pci-class-name-08 ENDOF 09 OF pci-class-name-09 ENDOF 0A OF pci-class-name-0A ENDOF 0B OF pci-class-name-0B ENDOF 0C OF pci-class-name-0C ENDOF 0C OF pci-class-name-0D ENDOF 0C OF pci-class-name-0E ENDOF 0C OF pci-class-name-0F ENDOF 0C OF pci-class-name-10 ENDOF 0C OF pci-class-name-11 ENDOF dup OF drop s" unknown" ENDOF ENDCASE ; : pci-bar-size@ ( bar-addr -- bar-size ) -1 over rtas-config-l! rtas-config-l@ ; : pci-bar-size-mem@ ( bar-addr -- mem-size ) pci-bar-size@ -10 and invert 1+ FFFFFFFF and ; : pci-bar-size-io@ ( bar-addr -- io-size ) pci-bar-size@ -4 and invert 1+ FFFFFFFF and ; : pci-bar-size ( bar-addr -- bar-size-raw ) dup rtas-config-l@ swap \ fetch original Value ( bval baddr ) -1 over rtas-config-l! \ make BAR show size ( bval baddr ) dup rtas-config-l@ \ and fetch the size ( bval baddr bsize ) -rot rtas-config-l! \ restore Value ; : pci-bar-size-mem32 ( bar-addr -- bar-size ) pci-bar-size \ fetch raw size -10 and invert 1+ \ calc size FFFFFFFF and \ keep lower 32 bits ; : pci-bar-size-rom ( bar-addr -- bar-size ) pci-bar-size \ fetch raw size FFFFF800 and invert 1+ \ calc size FFFFFFFF and \ keep lower 32 bits ; : pci-bar-size-mem64 ( bar-addr -- bar-size ) dup pci-bar-size \ fetch raw size lower 32 bits swap 4 + pci-bar-size \ fetch raw size upper 32 bits 20 lshift + \ and put them together -10 and invert 1+ \ calc size ; : pci-bar-size-io ( bar-addr -- bar-size ) pci-bar-size \ fetch raw size -4 and invert 1+ \ calc size FFFFFFFF and \ keep lower 32 bits ; : pci-bar-code@ ( bar-addr -- 0|1..4|5 ) rtas-config-l@ dup \ fetch the BaseAddressRegister 1 and IF \ IO BAR ? 2 and IF 0 ELSE 1 THEN \ only '01' is valid ELSE \ Memory BAR ? F and CASE 0 OF 2 ENDOF \ Memory 32 Bit Non-Prefetchable 8 OF 3 ENDOF \ Memory 32 Bit Prefetchable 4 OF 4 ENDOF \ Memory 64 Bit Non-Prefetchable C OF 5 ENDOF \ Memory 64 Bit Prefechtable dup OF 0 ENDOF \ Not a valid BarType ENDCASE THEN ; : assign-var ( size var -- al-mem ) 2dup @ \ ( size var size cur-mem ) read current free mem swap #aligned \ ( size var al-mem ) align the mem to the size dup 2swap -rot + \ ( al-mem var new-mem ) add size to aligned mem swap ! \ ( al-mem ) set variable to new mem ; : assign-bar-value32 ( bar size var -- 4 ) over IF \ IF size > 0 assign-var \ | ( bar al-mem ) set variable to next mem swap rtas-config-l! \ | ( -- ) set the bar to al-mem ELSE \ ELSE 2drop drop \ | clear stack THEN \ FI 4 \ size of the base-address-register ; : assign-bar-value64 ( bar size var -- 8 ) over IF \ IF size > 0 assign-var \ | ( bar al-mem ) set variable to next mem swap \ | ( al-mem addr ) calc config-addr of this bar 2dup rtas-config-l! \ | ( al-mem addr ) set the Lower part of the bar to al-mem 4 + swap 20 rshift \ | ( al-mem>>32 addr ) prepare the upper part of the al-mem swap rtas-config-l! \ | ( -- ) and set the upper part of the bar ELSE \ ELSE 2drop drop \ | clear stack THEN \ FI 8 \ size of the base-address-register ; : assign-mem64-bar ( bar-addr -- 8 ) dup pci-bar-size-mem64 \ fetch size pci-next-mem \ var to change assign-bar-value64 \ and set it all ; : assign-mem32-bar ( bar-addr -- 4 ) dup pci-bar-size-mem32 \ fetch size pci-next-mem \ var to change assign-bar-value32 \ and set it all ; : assign-mmio64-bar ( bar-addr -- 8 ) dup pci-bar-size-mem64 \ fetch size pci-next-mmio \ var to change assign-bar-value64 \ and set it all ; : assign-mmio32-bar ( bar-addr -- 4 ) dup pci-bar-size-mem32 \ fetch size pci-next-mmio \ var to change assign-bar-value32 \ and set it all ; : assign-io-bar ( bar-addr -- 4 ) dup pci-bar-size-io \ fetch size pci-next-io \ var to change assign-bar-value32 \ and set it all ; : assign-rom-bar ( bar-addr -- ) dup pci-bar-size-rom \ fetch size dup IF \ IF size > 0 over >r \ | save bar addr for enable pci-next-mmio \ | var to change assign-bar-value32 \ | and set it drop \ | forget the BAR length r@ rtas-config-l@ \ | fetch BAR 1 or r> rtas-config-l! \ | and enable the ROM ELSE \ ELSE 2drop \ | clear stack THEN ; : assign-bar ( bar-addr -- reg-size ) dup pci-bar-code@ \ calc BAR type dup IF \ IF >0 CASE \ | CASE Setup the right type 1 OF assign-io-bar ENDOF \ | - set up an IO-Bar 2 OF assign-mmio32-bar ENDOF \ | - set up an 32bit MMIO-Bar 3 OF assign-mem32-bar ENDOF \ | - set up an 32bit MEM-Bar (prefetchable) 4 OF assign-mmio64-bar ENDOF \ | - set up an 64bit MMIO-Bar 5 OF assign-mem64-bar ENDOF \ | - set up an 64bit MEM-Bar (prefetchable) ENDCASE \ | ESAC ELSE \ ELSE ABORT \ | Throw an exception THEN \ FI ; : assign-all-device-bars ( configaddr -- ) 28 10 DO \ BARs start at 10 and end at 27 dup i + \ calc config-addr of the BAR assign-bar \ and set it up +LOOP \ add 4 or 8 to the index and loop 30 + assign-rom-bar \ set up the ROM if available ; : assign-all-bridge-bars ( configaddr -- ) 18 10 DO \ BARs start at 10 and end at 17 dup i + \ calc config-addr of the BAR assign-bar \ and set it up +LOOP \ add 4 or 8 to the index and loop 38 + assign-rom-bar \ set up the ROM if available ; : gen-mem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size) over 4 + rtas-config-l@ \ | fetch upper 32 bits ( paddr plen baddr val.lo val.hi R: size) 20 lshift + -10 and >r \ | calc 64 bit value and save it ( paddr plen baddr R: size val ) 83000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ sizeof(BAR) = 8 Bytes ; : gen-pmem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size) over 4 + rtas-config-l@ \ | fetch upper 32 bits ( paddr plen baddr val.lo val.hi R: size) 20 lshift + -10 and >r \ | calc 64 bit value and save it ( paddr plen baddr R: size val ) C3000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ sizeof(BAR) = 8 Bytes ; : gen-mem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) -10 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) 82000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ sizeof(BAR) = 4 Bytes ; : gen-pmem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) -10 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) C2000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ sizeof(BAR) = 4 Bytes ; : gen-io-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) dup pci-bar-size-io \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) -4 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) 81000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ sizeof(BAR) = 4 Bytes ; : gen-rom-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len ) dup pci-bar-size-rom \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) FFFFF800 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) 82000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI ; : pci-add-assigned-address ( prop-addr prop-len bar-addr -- prop-addr prop-len bsize ) dup pci-bar-code@ \ calc BAR type ( paddr plen baddr btype) CASE \ CASE for the BAR types ( paddr plen baddr ) 0 OF drop 4 ENDOF \ - not a valid type so do nothing 1 OF gen-io-bar-prop ENDOF \ - IO-BAR 2 OF gen-mem32-bar-prop ENDOF \ - MEM32 3 OF gen-pmem32-bar-prop ENDOF \ - MEM32 prefetchable 4 OF gen-mem64-bar-prop ENDOF \ - MEM64 5 OF gen-pmem64-bar-prop ENDOF \ - MEM64 prefetchable ENDCASE \ ESAC ( paddr plen bsize ) ; : pci-device-assigned-addresses-prop ( addr -- ) encode-start \ provide mem for property ( addr paddr plen ) 2 pick 30 + gen-rom-bar-prop \ assign the rom bar 28 10 DO \ we have 6 possible BARs 2 pick i + \ calc BAR address ( addr paddr plen bar-addr ) pci-add-assigned-address \ and generate the props for the BAR +LOOP \ increase Index by returned len s" assigned-addresses" property drop \ and write it into the device tree ; : pci-bridge-assigned-addresses-prop ( addr -- ) encode-start \ provide mem for property 2 pick 38 + gen-rom-bar-prop \ assign the rom bar 18 10 DO \ we have 2 possible BARs 2 pick i + \ ( addr paddr plen current-addr ) pci-add-assigned-address \ and generate the props for the BAR +LOOP \ increase Index by returned len s" assigned-addresses" property drop \ and write it into the device tree ; : pci-bridge-gen-range ( paddr plen base limit type -- paddr plen ) >r over - \ calc size ( paddr plen base size R:type ) dup 0< IF \ IF Size < 0 ( paddr plen base size R:type ) 2drop r> drop \ | forget values ( paddr plen ) ELSE \ ELSE 1+ swap 2swap \ | adjust stack ( size base paddr plen R:type ) r@ encode-int+ \ | Child type ( size base paddr plen R:type ) 2 pick encode-64+ \ | Child address ( size base paddr plen R:type ) r> encode-int+ \ | Parent type ( size base paddr plen ) rot encode-64+ \ | Parent address ( size paddr plen ) rot encode-64+ \ | Encode size ( paddr plen ) THEN \ FI ; : pci-bridge-gen-mmio-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) 2 pick 20 + rtas-config-l@ \ fetch Value ( addr paddr plen val ) dup 0000FFF0 and 10 lshift \ calc base-address ( addr paddr plen val base ) swap 000FFFFF or \ calc limit-address ( addr paddr plen base limit ) 02000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) ; : pci-bridge-gen-mem-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) 2 pick 24 + rtas-config-l@ \ fetch Value ( addr paddr plen val ) dup 000FFFFF or \ calc limit Bits 31:0 ( addr paddr plen val limit.31:0 ) swap 0000FFF0 and 10 lshift \ calc base Bits 31:0 ( addr paddr plen limit.31:0 base.31:0 ) 4 pick 28 + rtas-config-l@ \ fetch upper Basebits ( addr paddr plen limit.31:0 base.31:0 base.63:32 ) 20 lshift or swap \ and calc Base ( addr paddr plen base.63:0 limit.31:0 ) 4 pick 2C + rtas-config-l@ \ fetch upper Limitbits ( addr paddr plen base.63:0 limit.31:0 limit.63:32 ) 20 lshift or \ and calc Limit ( addr paddr plen base.63:0 limit.63:0 ) 42000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) ; : pci-bridge-gen-io-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) 2 pick 1C + rtas-config-l@ \ fetch Value ( addr paddr plen val ) dup 0000F000 and 00000FFF or \ calc Limit Bits 15:0 ( addr paddr plen val limit.15:0 ) swap 000000F0 and 8 lshift \ calc Base Bits 15:0 ( addr paddr plen limit.15:0 base.15:0 ) 4 pick 30 + rtas-config-l@ \ fetch upper Bits ( addr paddr plen limit.15:0 base.15:0 val ) dup FFFF and 10 lshift rot or \ calc Base ( addr paddr plen limit.15:0 val base.31:0 ) -rot FFFF0000 and or \ calc Limit ( addr paddr plen base.31:0 limit.31:0 ) 01000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) ; : pci-bridge-range-props ( addr -- ) encode-start \ provide mem for property pci-bridge-gen-mmio-range \ generate the non prefetchable Memory Entry pci-bridge-gen-mem-range \ generate the prefetchable Memory Entry pci-bridge-gen-io-range \ generate the IO Entry dup IF \ IF any space present (propsize>0) s" ranges" property \ | write it into the device tree ELSE \ ELSE 2drop \ | forget the properties THEN \ FI drop \ forget the address ; : pci-bridge-interrupt-map ( -- ) encode-start \ create the property ( paddr plen ) get-node child \ find the first child ( paddr plen handle ) BEGIN dup WHILE \ Loop as long as the handle is non-zero ( paddr plen handle ) dup >r >space \ Get the my-space ( paddr plen addr R: handle ) pci-gen-irq-entry \ and Encode the interrupt settings ( paddr plen R: handle) r> peer \ Get neighbour ( paddr plen handle ) REPEAT \ process next childe node ( paddr plen handle ) drop \ forget the null ( paddr plen ) s" interrupt-map" property \ and set it ( -- ) 1 encode-int s" #interrupt-cells" property \ encode the cell# f800 encode-int 0 encode-int+ 0 encode-int+ \ encode the bit mask for config addr (Dev only) 7 encode-int+ s" interrupt-map-mask" property \ encode IRQ#=7 and generate property ; : encode-mem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 02000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ BAR-Len = 4 (32Bit) ; : encode-pmem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 42000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ BAR-Len = 4 (32Bit) ; : encode-mem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 03000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ BAR-Len = 8 (64Bit) ; : encode-pmem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 43000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ BAR-Len = 8 (64Bit) ; : encode-rom-bar ( prop-addr prop-len configaddr -- prop-addr prop-len ) dup pci-bar-size-rom \ fetch raw BAR-size dup IF \ IF BAR is used >r 02000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | calc and encode the size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI ; : encode-io-bar ( prop-addr prop-len BAR-addr BAR-value -- prop-addr prop-len 4 ) dup pci-bar-size-io \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 01000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ BAR-Len = 4 (32Bit) ; : encode-bar ( prop-addr prop-len bar-addr -- prop-addr prop-len bar-len ) dup pci-bar-code@ \ calc BAR type CASE \ CASE for the BAR types ( paddr plen baddr val ) 0 OF drop 4 ENDOF \ - not a valid type so do nothing 1 OF encode-io-bar ENDOF \ - IO-BAR 2 OF encode-mem32-bar ENDOF \ - MEM32 3 OF encode-pmem32-bar ENDOF \ - MEM32 prefetchable 4 OF encode-mem64-bar ENDOF \ - MEM64 5 OF encode-pmem64-bar ENDOF \ - MEM64 prefetchable ENDCASE \ ESAC ( paddr plen blen ) ; : pci-reg-props ( configaddr -- ) dup encode-int \ configuration space ( caddr paddr plen ) 0 encode-64+ \ make the rest 0 0 encode-64+ \ encode the size as 0 2 pick pci-htype@ \ fetch Header Type ( caddr paddr plen type ) 1 and IF \ IF Bridge ( caddr paddr plen ) 18 10 DO \ | loop over all BARs 2 pick i + \ | calc bar-addr ( caddr paddr plen baddr ) encode-bar \ | encode this BAR ( caddr paddr plen blen ) +LOOP \ | increase LoopIndex by the BARlen 2 pick 38 + \ | calc ROM-BAR for a bridge ( caddr paddr plen baddr ) encode-rom-bar \ | encode the ROM-BAR ( caddr paddr plen ) ELSE \ ELSE ordinary device ( caddr paddr plen ) 28 10 DO \ | loop over all BARs 2 pick i + \ | calc bar-addr ( caddr paddr plen baddr ) encode-bar \ | encode this BAR ( caddr paddr plen blen ) +LOOP \ | increase LoopIndex by the BARlen 2 pick 30 + \ | calc ROM-BAR for a device ( caddr paddr plen baddr ) encode-rom-bar \ | encode the ROM-BAR ( caddr paddr plen ) THEN \ FI ( caddr paddr plen ) s" reg" property \ and store it into the property drop ; : pci-common-props ( addr -- ) dup pci-class-name 2dup device-name device-type dup pci-vendor@ encode-int s" vendor-id" property dup pci-device@ encode-int s" device-id" property dup pci-revision@ encode-int s" revision-id" property dup pci-class@ encode-int s" class-code" property 3 encode-int s" #address-cells" property 2 encode-int s" #size-cells" property dup pci-config-ext? IF 1 encode-int s" ibm,pci-config-space-type" property THEN dup pci-status@ dup 9 rshift 3 and encode-int s" devsel-speed" property dup 7 rshift 1 and IF 0 0 s" fast-back-to-back" property THEN dup 6 rshift 1 and IF 0 0 s" 66mhz-capable" property THEN 5 rshift 1 and IF 0 0 s" udf-supported" property THEN dup pci-cache@ ?dup IF encode-int s" cache-line-size" property THEN pci-interrupt@ ?dup IF encode-int s" interrupts" property THEN ; : pci-device-props ( addr -- ) dup pci-common-props dup pci-min-grant@ encode-int s" min-grant" property dup pci-max-lat@ encode-int s" max-latency" property dup pci-sub-device@ ?dup IF encode-int s" subsystem-id" property THEN dup pci-sub-vendor@ ?dup IF encode-int s" subsystem-vendor-id" property THEN dup pci-device-assigned-addresses-prop pci-reg-props ; : pci-bridge-props ( addr -- ) dup pci-bus@ encode-int s" primary-bus" property encode-int s" secondary-bus" property encode-int s" subordinate-bus" property dup pci-bus@ drop encode-int rot encode-int+ s" bus-range" property pci-device-slots encode-int s" slot-names" property dup pci-bridge-range-props dup pci-bridge-assigned-addresses-prop s" interrupt-map" get-node get-property IF pci-bridge-interrupt-map ELSE 2drop THEN pci-reg-props ; : assign-bar-mapping ( bar-offset size var -- ) rot my-unit-64 + -rot assign-bar-value32 drop ; : assigned-addresses-property ( -- ) my-unit-64 dup pci-common-props pci-device-assigned-addresses-prop ; : pci-bridge-generic-setup ( addr -- ) pci-device-slots >r \ save the slot array on return stack dup pci-common-props \ set the common properties before scanning the bus s" pci" device-type \ the type is allways "pci" dup pci-bridge-probe \ find all device connected to it dup assign-all-bridge-bars \ set up all memory access BARs dup pci-set-irq-line \ set the interrupt pin dup pci-set-capabilities \ set up the capabilities pci-bridge-props \ and generate all properties r> TO pci-device-slots \ and reset the slot array ; : pci-device-generic-setup ( config-addr -- ) dup assign-all-device-bars \ calc all BARs dup pci-set-irq-line \ set the interrupt pin dup pci-set-capabilities \ set up the capabilities dup pci-device-props \ and generate all properties drop \ forget the config-addr ; : populate-pci-busses ( -- ) " /" find-device get-node child BEGIN dup 0 <> WHILE dup set-node dup " name" rot get-package-property 0 = IF drop dup from-cstring 2dup s" pci" strequal IF s" pci-phb.fs" included THEN 2drop THEN peer REPEAT drop device-end ; populate-pci-busses 600 cp ' rtas-quiesce add-quiesce-xt 640 cp 690 cp 6a0 cp 6a8 cp 6b0 cp 6b8 cp 6c0 cp s" /cpus/@0" open-dev encode-int s" cpu" set-chosen s" /memory" open-dev encode-int s" memory" set-chosen 6e0 cp 700 cp s" /openprom" find-device s" SLOF," slof-build-id here swap rmove here slof-build-id nip $cat encode-string s" model" property 0 0 s" relative-addressing" property device-end s" /aliases" find-device : open true ; : close ; device-end s" /mmu" open-dev encode-int s" mmu" set-chosen VARIABLE chosen-memory-ih 0 chosen-memory-ih ! : (chosen-memory-ph) ( -- phandle ) chosen-memory-ih @ ?dup 0= IF s" memory" get-chosen IF decode-int nip nip dup chosen-memory-ih ! ihandle>phandle ELSE 0 THEN ELSE ihandle>phandle THEN ; : (set-available-prop) ( prop plen -- ) s" available" (chosen-memory-ph) ?dup 0<> IF set-property ELSE cr ." Can't find chosen memory node - " ." no available property created" cr 2dup 2dup THEN ; : update-available-property ( available-ptr -- ) dup >r available>size@ 0= r@ available AVAILABLE-SIZE /available * + >= or IF available r> available - encode-bytes (set-available-prop) ELSE r> /available + RECURSE THEN ; : update-available-property available update-available-property ; : claim ( [ addr ] len align -- base ) claim update-available-property ; : release ( addr len -- ) release update-available-property ; update-available-property : input ( dev-str dev-len -- ) open-dev ?dup IF s" stdin" get-chosen IF decode-int nip nip ?dup IF close-dev THEN THEN encode-int s" stdin" set-chosen THEN ; : output ( dev-str dev-len -- ) open-dev ?dup IF s" stdout" get-chosen IF decode-int nip nip ?dup IF close-dev THEN THEN encode-int s" stdout" set-chosen THEN ; : io ( dev-str dev-len -- ) 2dup input output ; 1 BUFFER: (term-io-char-buf) : term-io-key ( -- char ) s" stdin" get-chosen IF decode-int nip nip dup 0= IF 0 EXIT THEN >r BEGIN (term-io-char-buf) 1 s" read" r@ $call-method 0 > UNTIL (term-io-char-buf) c@ r> drop THEN ; ' term-io-key to key : term-io-key? ( -- true|false ) s" stdin" get-chosen IF decode-int nip nip dup 0= IF drop 0 EXIT THEN \ return false and exit if no stdin set >r \ store ihandle on return stack s" device_type" r@ ihandle>phandle ( propstr len phandle ) get-property ( true | data dlen false ) IF false ELSE 1 - \ remove 1 from length to ignore null-termination char 2dup s" serial" str= IF 2drop serial-key? r> drop EXIT THEN \ call serial-key, cleanup return-stack, exit 2dup s" keyboard" str= IF 2drop ( ) s" key-available?" r@ ihandle>phandle find-method IF drop s" key-available?" r@ $call-method ELSE false THEN r> drop EXIT \ cleanup return-stack, exit THEN 2drop r> drop false EXIT \ unknown device_type cleanup return-stack, return false THEN ELSE false THEN ; ' term-io-key? to key? 800 cp 51 CONSTANT nvram-partition-type-cpulog 60 CONSTANT nvram-partition-type-sas 61 CONSTANT nvram-partition-type-sms 6e CONSTANT nvram-partition-type-debug 6f CONSTANT nvram-partition-type-history 70 CONSTANT nvram-partition-type-common 7f CONSTANT nvram-partition-type-freespace a0 CONSTANT nvram-partition-type-linux : rztype ( str len -- ) \ stop at zero byte, read with nvram-c@ 0 DO dup i + nvram-c@ ?dup IF ( str char ) emit ELSE ( str ) drop UNLOOP EXIT THEN LOOP ; create tmpStr 500 allot : rzcount ( zstr -- str len ) dup tmpStr >r BEGIN dup nvram-c@ dup r> dup 1+ >r c! WHILE char+ REPEAT r> drop over - swap drop tmpStr swap ; : calc-header-cksum ( offset -- cksum ) dup nvram-c@ 10 2 DO over I + nvram-c@ + LOOP wbsplit + nip ; : bad-header? ( offset -- flag ) dup 2+ nvram-w@ ( offset length ) 0= IF ( offset ) drop true EXIT ( ) THEN dup calc-header-cksum ( offset checksum' ) swap 1+ nvram-c@ ( checksum ' checksum ) <> ( flag ) ; : .header ( offset -- ) cr ( offset ) dup bad-header? IF ( offset ) ." BAD HEADER -- trying to print it anyway" cr THEN space ( offset ) dup nvram-c@ 2 0.r ( offset ) space space ( offset ) dup 2+ nvram-w@ 10 * 5 .r ( offset ) space space ( offset ) 4 + 0c rztype ( ) ; : .headers ( -- ) cr cr ." Type Size Name" cr ." ========================" 0 BEGIN ( offset ) dup nvram-c@ ( offset type ) WHILE dup .header ( offset ) dup 2+ nvram-w@ 10 * + ( offset offset' ) dup nvram-size < IF ( offset ) ELSE drop EXIT ( ) THEN REPEAT drop ( ) cr cr ; : reset-nvram ( -- ) internal-reset-nvram ; : dump-partition ['] nvram-c@ 1 (dump) ; : type-no-zero ( addr len -- ) 0 DO dup I + dup nvram-c@ 0= IF drop ELSE nvram-c@ emit THEN LOOP drop ; : type-no-zero-part ( from-str cnt-str addr len ) 0 DO dup i + dup nvram-c@ 0= IF drop ELSE 3 pick 0= 3 pick 0 > AND IF dup 1 type-no-zero THEN nvram-c@ a = IF 2 pick 0= IF over 1- 0 max rot drop swap THEN 2 pick 1- 0 max 3 roll drop rot rot THEN THEN LOOP drop ; : (dmesg-prepare) ( base-addr -- base-addr' addr len act-off ) 10 - \ go back to header dup 14 + nvram-l@ dup >r ( base-addr act-off ) ( R: act-off ) over over over + swap 10 + nvram-w@ + >r ( base-addr act-off ) ( R: act-off nvram-act-addr ) over 2 + nvram-w@ 10 * swap - over swap ( base-addr base-addr start-size ) ( R: act-off nvram-act-addr ) r> swap rot 10 + nvram-w@ - r> ; : .dmesg ( base-addr -- ) (dmesg-prepare) >r cr type-no-zero ( base-addr ) ( R: act-off ) dup 10 + nvram-w@ + r> type-no-zero ; : .dmesg-part ( from-str cnt-str base-addr -- ) (dmesg-prepare) >r >r >r -rot r> r> cr type-no-zero-part rot ( base-addr ) ( R: act-off ) dup 10 + nvram-w@ + r> type-no-zero-part ; : dmesg-part ( from-str cnt-str -- left-from-str left-cnt-str ) 2dup s" ibm,BE0log" get-named-nvram-partition IF s" ibm,CPU0log" get-named-nvram-partition IF 2drop EXIT THEN THEN drop .dmesg-part nip nip ; : dmesg2 ( -- ) s" ibm,BE1log" get-named-nvram-partition IF s" ibm,CPU1log" get-named-nvram-partition IF ." No log partition." cr EXIT THEN THEN drop .dmesg ; : dmesg ( -- ) s" ibm,BE0log" get-named-nvram-partition IF s" ibm,CPU0log" get-named-nvram-partition IF ." No log partition." cr EXIT THEN THEN drop .dmesg ; 880 cp wordlist CONSTANT envvars : listenv ( -- ) get-current envvars set-current words set-current ; : create-env ( "name" -- ) get-current envvars set-current CREATE set-current ; : env-int ( n -- ) 1 c, align , DOES> char+ aligned @ ; : env-bytes ( a len -- ) 2 c, align dup , here swap dup allot move DOES> char+ aligned dup @ >r cell+ r> ; : env-string ( str len -- ) 3 c, string, DOES> char+ count ; : env-flag ( f -- ) 4 c, c, DOES> char+ c@ 0<> ; : env-secmode ( sm -- ) 5 c, c, DOES> char+ c@ ; : default-int ( n "name" -- ) create-env env-int ; : default-bytes ( a len "name" -- ) create-env env-bytes ; : default-string ( a len "name" -- ) create-env env-string ; : default-flag ( f "name" -- ) create-env env-flag ; : default-secmode ( sm "name" -- ) create-env env-secmode ; : set-option ( option-name len option len -- ) 2swap encode-string 2swap s" /options" find-node dup IF set-property ELSE drop 2drop 2drop THEN ; : findenv ( name len -- adr def-adr type | 0 ) 2dup envvars voc-find dup 0<> IF ( ABORT" not a configuration variable" ) link> >body char+ >r (find-order) link> >body dup char+ swap c@ r> swap ELSE nip nip THEN ; : test-flag ( param len -- true | false ) 2dup s" true" string=ci -rot s" false" string=ci or ; : test-secmode ( param len -- true | false ) 2dup s" none" string=ci -rot 2dup s" command" string=ci -rot s" full" string=ci or or ; : test-int ( param len -- true | false ) drop c@ isdigit if true else false then ; : findtype ( param len name len -- param len name len type ) 2dup findenv dup 0= \ try to find type of envvar IF \ no type found drop 2swap 2dup test-flag if 4 -rot else 2dup test-secmode if 5 -rot else 2dup test-int if 1 -rot else 2dup test-string IF 3 ELSE 2 THEN \ 3 = string, 2 = default to bytes -rot then then then rot >r 2swap r> else \ take type from default value nip nip THEN ; : $setenv ( param len name len -- ) 4dup set-option findtype dup 0= IF true ABORT" not a configuration variable" ELSE -rot $CREATE CASE 1 OF evaluate env-int ENDOF \ XXX: wants decimal and 0x... 2 OF 2dup ( param len param len ) depth >r ( param len param len R: depth-before ) ['] evaluate CATCH IF \ Catch 'unknown Forth words'... 2drop r> drop env-string \ and encode 'unknown word' as string ELSE depth r> = IF env-bytes ELSE env-int THEN 2drop THEN ENDOF 3 OF env-string ENDOF 4 OF evaluate env-flag ENDOF 5 OF evaluate env-secmode ENDOF \ XXX: recognize none, command, full ENDCASE THEN ; : (printenv) ( adr type -- ) CASE 1 OF aligned @ . ENDOF 2 OF aligned dup cell+ swap @ dup IF dump ELSE 2drop THEN ENDOF 3 OF count type ENDOF 4 OF c@ IF ." true" ELSE ." false" THEN ENDOF 5 OF c@ . ENDOF \ XXX: print symbolically ENDCASE ; : .printenv-header ( -- ) cr s" ---environment variable--------current value-------------default value------" type cr ; DEFER old-emit 0 VALUE emit-counter : emit-and-count emit-counter 1 + to emit-counter old-emit ; : .enable-emit-counter 0 to emit-counter ['] emit behavior to old-emit ['] emit-and-count to emit ; : .disable-emit-counter ['] old-emit behavior to emit ; : .spaces dup 0 > IF spaces ELSE drop space THEN ; : .print-one-env 3 .spaces 2dup dup -rot type 1c swap - .spaces findenv rot over .enable-emit-counter (printenv) .disable-emit-counter 1a emit-counter - .spaces (printenv) ; : .print-all-env .printenv-header envvars cell+ BEGIN @ dup WHILE dup link> >name name>string .print-one-env cr REPEAT drop ; : printenv parse-word dup 0= IF 2drop .print-all-env ELSE findenv dup 0= ABORT" not a configuration variable" rot over cr ." Current: " (printenv) cr ." Default: " (printenv) THEN ; : (set-default) ( def-xt -- ) dup >name name>string $CREATE dup >body c@ >r execute r> CASE 1 OF env-int ENDOF 2 OF env-bytes ENDOF 3 OF env-string ENDOF 4 OF env-flag ENDOF 5 OF env-secmode ENDOF ENDCASE ; true default-flag auto-boot? s" " default-string boot-device s" " default-string boot-file s" boot" default-string boot-command s" " default-string diag-device s" " default-string diag-file false default-flag diag-switch? true default-flag fcode-debug? s" " default-string input-device s" " default-string nvramrc s" " default-string oem-banner false default-flag oem-banner? 0 0 default-bytes oem-logo false default-flag oem-logo? s" " default-string output-device 200 default-int screen-#columns 200 default-int screen-#rows 0 default-int security-#badlogins 0 default-secmode security-mode s" " default-string security-password 0 default-int selftest-#megs false default-flag use-nvramrc? false default-flag direct-serial? true default-flag real-mode? true default-flag use-axon-ddr? VARIABLE nvoff \ offset in envvar partition : (nvupdate-one) ( adr type -- "value" ) CASE 1 OF aligned @ (.) ENDOF 2 OF drop s" 0 0" ENDOF 3 OF count ENDOF 4 OF c@ IF s" true" ELSE s" false" THEN ENDOF 5 OF c@ (.) ENDOF \ XXX: print symbolically ENDCASE ; : nvupdate-one ( def-xt -- ) >r nvram-partition-type-common get-nvram-partition ( part.addr part.len FALSE|TRUE R: def-xt ) ABORT" No valid NVRAM." r> ( part.addr part.len def-xt ) >name name>string ( part.addr part.len var.a var.l ) 2dup findenv nip (nvupdate-one) internal-add-env drop ; : (nvupdate) ( -- ) nvram-partition-type-common get-nvram-partition ABORT" No valid NVRAM." erase-nvram-partition drop envvars cell+ BEGIN @ dup WHILE dup link> nvupdate-one REPEAT drop ; : nvupdate ( -- ) ." nvupdate is obsolete." cr ; : set-default parse-word envvars voc-find dup 0= ABORT" not a configuration variable" link> (set-default) ; : (set-defaults) envvars cell+ BEGIN @ dup WHILE dup link> (set-default) REPEAT drop ; (set-defaults) : set-defaults (set-defaults) (nvupdate) ; : setenv parse-word ( skipws ) 0d parse -leading 2swap $setenv (nvupdate) ; : get-nv ( -- ) nvram-partition-type-common get-nvram-partition ( addr offset not-found | not-found ) \ find partition header IF ." No NVRAM common partition, re-initializing..." cr internal-reset-nvram (nvupdate) nvram-partition-type-common get-nvram-partition IF ." NVRAM seems to be broken." cr EXIT THEN THEN drop ( addr ) \ throw away offset BEGIN dup rzcount dup \ make string from offset and make condition WHILE ( offset offset length ) 2dup [char] = split \ Split string at equal sign (=) 2swap ( offset offset length param len name len ) $setenv \ Set envvar nip \ throw away old string begin + 1+ \ calc new offset REPEAT 2drop drop \ cleanup ; get-nv : check-for-nvramrc ( -- ) use-nvramrc? IF s" Executing following code from nvramrc: " s" nvramrc" evaluate $cat nvramlog-write-string-cr s" (!) Executing code specified in nvramrc" type cr s" SLOF Setup = " type .enable-emit-counter s" nvramrc" evaluate ['] evaluate CATCH IF 2drop emit-counter 0 DO 8 emit LOOP s" (!) Code in nvramrc triggered exception. " 2dup nvramlog-write-string type cr 12 spaces s" Aborting nvramrc execution" 2dup nvramlog-write-string-cr type cr s" SLOF Setup = " type THEN .disable-emit-counter THEN ; : (nv-findalias) ( alias-ptr alias-len -- pos ) here 0 s" devalias " string-cat 3 pick 3 pick string-cat s" " string-cat s" nvramrc" evaluate 2swap find-substr nip nip ; : (nv-build-real-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len ) 2swap here 0 s" devalias " string-cat 2swap string-cat s" " string-cat 2swap string-cat 0d char-cat 0a char-cat ; : (nv-build-null-entry) ( name-ptr name-len dev-ptr dev-len -- str-ptr str-len ) 4drop here 0 ; : (nv-build-nvramrc) ( name-str name-len dev-str dev-len xt-build-entry -- ) 4 pick 4 pick (nv-findalias) dup s" nvramrc" evaluate nip >= IF drop execute s" nvramrc" evaluate string-cat dup allot s" nvramrc" $setenv ELSE \ if our alias is still defined in nvramrc 5 pick 5 pick 5 pick 5 pick 5 pick execute nip over + s" nvramrc" evaluate 3 pick string-at 2dup find-nextline string-at nip + alloc-mem 0 s" nvramrc" evaluate drop 3 pick string-cat rot >r >r >r execute r> r> 2swap string-cat ( mem, len ) ( R: alias-pos ) s" nvramrc" evaluate r> string-at 2dup find-nextline string-at string-cat 2dup s" nvramrc" $setenv free-mem THEN ; : $nvalias ( name-str name-len dev-str dev-len -- ) 4dup ['] (nv-build-real-entry) (nv-build-nvramrc) set-alias s" true" s" use-nvramrc?" $setenv (nvupdate) ; : nvalias ( "alias-name< >device-specifier<eol>" -- ) parse-word parse-word dup 0<> IF $nvalias ELSE 2drop 2drop cr " Usage: nvalias (""alias-name< >device-specifier<eol>"" -- )" type cr THEN ; : $nvunalias ( name-str name-len -- ) s" " ['] (nv-build-null-entry) (nv-build-nvramrc) (nvupdate) ; : nvunalias ( "alias-name< >" -- ) parse-word $nvunalias ; : diagnostic-mode? ( -- diag-switch? ) diag-switch? ; check-for-nvramrc 890 cp defer set-boot-device defer add-boot-device : qemu-read-bootlist ( -- ) 0 0 set-boot-device " boot-device" evaluate swap drop 0 <> IF EXIT THEN " qemu,boot-device" get-chosen not IF EXIT THEN 0 ?DO dup i + c@ CASE 0 OF ENDOF [char] a OF ENDOF [char] b OF ENDOF [char] c OF " disk" add-boot-device ENDOF [char] d OF " cdrom" add-boot-device ENDOF [char] n OF " net" add-boot-device ENDOF ENDCASE cr LOOP drop ; ' qemu-read-bootlist to read-bootlist 8a0 cp 0 VALUE debug-client-interface? VOCABULARY client-voc \ We store all client-interface callable words here. 6789 CONSTANT sc-exit 4711 CONSTANT sc-yield VARIABLE client-callback \ Address of client's callback function : client-data ciregs >r3 @ ; : nargs client-data la1+ l@ ; : nrets client-data la1+ la1+ l@ ; : client-data-to-stack client-data 3 la+ nargs 0 ?DO dup l@ swap la1+ LOOP drop ; : stack-to-client-data client-data nargs nrets + 2 + la+ nrets 0 ?DO tuck l! /l - LOOP drop ; : call-client ( args len client-entry -- ) >r ciregs >r7 ! ciregs >r6 ! client-entry-point @ ciregs >r5 ! cistack ciregs >r1 ! r> jump-client drop BEGIN client-data-to-stack client-data l@ zcount ALSO client-voc $find PREVIOUS dup 0= >r IF CATCH ?dup IF dup CASE sc-exit OF drop r> drop EXIT ENDOF sc-yield OF drop r> drop EXIT ENDOF ENDCASE THROW THEN stack-to-client-data ELSE cr type ." NOT FOUND" THEN r> ciregs >r3 ! ciregs >r4 @ jump-client UNTIL ; : flip-stack ( a1 ... an n -- an ... a1 ) ?dup IF 1 ?DO i roll LOOP THEN ; : (callback) ( "service-name<>" "arguments<cr>" -- ) client-callback @ \ client-callback points to the function prolog dup 8 + @ ciregs >r2 ! \ Set up the TOC pointer (???) @ call-client ; \ Resolve the function's address from the prolog ' (callback) to callback : (continue-client) s" " \ make call-client happy, client won't use the string anyways. ciregs >r4 @ call-client ; ' (continue-client) to continue-client : string-to-buffer ( str len buf len -- len' ) 2dup erase rot min dup >r move r> ; ALSO client-voc DEFINITIONS : exit sc-exit THROW ; : yield sc-yield THROW ; : test ( zstr -- missing? ) zcount debug-client-interface? IF ." ci: test " 2dup type cr THEN ALSO client-voc $find PREVIOUS IF drop FALSE ELSE 2drop TRUE THEN ; : finddevice ( zstr -- phandle ) zcount debug-client-interface? IF ." ci: finddevice " 2dup type cr THEN find-node dup 0= IF drop -1 THEN ; : getprop ( phandle zstr buf len -- len' ) >r >r zcount rot get-property 0= IF r> swap dup r> min swap >r move r> ELSE r> r> 2drop -1 THEN ; : getproplen ( phandle zstr -- len ) zcount rot get-property 0= IF nip ELSE -1 THEN ; : setprop ( phandle zstr buf len -- size|-1 ) dup >r \ save len encode-bytes ( phandle zstr prop-addr prop-len ) 2swap zcount rot ( prop-addr prop-len name-addr name-len phandle ) current-node @ >r \ save current node set-node \ change to specified node property \ set property r> set-node \ restore original node r> \ always return size, because we can not fail. ; : canon ( zstr buf len -- len' ) over >r move r> zcount nip ; : nextprop ( phandle zstr buf -- flag ) \ -1 invalid, 0 end, 1 ok >r zcount rot next-property IF r> zplace 1 ELSE r> drop 0 THEN ; : open ( zstr -- ihandle ) zcount debug-client-interface? IF ." ci: open " 2dup type cr THEN open-dev ; : close ( ihandle -- ) debug-client-interface? IF ." ci: close " dup . cr THEN close-dev ; : write ( ihandle str len -- len' ) rot s" write" rot ['] $call-method CATCH IF 2drop 3drop -1 THEN ; : read ( ihandle str len -- len' ) rot s" read" rot ['] $call-method CATCH IF 2drop 3drop -1 THEN ; : seek ( ihandle hi lo -- status ) swap rot s" seek" rot ['] $call-method CATCH IF 2drop 3drop -1 THEN ; : claim ( addr len align -- base ) debug-client-interface? IF ." ci: claim " .s cr THEN dup IF rot drop ['] claim CATCH IF 2drop -1 THEN ELSE ['] claim CATCH IF 3drop -1 THEN THEN ; : release ( addr len -- ) debug-client-interface? IF ." ci: release " .s cr THEN release ; : instance-to-package ( ihandle -- phandle ) ihandle>phandle ; : package-to-path ( phandle buf len -- len' ) 2>r node>path 2r> string-to-buffer ; : instance-to-path ( ihandle buf len -- len' ) 2>r instance>path 2r> string-to-buffer ; : instance-to-interposed-path ( ihandle buf len -- len' ) 2>r instance>qpath 2r> string-to-buffer ; : call-method ( str ihandle arg ... arg -- result return ... return ) nargs flip-stack zcount debug-client-interface? IF ." ci: call-method " 2dup type cr THEN rot ['] $call-method CATCH nrets 0= IF drop ELSE \ if called with 0 return args do not return the catch result dup IF nrets 1 ?DO -444 LOOP THEN nrets flip-stack THEN ; : test-method ( phandle str -- missing? ) zcount debug-client-interface? IF ." ci: test-method " 2dup type cr THEN rot find-method dup IF nip THEN 0= ; : milliseconds milliseconds ; : start-cpu ( phandle addr r3 -- ) >r >r s" reg" rot get-property 0= IF drop l@ ELSE true ABORT" start-cpu called with invalid phandle" THEN r> r> of-start-cpu drop ; : quiesce ( -- ) debug-client-interface? IF ." ci: quiesce" cr THEN quiesce ; : interpret ( ... zstr -- result ... ) zcount debug-client-interface? IF ." ci: interpret " 2dup type cr THEN ['] evaluate CATCH ; : set-callback ( newfunc -- oldfunc ) client-callback @ swap client-callback ! ; PREVIOUS DEFINITIONS false value elf-claim? 0 value last-claim 0 VALUE cur-brk : elf-claim-segment ( addr size -- errorcode ) 2dup elf-claim? IF >r here last-claim , to last-claim \ Setup ptr to last claim dup , r> dup , ( addr size ) 0 ['] claim CATCH IF ." Memory for ELF file is already in use!" cr true ABORT" Memory for ELF file already in use " THEN drop ELSE 2drop THEN + to cur-brk 0 ; : elf-load-claim ( file-addr destaddr -- claim-list entry imagetype ) true to elf-claim? 0 to last-claim dup -1 = IF \ If destaddr == -1 then load to addr from ELF header drop ['] elf-load-file CATCH IF false to elf-claim? ABORT THEN ELSE ['] elf-load-file-to-addr CATCH IF false to elf-claim? ABORT THEN THEN >r last-claim swap false to elf-claim? r> ; : elf-release ( claim-list -- ) BEGIN dup cell+ ( claim-list claim-list-addr ) dup @ swap cell+ @ ( claim-list claim-list-addr claim-list-sz ) release ( claim-list ) @ dup 0= ( Next-element ) UNTIL drop ; CREATE bootdevice 2 cells allot bootdevice 2 cells erase CREATE bootargs 2 cells allot bootargs 2 cells erase CREATE load-list 2 cells allot load-list 2 cells erase : start-elf ( arg len entry -- ) msr@ 7fffffffffffffff and 2000 or ciregs >srr1 ! call-client ; : start-elf64 ( arg len entry -- ) msr@ 2000 or ciregs >srr1 ! dup 8 + @ ciregs >r2 ! @ call-client \ entry point is pointer to .opd ; : set-bootpath s" disk" find-alias dup IF ELSE drop s" boot-device" evaluate find-alias THEN dup IF strdup ELSE 0 THEN encode-string s" bootpath" set-chosen ; : set-netbootpath s" net" find-alias ?dup IF strdup encode-string s" bootpath" set-chosen THEN ; : set-bootargs skipws 0 parse dup 0= IF 2drop s" boot-file" evaluate THEN encode-string s" bootargs" set-chosen ; : .(client-exec) ( arg len -- rc ) s" snk" romfs-lookup 0<> IF paflof-start f00000 + elf-load-file-to-addr drop start-elf64 client-data ELSE 2drop false THEN ; ' .(client-exec) to (client-exec) : .client-exec ( arg len -- rc ) set-bootargs (client-exec) ; ' .client-exec to client-exec : netflash ( -- rc ) s" netflash 2000000 " (parse-line) $cat set-netbootpath client-exec ; : netsave ( "addr len {filename}[,params]" -- rc ) (parse-line) dup 0> IF s" netsave " 2swap $cat set-netbootpath client-exec ELSE cr ." Usage: netsave addr len [bootp|dhcp,]filename[,siaddr][,ciaddr][,giaddr][,bootp-retries][,tftp-retries][,use_ci]" cr 2drop THEN ; : ping ( "{device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]}" -- ) my-self >r current-node @ >r \ Save my-self (parse-line) open-dev dup IF dup to my-self dup ihandle>phandle set-node s" ping" rot ['] $call-method CATCH IF cr ." Not a pingable device" cr 3drop THEN ELSE cr ." Usage: ping device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout]" cr drop THEN r> set-node r> to my-self \ Restore my-self ; 8a8 cp : enable-framebuffer-output ( -- ) s" screen" find-alias ?dup IF open-dev close-node s" display-emit" $find IF to emit ELSE 2drop THEN THEN ; enable-framebuffer-output 8b0 cp usb-scan 8c0 cp romfs-base 400000 0 ' claim CATCH IF ." claim failed!" cr 2drop THEN drop 8d0 cp : set-default-console s" linux,stdout-path" get-chosen IF decode-string ." Using default console: " 2dup type cr io 2drop ELSE ." No console specified " " screen" find-alias dup IF nip THEN " keyboard" find-alias dup IF nip THEN AND IF ." using screen & keyboard" cr " screen" output " keyboard" input ELSE " hvterm" find-alias IF drop ." using hvterm" cr " hvterm" io ELSE ." and no default found" cr THEN THEN THEN ; set-default-console 8e0 cp 0 VALUE direct-ram-boot-base 0 VALUE direct-ram-boot-size CREATE boot-opd 10 ALLOT : (boot-ram) direct-ram-boot-size 0<> IF ." Booting from memory..." cr direct-ram-boot-base boot-opd ! 0 boot-opd 8 + ! s" boot-opd to go-entry" evaluate s" true state-valid ! " evaluate s" disable-watchdog go-64" evaluate THEN ; 8e8 cp : check-boot-from-ram s" qemu,boot-kernel" get-chosen IF decode-int -rot decode-int -rot ( n1 n2 p s ) decode-int -rot decode-int -rot ( n1 n2 n3 n4 p s ) 2drop swap 20 << or to direct-ram-boot-size swap 20 << or to direct-ram-boot-base ." Detected RAM kernel at " direct-ram-boot-base . ." (" direct-ram-boot-size . ." bytes) " s" boot-command" $create " (boot-ram)" env-string THEN ; check-boot-from-ram 8ff cp : (boot) ( -- ) s" Executing following boot-command: " boot-command $cat nvramlog-write-string-cr s" boot-command" evaluate \ get boot command ['] evaluate catch ?dup IF \ and execute it ." boot attempt returned: " abort"-str @ count type cr nip nip \ drop string from 1st evaluate throw THEN ; : (function-key) ( -- n ) key? IF key CASE 50 OF 1 ENDOF 7e OF 1 ENDOF dup OF 0 ENDOF ENDCASE THEN ; : (esc-sequence) ( -- n ) key? IF key CASE 4f OF (function-key) ENDOF 5b OF key key drop (function-key) ENDOF dup OF 0 ENDOF ENDCASE THEN ; : (s-pressed) ( -- ) s" An 's' has been pressed. Entering Open Firmware Prompt" nvramlog-write-string-cr ; : (boot?) ( -- ) of-prompt? not auto-boot? and IF (boot) THEN ; false VALUE (sms-loaded?) false value (sms-available?) s" sms.fs" romfs-lookup IF true to (sms-available?) drop THEN (sms-available?) [IF] s" /packages" find-device new-device s" sms" device-name : open true ; : close ; finish-device device-end \ leave /packages : sms-init-nvram ( -- ) nvram-partition-type-sms get-nvram-partition IF cr ." Could not find SMS partition in NVRAM - " nvram-partition-type-sms s" SMS" d# 1024 new-nvram-partition ABORT" Failed to create SMS NVRAM partition" 2dup erase-nvram-partition drop 2dup s" lang" s" 1" internal-set-env drop 2dup s" tftp-retries" s" 5" internal-set-env drop 2dup s" tftp-blocksize" s" 512" internal-set-env drop 2dup s" bootp-retries" s" 255" internal-set-env drop 2dup s" client" s" 000.000.000.000" internal-set-env drop 2dup s" server" s" 000.000.000.000" internal-set-env drop 2dup s" gateway" s" 000.000.000.000" internal-set-env drop 2dup s" netmask" s" 255.255.255.000" internal-set-env drop 2dup s" net-protocol" s" 0" internal-set-env drop 2dup s" net-flags" s" 0" internal-set-env drop 2dup s" net-device" s" 0" internal-set-env drop 2dup s" net-client-name" s" " internal-set-env drop 2dup s" scsi-spinup" s" 6" internal-set-env drop 2dup s" scsi-id-0" s" 7" internal-set-env drop 2dup s" scsi-id-1" s" 7" internal-set-env drop 2dup s" scsi-id-2" s" 7" internal-set-env drop 2dup s" scsi-id-3" s" 7" internal-set-env drop ." created" cr THEN s" sms-nvram-partition" $2constant ; sms-init-nvram : sms-add-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-add-env drop ; : sms-set-env ( "name" "value" -- ) sms-nvram-partition 2rot 2rot internal-set-env drop ; : sms-get-env ( "name" -- "value" TRUE | FALSE) sms-nvram-partition 2swap internal-get-env ; : sms-get-net-device ( -- n ) s" net-device" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ; : sms-set-net-device ( n -- ) (.d) s" net-device" 2swap sms-set-env ; : sms-get-net-flags ( -- n ) s" net-flags" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ; : sms-set-net-flags ( n -- ) (.d) s" net-flags" 2swap sms-set-env ; : sms-get-net-protocol ( -- n ) s" net-protocol" sms-get-env IF $dnumber IF 0 THEN ELSE 0 THEN ; : sms-set-net-protocol ( n -- ) (.d) s" net-protocol" 2swap sms-set-env ; : sms-get-lang ( -- n ) s" lang" sms-get-env IF $dnumber IF 1 THEN ELSE 1 THEN ; : sms-set-lang ( n -- ) (.d) s" lang" 2swap sms-set-env ; : sms-get-bootp-retries ( -- n ) s" bootp-retries" sms-get-env IF $dnumber IF 255 THEN ELSE 255 THEN ; : sms-set-bootp-retries ( n -- ) (.d) s" bootp-retries" 2swap sms-set-env ; : sms-get-tftp-retries ( -- n ) s" tftp-retries" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ; : sms-set-tftp-retries ( n -- ) (.d) s" tftp-retries" 2swap sms-set-env ; : sms-get-tftp-blocksize ( -- n ) s" tftp-blocksize" sms-get-env IF $dnumber IF 5 THEN ELSE 5 THEN ; : sms-set-tftp-blocksize ( n -- ) (.d) s" tftp-blocksize" 2swap sms-set-env ; : sms-get-client ( -- FALSE | n1 n2 n3 n4 TRUE ) s" client" sms-get-env IF (ipaddr) ELSE false THEN ; : sms-set-client ( n1 n2 n3 n4 -- ) (ipformat) s" client" 2swap sms-set-env ; : sms-get-server ( -- FALSE | n1 n2 n3 n4 TRUE ) s" server" sms-get-env IF (ipaddr) ELSE false THEN ; : sms-set-server ( n1 n2 n3 n4 -- ) (ipformat) s" server" 2swap sms-set-env ; : sms-get-gateway ( -- FALSE | n1 n2 n3 n4 TRUE ) s" gateway" sms-get-env IF (ipaddr) ELSE false THEN ; : sms-set-gateway ( n1 n2 n3 n4 -- ) (ipformat) s" gateway" 2swap sms-set-env ; : sms-get-subnet ( -- FALSE | n1 n2 n3 n4 TRUE ) s" netmask" sms-get-env IF (ipaddr) ELSE false THEN ; : sms-set-subnet ( n1 n2 n3 n4 -- ) (ipformat) s" netmask" 2swap sms-set-env ; : sms-get-client-name ( -- FALSE | addr len TRUE ) s" net-client-name" sms-get-env ; : sms-set-client-name ( addr len -- ) s" net-client-name" 2swap sms-set-env ; : sms-get-scsi-spinup ( -- n ) s" scsi-spinup" sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ; : sms-set-scsi-spinup ( n -- ) (.d) s" scsi-spinup" 2swap sms-set-env ; : sms-get-scsi-id ( n -- id ) s" scsi-id-" rot (.) $cat sms-get-env IF $dnumber IF 6 THEN ELSE 6 THEN ; : sms-set-scsi-id ( id n -- ) swap (.d) rot s" scsi-id-" rot (.) $cat sms-set-env ; : sms-get-net-boot-file ( -- addr len ) s" net" sms-get-net-device (.) $cat s" :dhcp," $cat sms-get-server IF (ipformat) $cat THEN s" ," $cat sms-get-client-name IF $cat THEN s" ," $cat sms-get-client IF (ipformat) $cat THEN s" ," $cat sms-get-gateway IF (ipformat) $cat THEN s" ," $cat sms-get-bootp-retries dup ff <> IF (.) $cat ELSE drop THEN s" ," $cat sms-get-tftp-retries (.) $cat dup IF strdup ( s" :" 2swap $cat strdup ) THEN ; ' sms-get-net-boot-file to furnish-boot-file : $sms-node s" /packages/sms" ; : (sms-init-package) ( -- true|false ) (sms-loaded?) ?dup IF EXIT THEN $sms-node ['] find-device catch IF 2drop false EXIT THEN s" sms.fs" [COMPILE] included device-end true dup to (sms-loaded?) ; : (sms-evaluate) ( addr len -- ) (sms-init-package) not IF cr ." SMS is not available." cr 2drop exit THEN s" Entering SMS ..." type disable-watchdog reset-dual-emit 2>r $sms-node find-device 2r> evaluate device-end vpd-boot-import ; : sms-start ( -- ) s" sms-start" (sms-evaluate) ; : sms-fru-replacement ( -- ) s" sms-fru-replacement" (sms-evaluate) ; [ELSE] : sms-start ( -- ) cr ." SMS is not available." cr ; : sms-fru-replacement ( -- ) cr ." SMS FRU replacement is not available." cr ; [THEN] TRUE VALUE use-load-watchdog? : start-it ( -- ) key? IF key CASE [char] s OF (s-pressed) ENDOF 1b OF (esc-sequence) CASE 1 OF console-clean-fifo sms-start (boot) ENDOF dup OF (boot?) ENDOF ENDCASE ENDOF dup OF (boot?) ENDOF ENDCASE ELSE (boot?) THEN disable-watchdog FALSE to use-load-watchdog? .banner ; ." " \ Clear last checkpoint 0 VALUE load-size 0 VALUE go-entry VARIABLE state-valid false state-valid ! CREATE go-args 2 cells allot go-args 2 cells erase : $bootargs bootargs 2@ ?dup IF ELSE s" diagnostic-mode?" evaluate and IF s" diag-file" evaluate ELSE s" boot-file" evaluate THEN THEN ; : $bootdev ( -- device-name len ) bootdevice 2@ dup IF s" " $cat THEN s" diagnostic-mode?" evaluate IF s" diag-device" evaluate ELSE s" boot-device" evaluate THEN $cat \ prepend bootdevice setting from vpd-bootlist strdup ?dup 0= IF disable-watchdog drop true ABORT" No boot device!" THEN ; : set-boot-args ( str len -- ) dup IF strdup ELSE nip dup THEN bootargs 2! ; : (set-boot-device) ( str len -- ) ?dup IF 1+ strdup 1- ELSE drop 0 0 THEN bootdevice 2! ; ' (set-boot-device) to set-boot-device : (add-boot-device) ( str len -- ) \ Concatenate " str" to "bootdevice" bootdevice 2@ ?dup IF $cat-space ELSE drop THEN set-boot-device ; ' (add-boot-device) to add-boot-device 0 value claim-list : no-go ( -- ) -64 boot-exception-handler ABORT ; defer go ( -- ) : go-32 ( -- ) state-valid @ IF 0 ciregs >r3 ! 0 ciregs >r4 ! go-args 2@ go-entry start-elf client-data claim-list elf-release 0 to claim-list THEN -6d boot-exception-handler ABORT ; : go-64 ( -- ) state-valid @ IF 0 ciregs >r3 ! 0 ciregs >r4 ! go-args 2@ go-entry start-elf64 client-data claim-list elf-release 0 to claim-list THEN -6d boot-exception-handler ABORT ; : load-elf-init ( arg len file-addr -- success ) false state-valid ! \ Not valid anymore ... claim-list IF \ Release claimed mem claim-list elf-release 0 to claim-list \ from last load THEN true swap -1 ( arg len true file-addr -1 ) elf-load-claim ( arg len true claim-list entry elftype ) CASE 1 OF ['] go-32 ENDOF ( arg len true claim-list entry go ) 2 OF ['] go-64 ENDOF ( arg len true claim-list entry go ) dup OF ['] no-go to go 2drop 3drop false EXIT ENDOF ( false ) ENDCASE to go to go-entry to claim-list dup state-valid ! -rot 2 pick IF go-args 2! ELSE 2drop THEN ; : init-program ( -- ) $bootargs LOAD-BASE ['] load-elf-init CATCH ?dup IF boot-exception-handler 2drop 2drop false \ Could not claim ELSE IF 0 ciregs 2dup >r3 ! >r4 ! \ Valid (ELF ) Image THEN THEN ; : do-load ( devstr len -- img-size ) \ Device method wrapper use-load-watchdog? IF 4ec set-watchdog THEN my-self >r current-node @ >r \ Save my-self ." Trying to load: " $bootargs type ." from: " 2dup type ." ... " 2dup open-dev dup IF dup to my-self dup ihandle>phandle set-node -rot ( ihandle devstr len ) my-args nip 0= IF 2dup 1- + c@ [char] : <> IF \ Add : to device path if missing 1+ strdup 2dup 1- + [char] : swap c! THEN THEN encode-string s" bootpath" set-chosen $bootargs encode-string s" bootargs" set-chosen LOAD-BASE s" load" 3 pick ['] $call-method CATCH IF -67 boot-exception-handler 3drop drop false ELSE dup 0> IF init-program ELSE false state-valid ! drop 0 \ Could not load THEN THEN swap close-dev device-end dup to load-size ELSE -68 boot-exception-handler 3drop false THEN r> set-node r> to my-self \ Restore my-self ; : parse-load ( "{devlist}" -- success ) \ Parse-execute boot-device list cr BEGIN parse-word dup WHILE ( de-alias ) do-load dup 0< IF drop 0 THEN IF state-valid @ IF ." Successfully loaded" cr THEN true 0d parse strdup load-list 2! EXIT THEN REPEAT 2drop 0 0 load-list 2! false ; : load ( "{params}<eol>"} -- success ) \ Client interface to load parse-word 0d parse -leading 2swap ?dup IF de-alias set-boot-device ELSE drop THEN set-boot-args s" parse-load " $bootdev $cat strdup evaluate ; : load-next ( -- success ) \ Continue after go failed load-list 2@ ?dup IF s" parse-load " 2swap $cat strdup evaluate ELSE drop false THEN ; : noload false ; ' no-go to go : (go-and-catch) ( -- ) load-base c@ 5c = load-base 1+ c@ 20 = AND IF load-size alloc-mem ( allocated-addr ) ?dup 0= IF ." alloc-mem failed." cr EXIT THEN load-size >r >r ( R: allocate-addr load-size ) load-base r@ load-size move \ Move away from load-base r@ load-size evaluate \ Run the script r> r> free-mem EXIT THEN ['] go behavior CATCH IF -69 boot-exception-handler THEN ; read-bootlist : boot load 0= IF -65 boot-exception-handler EXIT THEN disable-watchdog (go-and-catch) BEGIN load-next WHILE disable-watchdog (go-and-catch) REPEAT .banner ; : load load 0= IF -65 boot-exception-handler THEN ; : yaboot ." Use 'boot disk' instead " ; : netboot ( -- rc ) ." Use 'boot net' instead " ; : netboot-arg ( arg-string -- rc ) s" boot net " 2swap $cat (parse-line) $cat evaluate ; : netload ( -- rc ) (parse-line) load-base >r FLASH-LOAD-BASE to load-base s" load net:" strdup 2swap $cat strdup evaluate r> to load-base load-size ; : neteval ( -- ) FLASH-LOAD-BASE netload evaluate ; cr .( Welcome to Open Firmware) cr cr .( Copyright (c) char ) emit .( 2004, 2011 IBM Corporation All rights reserved.) cr .( This program and the accompanying materials are made available) cr .( under the terms of the BSD License available at) cr .( http://www.opensource.org/licenses/bsd-license.php) cr cr ' start-it CATCH drop cr ." Ready!" ��xP��PGCC: (GNU) 4.4.5.symtab.strtab.shstrtab.rela.slof.loader.rela.text.rela.opd.rela.got.rela.data.comment.branch_lt.bss L�@�2��-�0=8=��8<hG��BMx@Q�`�`FpLR�=� W0��`��k��p�� X�� ` ��00��\��D;�& 5��C��a��w=,�=�� 8��`��@��L � ��hD#��3��8��@@�x�O��$W��(h8�u�X��H$� ��p\��J��9�� 98/��F� XKl��`��9��(��l� 0�� 1 ��P� �#�X6��E�8�M�P ^ A o�y�(D��h(� a��8(��<��JT�=`�� h��p`% p9 ��B�P<I�0�] ��g�t +��4��t� ��JT�J��<`�J��`h�� n! ��P$�� 6J$A=DQ ��T<�^� �i��q � }=$� ��=�� @|��x0��@4�� H'��$/��7��?�8tS�P�b�H<k9�tJ�|� ��X4��d��XD��H�engineprintfvsprintfio_printhex16the_data_stackget_partitionincrease_nvram_partition_sizevirtio_get_vring_descbootmsg_warningbootmsg_nvupdatep9_clunkmemmovenvram_write_qwordvirtio_vring_sizecall_clientreset_nvramadd_envvirtioblk_shutdownhash_tablethe_client_stackmemcpyelf_forth_claimputsp9_statp9_transactiontolowernvram_read_dwordromfs_lookupvsnprintfvirtio_9p_initp9_reg_transportthe_pocketsstrtoul_slof_textelf_load_filehv_logical_ci_loadelf_load_file_to_addrwriteLogBytep9_readclear_nvram_partitionc_romfs_lookupdelete_nvram_partitionfree_nvram_bufferhv_logical_ci_storeclient_entry_pointwrite_start_OFio_putcharnvram_read_qwordnvram_debugvirtio_9p_loadvirtio_get_vring_usedepapr_ima_sizevirtioblk_readthe_comp_bufferget_nvram_bufferstrncmpvirtio_9p_shutdownvirtioblk_initstrncpynvram_write_bytethe_return_stackp9_attachvirtio_queue_notifynvram_read_wordepapr_magicnvram_read_bytep9_openbootmsg_cp.hv_hascharbootmsg_checklevelelf_load_segments32elf_load_segments64virtio_get_configthe_exception_framethe_heapmemsetnew_nvram_partitionfdt_start.call_client_binary_OF_fsi_startvirtio_reset_devicethe_memelf_get_base_addr32rphv_hascharhv_send_crqGET_WRNG_LVLhv_putcharreset_buffers__virtio_read_config_binary_OF_fsi_endspnvram_write_dwordhv_getcharbootmsg_debugcpdpprint_msgp9_versionset_envstdout_databootmsg_errorthe_tibbootmsg_setlevelromfs_basenvram_write_word.client_entry_pointerase_nvramwriteLogByte_wrappervirtio_get_qsizevirtio_set_statusdel_envstrlentoupperp9_walkget_envelf_get_base_addr64elf_relocate64asm_coutio_printhv_genericvfprintfthe_client_framevirtio_set_guest_featuresvirtio_get_vring_availwipe_nvramnvramlog_printfWWqqJJ&=*=:*>*&S&,��* . 96 9H�,�?�?�?(?? ?:?V?z? ~?�?b?j?0�?�?8�?�?@�?�?H? ?P*?2?XR?Z?`z?~?h�?�?h�?�?p�? ?x *? .?� V? Z?� �? �? �? ? 2? Z? �? �? �?.? V?�?�?�??2?R?z?~? �? �?�? �? ? "?� J? R?� z? ~? �?� �? �? �?� �? �? &?Z?�?�?�?*?^?�?�?�??J?n?�?�?�??:?^?�?�?�?F?�?�??:?v?�?�? �?? :? �?�? �? .?R? z? �? �?�?~??�?F?�?�?��?" 6?�V?|a �?�g �?�^ �?� "?@� R?p_ �?�y �?��U �??L� b?|B �?�; �?�M �?0 B?hn z?�h �?�p �?O < N?Z?�^?�l+ �?�?��?��- �?K ?,I B?T# j?|9 �?�E �?�4 ? *?Hv ^?�R �?�C �?� �? ,> B? x& �? �4 �? �, �?!(4 !:?!P, !f?!�4 !�?!�, !�?!�, !�?"r ".?"Df "b?"x "�?"� "�?#0 #HU #` #�?$>?$p $� $�� $�: $�?% %,U %T| %�y %�?%� &U &0 &LU &x &�?&� &�U 'x 'F?'l0 '�?'� '�U ( (0U (\l (�?(�2 (�?(�?)"?)B?)V?)~?)�?)�?)�?)�?)�?*&?*>?*R?*v?*�?*�?+?+?+:?+^?+�?+�?+�?+�?,"?,J?,b?,v?,�?,�?,�?,�?-?-B?-j?-�?-�?-�?. ?.2?.Z?.�?.�?.�?.�?/?/2?/Z?/n?/� /�?/� /�?0 0?0~?0�?0�?0�V 3�?�3�z 3�z 6h8 78 708 7D8 7�. 7�$ 8t$ 9T$ 9�8 :8 :(8 :D8 :`8 :|8 :�8 :�8 :�8 :�8 ;8 ;$8 ;@8 ;\8 ;x8 ;�8 ;�8 <�8 <� <�8 <�8 <�8 <�8 <�8 <�8 <�8 <�8 <� =8 =� =8 =8 =(j =0` =<j=L` =Xj=l` >(} >@\ ?Q ?DP @T} @pQ @�~ @�\ @�P B� B�U EB?�ED E�?�E� E�?�H� H�U I� I� I�?�I�y I� I� J(N J:��J>��J^��Jb��J~��J��L�?�L� Mv M`� Mpv QDR Qdv Qx Q�� Q�< Q�?�R�H SF?�SH S�?�S� Tw TZ TXw Thw Tx� T�� T�w U?�U?UhR U�c U�k U�?U� U� VG V<{ Vl V�L V�/ V�?0V� W?W W2? W< WL W\ W�?W� W�?(W� Xw X$Z X.?�Xf?�X�w X�w X�� X�� X�w X�?8Y' Y�v Y� Y�� Y�< Z�H [�?@[�?@[�U [�U [�?H\J?@\N?H]�U ]�D ]�?P]� ^<b ^F?H^�! ^�?@_�b _�?H`�! `�?@aH a�b a�?Hb! b?@b�b b�?Hc�?Xc�A d?@dx d�?@d�! f0y fF?@fxb f~?Hf�! g,y g<y g�b g�?Hhy h4y hH hXy hpy h�y h� h�y i! i@b iF?HiJ?`i�y i�y i� jy j! jR?@j�?hj�A j�?pk?pk>?pkj?pk�?pk�?pk�?pl ?plB?plr?pl�?pm�?pm�?pn�?po2?po� (o� (p?pp$y pr?pp�?pp�?pq?pq2?pq� (q�?xq� �rf?psPA tl t�?pu2?puR?puX �u�?pwR?pw^?pw�?pw� xB?pxP �x� y?py0 �yL �y� z zv?pz�?�z� �z�?�z� �{v?�{x� {~?�{� �{� �|K |HK |�?�}K }PK }ty }�A ~� x~�y ~�y E ,y TE pE |y �?��U �(K �dK ��y ��A ��| ��y ��A �� x� �� @ �PK �xK ��E ��y ��E �E �43 �`E �� D x�X ��xK ��@ ��K �E �43 �Dt ��% �"?��H� ��?��y ��6 ��?��6 �0% �H6 ��?��?��` (�) �R?��$) �4y ��y �� @�$ (�P @�v?�� @�� (��?�� @� (�V?�� @�� (��s&��3��X&��3�&�3�&P� 3�0&��83�H&4P�P3�`&4��h3�x&5��3��&;��3��&<p��3��&=��3�&? �3� &?��(3�8&Ap�@3�P&A��X3�h&E��p3��&Gp��3��&I0��3��&Ip��3��&J��3��&J��3��&K@�3�&K��3�(&K��03�@&L@�H3�X&L��`3�p&L��x3��&N ��3��&N��3��&Q��3��&R@��3��&R��3�&V�3�&V`� 3�0&WP�83�H&Y��P3�`&Y��h3�x&Z0��3��&\ ��3��&]`��3��&_`��3��&`��3��&d`��3�&e�3� &g �(3�8&h��@3�P&i�X3�h&i0�p3��&i`��3��&i��3��&i��3��&i��3��&j��3��&j �3�&jp�3�(&j��03�@&k`�H3�X&k��`3�p&l0�x3��&l��3��&m`��3��&mp��3��&o��3��&p��3�&r�3�&t�� 3�0&v��83�H&w��P3�`&x@�h3�x&y��3��&z��3��&|��3��&}��3��&��3��&��3�&��3� &��(3�8&��@3�P&� �X3�h&�`�p3��&��3��&�`��3��&��3��&��3��&��3��&�p�3�&��3�(&��03�@&��H3�X&��`3�p&�`�x3��&��&0��i&�� &��]&��&��o&��(&��S&��&��&��?&��7&��&��W&�q&�J&�=&� &� F&�(&�0&�8&�@&�H&C��P& �X&P�h&h�p&��x&��&��(��&��&��&��&��&��&0��&H��&0��&��0��e&��&`��&p��&x��&��&��X�&��&�� &��(&��p�0m&�8m&�@&��H&��P&��X&�h��&��&��&��&��&��& ��&h�&��&8�&�� &��(& P�0&x�8& p�@& ��H& ��P& ��X&��`& ��h& ��p&��x& ��& ��&H��& ��&8��&`��&x��&��&��&��&��&��&��&�&x�&��&�� &��0&8�8&`�@&��H&��X&��h& ��&��&��&��& ��&��& ��& ��& ��& T��&�&8�&�(&��0&��@& P�H&�X& 0�`&0�p&��x&P��&��&p��&��&`��&x��&��&��&��& ��&�&�&x� &��(&��0&��@& ��H&0�P&H�X&��`&�p&x�x&��&��&��&��&��&H��&��&��&��&��&(��& ��&8�&��&8�&`�&�� &��(&X�0&p�8&��H&0�P&`�X&��`&��p&`�x& ��&��& ��&x��&`��&��&��& ��&`��&��&8��&8��& ��&`�&x�&�� &��(&�0&��@&��H&�X&x�`&�p& 8�x& ��&��&��&(��& ��&@��& p��&��&@��& P��&@��& ��&��&@��&8�&�&@�&@�& � &��0&�@&H�P&��X&(�`&��h&x�p&@�x&��&��& ��& ��& `��&0��& ��&��&��&��&��&��&��(&0�8&��H& ��P&��`&��h&X�p&@�x&��&��&@��& ��&��& ��&��&(��&��& ��&(��&��&8��& ��& �&��&(�&(�&8� & ��(&(�0& ��8& ��@&(�H&��P& P�X&(�`& p�h& ��p&(�x&��& ��&@��& ��& ��&��&0��&��&��&��&`��&(��&��& ��&(�&��&@�&p�&�� &(�(& �0&x�@&��H& �P&��p&��&(��&��& ��&��&x��&��&@��&`��&��&��&��&�&��& 8� &(�(& ��0&(�8&�@&�P&0�X&h�`& �h&�x&��&x��&��&��&��& ��&��&��&h��& ��&��&X�&�� &x�(&`�8&x�@&��X& ,�`&�p&�x& ��& ��&(��&T��&��&-l��&��&��&x�&��&��&��(& ��0&`�8&H�@&��H&(�P&��X& ��`&x�h&��x&��&��&��& ��&��& ��&��&��&��&0��& ��&��&t��&�&��&X� &��0&@�8&@�@&x�H&(�P&(�X& �`& ��x&��&��&��&x��&x��&��&��& ��&��&��&��&��&�&��&0� &H�0& �8&��P&��`&P�p& ��x& ��&��&h��&��&`��&h��&��&��&��&��&��&��& �&��&��&�� &p�(& �0&(�H&��P&��X&��`& ��h&��p&�x& p��& ��&8��&��& P��& ��&��&��&��&��& ��&��&`��& ��& h�&��& P�&�� &��0& ��8& x�@&8�H&8�P& ��X&��`& ��h& P�p&��x&��&��&h��& ��&��&H��& ��&��&��&`��& ��&��&��&!`�&!`�&� & ��(&`�0&!��8&��H&��P&��`&H�h&@�p& 8�x&(��& ��& ��&��&#P��&��&#`��&��&$H��& ��&%��&��&H� &��(&`�0& ��8&��H&%��P&��`&!`�h&!`�p&�x& ��&%��& 8��& ��&`��&!��&��&��&��&H��& ��&��&%��&%��& 8�& �&%��&�� &&h�(& ��0&�8&%��@&&��H&�P&��X&&��`& ��h&%��p& �x&0��& ��&��& x��&&��&��&'0��& ��&h��&��&'`��& ��&'��&��&'��(&��8&'��P&��`&�x&��&(��&��&x��&��&x��& ��&H��&H��&(��&��&��& ��&)@�&)p�&)�� &(��(& �0&)��@&��H&)��P&�X&)��`&��p&)��x&*��& ��&*H��&��&*h��&��& ��& ��& ��&��& ��&*��&��&�� & �(&*��@&��H&x�P&H�X& �`&*��x&D��& (��&��&��&��&��& ��&��&��&+X��&��&+��&(�&+��&(�& �&��(&��8&H�H&$�P&+��h&,�p&+��&��&,��&(��&,8��&H��&��&x�&��&*X� &0�(&@�0&0�8& �@&��P&�`&,`�x&��&8��&��&X��& ��&p��&0��&,��&��&X��&x��&��&��&��& ��&8� &��0&X�8&�@& ��H&-�P&(�X&p�`&H�p& �x&P��&��&8��&��&`��&H��& ��&'P��&��&-8��& ��& ��&H�&-X�&�� & ��(&��0&��8& �@&-��P&��X&-��h&��p&(�x&��&��&@��& ��&��&8��&.��& ��&.��&��&.P��&@�& ��&.0�&x�&�� &)@�(&��0&��8&/�@&��H&x�P&��X&)@�`&��h&��p&x�x&��&��&��&��&)��&/��&(��& ��& ��&��&`��& ��&��&��&!`�&!`�&��&� &h�(& �0&/ �@&�P&/H�h&��p&��x&��&��& ��&��&H��&��& ��&/p��&��&h��&��& ��& �&`�&�� &��(&/��8&��@&/��H&0 �P&/��X& �`&0`�p&��x&/��&x��&@��&0��&8��&1��&(��&1`��&0p��& ��& ��&��&��& ��& ��& �& 8�&��& �� & p�(&�0& �8&1��P&��X&1��`&x�h&��x&��&x��&2��&��&��&��& ��& ��&��&��&��& ��&2��&��&x�&��&�� &��(&��0&��8& ��@&@�H&x�P&@�X&��`&��p&��x&x��&��&(��&x��&(��&-��&x��&��&��&��&��&��&��& ��&@�&@�&8�&8�&(� &(�(&3�0&!`�8&��@&��P&��X&��`&��p&4P�x&h& �&�&�&� &�¨& °&$8��&��& ��& ��&��&x��&8��&��&4��&��& ��&8� &�(&��0&��8&��@&4��H&��X&4��`&8�h&*�p&À&�È&�Ð& Ø&4�è&�ð&@ø& ��&8��&��&��& ��&��&8��&��& ��&`�&(�&5�&��(&!`�0&x�8&4��@&��H&�X&x�`&8�h&*�p& �x&6Ĉ&�Đ&8Ę&Ġ&-Ĩ&8İ& �ĸ&@��&$H��& 8��& ��&6X��&��&6p�&6��&6��& �&&X�0&��8&6��@& �H&7�X&��`&&h�h& ��p&+��x&%�ŀ&&�ň&Ő&��Ř&&�Š& �Ũ&%�Ű& Ÿ&7X��&��&��&��&��& ��&��&H�& �&7��(&��8&7��P&��X&7��h&��p&8(�x& ƀ&8HƐ&�Ƙ&8�Ơ&�ƨ& ư&8��&��&8��&��& ��&8��&��&8�&��&�� &H�(& �0&9�@&��H&��X&9`�`& �h&�ǀ&�ǈ&(ǐ&�ǘ&xǠ&xǨ&�ǰ&�Ǹ&��&6��&@��& ��&9h��&��&`�&)��&x�&��&)p� &��(&��8&x�@&��H&�P&)��X&x�`&4��h&)p�p&9�Ȁ&�Ȉ& Ȑ&9�Ƞ&�Ȩ&4�Ȱ&�ȸ& ��&: ��&��&:`��& ��&!��&��&��&��&��&�� & �(&:��8&��H&��X&l�`&:��p&��x&*xɀ&Ɉ&�ɐ&�ɘ& �ɠ& ɨ&:�ɸ&��& ��&��&��& ��& ��&;�&0�&; � &2��0&��8&��@&2��H& �P&;��`&��h&��p&�x&�ʀ&�ʈ& pʐ&�ʘ&ʠ&<(ʨ& �ʰ& ʸ&P��&��&<X��&(��&<X��&(��&<X��&(�& �&<H�&�(&9��@&��H&<h�X&��`&<��x&�ˀ&<�ː&-0˘&��&@��&��&��&��&X��& �&<��&��&=(� &�(&��0&=H�8&p�@&=(�H& ��P& �X&)0�h&��p&4��x& �̀& ̈&' ̘&�̠&=�̨&�̰& ̸&=��&��&)@��&��&6��& ��&��&��&=�� &��(&8��0&-�8&��@&8��H&4P�P&6��X& �`&6��p& ��x&>͠&>HͰ&�͸&>��&>`��&��&��&>��&��&>`��&�&4��&��&x�&��(&��0&��@&��H&8�P&>`�X& ��`& �h&�x&�΀&>�ΐ&�Θ&>�Π& Ψ&�θ&��&��& ��&*��&��&0��&��&��&>��&x�&� &*x�(& ��0& �8&?�H&��P&>��X&x�`& ��h& �p&?xπ&�ψ&?�ϐ&xϘ&�Ϩ&ϸ& ��&0��&��& 8��&>��&x��&��&*x�& ��& �&4@� &��(&x�0&�8&��H&4P�P& �X&?��h&��p&?��x&`Ѐ&.Ј&�И&Ш& а&@��&��&��&��&��&@(��& �&@�&�� &*��(&x�0&@�8&;�@&@��H&��X&`�`&��h&�p&��x&р& ш&0ѐ&�Ѡ&!`Ѩ&!`Ѱ&(Ѹ&��& ��&(��&:0��&��&(��&0��&8�& �&��&�� &x�(&x�0&��8&)@�@&'�H&-��P& �X&@��p&��x&xҀ&�҈&�Ҙ& �Ҡ& �Ҩ&�Ұ&=(Ҹ&��&@��&��&��&@��&��&@��&@�&=(�&�&:�&�� &=(�(&�0&A��8&B0�@&��H&(�P&8�X&Bp�`&(�h&x�p&(�x&-Ӏ&Ӑ&�Ә& Ӡ&B�Ӱ&�Ӹ&8��&��& ��& ��&X��&��&��&+��& �&C�&�� &4��(&��0& �8&(�H&�X&C8�p&��x&�Ԁ&8Ԉ&�Ԙ& �Ԡ&Ԩ&�԰&�Ը& ��&x��&��&��&��&4��&�&��&��&� &:��(&!`�0&!`�8&��@& ��H&H�X&��`&��h&h�p& �x&C�Ո&�Ր&�ՠ&$Hը& 8հ& ո&X��&��&C��& \��&C��&��&8�&D8� & �(&)��8&��@&��H& ��P&8��X&)��`& �h&DX�x&�ր&&hֈ& �֐&9�֘&%�֠&D�֨&E�ְ& ָ&��&��&��&��& ��& ��&F�&��&&h�&FX� &F��(& �0&F��H&��P&)`�`&��h&8��p& �x&8x׈&�א&:`ט&�נ& ר&F�׸&��&G(��&��& ��&G��&��&8��&>��& �&GH�&�� &G��(&��0& �8&Gx�H&�X&G��h&��x&9P؈&�ؐ&�ؠ&9`ب& ذ&H��&|��&H��&��&��&8��&-��&6��&��&8�&H�� &�0& �8&8�P&��X&I�h&��p&>��x& ـ&I`ِ&�٘&8�٠& �٨& ٰ&I��&��&=��&>��& ��&I��&-��&I��&��&(�&(� &(�(& 8�0&@�8& �@&J@�P&�`&<�x&�ڀ&X�& X�&��&9x� &��(&<(�0&�8&6��@&��H& ��P&8�X&H��`&��h&9x�p& �x&J`ۈ&�ې&Jxۘ&�۠& ۨ&4�۸&��&J��&D��&J��&��&J��&-� &J��0&��8&=(�@&�H&��P&K��X&p�`&=(�h& ��p& �x&�܈&�ܘ&Kpܨ&�ܰ&K�ܸ&=(��& ��& ��&K��&��&K��&��&<X�& ��& � &L �0&��8&L��@&L��H&��P&L��X&M�`& �h&��x&�݀&MP݈& �ݐ&ݘ&%�ݠ& ݨ&H��&��&��&��& ��&��&M��&�� &��(&`�0& �8&N�H&��P&��X&��h&��p& �x&NPވ&�ސ&xޘ&@ޠ&N�ި&(ް&�޸&@��&O ��&(��& ��& ��&��&=(��&�&N��&��&Nh�&@(� & �(&1P�8&��@&=(�H&�P&?(�X&B0�`&Nh�h&@(�p& �x&/�߈&�ߐ&>�ߘ&xߠ&ߨ&-߰&*x߸&��& ��&)��& ��&Ox��&��& ��&��& �&O��&�� & ��(&O��0&x�8&��H&��X&Ph�`&��p&��& ��&��& ��&x�&B0�&8�&��&P��&��&!`��&��&��&��&h�& �&Q(� &��(&8�0&Q��8&��H&8�P&-��X&Q8�`&H�p&��x& �&Q��&��&@�&��&(�&��& ��&R��&��&@��&R ��&(��&��& �&R��&��&@� &S�(&��0&��@&S0�H&.�P&(�X&SH�`& �h&4x�x&��&��& �& �&%x�&��&<(��&��&��&x��&��&6p��&.��&��&)��& �&Sh�&�� &`�(&��0&��8& �@&T(�P& (�X&T@�h&��p&8�x&4��& �&4��&��&��&��& �&Tp��&��&&h��& ��&H��&%��&D��&E��& �&&�� &��(&&��0&�8&0�@&��P&x�X&�`&��h&��p& ��x& ��&��& ��&�&��& ��&%��&&��& ��& ��&T��&��&��&��&*�&��&�&�� & ��(&U��0& ��8&U��@&�H&��P&��X&V �`&�h& �p&V(�&��&&h�&V��&��& �&V��&��&&h��& ��&��&%��&W��&E��& ��&Vx�&��&&h�&W`� &E��(& �0&W��@&��H&W��X&��`&X�h&��p& �x&W��&��&G��&>��& �&X(�&��&Xh��&��& ��&XX��&��&O��&��&x�&��(&��8&Ph�@&��P&��`&��h& �p&Xx�&��&��&��&�&Y�&Y ��&��&YX��&G��&9��& ��&Y`�&��&��&YX�&G�� &)��(& �0&6��@&��H&��P&)��X&=��`&)��h& �p&Y��&��&`�&4��&��&��&��& ��&p��&��&=��& ��& ��&8��&�&Y��(&.�0&��@&��H&(�P&(�X&(�`&��h&��p&@�x&��&@�&��&@�& �&��&��&0��&0��&X��&Z�&��&Z0� &��(&ZP�8&,��@&Zh�P&��X&��`&��h&B0�p&`�x&+��&��& ��& ��&(�&�&��&��& ��&=��&��&K��&=(�& ��& �&Z�� &�0&[�@&�P&,��`&��h&<X�p&��x& �&[@�&��&[��&@�&[��&(�&M��& ��&[��&��&x��&[0��&6��&��&\8�&T8�& � &Y�0&��8&\`�@&��H&\��P&��X&[��`& �h&\��x&��&\8�&S0�&.�& �&]�&��&&h��&��&$H��& ��&( ��&%��&x��&H��&��&��&� &��(&H��0&H�@&9x�H& �P&]`�`&��h&C��p& �x&=8�&��&[�&=(��& ��& ��&>��&��&x��&��&4��&��&��&��&��(&��0& �8&]��H&��P&8�X&��`&O �h& �p&^P�&��&��&8�&-��&^`�&H��&��&��& ��&_��&��&C��&��& �&h�&�� &�(&p�0& �8&_8�H&��P&x�X&��h&��x&Ph�&��&��& ��& �&P��&��&4��&��&P��& ��&@x�&��&B0�&x�&B0� &TP�(&��8& 8�@&h�H& ��P&4��X&��h&h�p& ��x&��& ��&_��&��&@�&x�&�&@��&_��&(��&��&��&R ��&(��& �&B �&��&�� &@�(&��0&(�8& �@&!P�P&��X&8�`&p�h& �p&`(�&��&��&@�&x�&@�&��&x�&(��& ��&(��&��& ��& ��&_��&��&@�&S�&��&��(&S0�0&.�8&(�@&S�H& �P&`p�`&��h&4��p&T8�x& �&>��&��&R��&��&4��&C��& ��&.@��&��&.P��&@��&$H��&x�&��&)��&��&(� &x�(&\��0&��@&x�H&�P&��X& ��`&)��h&H�x&��& �&S �&��&D(�&��&+��&��& ��&`��&��&U��&&��&�& ��&��&%��&�� &��(&&��0& ��8&8�@&%��H& �P&U��`&��h&��p&�x&4��&��&*��&��& ��&��&U��& ��&V ��&��&��&U��&��& ��&a�&��&(�&�� &x�(&�0&%��8&@�@& �H&U��X&��h&aP��&(��&FH��&��&&h��& ��&��&%��&W��&E��& ��&ap��&��&U��& ��&��&%��&��&8� &%��(& �0&W�@&��H&U�P&��X& �`&a��x&��&��&��& ��&%��& ��&Ep��&��&��& ��&��& ��&��& ��& �&b�&�(&8�8&��@&b0�H&��P& �X&b �h&��p&Xh�x&>��& ��&-(��&��&b`��&��& ��&bP��&��&bp��&��&��&��&�&Y� &[P�(&�0&YX�8&G��@&9��P& �X&b��h&8�p&M��&��&L��&��&M��& ��&X��&\��&c��&��&��&c��&Xh��&)��& �&0��&��&`� &+��(&��8&��@&��H& �P&cH�h&-��p&c`��&��&c��&x��&c��&.|��&c��&��&��& ��&B0��&`�&+��&��& �� & ��(&(�0&�@&��H&��P& �X&c��h&�x&d��&��&d0��&��&d��&��&\��&��&d@��& ��&d��&��&e�&@�&e�&(� &d��(& �0&e8�H&��P&x�X&d �`&6��h&��p&K��x&T8��& ��&K��&��&Lh��&��&[��&@��&eP��&(��&eP��& ��&Q��&��&@�&Q�� &(�(&Q��0& �8&e��H&��P&[��X&��`&d��h& �p&e��&��&&h��& ��& ��&%��&+��&��& ��&f ��&��&T8��& ��&fH��&��&x�&@�&`�&`� &�(&@�0&fX�8& ��@&6��H&(�P&6��X&��h&-�p&��x&(��&��&��& ��&(��&��& ��&g��&��&@��&x��&��&@��&_��&(��& ��&��&@��&.�&��(&@�0&4��8&.�@&(�H&��P& ��X&(�`& �h&g��x&��&8��&TP��& ��&8��&��&x��&@��&)@��&��&x��&��&)��&/��&(��& �&B`�&��&g�� &Bp�(& �0&PP�@&��H&`��P& ��X&�`& ��h&@�p&`��x&(��& ��&g��&��&x��&��&��&g��& ��&h(��&��&4��&S0��& &D�&�&U &&�(&0&��8& �@&-�H&%�P&8X&&�`& �h& p&h@�&��&��&$H�&��& �&h��&�&WH�&��&U�& ��&&%�&��&8&%� & (&h�8&�@&&hH&@P&i�X&(`& h&i�x&��&:P�&��&b`�&>��& �&=p�&�&i��&��&��&�&&Y&=� &(&YX0&G�8&9�H& P&jp`&h&H�x&��&��&j��&b`�&)��& �&j��&-��&YH�&��&V�&P&j�&.�&k(&�0&�8&�@&`H& P&+�`&p&k(�&�&L��&��&d��&@�&d��&(�&M�& �&\H�&��&L�&@&[�&(&[� & (&e8&�@&K�H&S0P&.X& `&kHp&�x&[�&S0�&.�& �&k��&��&x�&k8�&6��&��&[�&T8�& �&[�&�&eP&�&e & (&k�@&�H&9xP&��X& �`&�h&%�p&7hx& �&S8�&��&S0�& �&O�&��& ��&@�&@�&`8�&��&0��&O �&(&&�&4P &((&0&�@&4PH&�P&4PX&�`& h&A�x&��&`�&`�&@�&@�&0��&(�&0��&A��&(�&�&��&g��& �&6�&�&8&4�& &l8&�@&>�H&@P&4PX&x`&�h&(p&�x& ��& �&lH�&��&l��&��&��&�&��&m�& ��&��&%��& �&�&$H&� & (&m�8&�@&m�P&�X&&h`&)@h&@p& �x& ��&%��& ��&��&%��&V��& ��&��&%��&(�& �&F��&��&&h�& ��& &%� &�� &8 &%� &� (&W` 0& 8&/ H&� P&np h&� p&� x&� �& �&j� �&L� �& �&c �&Xh �&9� �& �&j� �&� �&n� �&� &�� &� (&�� 0& 8& @&o X&,� `&` p&� x&p �& �&\( �& �&dx �&� �&L� �&@ �&\` �&( �&\` �& �&o(&�&o8&!` & (&%�8&�@&`H&;�P& �X&�`&%�h&7hp& x&��&��&x�&�& �&oh�&��&(�&(�&��& ��&@�&B0�&@�&�& &m&� &m(&`0&�8&8@&�H&)�P&�X& `&M@p&�x&��&�&��&MP�& ��&H�&%��& ��&��&$H�&x�&@�&.P�&x�&@ &� &/ &( &( & (&>p 8&� @&o� X&� `&&h h& � p&� x&%� �&0 �&� �&- �&� �&F� �& �&E� �& �&o� �&� �&� �&�&&j�&\� &(&c0&Xh8&9�H& P&)�`&�h&ph�&,��&p��&��&@�&g�&(�&]��& �&p��&��&(�&(�&(�&B0&@&�& &ip(&�0&U8&8@& H&q`&�h&�p&��&�&o�&e��&�&j��&b`�&9��& �&qX�&,0�&qx�&�&q�&�& &q�(&�0&(8&B0@&@H&�P&@X&@`& h&r�x&��&x�&@�& ��&(�&��& ��& �&s�&,X�&q��&��&q��&!`& &N�&� &@(&l(0&(8&]�@& H&sX&�`&xh&0p&��&@�&B0�&(�&��&@�&4��& ��&�&0�&��&(�&��&4��& �&& &s�(&�0&x8&�@&H&�P&X& `&t@p&+�x&tX�&��&x�&0�&��&B0�&@�&4��& ��&�&0�&��&(&Q�&4�& �&(& 0&t�@&�H&oP&xX&�h&TPp&��&��& ��& �&t��&,�&\��&��&@�&@�&\��&(�&(�&\�& &`&� &�(&�0& �8& @&t�P&+�X&uh&+�p&u(�&+@�&u@�&+h�&uX�&*��&up�&+�&u��&*��&u��&*�&u�&*H&u�(&*t0&u�@&* H&vX&)�`&vp&)�x&v0�&)��&vH�&($�&v`�&)��&vx�&'��&v��&'��&v�&'�&v�&'| &v�0&'T8&v�H&' P&w`&&�h&w x&(��&w8�&(��&wP�&(t�&wp�&(P�&w��&)8�&w�&)&w�(&)\0&w�H&&�P&xp&%�x&x@�&$��&xh�&#��&x��&"��&x�&&�&x�8&%D@&yh&"<p&y8�&!��&yh�& ��&y��& ��&y�&"�&y�(&"�0&y�P&"�X&zp& `x&z8�&h�&zX�& ,�&zx�&@�&z��&��&z�&&z�0&�8&z�P&�X&{ x&��&{@�&L�&{h�&��&{��&4�&{�&�&{�8&x@&|X&@`&|(�&��&|H�&��&|h�&��&|��&`�&|�&@&|�0&�8&}X&�`&}(�&��&}P�&\�&}x�&(�&}��&&}�&�&}�(&80&}�@&�H&~X&�`&~p&�x&~0�&��&~H�&d�&~`�&��&~��&�&~��&P&~�& &~�8&�@&X&�`& x&��&@�&T�&��&��&`�&=(�&�&@�&N(�&��&(�&=(�& �& &�&� &`(&=(0&8&@@&=HH&�P&(X&=(`& �h& p&�x�&��&`�&=(�&�&@�&K��&��&(�&=(�& ��& �&��&��&� & &*� &%� & &�� 8&� @&+ H& P&�( `&� h&<X p&8 x& � �& �&�` �&� �&<X �&8 �&� �& �&�� &� �&� �& �& �&�!&�!&H!&�! &!(&�!8& �!@&�!H&%�!P&%�!X& �!`&�!h& �!p& !x&��!�&�!�&x!�&H!�& �!�&�!�&B0!�&�!�&�!�&�!�&%�!�&�!�&4P!�& �"&h"& �"& "&�"(&�"0&H"8& �"@& �"H&%�"P&%�"X& "`&�0"p&�"x&C�"�&� "�& "�&�P"�&�"�&`"�&`"�& �"�&�"�&�"�&�"�&�"�&�"�&#&%�#&�#&�# & �#(& �#0&%�#8&%�#@& �#H&%�#P&%�#X& 8#`& #h&��#�&�#�& �#�&�#�&%�#�&%�#�& #�&�#�&�#�&H#�&%�#�& #�&��#�&�$&`$&;�$& �$&X$ &%�$(& �$0&6�$8&�$@&+$H& $P&� $h&�$p&�$x& $�&�H$�&�$�&8$�& $�&��$�&�$�&`$�&;�$�& �$�&�$�&%�$�&H$�&%�$�&+%& %&�%&�% &`%(&;�%0& �%8&�%@&%�%H& �%P&'�%X&%�%`&+%h& %p&�p%�&�%�&`%�&;�%�& �%�&�%�&%�%�&)�%�&+%�& %�&��%�&�%�&`%�&;�&& �&&�&&%�&&8& &%�&(&+&0& &8&�0&H&�&P&`&X&;�&`& �&h&0&p&%�&x&%�&�&+&�& &�&��&�&�&�&`&�&;�&�& �&�&&�&%�&�&%�&�&+&�& &�&��'&�'& �'&��'&%�' & '(&�('@&�'H&('P&�'X&�'`&'h&*�'p&�'x& �'�& '�&�X'�&�'�&`'�&�p'�& '�&��'�&�'�&;�'�& �'�&�'�&%�'�& �(&�(&�(&%�(&+( & ((&�(@&�(H&`(P&�(X& (`&� (x&�(�&�`(�&`(�&@(�&@(�&�(�&�(�&((�&�(�&�(�&@(�&�(�& �(�&�(�&�(�&`)&@)&5)&�) &!`)(&x)0&@)8&�)@&()H&)@)P&9�)`&()h&()p&��)x& )�&�p)�&�)�&�)�&�)�&�H)�&�)�T&*T&�*&�* &�*(& �*0&�*8&�*@&0*H& �*P&X*X&�*`& *h& �*p& 8*x&�*�& p*�&�*�Y&*�&�*�d&*�& �*�& �*�& �*�&�*�& *�&*�& *�&&�*�&0*�[&+&, + &+(5&+0&�+P&+Xu&+`&+�&+�1&�&��x�&��H0bootinfo��P(snkELF�@@`@8@ �?p2�Q|��8c��|�#x��!��|c"xc H�`8!�|�;��|�||c8��|�N� �`|��8`��!��肀��P{� ��x��H��`9 �J;�U)0W�0��PW��|Hl|�|O�|�L,9)�B��Hi`8!��|�N� �`|��|~x|�#x��!��8 9`�A��a��| ��9@�!�A�"�```8�i�I9)@|�B�쀢�$�48�p;��b�(|�0Px� H7`/�A��"�8�p8�;@낀��"��P� {� #�x��x��H��`��x��x8`H��`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� ``/�@��89p| �|�#x} Cx9@ �8�� | P9)�(��/ A�p@�B��`|�HP}Cx�"�@x`6d}i| ./�A��xxc6d8})*/�A��d� �A(}c[x| ��i�IN�!�A(K��D``�I9)K��8�9pK��```|��!��|dx��!��A�;�p8��xH��`��x|~x8`��xK��8!��x��|�N� �```|��!��H�`8!p�|�N� �|��8`|�#x��!��|�+xH �`,#A�T�#@/�A�H� �A(��x��x| ��i�IN�!�A(8!��|�N� ``�b�HK��8`��K��`|�+� ��|x��A��a��!�QA�d�"�PyJ�| R�} J})�N� HHHx8HHhxHHH�|�+�@�``8`��8!��A��a��|��N� `/�A�|A��/�@��8`��pH5`��p|yA��?/�A�؀/�A��|�;x8�P8�H��``8!�8`��A��a��|��N� `|�+�A��8�"�@{�6d|i�| �./�A�� #/�@�hK��```8!�|c��A��a��|��K��`�b�@8 |��;�}i[x| �H`;�9)@��B@4� /�@��{�6dK�뢀X;�HH� �A(C�x��xe�x| ��i�IN�!�A(/�A��;�;��/� A��@�}/�A��+0/�A��؀/�@��+� �A(| ��i�IN�!�A(�=�)0K��p```|�+�A��"�@{�6d|i| ./�A��#|��/�A�`� �A(| ��i�IN�!�A(K��```��xK��``�b�`��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��"�@{�6d|i�| �./�A��#0/�A�� A(| ��i�IN�!�A(8`��K��h�b�xK��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�pK��8`��K��b�hK��8`��K��`|��!��A��; ;@�a��|�+x�"��|}x|~x��!�Q�/� H��x/� ;�A��@@��P��P{ �xH�U`8��xx� ��x�{H�i`��?��`�/� A��<�@@�;Z;{Z�/ ��x@��8!�8z|c��!��A��|��a��N� �|��|��!�1;�p��xK��xH� `8!��|�N� �`|��|��!�1;�p��xK��u��xH�m`8!��|�N� �`|mB�|B�|�B�| @��xc�|cxN� `}-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� `|�8�Tc0T�0|� PT��|��|l|�|�|�L,8c�B��N� ``��|��‘��;��!�q;�PH``��;��A�L�?/�A�� /�A��) � �A(| ��i�IN�!�A(��;��@��8!��|�N� �8 �"��| �`�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��xH��`/�@��A��8 �"��| �```� 9)/�@�tB��9@ ;�}I��x``� 9/�A��}�9)B��;��8!��x��|��}�� N� ``8!�;��x��|��}�� N� `8!�;��x��|��}�� N� `��x8�pH`/�@�X�‸�ap8�x8�肀�H��`/�A�<�"��b��;��)� �A(| ��i�IN�!�A(K��;��K��!x�b��8�x� �A(| ��i�IN�!�A({�$/�|~*A� �/�@��8cPH�`K��;��K��`��|~x�†|��!��/�A�4;�`��@�K��/�@�<�;�/�@��8!�8`��|�N� ```8!��"��xc$��|i*��|�N� �|��!��"��B��b��I`�iX9@ 9>}I��8```� 9)B��†�/�A�;�K��;�/�@��9` ��x}i�;�```� 9/�A�4}�9)B��8!��|�N� ```H,1`8!�{�$�|~�*��|�N� �`|�3x|�;x|&x|��B�`��kt}��(|!B�A@��8�H|BB��B��*K��8|��A@�!N� |��!��|�3x|�;xK��e�!�|�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��肁08�8�H �`�/�@��x� 8�K��`|}yA��xH�`/�|dxA��b�P��H�`/��@��8`8!��|�N� ``�"� �b�(�)� �A(| ��i�IN�!�A(8`��K��"� �b�8�)� �A(| ��i�IN�!�A(8`��K��"� �b�HK��"� �b�@K��"� �b�XK��|��|dx��!�a�/�A�@8�p8�HE`8/��A��r8!�|x��|�N� `��K��=��K��|��!��K��/�@��b�`K��a��h��b�pK��Q��b�xK��E��b��K��9��b��K��-��b��K��!��b��K��b��K�� b��K�� 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'e`8`K��```�"�h|�8�8��!��8 8` � ,8�pK��i�b��K��`�ar8!��|�N� �``|��|~x��8|�#x뢁h�!�a�}*/�A�$|�+x8�8�8�p��x��K��*�r�b��|x��x��xK��`�ar8!��|�N� �`|��"�h|kx8`��!�a8��&/�A�D��|�3x8��+�K8�8��k��p�ax��K��-�a�8!��|�N� �``|��"�h��|x8`��!�A8�� "/�A�D|x8��p8�8��x8�8�8��8��9�9!�9A�K��a��8!��|�N� �``|��"�h��!��i/�A�8�8�8�pK�� ar8!��|�N� �`|��b�h|ix��!�q|�#x�k/�A�(9`8��!��8�8�p�ax8�xK��ar8!��|�N� �``|��"�h|gx��!��i/�A�8�8�8�pK��E�ar8!��|�N� �|��b�h|ix��!�q|�#x�k/�A�(9`8��!��8�8�p�ax8�xK��ar8!��|�N� �``|��"�h}Cx��!�q|`x�i/�A�/�@�HT�@.�i |�;xT��|�+x|�#x8��|��}i[x8�8�K��Y�a�8!��|�N� T�@.|�;xT��|�+xx �ap|�#x8��|v|��8�8�K��a�8!��|�N� �```|��"�h��!��|`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� ��"��88`� N� �"��88`� N� |�#xN� ```|�#xN� ```8`N� ```|��||x|�+x��8�L|�#x��!�!8�;�p��xH��`��x��|�p��8�t��H �`8!��|�N� �```|��|}x|�#x��8�8�L�!�!;�p��xH�!`��x��|�p��8�tH `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� �`|��8�8�L��!�1;�p��xH�a`��x�p8�xHU`�a~8!��|�N� �``|��||x|�#x��8�|�+x��!�!8�L;�p��xH��`��x��|�p��8�t��8�xH�`��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� �}�&|�.��|�#x��!��A��肂08�p8��K��!/�@�x9!�H@```� ��}c��@A��i��|x �@@�`/�9)@�49c��9I��@��Ȉ ��}c�/�A��/�9)A��``8`��8!`��|�}�� N� �jxcG�/�@��8!`8`��|�}�� N� 肂(K��$�```|��|~x8��!�18�L;�p��xH�Y`��8��x��|�p8�tHI`8!��|�N� �```|�|iy8`��!��A�8� �)8�iK��Y8`8!p�|�N� �`|��|}x|�#x��8�L8��!�!;�p��xH��`��@��x��|�p8�t8�xHi`��a�8!��|�N� �```|��||x��|�#x��!�H�m`;�x8�8�L|}x��xH��`��H��x��x��8�|8��H�`��!��a�8!�x�|Kx��|��N� �``|��|~x8��!�18�L;�p��xH�)`8��x�"�P��|�t�x�!pH`�a�8!��|�N� �`|��|~x8��!�18�L;�p��xH��`8��x�"�X��|�t�x�!pH�`�a�8!��|�N� �`|��|x|�#x��!��K��a�"�|`x/�8`��{�d��A�<��B�p9)8`�b�`��h�_0��yd})B�?89 �?8!��|�N� �|��|~x8��!�18�L;�p��xH��`8��x�"�x��|�t�x�!pHu`�a�8!��|�N� �`|��b��!��K��m/��A�D;�p肂�8��xK��xK��I|`x8!�|x��|�N� ``�b��K��/��|`xA��;�p肂�8��xK��]K��``|��|~x��!�qK��I/��A�<肂�;�p8��xK�� /�@� /�A�<��x��x8�H�}`8!��|�N� ```��x8�r8�H�E`8!��|�N� �``|��|~x8��!�18�L;�p��xH��`8��x�"��|�t�x�!pH�`�a�8!��|�N� �`|��!��8��|�#x��|x��x��A��a��!�!�"��$�x;�|��xK��x8�K��E/��|~xA��x{� K��:�t:�x;p|}x��xK��|{yA�``�B��~ųx8��xD�xK��=肂�8�~�x��xK��)D�x�x8�c�xK��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��q}�xc�x$�x��x8��K��Y��xK��|{y@��8!��|��!��A��a��N� `�'�gy)�})[xK��8xd}G}g.� yk�}`xK��D9 K��x8�K��i|~xK��,�|��|x��!��K��8!�|dx��x��|�K��p�|��8��!�a�x�pK��|~yA��낂(��x;�xH ```K��x|yA�d�x��x��x8��x�pK��/��xA��8ap��xK��ap8!��|��N� ``8!�8`��|��N� �|��|x��!��K��q8��/��|~xA��K��낂�;�p8�@��x��xK��%肂��xH�)`/�A� 肂��x8� H�`/�@�`8肂(8��x8�0��xK��x8��8�@�|��xK��88!`|x��|��N� 8肂�8��x8��x;��;�xK��q肂�8��8��xK��]肂�8��8��xK��I肃8��8��xK��5肃8��8��xK��!肂0��x��x8��K�� 8��/�@��L��x �"x�"��?�``�8c��|c�T>xG"9k��/�yk�yi&�ykd}+HP}=J9) � �� ;�� A��xK��-8��|x8!`��|��N� �|��|~x8��!�18�L;�p��xH�y`8��x�"��|�t�x�!pHe`�a�8!��|�N� �`|��|~x8��!�18�L;�p��xH��`8��x�"��|�t�x�!pH �`�a�8!��|�N� �`|��||x|�#x��|�+x��a��!�� xK��M/�@�@;ap8�c�x8�LH�Q`8c�x��p��|�t��H =`8!��a��|��N� �`|��|�#x|�+x��a��|x�!��(��xK��x/�@�L;ap8�8�Lc�xH��`8c�x��p��|�t��8�x��H�`��8!�|x��a��|��N� �|��A��a��|zx|�#x��8�|�+x��8�L;��!�;�;�p��xH��`��0��x��t�p��8�|H�`��x8�8�LH��`��8��x��t�p��x�A|�a��H�`�a�8!��A��a��|��N� �``|��||x|�#x��8�|�+x��!�!8�L;�p��xH� `��@��x��|�p��8�t��8�xH �`�a�8!��|��N� �|�|iy8`��!��A��)8|��iK��=8!p�|�N� �```|��||x|�#x��8�|�+x��!�!8�L;�p��xH�`��H��x��|�p��8�t��8�xH �`�a�8!��|��N� �|�|iy8`��!��A��)8|��iK��=8!p�|�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��`��X��x��|�p��8�t��8�xHi`�a�8!��|��N� �|��||x|�#x��8�|�+x��!�!8�L;�p��xH��`��`��x��|�p��8�t��8�xH�`�a�8!��|��N� �|��A��a��|�3x|�+x��|~x|�#x�b��!��!�AK��8��/��||x��_@�L8!�|x��|��!��A��a��N� ```�b�h��`8:��h�B�p; |x肃p8��8�[0��;��K��A8��@��H8��x�[p|x��x�P�;X肃xK��肃�8�K��8��/�A��,��xK��}/��A��b��K��}/��A� K��/��A�肃��x8�K��K��`��8��B��b��"��(�> ��0�(�^h�~p��K��8�K��>�b�� A(| ��i�IN�!�A(K��\� ```|��||x|�#x��8�|�+x��!�!8�L;�p��xH�9`��x��|�p��8�t��8�xH`�a�8!��|��N� �/�A��/�A�T/�8�A�|�#xN� ```|ex8�8`<D"/�x� A��8��K��```|ex8�8`<D"/�x� A��8��x� |�#xN� `|ex8�8`<D"/�x� A��t8��x� K��h```/�|`xA�X/�A�0/�8`��L� x� |x8`@8�D"8`N� `|ex|�#x8`@8�D"8`N� `|exx� 8`@8�D"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� �``|��b��"��!��8�b��)� �A(| ��i�IN�!�A(8!p8`�|�N� ��"��88`� N� 8`N� ```|��"��|�#x��!��|`x|x�iK��`8!p�|�N� �```|��"��|�#x��!��|`x|x�iK��`8!p�|�N� �```|��!�q�b��;�p��xK��`��x8��~K��`/��@�,8`8!��|�N� ```�~��x8�K��`/��A��b��K��肄|��!��|��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�Hx�`��x��x8�Hx�`8!��|�N� �`|�|�#x8��!��|dx8`K��E`8!p�|�N� �|�|dy��!��A�0�b� 8�Hx5`8!p�|�N� ```�b� 8�8�Hw�`8!p�|�N� �|��8�8��!�a� ;��xHwu`8`��x8��8�K��`8,#@�,8!�|x��|�N� ``x} +� A�8��K��```肄(��x8�Hx5`/�A�<肄0��x8�Hx`/�A� ��x��x8�Hw�`/�@�P�/�A�(/�@��8��8~|��H�`|`xK��88��8~|��H1`|`xK��|$x833��x8��pHw�`/�A��8��K��``�"�8�iN� ``�"�8�iN� ``�"�8�iN� ``�"�8�iN� ``89 �� 8��#8E��N� ``�"�8�iN� ``�"�8|��;��8;��!�q��x� � ;�� {�>${�M�|`P8�|P;�xcd||8�8c��Ht�`/� ��;��@��"�@��H8!�� |�N� ��"�8�iK��8``�"�8�iK��``�"�8�iK��``|�=# ��!��<�`��@A�T�"�P�b�8x`�bTj�>8!p� �I8^� �i8� �k8� �|�N� ``�"�8�b�P88��8�� Hs�`8!p�|�N� �`|��}Cx|�;x��8|�3x��!�q|x��8|�+x�88��8�8cHsE`��x88�Hs-`8!��|��N� �`|�+��a��||x��!�QA�88`��8!��a��|��N� ```�/�@��Ġ/�@��뢄8��=�@��#/�A�4/�@��K��1`8�8�HsA`/�A��8`K��l/�A��;�8�8�*�p;�xM�x >$})XP|HPxd�;� ��xHq�`K��`8��x|ex��xK��`K��`��p��x8�|ex8~K��x8�*K��`8`K��ā|/�A��<��́=��x`��y >$y%M�|(P�8@| P9Ixd�A��|�?�XA�$| 0T��T 8T<} J})PPy) K��;�肄X8��;��xHq�`|{y@��(8��x8�Hp�`�/�@��;� ��x8��xHp�`��xK��`�8`K��``}�&|��|�#x��8|x+��8`��!��A��a��!�!A��/�A�(/�A� �89` 8}i�� x��x;8``�i9)|ZB��x x�| �? x�|/�|�� A�܂�z� /��A�Ё>} H�~�8�A��A�\�|�x|H8,@�X�>�~�H@A��y*M�y >$|PP=��| Pa��x d}^R�J��@�H�`�J��A��9)| @T��T 8T<|R} HPy) y*M�y >$|PP�H@| Px d}^R@��;��b�X�"�`.<y`>$yxM��P8��P8�*{d�;[;� ��xHni`K��`��~�x8�G�x|ex8xK��K��]`8�F�x|ex��xK��e`��x8�*K��`A� 8`��8!��|��!��A��}�� a��N� ``�8��K��܀|�x|H8,@��L��B�X;�x >$xM�})XP;Z|HPxd�K��`;� F�x{� 8�|ex��xK��`��x��x8|;�Hm}`��x��K��`8!��|��!��A��}�� a��N� ``�>�~��H@A��,y*M�y >$|PP<��| P`��x d}^R�J�@@� H````�J�@A�H9)| 8T��T 8T<|R} HPy) y*M�y >$|PP�H@| Px d}^R@��K��xd;>�.<A��b�X;\8�C�xd�xHmY`/�@��~K��l```��B�P;�x >$xM�})XP|HPxd�K��X``�8��K��``8;Ap�C�x8�8�Hk�`�;� ��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|{� Hja`K��y`f�x8�|ex8| K��`��x��x8|;�Hji`��8`K��b�X�~K��x� ```�"�8|�/��!�|`x�i@�8!��|�N� ;�p9@E�Ap9@;��9 9`�_�9@p8�_�9@��8a��_�9@8�*�_ �? 8�T�?��8�v��>8��~Hi9`��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 �~�> ��~�� Hg�`�~��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�"�8�c�I�X@��@/�A��8� 8`K��```|�+��|x��!��@�@�8�>/�A�T�_y@ �@A�t/��A�l�>/�A�`�H@A�X8`��8!��|�N� ``�_=`��ak��y@ �X@@��= ��a)��H@A��K��`9` 8� }i�� x8�8�i9)|ZB��x x�| x �| |�T>�@@��\�x �@�4x ��A��x8~;�He]`8`K��0```;�;��~�A�8`K��~ � �@��~��@��܀�P@��Р�y)$8i8��|~x� Hd�`�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 ��/��A�L/�D@��̠/�C@��9)��8c}$�H�`K��```H-A`|ctK��/�5@��9)��8c}$�H�`|ctK��h�```8`��N� ```N� �"�h�i8`N� `|��a��|{x;��|�+x|�+x��|�#x�!�a```�?|�P��x��x})tU+28�|J/��x� ,��/)A�\A�lA��Ha�`�?})t8 ��|�P��x��x�?})tU+28�|J/��x� ,��/)@��;�x��K��d/��>A�p8!��x��a��|��N� ```肄p��xH^I`8!�8`��a��|��N� ;�K��`|��|x��!��A��a��!�Q�/�4A�88`8!��!��A��|��a��N� �T(mi��/��@��x !@�h�;�/�A�x낄x;�H``�;��@�T��x��x��x;�K��,#@��8`��K��\``�"�h88`� K��@```�/�A��$�b�h;�;;;�;[8�xH ``;��@��x��x��xK��1|~yA��x�/�@��D�x��xH\`/�@�4�/�/A�dA�@�>8 �K��```��x�xH[�`/�@��K��`8� ��x%�xK��/�@��8`��K��D� 8`�K��4�`|��!��A��;@��a��|{x��!�QH[�`뢄h8�;�;�{� ��x;�(;=8{� {� ��xH^=`9=,84�,8d�x#�x� �IH[U`c�xH[�`8�8�x� `��8c8�5xc }9Y.8}$�IK��`��8�(��xx� 8�8�K��`��x��K��e`8!��!��A��a��|��N� �`|��!��A��|�#x��a��8��||x��!�A�B�p�b�h;� D�x��x��xHZI`肄��xH\ `/�A�肄��xH[�`;�뢄��x��xH[�`/�A��x��xH[�`;�뢄��x��xH[�`/�A��x��xH[�`뢄�||P��xxx ��xH[u`/�A��x��xH[]`�P{� ��@@��x{�!A�+��@�T�b��Hf}`8!�8`��!��|��A��a��N� ```��x��x��x;HZ1`8D�x|��x�xHX�`��xHY`+��A��;� �xH8```HY�`��P}}�/�A��x;�;��}>�P;�|��Py) /�.x� ��x��x/ (�?A�@��ș+@��~�xD�xHXE`�b��HeY`8!�8`��!��|��A��a��N� ``��xHX-`뢄�xx ��x��xHY�`/�@��4`��xHW�`x} K��4```��;/�A��;�D�x��x��x;�~�xHWq`��xHW�`/�A��xK��qK��`K��````K��Q`�/�@�@� /�@��K��`/�A��;��/�@��b��8�Hd `8!�8`��!��|��A��a��N� ``�xK��K��L`�b��Hc�`8!�8`��!��|��A��a��N� ```8!��8`��!��|��A��a��N� � ``|��|}x8��8�V�!�q�|?x��;�p��xHXy`��x;�8�H8�8�K��`��x;�8�C8�D8�4K��]`89 肄Ș�=8~��HUY`K��1`8�|dx8~8HX=`��xK��`8?�8`��|�N� �``|��8�8��!��|yx;�A��a��!�A�|?x��!;�p��x;]"HWY`;�;}*K�� `:�F^�xK��`8`��x8��8�K��q`/�A��\ � ��x8�i9)��|Z@��x x�| x �| |�T>�P@�̈ /�@��/�D@��/�C@��/�@��K�ݹ`~�x8�HW�`/�@�|�"��i/�A�d�x8��HV�`��;8y8�l��9HS�`8?�8`��!��|��A��a��N� K��`/�A��8?�8`��!��|��A��a��N� � ```|��a��;e��8|}x�b��{~ ��|�#x�!�aH_�`�"��낄��x��xH_�`/��xA�TK��x;��K��u{� /�@��b��H_q`8!�8`��a��|��N� �b��{d H_9`8!�8`��a��|��N� �```|��A��a��|�3x��;�|�#x��!�a{� |x��|�;d��;Ape�P`�P{{ |� Pe�x|�"C�xHTm`��|D�xe�x|c|{P|HTI`��8�{P|�HT-`}?讈| |鮈�>| �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�HR`�{�<8|J��;��K��`8!�8`��!��A��|��a��N� ```�;K��l``�9}%Kx��xd�x��xK��K��``|��a��A��|�#x8��|�+x8��|~x��x��!��!�AHP�`肄��x8�HR`/�@��:�;;�;�; {� ��@@�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;�|�ЮHO)`}>Ю}=J�)|Ю��K��(`��;�� K��8!�8`��!��|��A��a��N� ``;_8�|�"~�x;�|�ЮHN�`}>Ю}=J�)|Ю��K��`��;�� K��d� ;�� K��H`8!�8`��!��|��A��a��N� � ```|��|�#x8�肄��|}x��!�qHM�`�+�@�$8!�8`��|�N� |t9 } 6p�A��9}85�;��+��/�A�84��?��;� �2/�A� 82�8��;��6/�@��9`��x}i��x8``�i9)|Zx B��/�A�@9 7��?;�9 �j8 9J/�A��?;�x /�@��܈B/�@��C/�@�L8��8!��8`��|�N� 86�8��;�K��08C;��xHII`��x8�8x� ��HK�`�?8 �K��x8B;��xHI`��x8�8x� ��HK�`�?8 ��C/�A��,K��p�``|��a��A��|�#x8��|}x8��!��!�;�t��xHJ�`�/�A�@8`��8!��!��A��a��|��N� ```��/�A�/��A��x{e HJ�`肄�;]�8�C�x;��HK�`/�A��};},�=�c�x�?�HG�`/�A�(��/�@�d�x88�@HH}`��X;�l��xHGy`/�A� ��x88��HHM`8��88`�8!��!��A��a��|��N� `��x8��HI�`K��```{{ C�x8��xx� K��=/�A��x��/�@�\��/�@��=�;},�?�c�xHF�`/�A��/�A��;�l��xHF}`/�@�`��8��K�ԩ`�u/�A��w/�@�T�z/�@�8`K��Ѐa|K��Q`8`K��x88��HF�`8��K��d�x88�@HF�`��XK��T��/�A�8/�@��h/�A��/�@��89 �?�8`�K��@/�@��d�;� 8��t8�H��x�;��HG�`9?<8��<� ��K��`8�|dx8XHG�`8�8��xHG�`88��8�8a��HG�`8�8��8a�HG�`��x8(��ϛ�Λ��K��8�48�D8�C84K��U`8��xx� 8�H8�8�K��u`��x8�HK��`88`�K��9;�;a�y) D�x8�c�x�!px� HG `��/�A�/�A��/�@��8a�8�p8�l8��K�� /�A��pc�x��x8�x� K��Y/�@��,K��a�K��`�a�K��`K��a��=�/��t�?�A��88��HCa`��/�A�t88��HCE`8�K��;!�;Ap#�xD�x8�l8��K��I/�A��#�xD�x8�,8�@K��-K��$8a�8�p8�,8�@K��K��肅;��xHB�`��/�A��/�A��|;�l��xHB�`/�A��d��x��x8��HC�`��K��H肅;��xHBu`��0��T>+�@��/�@��x8�,8�@HCq`��XK��`|��a��8�H8��;��!�A��;� ;�<��xHD�`8��<8��肅;apHA�`K�˙`8�|dx8XHD�`�8�8��c�xHDI`�9 d�x��8(�p�!�K��848�48�D8�CK��1`��x8�H8�K��U`��x8�HK�ӥ`8!��a��|��N� �```|��8�8�H��;��!�Q�;� ��xHCm`9><8��<;�p� ��K��m`8�|dx8~XHCy`8�8��xHC%`��x8~(��q��v��sK��m8~48�48�D8�CK�� `��8��xx� 8�H8�K��)`��x8�HK��y`8!��|��N� �`|��A��a��;@��8||x��;��!�a��;ap|t/�|x/A�,A��HD�`/��xA��뢅��xHA`��x/��xA��HA`��x|P|}4{� c�xH@E`}!��Ip8�c�x8� ;�HF`|c4T`>+��A�<��4T@.|`�|�|t/�.@��@�|tK��4``8`8!��A��a��|��N� `��xc�xH>i`c�xH>�`�K��P```k�|c4Tc�~xc K��|��8|�+x�!��A��a��|{x|�#x��;��!�!��;?;_��x#�x�pW�x��xH=�`��xC�xH=�`��b�;`HJ�`� ;��x��xHJ�`HLE`/�A��/�A��K��m�:�K��`K��`K��Q`�/�/A��A��K��`/�A��:�~��/�@��;��x��xHJ`HK�`/�@��|```�b�(HI�`8!�8`��|��!��A��a��N� `�b�8HI�`�/�A��/�A��/�@��~�xH<u`/�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�0�xHHy`8!�8`��|��!��A��a��N� �8`��/�A��pK��```�"�@ c��8� �iN� ```|��|�#x��a��뢅@��!�� } P}+�q@��H�?/�A�\낅P�Vp��x|��HGy`8��9 �8�8!�?��a��|��N� 낅P|Vp;ap|�c�x��xHFY`�p/�A�(i�x9````�i� /�@��c�xHF�`K��P��H�?y+�A��09)/�y) @�� K��X�|��|�#x|~x��8�8��a��!�a;�p��xH< `�"�@� /�A��;�8`;`��x8�8��K��`8��"�X��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��h;:�;@;�p;��;88cH8`|tx��xH8`|ux��xH7�`|vx��xH7�`|��8�E8�8��|��|�~�xx� K��]`8��;�xH7�`�x8�#�xx� H:I`�8cH7y`8��xx 9H7a`��x8�#�xx� H: `��xH7=`8��xx 9H7%`��x8�#�xx� H9�`��xH7`|x��xH6�`8��xx 8�|yx� H9�`�"�Xc�xD�x�)� �A(| ��i�IN�!�A(8!��|��!��A��a��N� ```�;�p;�:��8cH6=`|xx��xH6-`�h|zx��xH6`X�;�;Z"|yx��xH5�`�?Z�8�8�Zc�xZ��{D K�±`K��``��|��@9`/��!�q8|�#x��$�� 8��(�_��8��0��@�/��A�p}%�肅p8��xHA]`�b�xHB`8�8`��K��1��@K��Y`K��q`K��YH,K��`�?0� �i�@A��)�@A�l�/�@�@K��M`/�A��=0�i+�@�p�B�H��/��A�Р}H+�@�dx� K��=0�iHP```8��8`�א8�@8!��|�N� �B�H� /��A�d9k�iK��i`K��`K��`�?0� �i�@@��8��8`�ؐK��```9 �K��``�H/�@��U`�/�@��b��H@�`K��=0�iK��p```�}8�@/�@��$�N8`��K��b��H@M`�R/�@�,�N8!��|�N� ``�b��H@ `�NK��|��A��|�#x��@��|}x�a��!�a�@/�A��N8`;}K��K��`K��`�낅H��|�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�{9Iyc }@��A��m*��/��A��@A�LA��?0Uk>8`�֐ �i8�֐K��```{[ }�;� ��@@��hHD`��x8�H0)`,#A��8c8�H0`,#A��;��@@��xH1`��x8��xx� H4�`/�@��xH0�`8�8� 8c|}H6=`xc 8��8T>+��A��8`K��8`K��$``�"��x�| �} J})�N� ��h8(��h��h�``��8�8;�p8��x8�H2�`�/�A��;�8`;`{� 8� 8��K�Ι`8�"�X��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� |cJH1m`�{��K��݁?L�8�9)��9k�| �L@��?Hm ��/��@��(�(/�@��8��8`��K��\K��?0�P8`8�i�P8� K��?��x8�!8�8�;��;`!��K��`8a�K��88`�K��|��K��```}�&|��|vx8��!��A��a��|�#x8��;��a��!��{H4A`8�8�;A�;�t|xx�{H4!`8�8�|yx�{H4 `88�8� |wx�{ �pH3�`8�8� |}x�{(H3�`|~x�b��H9�`�b��H9�`8�8�C�xH/A`8`8�8��xK��`/��@�l``H;1`/�A� �;��/�XA� �K��`K��`K��`/�A��8`8�8��xK��A`/��A��/��A� ��t��u��v��w�x�!y�b��H8�`��xK��q`/�@��0~óxHI`.#|ux@�L8��b��;��/�A��@��8X��8�̀�|P|�/�WA��8X��C�x��x8�H.=`�/�A��/�A�/�A�t;��/�A�(��b�x� x�Fxņ"x��"H8 `;�+�@� x�T;��/�@��b��x�x� x��"x��"x�FH7�`�[��C�x$�x��x��8�|K��`��/�|~xA��/�A�D/��A��/��A��/��A� D/��A��/��A� t/��A� �/��A� �/��A�@/��A��8+�@��/��A��/��A� �/��A� @8!P��x��a��|��}�� !��A��a��N� �b��H6�`��~�xD�xK��m`|x/�@��l/��A�Ȁ��b�x� x�Fxņ"x��"H6y`/��@��h��肆;��;��xx� x�Fx�"x��"H5�`8��8`0K��`��xH)I`8��|dx��xK��`K��``8�8�|8aT;��H+�`�b��8C�x��8X��x��8�8��H+�`�/�@��h;�p��x��x8�H,}`/�A��H:��x~óx8�H,]`/�A��(�T/�A��~ĳx8a�8�H+5`8��K��Vp�b� ��x|��H51`K��b��;��H5`��x8�p8�H+�`/�@�L8��Ԁ��~�xD�xK��`|xK��8��x8�T8��H(�`8��K��А�K��HA��:��8�~��x8�d~óx;��H�`~��x��xH!`/�@�$��/�@� ��x8�8�H)�`~óx8�;��HE`{� /�|vx@�8�T;��8��x8�H)�`8a�8�8�H)�`A��d:��~óx8�~��x8�dHA`��/�@��8X��~óx8�H�`/�|vxA�� 8�~��x8�dH�`��/�@�`8��~óx8�Hy`K��;��8��x8�d~óxH�`肅��xH*�`/�@��~óx8�8��:��H%`z� |vx.5K��dK��`K��|:�p��x~�x8�H)�`/�@�h;��~�x��x8�H)�`/�@��a�K��-`K��x8a�8�H(�`K��肅��xH)�`/�A��肅��xH)�`/�@��8~óx8��:��HU`�b��z� 8.5;��|vx�K��~��x8�8� H,!`|c�/��a�@��K��~óx8�8K��8a�8�8�H'�`K��~��x8�8� H+�`|c�/��a�@��K��:��x~�x8�H(�`/�A��~�x��x8�H'i`K��xD�x8�H(Q`/�A��xC�x8�H'5`K��l��x8�8�~��xH&�`:aT~ó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�H%�`K��d~c�x8�8�H%�`~óx8�H�`|vxK��8肅�;��xH"�`8��8`0K��`��x;��H"�`8��|dx��xK��`K��p肅�;��xH"U`8��8`0K��肆p;��;��xH.�`+�@��xH"]`肆�|H.m`��x;��H"=`肆�|H.M`8��8`0K��M`��xH"`8��|dx��xK��M`K��x8�8�H$e`K��l肆(8`0;��K��`K��;��肆@;��xH!q`8��8`0K��`��xH!�`8��|dx��xK��`K��D�"�x{��| �} J})�N� �� @;��肆8��x��xH-Y`8��8`0 K��Y`��xH!`8��|dx��xK��Y`;��K��Ȁ��;��;��肆��xH-`8��8`0K��`��xH �`8��|dx��xK��`K��t;��肆;��xH U`8��8`0K��`��xH y`8��|dx��xK��`K��(��肆�;��;��xH,e`8��8`0K��e`��xH )`8��|dx��xK��e`K��;��肆H;��xH�`8��8`0K��`��xH�`8��|dx��xK��`K��;��肆P;��xHm`8��8`0K��`��xH�`8��|dx��xK��`K��@;��肆X;��xH!`8��8`0K��`��xHE`8��|dx��xK��`K��;��肆`;��xH�`8��8`0K��5`��xH�`8��|dx��xK��5`K��;��肆h;��xH�`8��8`0K��`��xH�`8��|dx��xK��`K��\��|肆�;��;��xH*�`8��8`0K��`��xH]`8��|dx��xK��`K��;��肅�;��xH�`8��8`0K��M`��xH`8��|dx��xK��M`K��;��肆0��x��x��xH)�`8��8`0K��`��xH�`8��|dx��xK��`;��K��l��xH�`肆�|H)�`K��<��xHy`肆�|H)�`K��xHY`肆�|H)i`K��xH9`肆�|H)I`K��xH`肆�|H))`K�� |��|�#x��|x�b��!�Q;��H)�`8��x8�H1`/�A��/�@��>� /�-@�� /�f@�� /�@��~8�8�H#E`/��|xA�X�b��;�pH))`8`8�8��xK��1`/��A�/��A�Ȉ�p��q��r��s�t�!u�b� H(�`��xK��a`�b�(H(�`8`��x8�K��q`|c4/�A��a�K�� `��b�@x�Fx� xņ"x��"H(y`��/�A�<9 /H``�/�A�/�\@��$�/�@��b�HH(%`�;��xH�`��x��x<��8�8�x99 9@K��Y`|}xK�؝`/�A�@/��A��/��A��8+�@��/�A�x�b��x;�H'�`H`�>� /�-A��b��;��H'y`�b��H'm`�b��H'a`�b��H'U`�b�H'I`�b�H'=`8!��x��|��N� /��A�</��@��t��肇88a�;�x� x�Fx�"x��"H&!`K��`� /�cA�/�r@��@� /�@��48`K�|m`|}xK��l```�Vp�b�P��x|��H&�`�b�XH&u`��x��xK�{�`8!�|}x��x��|��N� �b�;��H&-`K��b�p;�H&`+�@�p�b��H&````�b��;�H%�`K��```�b�0;�H%�`K�� /�@��48`K�{m`|}xK��l�"�x{��| �} J})�N� 4$DT�b��H%m`K��t�b��H%]`K��d�b��H%M`K��T�b��H%=`K��D�b��H%-`K��4�b�`��x;�H%`K��b�h��x;�H$�`K��b�;��H$�`K��b��;��H$�`K��```|��|�#x|~x��8�8��!�;�x��xH`/�@��xH�`8 ��||yA�p/�A��;��8�@��x8��xH�`��x��xH�`/�A��x8�@8��xHa`��x��xH�`/�@��b��H#�`8`��8!��|��N� ;��8�@��x8��xH�`��x��xH-`/�A��;��8�8��xH `�b� ;�pH#]`8`8�8��xK��e`/��A��/��A��p��q��r��s�t�!u�b��H#`��xK��`�|/�@�4�b��H"�`��x8`8�K�י`|c4/��A��a�K��1`��b�x� x��"x�Fx��"H"�`��x8�8a�Hm`��b�x� x�Fxņ"x��"H"m`�a�K��`K��`<ff`fg|�|c�p|p|cP��|c�|c�K��``K��`/�@��K��`K��Y`/�@��b�H!�`8!�8`��|��N� ``��x8�|8�H�`�b��H!�`K��```�b�H!�`8!�8`��|��N� ��x8�HY`;��{�!|~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� H�`�a�K��```��x8�Hi`;��{� |~xK��D�b��H M`8`��K��p�b��H 9`8`��K��\�b��H %`8`��K��H�``,$M� 9 `�/�,A�,/�@�H<``A�0�/�,/ @��9)8cy) �H@A��N� `8`N� ```|ix8```� /�,A�,/�@�H@``A�0� /�,/ @��5)A� 8cxc K��``N� N� N� ``�|kx/�,A�8/�A�0|ix`9)|HPx � /�,/ M� @��N� 8`N� ``|��|�+x��!��|�#yA�\9````�#/�,A�,/�@�H�``A��#/�,/)@��9k8cyk �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��HA`/�A��"�(��x$�xH�`|~yA��$�x��xH�`�P�4{� +� A�t��xc�x��x��H�`}!��Ipc�x8�8� H�`|c�+��A�4�|�/�.A�T;�/�{� ;�@��H/�8`��A�8`8!��!��A��a��|��N� �K��``��x8� c�xH`c�x��yH`�K��H�``|��|}x|�#x�b�0��!�qH�`�b�8H�`/�@�8낈@;�`��x;��x��Hm`��;�A��8!�8`��|��N� �``|��|�#x��|x�b�H��!�qK�{I`肈P�}H I`/�@�/�A��肈X�}H )`/�A�L肈`�}H `/�@��x��xK��`8!��|��N� ��x��xK��`8!��|��N� ��x��xK�ߙ`8!��|��N� �b�hH `/�@�8낈@;�`��x;��x��H�`��;�A��8`��K��4�`|��!��cm`E/�LFA�8!p8`��|�N� �/�@��c8��T>+�A��Сc8��T>+�A��/�A�$/�@��HI`8!p�|�N� H�`8!p�|�N� �```|�=`E��|�#x��!��akLF;��XA�$8!��x��|�N� `�;��/�@��Ԡ;��0��T>+�A��;��0��T>+�A��/�A�8/�@��8�H�`8!��~��x��|�N� 8�H]`8!��~��x��|�N� �``|�= E�A��a��|�3x��a)LF|�#x��|�;x|�+x��!�a|x;��HA�48!��x��A��a��|��N� `�;��/�@��Ġ;��0��T>+�A��;��0��T>+�A��/�A�t/�@��H`E�xf�x��P��x��xH1`��x��x��Hi`8!��x��A��a��|��N� He`E�xf�x��P��x��xH�`8!��x��A��a��|��N� ��,}C|./�A�L�*9`}*BH ``� }*Kx})B/�A� 9k}k��8@��8`N� `�jN� ```|�}�&��.%-��|�3x�A��a��|�#x;`��|�+x|}x��!��;��!�A��H,```�,;��*A��/�@��/�A��?9��A�0��A(#�x| ��|�\N�!�A(/�@��|��#�xH `��?8�|y|HPx H Y`��/�A��XA��T��A(#�x;��| ��w�WN�!�A(�,��*@��4``8!��`��{c ��|��!��A��}� �a��}�� N� `�?�{�P{�K�� 8}C|./�A�L�69`}*BH ``� }*Kx})B/�A� 9k}k��8@��8`N� `�jN� ```|��!��A��a��|�#x��;��|x�!�Q�#(#�>�xH(```;��<;�@��A��/�@��>,�^(y)6d}9J{Z6dY�� x ��A�� /�A��_ ��8;��z��8|�2|�2|P.}_R/��A��``�69`}*BH� }*Kx})B/�A��9k}k��8@��|0*x�"y+.�y)$})XP�ex� |i+�@|�#}+J}`�})�@��b��H`� �8��`@��x@��_ ��z��8|�2|�2|P.}_R/��@��@```|0*�*�@@��\�b�pH�`� K��```�B�xx�d| �}@R}I�N� ��X��X��XdP��X��X��X��h��h��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��X��XD8��X,��X��X��h��X��X��h��h��h��h��X��X��X��X��X��h��h��X��X��X��h��hU):�+K��\�+K��T�|�� K��@y)� �+K��4y)"�+K��(�+� K��y �y)��| �K��y)��+K��``8!��!��A��a��|��N� �``|�}�&��.%-��|�3x�A��a��|�#x;`��|�+x|}x��!��;��!�A�� H,```�8;��6A��/�@��/�A��?9��A�0��A(#�x| ��(�|�\N�!�A(/�@��$|��#�xH `� �?(8�|y|HPx HY`�(/�A��XA��T��A(#�x;��| ��w�WN�!�A(�8��6@��4``8!��}|{��|��!��A��}� �a��}�� N� ``�?�{�PK�� `�/�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� ``,%|ix8`M� �I/�A�p�}KSx/�A�T8��x�!A�H�@@�@|��H$``�/�@A� B@@��i8�/�@��܈}`XP}c�N� �9`K��|ix/�A�4/�M� |��HB@p� 8��9)x� �/�@��/�M� 8��9ix� 88�|��H```9k� }i[xB��N� ```N� |��|y|�#x��!�q@�,8!��x��|��N� `/�A�dK��`||x��xK�� `/�|}x@��@@�0`��x��x��xK��%`/�A��;��@A��8!�;��x��|��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� ```,%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/� / ,� A��/� A��A��A��/�@��/�0A��8� /�A��8``8��9K��T>UJ>+� + 9)9K��|4@�$8��T>+�}@4@�M� 9k��}`4�(L� �$|c)҉i/�|`@��N� `/�@��|/�08�@��p� 9I/�x@��h9*�$�jK��P```8`N� � 9I/�x@��(9*�$�jK��8��K��`,$|ixA�X+�$�$8`@�N� 9)�$�i/� / ,� A��/� A��A��A��/�-8�A��/�@��/�08� A�/�8`A�t8`H�$|c)҉i/�|`A�T8��9K��T>UJ>+� + 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+�$�kK��8��+�$8`�$@��N� � 9i/�xA�9`0K��9+�$�kK��`|��!��A��a��;��{� |x��!�Q;]��WZ&��Y��x�```/�A��>|�8h�H@@��~}i[x```� )@@T 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 }k�X@@�Ј/)T 6x�(/�@��A��I� �� yC�(y��{�䈉}�;xxxE�x�E�|�;x|x|�3x|�x|�:UJ688�xG"x�}J;xx��I�� K��x�(xƃ�|�xyJE�}Jx|�Sx8 }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�`Hq`8!p�|�N� �```|��!��|`x�b��|x��!��A�8��H9`8!p�|�N� �`|��|x��!�q�/�A��/�A��# /�A�/�O@�d�8�PK�y�`8|c�/�A�x/�O@��8�9 ��?8!�|x��|�N� ``|H�9)})�/�@��8�PK�ye`8|c�/�@��?9`}i�8�9 ��K��``�?|`x9`}i�K��```�8�p8�K�x�`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��/� A��/� A��/�A��;��x9i�{�)� K��xc /� A��/� A��/� A��/� A��/�A��/�A��= /�@��9)��=�</�@��8!�8`��!��|��A��a��}� ��}�� N� ``��xK��/�xx A��. A� -� A��/� A��/� A��/�A�x��@�p```�xH }`/�A��}!��x;�� pK��xx . A��-� A�$/� A�/� A�/�A��A��}!��pA�H/� A�@/� A�8/�A�0�/�A�$�= /�@�9)��=```#�xK��`/�A��;#�x8�8�8 �� K��`�xK��xK��/�xi A��/� A�/� A�/� A��/ A��/)A�x�@�p```8 ��T>+A�T}a��x;��+pK��mxi /� A��/� A��/� A� / A�/)A��A��`}a��pA�4/� A�,/�A�$�/�A��= /�@�9)��=#�xK��`/�A�T�;#�x8�8�8 �� K��e`�xK��`��xK��/�x` A�P/� |xA�T/� A�L/� A�t/� A�l/�A�d��@�\``}!��x;�� pK��Mx` /� |xA��/� A��/� A�/� A�/�A��A��}!�/� ��pA�4/� A�,/�A�$�/�A��= /�@�9)��=�;$�x8 ��iK��=`K��xK��/�xx A��. A�0-� A��/� A��/� A��/�A�x��@�p```�xK��-`/�A�h}!��x;�� pK��9xx . A��-� A�$/� A�/� A�/�A��A��}!��pA�H/� A�@/� A�8/�A�0�/�A�$�= /�@�9)��=```#�xK��m`/�A��;#�x8�8� 8 �� K��!`�xK��}!��x;�� pK��]x` /� @�```}!�$�x��p�;8 ��iK��`K��,``/� A�```/� A�P/� A��/ A��/)A��8 ��T>+A��}a��x;��+pK��xi /� @��}!�#�x��pK��a`/�@��8!�8`��!��|��A��a��}� ��}�� N� . A�d``-� A��/� A��/� A��/�A��xH�`/�A�}!��x;�� pK��xx . @��}!��pK��```. A�d``-� A��/� A��/� A��/�A��xK��m`/�A��}!��x;�� pK��yxx . @��}!��pK��```/� A��``/� A��/� A�$/� A�,/�@��9`K��``9` K��``9` K��}!��pA��K��}!��pA��0K��```}�&|��a��A��|{x��;��!�1��x!A�`;�p;�;AH ```�8�x!A�4/�%|�#x@��x ��x� ;�9)|�P| ��-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��```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�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� 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��!��;aP;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| ��/�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��Xh��8�8� ~��x�?K�� `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� 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� ~g�x9~��xc�xK��9c�x~D�x8� 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 No net_ioctl function availableNo net_init function availableNo net_receive function availableELF loading failed! net_e1000net_bcmnet_vethnet_virtio``/rtas Could not open /rtas rtas-size Size of rtas (%x) too small to make sense Failed to allocated memory for RTAS Could not open /rtas instantiate-rtasinstantiate-rtas failed 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 start-cpu called %d %x %x %x bootmsg-warningbootmsg-errorreleasepeeryieldcall-methodgetpropregassigned-addressescloseinterpretibm,romfs-lookupset-callbackopenfinddevice/chosen/aliasesnetbootpathlocal-mac-addressparentname#address-cells#size-cellsrangescompatibleIBM,vdeviceibm,virtiovendor-iddevice-idrevision-idclass-codeinterruptschildtestdma-map-outdma-map-inset-ledwrite-mm-logreadwritertas-write-vpdrtas-read-vpdclaimstdinstdout No net device found /cpustimebase-frequencyseekclient-interface module initialized! my-parent``��`:////@/: ERROR: Bad URL! ERROR: Bad host name! ERROR: Can't resolve domain name (DNS server is not presented)! Giving up after %d DNS requests bla %02d Giving up after %d bootp requests . %03d Aborted Giving up after %d DHCP requests %d KBytesblksizeoctet%d Receiving data: Repeating TFTP read request... Lost ACK packets: %d Bootloader 1.6 E3000: (net) Could not read MAC address Reading MAC address from device: %02x:%02x:%02x:%02x:%02x:%02x E3006: (net) Could not initialize network devicebootpdhcpipv6 Requesting IP address via BOOTP: Requesting IP address via DHCP: E3001: (net) Could not get IP address%d.%d.%d.%d E3002: (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 TFTP: Received %s (%d KBytes) (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 Flasher 1.4 Bad buffer address. Exiting... Usage: netflash [options] [<filename>] Options: -f <filename> flash temporary image -c commit temporary image -r reject temporary image Bad arguments. Exiting... E3000: Could not read MAC address E3006: Could not initialize network device %02x:%02x:%02x:%02x:%02x:%02x DHCP: Could not get ip address ARP request to TFTP server (%d.%d.%d.%d) failed Requesting file "%s" via TFTP Now flashing: Tftp: Could not load file %s Tftp: Buffer to small for %s ICMP ERROR: Destination unreachable: UNKNOWN: rc = %d! Reading MAC address from device: ping device-path:[device-args,]server-ip,[client-ip],[gateway-ip][,timeout] Own IP address: Ping to %d.%d.%d.%d success failed Reading MAC address from device: No such callback function argv[%d] %s netbootnetflashpingUnknown client application called `` ELF relocation out of bounds! ERROR: Unhandled relocation (A) type %i 0123456789ABCDEF��`��`��`�� P�� p��p��0��<��`�� @�� 0�� !`��!��" ��"��#��#��$��%��& ��&p��'��'��(P��(��)p��)��*��+P��+��/0��/p��0`��2��3��3��40��4��5��6��6��7p��7��8`��9��9��;��<P��= ��=��>��>P��?P��?��?��?��@@��@��A0��A\��Ap��A��B��B ��B@��B`��B��B��B��C0��Cp��C��C��D��D ��D@��D`��D��E��E��G��G ��G@��G`��G��G��G��H��H��H��I��I��Jp��L��S0��T`��V��Y@��Yp��Y��Z��Z��Z��Z��\`��^��_��dp��ep��g��h��i��l��o��q��x@��y��z��|@�� `��@��`��0�� `��`�� 0��Ơ��0��ǀ��@��`��p�� Ր��p��``````````````````````````````````````````````��x��(�H�x�X�p�8��8� �^��c�Sc��`2�P2�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 �` `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�| 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#�`#`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(�`(`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� �!��A@�aH��P��X��`��h�p�!x�A��a��!��A��a��!��A�a�� (}��0}i�<``cxc�dc`c��C�b��#}��N�!}��0}��A@�aH�P�X��`��h�p�!x�A��!��A��a��!��A�a�� (8!0N� 7� @��2�Q��ߠ��8��Cނ׶4� ě��S��P��`�`�x8��X��8�P�h��0�@�P�`�p��8��0�� 0�H�X��`�p�x�� 0�@�P�`�p�x�� (��@�(�X�@�@��H��p��8�� ě��S��1�@��1�82��1�T2� �2�(��@�h2� �p�x��2�(��2�8��2�� (�0�H��p�8��H�P�X�`��(�`�� @�h��@�D�`�p��X��0�p��(�`��8��X��8��`�p��h��8��X��(�8�@��h��02�0�$�X2�P�XGCC: (GNU) 4.4.5.symtab.strtab.shstrtab.rela.client.rela.lowmem.rela.got.comment.branch_lt.bss �Z�0- �.�(�H�:7�7(�5�@?0@p?�H@�@S@�?�1��@XC�` S7� @�� ` @p@�3�hI�(|Q��X�<_�8o�(u��`�@\�(D�<� ��8��h��t��D��8��0�@� ��)00� �;�H�I�P|W�`�_ Df��k�P|�@��d��P��Pd�0��Hp��x��x��|�(X�\��'�`�8��TD�@8K ��PW8Xa��l 2�Qy�� X��7��p8��X� ��(�$*��3�x�B��J��P��@b��k ${��P��(��L��L��t��h� ��%x4 ��:PtA�|J��Q�XX�`8u� |}��l��H��D� 2��<��l�p��t�4� ��x|"p*��:�0@��4R�0@]@4e�pt�\�0 ��8�A0�� p��7��p��0�X#��H.��|8�H?��D��M�$U�0Hh��h�A\�`H�t�0�� X��l��8��`x��|� �._start_kernel.callback_entry.exception_forwardcall_client_interfaceof_testmdelaystrcpyset_ipv4_routerioctltranslate_address_devprintfvsprintf.undo_exception_prom_entryrecvhandle_arpget_arg_ptrset_timersend_ipv4get_sec_ticksmemmoveglue_inithandle_udp_lowmem_startfd_array._exitrtas_tokenrmmod_by_typeof_finddeviceread_iomemcpypingset_ipv4_addressrtas_pci_config_readromfs_lookupmalloccimod_check_and_installrtas_callvsnprintfset_mac_addressof_getpropwrite_ioof_set_callbackhandle_udp_dunstrtoulhandle_dnsof_call_method_3handle_ipv4socketsnk_modulesof_moduleof_release__client_endelf_load_file_to_addrtb_freq_system_call_lowmem_end_callback_entrysendget_mac_addressget_timerisxdigitstdin_datapong_ipv4strtolmodules_initglue_releasefill_udphdrof_claiminsmod_by_typeget_macwritetranslate_addressof_writehandle_tftp_dunrtas_ibm_manage_flashmodules_termof_readget_puidrtas_pci_config_writenetflashhandle_dhcp_startstrstrreadnetbootstrncmpof_closestrncpyudelaystrcasecmptftpget_args_count_rtasmemcmpof_childprintk_entrystrtoipsnk_kernel_interfaceof_opensbrkelf_load_segments32elf_load_segments64handle_tftpsend_ipmemsetmaingetchardns_get_ipelf_get_base_addr32dhcpexception_stack_framestrcmp__client_startsprintfrtas_call_entrybootpdhcp_send_releasesend_etherargncpyhandle_tcp_dunmalloc_alignedstdout_data._callback_entryisdigit.call_client_interfaceof_interpret_1set_ipv4_netmaskbootmsg_errorwrite_mm_log_gotcallback_exitping_ipv4handle_tcpfill_iphdrof_parentstrlenopendns_inittoupperget_module_by_typertas_ibm_update_flash_64.rtas_call_entrystrchrelf_get_base_addr64elf_relocate64rtas_argsfill_ethhdrundo_exceptionrtas_initclosereceive_ethervfprintffree._entry * j/z/~?�% �� B?j/$n/4z?(� �?8�?�/�?�% �% $H 4Y @S T% �I z?@@ X �� B?HDg �?P<� t% �?@ ��"?@f?X ?@ �?` �g � �@ �� J?@ �?x �g �� 2?p4g B?hDg �* �% � �p�� p�r n?� r?� �?�?��?�v?��?��?��x �?�&?��) ?�?�< .?�2?�j?��M �?� �`V?��?��?��?��?��?��?�� ``+ ��,��,?��?��?�� 2?�>?��P&�x�`&߈�p&ߐ߀&ߠg&`&&0*&8�&@�&Hx&Pr&��&��&[&N&&"& L&�&�3��&`��3��&��3��&��3�&�3�(&��03�@&��H3�X&`�`3�p& `�x3�&��3�&��3�& ��3��&P��3��&��3�& p�3�& �� 3�0&p�83�H&��P3�`&��h3�x&��3�&��3��&�3��&��3�� &��3��&��3? # *?:?0D/ `� tk �?P�5 �? �?(? ?82? 6?H>? B?@J? N?Xj?�/ � �� ?`! ?h?p! ?x! &?�(! 2?�4! >?�@! J?�L! V?�X! b?�d! n?�p! z?�|! �?��! �?�~?�{ �?�{ "?hH, N?�Pg �?h�, �?��g &?h�, �?h, �?h�, �?h, F?hl, �?h�, ?hX, �, �?h(, l, �?��?� hq r?� � !q ! ?�!$ !�q !�?�!� !�?": "Hq "Z?"l "�q "�?"� #Hq #R?#x $q $? $D $�?0$�/ %�?(%�q %�?8%� &H^ &�q &�?@&� '4� 'Pq 'Z?H'| '�q ( ?P( (xq (�?X(� (�k (�?)?p)&?`)*?h)�q )�?x)� )�?�*# *?�* / *(# *R?�*T# *j?�*t/ *� �h*�?�*�/ *�% +% +xq +�?�+� ,?�,,/ ,< ��,T� ,l� ,�?�,�/ ,�?�,�/ ,�/ ,�?�,�/ .`/ .x/ .�� / ��/D �h/` /�� /�?(/�� /�/ 0 0� �h0�� 0�?�0�/ 0�?�0�x 0�?�0�] 0�?(0�/ 1/ 1F?�1`/ 1f?�1t/ 1z?�1�/ 1�?1�/ 1�?1�/ 1�?01�/ 2DU 2�q 2�?2� 3(q 3:?3L 3�? 3� 3�q 3� 4^?(4d 4�q 4� 58q 5B?05\ 5pq 5z?85� 6q 6"?@6H 6�T 7q 7?H78 7�P 7�q 8?P8( 8�q 8�?X8� 98q 9B?`9h 9�?�9�# 9�?:R?h:V?`:b?h:f?p:r?p:�/ :�?x:�/ :�?�:�P :� ��:�?�:�# ;f ;?�;/ ;� ;&?�;*?�;2?�;6?�;:?�;>?�;`K ;v?�;�q ;�?�< =�V >$( >�( >�V >�( ?V ?V?�?Z?�?j?�?�?�?�?�@P @F?�@`T @�?�@�� @�?�@�T AP A?�A2?P&�XX&�ph&�8p&�x&��&��&��&��&�8�&� �&��&�3� &`�(3�8&��@3�P&��X3�h& �p3�&��3��& ��3��&��3��&��3��&��3��&@�3�&��3�(&�03�@&��H3�X&��`3�p&��x3��&��3��&��3��&��3��&0��3��&��3�& `�3�& �� 3�0&! �83�H&!��P3�`&"�h3�x&"��3��&#��3��&$��3��&% ��3��&%p��3��&&��3�&&��3� &'P�(3�8&'��@3�P&(p�X3�h&(��p3��&)��3��&*P��3��&*��3��&.0��3��&.p��3��&/`�3�&1��3�(&2�03�@&2��H3�X&30�`3�p&3��x3��&4��3��&5��3��&5��3��&6p��3��&6��3�&7`�3�&8� 3�0&8��83�H&:��P3�`&;P�h3�x&< ��3��&<��3��&=��3��&=P��3��&>P��3��&>��3�&>��3� &>��(3�8&?@�@3�P&?��X3�h�&�p3��&��3Ar?C�?C�?C�?��&@p��3��&@��3��&A��3��&A ��3��&A@�3�&A`�3�(&A��03�@&A��H3�X&A��`3�p&B0�x3��&Bp��3��&B��3��&B��3��&C��3��&C ��3DB? D�% D�% D�A E&? E,% ER? E\q E�? E�q E� F"?(F,e F>?0FHe Fde F� F�6 F�e G?8G"?8GB?8Gb?8G�?8G�?8H`q Hz?@H~?HH�?8H� �H�?8H� �H�?8H� �I2?PI6?8I�?8I�?PI�q J% J4% J�?8KB K e K|q K�B K�� K�B K� ��K�~ LV?XLhe L�% L�% L�~ MF?8N�?XN�?`N�q N�B N� ��N�B N�� O~ Ob?8O�?XO�B O�� O�% O�~ P�?XQe Q6?PQb?8Q�q R�q R�B R�� R�% S?XS2?8S�q T8 U�% U� Vd2 V�� V�?8W?8X% X�% X� ��Y Y� Y�Q Z8X ZPo Zx4 Z�?h[l% \?p\ \�?x]0 ��]R?h]~?h]� ��]�x ^(x ^L ��^�� ^�?h^�q _ _� _LJ _l� _| `?p`?h` `"?�`(Z `:?�`@Z `N?�`XZ `pZ `~?�`�Z `�Z `�?�`�Z `�Z a?�a a`_ a| a�� a�_ b b&?�b( bt� b~?�b�Z b�� b� b�� c ��c c c0� cPC cr?�cx c� ��c�?�c� d�q d�� d�J d�?�e eB e$% e4 e�q e� e� f f�B f�e f�?�f�% f� g C g�?�g� g�?�g�?�g� g� �g� �h?�h hB?�hH h�% i% i4% kL% k� �HlHq lR?�l\e n8% n�% o�?�o�% qX� qt% q�� q�% r0q r�?r�% r�?�r�e r�� s_ s(� sD_ s�% s� �xt� t$� tH' t�� t�_ t�_ u8q uTB uh% u|q u�% u�% u� ��u�J v� v vT% v� �`v� �xv� v�� w w wH �`wd �`w| �`w�?w� w�� w�_ w�?w� x _ xn?x|q x�?x� x�B x�% x�q x� ��yJ y,� y< y�?y�q y�B y�% y�q z$ ��z8J zX� zh z�?z�� {?{Z {0Z {L_ {pG {� |� |�?|�?|� |� |�?|� |�? |� |�s } ��} }( }0� }LC }| }�s }�?(}� }�?8}� ~,� ~D ��~h ~� ~�t ?0 �?@�?@�?H�?P� �R?P�hz �� ?H�q �"?@�HJ �Z?X�� 6?`�Pq �Z?@�j?h�� J �� % �(� �@� �X% �d� �|� ��% �� % ��?X�d� �t� �~?h�� ?@�Z?p�dz �n?x�p �� 8�� h�� C ��?H� �P�b?H�x �� ?�� h�, �8�2?��4 �r?��t ��?@�� 8�� ?H�V?h�h� �� e �� 3 � �P�"?��|q ��J ��?X� �P��% � �P�X �P�� @G �`G �xG ��G ��G ��?�� ?�� q ��7 �s �0 �8 �@C �`7 ��?�� . ��c ��?��$% �b?�t ��?�� b ��?�� v ��?� �?�<z �L� �X� �l� ��q ��?��% ��e �e �,% �F? �P �^?��d �xe ��| ��_ �� i �(q �< �lq ��q �� ( �2?��8a �\ �t} ��e ��e ��' ��% ��?��a �?��a �, �6?��`G ��q ��G ��e ��% �e �,% �Hq �d �� i �q � �D �Ti �|q ��q �� ?�� ?�� "?p�0z �D� �N?��Tz �d� �n?��tz �� q ��?(�� ?@�� .?x�^?8�hz �x� �� ?��z �� ?� �� (� �<� �N?��\z �l� �x� �� ?H�� ?P�� $� �6?X�@ �P� �\� �p� ��?`�� ?h�� ?��(z �8� �D� �X� �j?��t �� ?0��z �� ?��z �(� �2?��8z �H� �R?��Xz �h� �r?��xz �� ?��z ��?�� q �<G �R?��X �p7 ��? �� . ��?(�� v ��' ��?@� �Z?H�\ �p ��b ��} ��?�� ?�� ?�� ?�� *?��, �6?�8 �B?�D ��?8��z ��R ��?P� � ?X� �� N?�T �b?p�h �z?��| ��?�� ?0�� R ��?x�?�� "?��$ �2?��4 �B?��D �R?��T �b?`�l �z?h�� ?�� ?�� q �c �P �`i �� i ��?�� i �q �? �$ �<7 �n?��p �|. ��?�� v ��' ��?�� % �?� � � �( �T �`C �p� �xF ��?�� % ��?�� ?�� ( �L �\i �t �� i �� G � �2?��4 �F?��H �Z?��\ ��_ �p� ��?(��Z ��Z ��_ ��G �|_ �� ?0�� ?8�� ?@� �~?H��1 ��?P��x ��?X��x ��?`��x ��& �W �H\ �r?h�t ��?@�� &C@�3�&C`� 3�0&C��83�H&D�P3�`&D��h3�x&F��3��&F ��3��&F@��3��&F`��3��&F��3��&F��3�&F��3� &G��(3�8&G��@3�P&G��X3�h&H�p3��&H��3��&Ip��3��&K��3��&R0��3��&S`��3��&U��3�&X@�3�(&Xp�03�@&X��H3�X&Y��`3�p&Y��x3��&Y��3��&Y��3��&[`��3��&]��3��&^��3�&cp�3�&dp� 3�0&f��83�H&g��P3�`&h��h3�x&k��3��&n��3��&p��3��&w@��3��&x��3��&y��3&{@3 &~�(38&~�@3P&�X3h&��p3�&��3�&��3�&��3�&��3�&��3�&��3&�3(&��03@&��H3X&� `3p&��x3�&�`�3�H� �`u �8n �dm �t� ��n �� u ��m �&��3�&��3�&��3�� q �&�@�3&��3�b?��d ��?p�� ?x�� q &�� 30&�83H&��P3`&��h3x&��3�&�`�3�&��3�&��3�&��3�� ] �&�0�3&� 3 &�`(38&��@3P&�`X3�� h&��p3��?��&��3�&��3�&� �3�&��3�n?��pl �Xl �&�0�3�&Š3� &��3�P- (&�003ǒ?�Ǹ� @&ƀH3 &1� @&1�p�([ Ȝ[ �[ �B?��D X�` X�?�� X� X�� X�D �8 X�� G � X�t X�� G �4 XΔ X�$ �4 Xτ� Ϩ X�4� �`G Є Xм �$ X�@� ��D �� X�D� �h XԔ �X&��`3p&�@x3�&�`�3�&�p�3�&� �3�&Ԑ�3� - �8N �&��3�v?��?��P �3 �B?��3 �$� ܤ� �� @ �f?�ݔ ݤ ݶ?�� F?�ވ ޘ &�p3&�� 30&��83 `& `& �&`&�&`& `&`&`&`&`&`&?`&`&`&`&`&`&`&`&`&`&`&`& `&!`&"`&#`&$`&%`&&`&'`&(`&)`&*`&+`&,`&-`&.`&/`&0`&1`&2`&3`&4`&5`&6`&6�h)6�h'7h7h7?7�?&7�&7�&7�&7�y&7�&7�;&7�=&7�&7�&ޠ7�&�88&8&��8&��8&�8 &�88(=&8@8&8H&�P8P8&8Xy&�8`&�8hj&8p&�`8x$&8�0&8�9&8�w&8�&@8�&8�w&8�>&8�&߰8�d&8�j&8�&߸8�&��8�&��8�&�8�&�88�&�P9&�h9&��9&Hp9&��9 &�9(&��90&��98&�9@&�9H&�09P&�@9X&�P9`&�`9h&�p9p�&9x&�9�&�9�&89�&�9�&�9�&��9�&H�9�&��9�&��9�&��9�&��9�&��9�&�9�&�9�&� 9�&�09�&�H:&�X:&��:&��:&��: &�`:(&�p:0&�x:8&�:@&�:H&�:P&�:X&��:`&��:h&��:p&��:x&��:�&�:�&�:�&� :�&�0:�&�@:�&�P:�&�`:�&�p:�&�x:�&�:�&�:�&�:�&�:�&�:�&��:�&��;&��;&��;&;&��; &��;(&�;0&�;8&� ;@&�(;H)&;PO&;X(&;`V&;h&�X;p&�@;x&�@;�&�;�j&;�&�H;�&I4;�&�p;�&;�&I�;�=&;�&0I�;�&�;�&�;�&0O�;�p&;�&;�&�<&�<&0O�<&1��<&�< &1��<(&�<0&�<8&�<@&�<H&�<P&��<X&��<`&��<h&�@<p&�h<x&1��<�&�p<�&�x<�&�<�&�<�&�<�&1��<�&�<�&�<�&�<�&��<�&��<�&��<�&�<�&1��<�&�<�&�=p&=&� =&�=&�(= &�0=(&�H=0&�=8&�p=@&�8=H&�=P&�=X&�=`&��=h&�=p&�H=x&�P=�&�X=�&=�&�`=�&�=�&�=�&��=�&��=�&�(=�&�`=�&�=�&��=�&��=�&� =�&�@=�&�h=�&�>&�>&��>&�>&�@> &�D>(&�`>0&�p>8&�>@&�>H&�>P&��>X&�X>`&��>h&�0>p&�p>x&�>�&��>�&��>�&�>�&�(>�&�`>�&�>�&��>�&��>�&�>�&�8>�&�>�&�X>�&�>�&��>�&��>�&�?&��?&��?&�?&�8? &��?(&�`?0&�p?8&�?@&�?H&�?P&��?X&�?`&�h?h&�?p&�?x&��?�&�?�&�8?�&�?�&�X?�&��?�&��?�&�?�&�(?�&�8?�&�@?�&�?�&�?�&�h?�&�?�@&?�&�@&�@&�@&�@&��@ &�@(&�@0&�0@8&1�@@�&@HE&@P&�$@X&�X@`&1��@h&�X��H0net_vethELF�@�@8@��P� ��|��"��b��!��8��}iXPx`�@�@�#�b�}d[x� �A(| ��i�IN�!�A(8`8!p�|�N� �"��$| Px!A�,0��9ix || P| �8� 9)B��HA`K��8`N� ```|��"�0��|�#x��(�!��?� �c�A�,8`8!��|�N� ```�#H肀88~8� �A(| ��i�IN�!�A(/�@��>��@�?�K��```|��|�#x8��!��g��(xd,x8�8�8�99 �~HM`|dy@� 8!��x��|�N� �>�b�H;��)� �A(| ��i�IN�!�A(K��`|��A��a��|zx|�#x��?��c��!��!�A��(��x�```�?� x&�}I}i.�*U`�@@�y`�;�A�X��@A��/�|��A�@8��yk x� }yZ8�I�x|��```�9k� 9)B��!t��p8`��pHA`�?8 x /��@��= =)��= /�A��88!��x��!��A��a��|��N� `�=�b�P�)� �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&,``cx8y��@8`;�H�`|dy@��;�?��c�c��x``�?@��8`| �| �*�t;��p�pHu`��@��;8!�88`�a�� |��N� �?�b�X�)� �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�`�)� �A(| ��i�IN�!�A(K��D"N� xf��8`X8�D"N� }H�H-}H�,M� = �a)8��|dH�8��N� |dx8`��= �a)8��|0@L� 8`TD"= �a)8��8`�i(M� 8`��N� ��|dx8`D"N� 9`}*Kx} Cx|�;x|�3x|�+x|�#x|dx8` D"N� |�#x|dx8`<D",#|�#xM� 8`��N� |�+x|�#x|dx8`@D"N� Module size (%llu bytes) is too big! IBM,l-lanveth: Error %ld sending packet ! veth: Dropping too big packet [%d bytes] veth: Failed to allocate memory ! veth: Error %ld registering interface ! �p�X�@�(� ��p��0��p��P�� P�� H� pGCC: (GNU) 4.4.5.symtab.strtab.shstrtab.rela.code.branch_lt.rela.got.bss.comment ��x� &��p6��h18 ;��p`@0p�I�h �{��P��(��4��PA�P��\� Pp��__bss_end.hv_hascharveth_module_init__bss_start__module_end__module_startmodule_inithv_send_logical_lanhv_generic�&?�*?�N?��?��/$�� & �3�?0�?(�f?8��?@��?(� �6?H��?(�X ��?P�:?(�x ��?(�� $ �n?X�f?`� �&p� �&X� �&@� �&(� �& �� &��3�&�3�(&��03�@&p�H3�X&0�`3�p&p�x3�� H��H��H��H� H� H�� &�� &��&��& ��&��&��& ��& ��&��& ��& ��& H��& p��)(�0net_e1000ELF�@(@8@��HV�� |��"��b��8��}iXPx`��!��|ix@�D�#�b�}d[x� �A(| ��i�IN�!�A(8`8!��|�N� �b��$|Px!A�,0��9Kx | |P| �8�9kB��(�i��A�8`K��b�0|�#x�+HM`/�A��8��x�K��l�|��"�@�b�H8��!��)�|c�)X� �A(| ��i�IN�!�A(8!px` xc�T D.T�>} xTiD.Tc�>T�}#x|x�xc |�N� �`|��"�@�b�H8��!��x� T D.T�>}Jxx��T�D.T��>}#xUJ�}D#xx� �)�k|cZ�)`� �A(| ��i�IN�!�A(8!p�|�N� �`�c|ixm`��/��A�8`��N� `�/�A��P9@9g``�9J/�@@A��9k@��/�A��y@.�yJ$| P�B�H8`|�=j�� 8� �I� �K@(�@ � �@)N� ��P9@K��```|��X��!�q�/�A��8`8�K��m8�8`K��a뢀@8` �=�)� �A(| ��i�IN�!�A(8`(8�K��)8`(8�K��8`88�K��8�8`8K��8`TK��mxd`8`TK��8`K��Ydd�8`x� K��=8` �)� �A(| ��i�IN�!�A(8`K��dd8`x� K��=8` �)� �A(| ��i�IN�!�A(�=8�8�낀H�)(?��@(��@)� �A(| ��i�@�I�~@ N�!�A(�=�@0<��x`�@*|�"�)0� �A(| ��i�IN�!�A(8�8!�8`��|��N� �``8`N� ```|��||x8`(��!�qK��"�H?��@�A�9)x&��yj�@�08!�;��x��|��N� `}i��?��x��yk��y)�Ɖ_})[xyEƉ}KxxƉ?|CxyJ��}Jxyk��}kSxy)E�})[x| Kx�y+ y)"y* yh UGD.UD.y)�yk�U�>UJ�>|�Cx|�SxU(D.UgD.U)�>Uk�>|�[x} Kx��@0UJ�TD.T��T�>�x|�[x}IKx;��y) x��|�Kx��|� P{� H M`88�8�H�`|��@8`(K��>@8!��x8 T~��@��|�N� �|��8`��X��!��A��a��!�1�/�A�@8!��!��|��A��a��N� ``�@낀H<�8�`�@*��x?��>�)(� �A(| ��i�IN�!�A(�>��@(8�8��@)||P�}@0�}@ �) � �A(| ��i�IN�!�A(��x�>Tc6�k �)p� �A(}c[x| ��i�IN�!�A(�>��@(8�8��@)�}@ �) � �A(| ��i�IN�!�A(8��x� �}@8`�K��E8`K��x`��@��>8`d;`0�)� �A(| ��i�IN�!�A(8`K��q|`xHD`�>;{��)� �A(| ��i�IN�!�A(8`K��5{{!|`xA�8x ��8`dA��9`9?P}i�8�i9)|x B��/�;!p;@��xA��S�R�?P��Qx�(yk�(��U}kxT�@.�T}iKx{�D(|�Kx�xx� 8`TK��1gĀ8`Tx� ;�TK��x8�K��8~;�xc 8�{� K��/�T�@��;;\;<��x[�x<�x�x��x8�8�H�`|��@0|�;�0x x"x y* UFD.UgD.x�y)�UJ�>Uk�>|�Sx|�[xU&D.TD.U)�>T�>|�Kx|�xUJ�Uk�}IKx}`xy)�x } x�;��@��lB8`8{"K��-{ 8`8K��!8`88�K��8`88�K�� 8`88�K��<�8``��?�K��8`8�K��;�x;�(^�x��x``��x8�8�H�`|��@0|�;�0x x"x y* UFD.UgD.x�y)�UJ�>Uk�>|�Sx|�[xU&D.TD.U)�>T�>|�Kx|�xUJ�Uk�}IKx}`xy)�x } x�;��@��l8ZB�@8`({D"K��{D 8`(K�� 8`(8�K��8`(8�K��8`(8�K��8`( 8�K��8�8``��K��88`�K��<�x ��A�<;`8�D 08``�x� K��8`K��i9|`x@��>8`:��)� �A(| ��i�IN�!�A(8`K��|`xHL```�>:��)� �A(| ��i�IN�!�A(8`K��uz�!|`xA��| �98`A��;ZT�>{Z �;9/�@��x ��@��t�!r�pW��>�?R��TU*�>T�>y)��Q�P}$x�_S�UK��T`xk��8`��A��K��x��;`8�A��K��|k�9@��p�8�b�`�)� �A(| ��i�IN�!�A(8`��K��8`K��xk��A��X��tk��tK��L� ``|��||x8`8��|�#x��!�qK��9|x8`8K��-;�W�~�|}xA�H�b�Hx`&��x{� 9+=�}i��@0��?�_yk��x��|[xx�EƉ|�xy)ƈ});xyJ��}JKxyk��?}kSxxE�|[x} xx x"x y* UgD.UCD.x�y)�UJ�>Uk�>|cSx|�[xT D.U'D.T�>U)�>|�Kx}@xUk�Tc�|cKx}`xx xc�|cx|hPH�`{� T �>T@.|Kx9 �?�9 �?|�8�8`8x�`K��8!��x��|��N� 8!�;��x��|��N� �,%M� 8��x� x� |ix8�|��9)B��N� ,%M� 8��|ixx� 8�|��`�8�� 9)B��N� Module size (%llu bytes) is too big! �� y�0z�P{�p��&��'��(��v� w�0x�@|�P�X�h�x��Failed to read MAC address from EEPROM! 82547EI/GI Copper82547EI Mobile52546EB Copper, Dual Port82546EB Fiber, Dual Port82546GB Copper, Dual Port82546GB Fiber, Dual Port82546GB SerDes, Dual Port82545EM Copper82545EM Fiber82545GM Copper82545GM Fiber82545GM SerDes82544EI Copper82544GC Copper82541EI Copper82541EI Mobile82541GI Copper82541GI Mobile82541ER Copper82541PI82540EM Mobile82540EP Mobile82540EP Desktop82540EM Desktop��8�h��P� ��@�� P�V��V��P��P�`�@��GCC: (GNU) 4.4.5.symtab.strtab.shstrtab.rela.code.branch_lt.rela.got.bss.comment �� &��6��`h1'�8 ;�P�@H@0��I�� h��P��D� ��V��P4�P@��<G��X\��V�i�x�memcpycheck_driver__bss_endsnk_kernel_interface__bss_startmemsetsnk_module_interface__module_end__module_startmodule_init�&?�*?�V?��?��/$��?(��?0�� ?8�& �3�&?@�*?H��?@��?H�n?P��?H��?P�&?X�D �P �V?@�� R?H�D ��J?H�� ?X�r?@�v?H�l �t �� ( ��h �� b?`� � �� ?H�� ( ��&��&8��&h��&��&P��& ��3�&��3� &@�(3�8&�@3�P&�X3�h& �p3��&��3��& ��3�P&��h&��&��&��&0��&P��&p��&��&��(&��@&��X&��p&��&��&��&��& ��&0�&@�&P�0&X�H&h�`&x�x&��&��3��&��3�� &�� &��&��&�&�&�&�&� &�(&�0&@�8&��@&��'X' 0net_virtioELF�@�@8@�� @|��"��b��8��|�#x}iXPx`��!�q|x@�P�#�b�}d[x;�� A(| ��i�IN�!�A(8!��x��|�N� ��"�$8�|x|HPx H 1`뢀8�b�(�"�0��@�]��PA�;�K��x��xH�`/�A��xK��8`��N� ```|�/��|�#x��!�qA��"�X�`9��IP� 8�iH� U<|��|��|�@P|��x�&�8�|�"x�&�}*x� �!*;��|k)*;��9� ��j}�|�}`XPyk�}JZ��|��)P�b�h8��i8� H!`8!��x��|�N� ``�"�H�b�P;��)�)� �A(| ��i�IN�!�A(8!��x��|�N� �`|��;��X뢀p�a��|{x�!�a�?(�}� �XA��}K�}J�}jXPykH})Z��9<;��HP� ��A��?{�&�c�x{� ;��|�*H�`�? ��9� �}@[�}jY�|Px�})��|��? �b�h8��i8� H �`8!��x��a��|��N� ```�"�H�b�x|�#x�)�)� �A(| ��i�IN�!�A(K��(�|��!�� ?� /�A�0�h8��xH =`��xH�`�?8� 8!�8`��|�N� �`|��8`�� !�q�?� /�A�$8!��|�N� `�h8��xH�`��x8�H�`뢀H8`_@�=�)0� �A(| ��i�IN�!�A(邀X/��lA��,�L 9`;� 8�8��8�898�� jy 9 /� �i��8c�� 9J9) @��|��, �(9`9@��x8��I�i�B�p�,P�� iH�`��x8�H=`�?8!�88`�� |�N� �=�b��)� �A(| ��i�IN�!�A(��x8��H)`8`��K��\��|��‘��8�!��A��a��!�!�/��A�<8`��8!��!��|��A��a��N� �$8 �+�?A��$$<�@��뢀��8��d�8��=�) � �A(| ��i�IN�!�A(x`��apA�\|+xxcd�=; ;��x�kq�)p� �A(}c[x| ��i�IN�!�A(�p��x�H=`�b��{�&�{�6d��P�8`@8�{�D(8��*D"�8`<8�8�D"/�8`��=��x� xc @�x�D(x��|c#x�|�I8HE`��A(8�xc | ��z�Z{��Z�;Z{Z&�N�!�A([�/�|wx�zA��|H�`8�xe ~�xHM`��8`@8�|ft|�8�x x x�U&D.U)�>|�KxT D.T�>} xTƀ|�xx� D"�<�;9��;�{9!��y+dy)&�|J9+�} J� y)��<(@��8뢀�;��8`<8�|��D"/�}=�x� A�8��<;�5 ��!�@��x8�H`8`K��@�8�b��)� �A(| ��i�IN�!�A(8`��K��=�b��K�� ,%M� 8��x� x� |ix8�|��9)B��N� ,%M� 8��|ixx� 8�|��`�8�� 9)B��N� xi&�89)�x(xc$| 8c�x�xc�|`N� ``��|x8`�/�@�Tx� �8`@T��>T�@.|�x8�x� 8�D"|��8`<8�8�D"/�8`��xc A��N� x� ��T�@.|c4T��>|c#xxc N� `��|x8`�/�@�|x� �8`@T��>T�@.|�x8�x� 8�D"|��8`<8�8�D"/�@�Dx� x x�U+�>U#@.|c[xT D.T�>} xTc�|cxxce��N� ``�b��N� ``|��|}x|�#x��!�qK��!��x|x��xK��q8!�xc&��|��|�N� �```|��|}x|�#x��!�qK��q��x|x��xK��8!�;��xcd��{��|�N� �`�/�L� �8�8`@8�8�D"N� ```�/�L� x� �8`@T��>T�@.|�x8�x� 8�D"N� ```�/�L� �x� 8`@8�8�D"N� ```�/�L� �x� 8`@8�8�D"N� ```��|ix|�#x��8`��/�@�0��/�;�A��A�,/�A��8`��```��N� /�A��/�@��8`<8�|��D";��/�{��@�x��8�8`<|�*8�D"/�x� A�8��x� |��x��N� |�"8`<8�D"/�x� A��h8`��xc K��\``|�"8`<8�D"/�x� A��88`��xc K��,``|�"8`<8�D"/�x� A��8`�K��|�3x��/�A�(;��x��N� ```/��@��9&��;�y) ��9)|�#x�!��``8`<8��xD"/�x� A�8��;�;��5 ��!��@��x��N� Module size (%llu bytes) is too big! virtionet: Packet too big! virtio-net: Receive buffer not big enough! virtionet: Failed to allocate buffers! First BAR is not an I/O BAR! malloc failed! ��x�0��@�P��@��@� ��@��@��@� ��@� 0��@� ��@� ��@�`��@� ��@��@� ��@� @��@� ��@� ��@��@�p��@��@�� h� �� GCC: (GNU) 4.4.5.symtab.strtab.shstrtab.rela.code.branch_lt.rela.got.bss.comment ��@� ` &�@�6�@��1$�@ ;��@0��I�� 0O��@��@�h��88)� D0� XD��N� `Q��[��Do��X��<��4��P��4��48��dvirtio_get_vring_descvirtio_vring_sizememcpyvirtionet_interface__bss_endvqvirtiodevvirtio_queue_notifysnk_kernel_interfacevn_module_init_pci__bss_startmemsetvirtio_reset_devicesnk_module_interface__module_end__module_startvirtio_get_qsizevirtio_set_statusmodule_initvirtio_set_guest_featuresvirtio_get_vring_avail�&?�*?�b?��?��/$�� ?8��?(��?0��?@� �& �3�v?X�z?`�?h� �R?H�V?P��?X��?p�P ��?h�� ?H��?x�6?��J?h�T �` ��?��?h�� ?H�B?X��?p�� >?��h �8&��@&��X&��`&��h&x�x&0��3��&P��3��&��3��& ��3��&��3��?��2?�� ?��< �� >?�� ?�� ?��&��3�& ��3� & 0�(3�?��@ �P �� 8& ��@3�P& ��X3�h&`�p3��& ��3��&��3��& ��3��& @��3��& ��3��& ��3�&�3�(&p�03�@&�H&�P&@�X&�` &�h&�p&�x &��&��&��&h��&��&��&��&��&��&��&�� &��&��&��&��&��&��<�<](ide.fs1 encode-int s" #address-cells" property 0 encode-int s" #size-cells" property : decode-unit 1 hex-decode-unit ; : encode-unit 1 hex-encode-unit ; 0 VALUE >ata \ base address for command-block 0 VALUE >ata1 \ base address for control block true VALUE no-timeout \ flag that no timeout occured 0c CONSTANT #cdb-bytes \ command descriptor block (12 bytes) 800 CONSTANT atapi-size 200 CONSTANT ata-size : ata-ctrl! 2 >ata1 + io-c! ; \ device control reg : ata-astat@ 2 >ata1 + io-c@ ; \ read alternate status : ata-data@ 0 >ata + io-w@ ; \ data reg : ata-data! 0 >ata + io-w! ; \ data reg : ata-err@ 1 >ata + io-c@ ; \ error reg : ata-feat! 1 >ata + io-c! ; \ feature reg : ata-cnt@ 2 >ata + io-c@ ; \ sector count reg : ata-cnt! 2 >ata + io-c! ; \ sector count reg : ata-lbal! 3 >ata + io-c! ; \ lba low reg : ata-lbal@ 3 >ata + io-c@ ; \ lba low reg : ata-lbam! 4 >ata + io-c! ; \ lba mid reg : ata-lbam@ 4 >ata + io-c@ ; \ lba mid reg : ata-lbah! 5 >ata + io-c! ; \ lba high reg : ata-lbah@ 5 >ata + io-c@ ; \ lba high reg : ata-dev! 6 >ata + io-c! ; \ device reg : ata-dev@ 6 >ata + io-c@ ; \ device reg : ata-cmd! 7 >ata + io-c! ; \ command reg : ata-stat@ 7 >ata + io-c@ ; \ status reg 00 CONSTANT cmd#nop \ ATA and ATAPI 08 CONSTANT cmd#device-reset \ ATAPI only (mandatory) 20 CONSTANT cmd#read-sector \ ATA and ATAPI 90 CONSTANT cmd#execute-device-diagnostic \ ATA and ATAPI a0 CONSTANT cmd#packet \ ATAPI only (mandatory) a1 CONSTANT cmd#identify-packet-device \ ATAPI only (mandatory) ec CONSTANT cmd#identify-device \ ATA and ATAPI : set-regs ( n -- ) dup 01 and \ only Chan 0 or Chan 1 allowed 3 lshift dup 10 + config-l@ -4 and to >ata 14 + config-l@ -4 and to >ata1 02 ata-ctrl! \ disable interrupts 02 and IF 10 ELSE 00 THEN ata-dev! ; ata-size VALUE block-size 80000 VALUE max-transfer \ Arbitrary, really CREATE sector d# 512 allot CREATE packet-cdb #cdb-bytes allot CREATE return-buffer atapi-size allot scsi-open \ add scsi functions : show-regs cr cr ." alt. Status: " ata-astat@ . cr ." Status : " ata-stat@ . cr ." Device : " ata-dev@ . cr ." Error-Reg : " ata-err@ . cr ." Sect-Count : " ata-cnt@ . cr ." LBA-Low : " ata-lbal@ . cr ." LBA-Med : " ata-lbam@ . cr ." LBA-High : " ata-lbah@ . ; : status-check ( -- ) ata-stat@ dup 01 and \ is 'check' flag set ? IF cr ." - ATAPI-Status: " . ata-err@ \ retrieve sense code dup 60 = \ sense code = 6 ? IF ." ( media changed or reset )" \ 'unit attention' drop \ drop err-reg content ELSE dup ." (Err : " . \ show err-reg content space rshift 4 .sense-text \ show text string 29 emit THEN cr ELSE drop \ remove unused status THEN ; : wait-for-ready get-msecs \ start timer BEGIN ata-stat@ 80 and 0<> \ busy flag still set ? no-timeout and WHILE \ yes dup get-msecs swap - \ calculate timer difference FFFF AND \ reduce to 65.5 seconds d# 5000 > \ difference > 5 seconds ? IF false to no-timeout THEN REPEAT drop ; : wait-for-status ( val mask -- ) get-msecs \ initial timer value (start) >r BEGIN 2dup \ val mask ata-stat@ and <> \ expected status ? no-timeout and \ and no timeout ? WHILE get-msecs r@ - \ calculate timer difference FFFF AND \ mask-off overflow bits d# 5000 > \ 5 seconds exceeded ? IF false to no-timeout \ set global flag THEN REPEAT r> \ clean return stack 3drop ; : cut-string ( saddr nul -- ) swap over + swap 1 rshift \ bytecount -> wordcount 0 do /w - dup ( addr -- addr addr ) w@ ( addr addr -- addr nuw ) dup ( addr nuw -- addr nuw nuw ) 2020 = IF drop 0 ELSE LEAVE THEN over w! LOOP drop drop ; : show-model ( dev# chan# -- ) 2dup ." CH " . \ channel 0 / 1 0= IF ." / MA" \ Master / Slave ELSE ." / SL" THEN swap 2 * + ." (@" . ." ) : " \ device number sector 1 + c@ 80 AND 0= IF ." ATA-Drive " ELSE ." ATAPI-Drive " THEN 22 emit \ start string display with " sector d# 54 + \ string starts 54 bytes from buffer start dup d# 40 \ and is 40 chars long cut-string \ remove all trailing spaces BEGIN dup w@ wbflip wbsplit dup 0<> \ first char IF emit dup 0<> \ second char IF emit wa1+ \ increment address for next false ELSE \ second char = EndOfString drop true THEN ELSE \ first char = EndOfString drop drop true THEN UNTIL \ end of string detected drop 22 emit \ end string display sector c@ \ get lower byte of first doublet 80 AND \ check bit 7 IF ." (removable media)" THEN sector 1 + c@ 80 AND 0= IF \ is this an ATA drive ? sector d# 120 + \ get word 60 + 61 rl@-le \ read 32-bit as little endian value d# 512 \ standard ATA block-size swap .capacity-text ( block-size #blocks -- ) THEN sector d# 98 + \ goto word 49 w@ wbflip 200 and 0= IF cr ." ** LBA is not supported " THEN sector c@ \ get lower byte of first doublet 03 AND 01 = \ we use 12-byte packet commands (=00b) IF cr ." packet size = 16 ** not supported ! **" THEN no-timeout not \ any timeout occured so far ? IF cr ." ** timeout **" THEN ; : pio-sector ( addr -- ) 100 0 DO ata-data@ over w! wa1+ LOOP drop ; : pio-sector ( addr -- ) wait-for-ready pio-sector ; : pio-sectors ( n addr -- ) swap 0 ?DO dup pio-sector 200 + LOOP drop ; : lba! lbsplit 0f and 40 or \ always set LBA-mode + LBA (27..24) ata-dev@ 10 and or \ add current device-bit (DEV) ata-dev! \ set LBA (27..24) ata-lbah! \ set LBA (23..16) ata-lbam! \ set LBA (15..8) ata-lbal! \ set LBA (7..0) ; : read-sectors ( lba count addr -- ) >r dup >r ata-cnt! lba! 20 ata-cmd! r> r> pio-sectors ; : read-sectors ( lba count addr dev-nr -- ) set-regs ( lba count addr ) \ Set ata regs BEGIN >r dup 100 > WHILE over 100 r@ read-sectors >r 100 + r> 100 - r> 20000 + REPEAT r> read-sectors ; : ata-read-blocks ( addr block# #blocks dev# -- #read ) swap dup >r swap >r rot r> ( addr block# #blocks dev # R: #blocks ) read-sectors r> ( R: #read ) ; : set-lba ( block-length -- ) lbsplit ( quad -- b1.lo b2 b3 b4.hi ) drop \ skip upper two bytes drop ata-lbah! ata-lbam! ; : read-pio-block ( buff-addr -- buff-addr-new ) ata-lbah@ 8 lshift \ get block length High ata-lbam@ or \ get block length Low 1 rshift \ bcount -> wcount dup 0> IF \ any data to transfer? 0 DO \ words to read dup \ buffer-address ata-data@ swap w! \ write 16-bits wa1+ \ address of next entry LOOP ELSE drop ( buff-addr wcount -- buff-addr ) THEN wait-for-ready ; : send-atapi-packet ( req-buffer -- ) >r ( R: req-buffer ) atapi-size set-lba \ set regs to length limit 00 ata-feat! cmd#packet ata-cmd! \ A0 = ATAPI packet command 48 C8 wait-for-status ( val mask -- ) \ BSY:0 DRDY:1 DRQ:1 6 0 do packet-cdb i 2 * + \ transfer command block (12 bytes) w@ ata-data! \ 6 doublets PIO transfer to device loop \ copy packet to data-reg status-check ( -- ) \ status err bit set ? -> display wait-for-ready ( -- ) \ busy released ? BEGIN ata-stat@ 08 and 08 = WHILE \ Data-Request-Bit set ? r> \ get last target buffer address read-pio-block \ only if from device requested >r \ start of next block REPEAT r> \ original value drop \ return clean ; : atapi-packet-io ( -- ) return-buffer atapi-size erase \ clear return buffer return-buffer send-atapi-packet \ send 'packet-cdb' , get 'return-buffer' ; : atapi-test ( -- true|false ) packet-cdb scsi-build-test-unit-ready \ command-code: 00 atapi-packet-io ( ) \ send CDB, get return-buffer ata-stat@ 1 and IF false ELSE true THEN ; : atapi-sense ( -- ascq asc sense-key ) d# 252 packet-cdb scsi-build-request-sense ( alloc-len cdb -- ) atapi-packet-io ( ) \ send CDB, get return-buffer return-buffer scsi-get-sense-data ( cdb-addr -- ascq asc sense-key ) ; : atapi-read-blocks ( address block# #blocks dev# -- #read-blocks ) set-regs ( address block# #blocks ) dup >r ( address block# #blocks ) packet-cdb scsi-build-read-10 ( address block# #blocks cdb -- ) send-atapi-packet ( address -- ) r> \ return requested number of blocks ; : atapi-read-capacity ( -- ) packet-cdb scsi-build-read-cap-10 \ fill block with command atapi-packet-io ( ) \ send CDB, get return-buffer return-buffer scsi-get-capacity-10 ( cdb -- block-size #blocks ) .capacity-text ( block-size #blocks -- ) status-check ( -- ) ; : atapi-read-capacity-ext ( -- ) packet-cdb scsi-build-read-cap-16 \ fill block with command atapi-packet-io ( ) \ send CDB, get return-buffer return-buffer scsi-get-capacity-16 ( cdb -- block-size #blocks ) .capacity-text ( block-size #blocks -- ) status-check ( -- ) ; : wait-for-media-ready ( -- true|false ) get-msecs \ initial timer value (start) >r BEGIN atapi-test \ unit ready? false if not not no-timeout and WHILE atapi-sense ( -- ascq asc sense-key ) 02 = \ sense key 2 = media error IF \ check add. sense code 3A = \ asc: device not ready ? IF false to no-timeout ." empty (" . 29 emit \ show asc qualifier ELSE drop \ discard asc qualifier THEN \ medium not present, abort waiting ELSE drop \ discard asc drop \ discard ascq THEN get-msecs r@ - \ calculate timer difference FFFF AND \ mask-off overflow bits d# 5000 > \ 5 seconds exceeded ? IF false to no-timeout \ set global flag THEN REPEAT r> drop no-timeout ; 2 CONSTANT #chan 2 CONSTANT #dev : #totaldev #dev #chan * ; CREATE read-blocks-xt #totaldev cells allot read-blocks-xt #totaldev cells erase : dev-read-blocks ( address block# #blocks dev# -- #read-blocks ) dup cells read-blocks-xt + @ execute ; : read-ident ( -- true|false ) false 00 ata-lbal! \ clear previous signature 00 ata-lbam! 00 ata-lbah! cmd#identify-device ata-cmd! wait-for-ready \ first try ATA, ATAPI aborts command ata-stat@ CF and 48 = IF drop true \ cmd accepted, this is a ATA d# 512 set-lba \ set LBA to sector-length ELSE \ ATAPI sends signature instead ata-lbam@ 14 = IF \ cylinder low = 14 ? ata-lbah@ EB = IF \ cylinder high = EB ? cmd#device-reset ata-cmd! wait-for-ready \ only supported by ATAPI cmd#identify-packet-device ata-cmd! wait-for-ready \ first try ata ata-stat@ CF and 48 = IF drop true \ replace flag THEN THEN THEN THEN dup IF ata-stat@ 8 AND IF \ data requested (as expected) ? sector read-pio-block drop \ discard address end ELSE drop false THEN THEN no-timeout not IF \ check without any timeout ? drop false \ no, detection discarded THEN ; scsi-close \ remove scsi commands from word list : find-disks ( -- ) #chan 0 DO \ check 2 channels (primary & secondary) #dev 0 DO \ check 2 devices per channel (master / slave) i 2 * j + set-regs \ set base address and dev-register for register access ata-stat@ 7f and 7f <> \ Check, if device is connected IF true to no-timeout \ preset timeout-flag read-ident ( -- true|false ) IF i j show-model \ print manufacturer + device string sector 1+ c@ C0 and 80 = \ Check for ata or atapi IF wait-for-media-ready \ wait up to 5 sec if not ready no-timeout and IF atapi-read-capacity atapi-size to block-size \ ATAPI: 2048 bytes 80000 to max-transfer ['] atapi-read-blocks i 2 * j + cells read-blocks-xt + ! s" cdrom" strdup i 2 * j + s" generic-disk.fs" included ELSE ." -" \ show hint for not registered THEN ELSE ata-size to block-size \ ATA: 512 bytes 80000 to max-transfer ['] ata-read-blocks i 2 * j + cells read-blocks-xt + ! s" disk" strdup i 2 * j + s" generic-disk.fs" included THEN cr THEN THEN i 2 * j + 200 + cp LOOP LOOP ; find-disks ��21�0fbuffer.fs0 VALUE line# 0 VALUE column# false VALUE inverse? false VALUE inverse-screen? 18 VALUE #lines 50 VALUE #columns false VALUE cursor false VALUE saved-cursor defer draw-character \ 2B inited by display driver defer reset-screen \ 2B inited by display driver defer toggle-cursor \ 2B inited by display driver defer erase-screen \ 2B inited by display driver defer blink-screen \ 2B inited by display driver defer invert-screen \ 2B inited by display driver defer insert-characters \ 2B inited by display driver defer delete-characters \ 2B inited by display driver defer insert-lines \ 2B inited by display driver defer delete-lines \ 2B inited by display driver defer draw-logo \ 2B inited by display driver : nop-toggle-cursor ( nop ) ; ' nop-toggle-cursor to toggle-cursor : (cursor-off) ( -- ) cursor dup to saved-cursor IF toggle-cursor false to cursor THEN ; : (cursor-on) ( -- ) cursor dup to saved-cursor 0= IF toggle-cursor true to cursor THEN ; : restore-cursor ( -- ) saved-cursor dup cursor <> IF toggle-cursor to cursor ELSE drop THEN ; ' (cursor-off) to cursor-off ' (cursor-on) to cursor-on false VALUE esc-on false VALUE csi-on defer esc-process 0 VALUE esc-num-parm 0 VALUE esc-num-parm2 0 VALUE saved-line# 0 VALUE saved-column# : get-esc-parm ( default -- value ) esc-num-parm dup 0> IF nip ELSE drop THEN 0 to esc-num-parm ; : get-esc-parm2 ( default -- value ) esc-num-parm2 dup 0> IF nip ELSE drop THEN 0 to esc-num-parm2 ; : set-esc-parm ( newdigit -- ) [char] 0 - esc-num-parm a * + to esc-num-parm ; : reverse-cursor ( oldpos -- newpos) dup IF 1 get-esc-parm - THEN ; : advance-cursor ( bound oldpos -- newpos) tuck > IF 1 get-esc-parm + THEN ; : erase-in-line #columns column# - dup 0> IF delete-characters ELSE drop THEN ; : terminal-line++ ( -- ) line# 1+ dup #lines = IF 1- 0 to line# 1 delete-lines THEN to line# ; 0 VALUE dang 0 VALUE blipp : ansi-esc ( char -- ) csi-on IF dup [char] 0 [char] 9 between IF set-esc-parm ELSE CASE [char] A OF line# reverse-cursor to line# ENDOF [char] B OF #lines line# advance-cursor to line# ENDOF [char] C OF #columns column# advance-cursor to column# ENDOF [char] D OF column# reverse-cursor to column# ENDOF [char] E OF ( FIXME: Cursor Next Line - No idea what does it mean ) #lines line# advance-cursor to line# ENDOF [char] f OF 1 get-esc-parm2 to line# column# get-esc-parm to column# ENDOF [char] H OF 1 get-esc-parm2 to line# column# get-esc-parm to column# ENDOF [char] ; OF 0 get-esc-parm to esc-num-parm2 ENDOF [char] J OF #lines line# - dup 0> IF line# 1+ to line# delete-lines line# 1- to line# ELSE drop THEN erase-in-line ENDOF [char] K OF erase-in-line ENDOF [char] L OF 1 get-esc-parm insert-lines ENDOF [char] M OF 1 get-esc-parm delete-lines ENDOF [char] @ OF 1 get-esc-parm insert-characters ENDOF [char] P OF 1 get-esc-parm delete-characters ENDOF [char] m OF 0 get-esc-parm 0<> to inverse? ENDOF [char] p OF inverse-screen? IF false to inverse-screen? inverse? 0= to inverse? invert-screen THEN ENDOF [char] q OF inverse-screen? 0= IF true to inverse-screen? inverse? 0= to inverse? invert-screen THEN ENDOF [char] u OF saved-line# to line# saved-column# to column# ENDOF dup dup to dang OF blink-screen ENDOF ENDCASE false to csi-on false to esc-on 0 to esc-num-parm 0 to esc-num-parm2 THEN ELSE CASE [char] 7 OF line# to saved-line# column# to saved-column# ENDOF [char] 8 OF saved-line# to line# saved-column# to column# ENDOF [char] [ OF true to csi-on ENDOF dup dup OF false to esc-on to blipp ENDOF ENDCASE csi-on 0= IF false to esc-on THEN 0 to esc-num-parm 0 to esc-num-parm2 THEN ; ' ansi-esc to esc-process CREATE twtracebuf 4000 allot twtracebuf 4000 erase twtracebuf VALUE twbp 0 VALUE twbc : twtrace twbc 4000 = IF 0 to twbc twtracebuf to twbp THEN dup twbp c! twbp 1+ to twbp twbc 1+ to twbc ; : terminal-write ( addr len -- actual-len ) cursor-off tuck bounds ?DO i c@ twtrace esc-on IF esc-process ELSE CASE 1B OF true to esc-on ENDOF carret OF 0 to column# ENDOF linefeed OF terminal-line++ ENDOF bell OF blink-screen ENDOF 9 ( TAB ) OF column# 7 + -8 and dup #columns < IF to column# ELSE drop THEN ENDOF B ( VT ) OF line# ?dup IF 1- to line# THEN ENDOF C ( FF ) OF 0 to line# 0 to column# erase-screen ENDOF bs OF column# 1- dup 0< IF line# IF line# 1- to line# drop #columns 1- ELSE drop column# THEN THEN to column# ( bl draw-character ) ENDOF dup OF i c@ draw-character column# 1+ dup #columns >= IF drop 0 terminal-line++ THEN to column# ENDOF ENDCASE THEN LOOP restore-cursor ; 0 VALUE char-height 0 VALUE char-width 0 VALUE fontbytes CREATE display-emit-buffer 20 allot defer dis-old-emit ' emit behavior to dis-old-emit : display-write terminal-write ; : display-emit dup dis-old-emit display-emit-buffer tuck c! 1 terminal-write drop ; : is-install ( 'open -- ) s" defer vendor-open to vendor-open" eval s" : open deadbeef vendor-open dup deadbeef = IF drop true ELSE nip THEN ;" eval s" defer write ' display-write to write" eval s" : draw-logo ['] draw-logo CATCH IF 2drop 2drop THEN ;" eval s" : reset-screen ['] reset-screen CATCH drop ;" eval ; : is-remove ( 'close -- ) s" defer close to close" eval ; : is-selftest ( 'selftest -- ) s" defer selftest to selftest" eval ; STRUCT cell FIELD font>addr cell FIELD font>width cell FIELD font>height cell FIELD font>advance cell FIELD font>min-char cell FIELD font>#glyphs CONSTANT /font CREATE default-font-ctrblk /font allot default-font-ctrblk dup font>addr 0 swap ! dup font>width 8 swap ! dup font>height -10 swap ! dup font>advance 1 swap ! dup font>min-char 20 swap ! font>#glyphs 7f swap ! : display-default-font ( str len -- ) romfs-lookup dup 0= IF drop EXIT THEN 600 <> IF ." Only support 60x8x16 fonts ! " drop EXIT THEN default-font-ctrblk font>addr ! ; s" default-font.bin" display-default-font : .scan-lines ( height -- scanlines ) dup 0>= IF 1- ELSE negate THEN ; : set-font ( addr width height advance min-char #glyphs -- ) default-font-ctrblk /font + /font 0 DO 1 cells - dup >r ! r> 1 cells +LOOP drop default-font-ctrblk dup font>height @ abs to char-height dup font>width @ to char-width font>advance @ to fontbytes ; : >font ( char -- addr ) dup default-font-ctrblk dup >r font>min-char @ dup r@ font>#glyphs + within IF r@ font>min-char @ - r@ font>advance @ * r@ font>height @ .scan-lines * r> font>addr @ + ELSE drop r> font>addr @ THEN ; : default-font ( -- addr width height advance min-char #glyphs ) default-font-ctrblk /font 0 DO dup cell+ >r @ r> 1 cells +LOOP drop ; 0 VALUE frame-buffer-adr 0 VALUE screen-height 0 VALUE screen-width 0 VALUE screen-depth 0 VALUE window-top 0 VALUE window-left 0 VALUE .sc : screen-#rows ( -- rows ) .sc IF screen-height char-height / ELSE true to .sc s" screen-#rows" eval false to .sc THEN ; : screen-#columns ( -- columns ) .sc IF screen-width char-width / ELSE true to .sc s" screen-#columns" eval false to .sc THEN ; : fb8-background inverse-screen? ; : fb8-foreground inverse? invert ; : fb8-lines2bytes ( #lines -- #bytes ) char-height * screen-width * screen-depth * ; : fb8-columns2bytes ( #columns -- #bytes ) char-width * screen-depth * ; : fb8-line2addr ( line# -- addr ) char-height * window-top + screen-width * screen-depth * frame-buffer-adr + window-left screen-depth * + ; : fb8-erase-block ( addr len ) fb8-background rfill ; 0 VALUE .ab CREATE bitmap-buffer 400 4 * allot : active-bits ( -- new ) .ab dup 8 > IF 8 - to .ab 8 ELSE char-width to .ab ?dup 0= IF recurse THEN THEN ; : fb8-char2bitmap ( font-height font-addr -- bitmap-buffer ) bitmap-buffer >r char-height rot 0> IF r> char-width 2dup fb8-erase-block + >r 1- THEN r> -rot char-width to .ab fontbytes * bounds ?DO i c@ active-bits 0 ?DO dup 80 and IF fb8-foreground ELSE fb8-background THEN ( fb-addr fbyte colr ) 2 pick ! 1 lshift swap screen-depth + swap LOOP drop LOOP drop bitmap-buffer ; : fb8-draw-logo ( line# addr width height -- ) ." fb8-draw-logo ( " .s ." )" cr 2drop 2drop ; : fb8-toggle-cursor ( -- ) line# fb8-line2addr column# fb8-columns2bytes + char-height 0 ?DO char-width screen-depth * 0 ?DO dup dup rb@ -1 xor swap rb! 1+ LOOP screen-width screen-depth * + char-width screen-depth * - LOOP drop ; : fb8-draw-character ( char -- ) >r default-font over + r@ -rot between IF 2swap 3drop r> >font fb8-char2bitmap ( bitmap-buf ) line# fb8-line2addr column# fb8-columns2bytes + ( bitmap-buf fb-addr ) char-height 0 ?DO 2dup char-width screen-depth * mrmove screen-width screen-depth * + >r char-width screen-depth * + r> LOOP 2drop ELSE 2drop r> 3drop THEN ; : fb8-insert-lines ( n -- ) fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + #lines line# - fb8-lines2bytes r@ - rmove r> fb8-erase-block ; : fb8-delete-lines ( n -- ) fb8-lines2bytes >r line# fb8-line2addr dup dup r@ + swap #lines fb8-lines2bytes r@ - dup >r rmove r> + r> fb8-erase-block ; : fb8-insert-characters ( n -- ) line# fb8-line2addr column# fb8-columns2bytes + >r #columns column# - 2dup >= IF nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN ELSE fb8-columns2bytes swap fb8-columns2bytes tuck - over r@ tuck + rot char-height 0 ?DO 3dup rmove -rot screen-width screen-depth * tuck + -rot + swap rot LOOP 3drop r> THEN char-height 0 ?DO dup 2 pick fb8-erase-block screen-width screen-depth * + LOOP 2drop ; : fb8-delete-characters ( n -- ) line# fb8-line2addr column# fb8-columns2bytes + >r #columns column# - 2dup >= IF nip dup 0> IF fb8-columns2bytes r> ELSE r> 2drop EXIT THEN ELSE fb8-columns2bytes swap fb8-columns2bytes tuck - over r@ + 2dup + r> swap >r rot char-height 0 ?DO 3dup rmove -rot screen-width screen-depth * tuck + -rot + swap rot LOOP 3drop r> over - THEN char-height 0 ?DO dup 2 pick fb8-erase-block screen-width screen-depth * + LOOP 2drop ; : fb8-reset-screen ( -- ) ( Left as no-op by design ) ; : fb8-erase-screen ( -- ) frame-buffer-adr screen-height screen-width * screen-depth * fb8-erase-block ; : fb8-invert-screen ( -- ) frame-buffer-adr screen-height screen-width * screen-depth * 2dup /x / 0 ?DO dup rx@ -1 xor over rx! xa1+ LOOP 3drop ; : fb8-blink-screen ( -- ) fb8-invert-screen fb8-invert-screen ; : fb8-install ( width height #columns #lines -- ) 1 to screen-depth 2swap to screen-height to screen-width screen-#rows min to #lines screen-#columns min to #columns screen-height char-height #lines * - 2/ to window-top screen-width char-width #columns * - 2/ to window-left ['] fb8-toggle-cursor to toggle-cursor ['] fb8-draw-character to draw-character ['] fb8-insert-lines to insert-lines ['] fb8-delete-lines to delete-lines ['] fb8-insert-characters to insert-characters ['] fb8-delete-characters to delete-characters ['] fb8-erase-screen to erase-screen ['] fb8-blink-screen to blink-screen ['] fb8-invert-screen to invert-screen ['] fb8-reset-screen to reset-screen ['] fb8-draw-logo to draw-logo ; : fb-install ( width height #columns #lines depth -- ) >r fb8-install r> to screen-depth ; : fb8-set-tokens ( -- ) ['] is-install 0 11C set-token ['] is-remove 0 11D set-token ['] is-selftest 0 11E set-token ['] #lines 0 150 set-token ['] #columns 0 151 set-token ['] line# 0 152 set-token ['] column# 0 153 set-token ['] inverse? 0 154 set-token ['] inverse-screen? 0 155 set-token ['] draw-character 0 157 set-token ['] reset-screen 0 158 set-token ['] toggle-cursor 0 159 set-token ['] erase-screen 0 15A set-token ['] blink-screen 0 15B set-token ['] invert-screen 0 15C set-token ['] insert-characters 0 15D set-token ['] delete-characters 0 15E set-token ['] insert-lines 0 15F set-token ['] delete-lines 0 160 set-token ['] draw-logo 0 161 set-token ['] frame-buffer-adr 0 162 set-token ['] screen-height 0 163 set-token ['] screen-width 0 164 set-token ['] window-top 0 165 set-token ['] window-left 0 166 set-token ['] default-font 0 16A set-token ['] set-font 0 16B set-token ['] char-height 0 16C set-token ['] char-width 0 16D set-token ['] >font 0 16E set-token ['] fontbytes 0 16F set-token ['] fb8-draw-character 0 180 set-token ['] fb8-reset-screen 0 181 set-token ['] fb8-toggle-cursor 0 182 set-token ['] fb8-erase-screen 0 183 set-token ['] fb8-blink-screen 0 184 set-token ['] fb8-invert-screen 0 185 set-token ['] fb8-insert-characters 0 186 set-token ['] fb8-delete-characters 0 187 set-token ['] fb8-insert-lines 0 188 set-token ['] fb8-delete-lines 0 189 set-token ['] fb8-draw-logo 0 18A set-token ['] fb8-install 0 18B set-token ; fb8-set-tokens : fb8-dump-bitmap cr char-height 0 ?do char-width 0 ?do dup c@ if ." @" else ." ." then 1+ loop cr loop drop ; : fb8-dump-char >font -b swap fb8-char2bitmap fb8-dump-bitmap ; ��0generic-disk.fsnew-device set-unit ( str len ) 2dup device-name s" 0 pci-alias-" 2swap $cat evaluate s" block" device-type s" block-size" $call-parent CONSTANT block-size s" max-transfer" $call-parent CONSTANT max-transfer : read-blocks ( addr block# #blocks -- #read ) my-unit s" dev-read-blocks" $call-parent ; INSTANCE VARIABLE deblocker : open ( -- okay? ) 0 0 s" deblocker" $open-package dup deblocker ! dup IF s" disk-label" find-package IF my-args rot interpose THEN THEN 0<> ; : close ( -- ) deblocker @ close-package ; : seek ( pos.lo pos.hi -- status ) s" seek" deblocker @ $call-method ; : read ( addr len -- actual ) s" read" deblocker @ $call-method ; finish-device ��W0pci-device.fsget-node CONSTANT my-phandle s" my-puid" my-phandle parent $call-static CONSTANT my-puid : config-b@ puid >r my-puid TO puid my-space + rtas-config-b@ r> TO puid ; : config-w@ puid >r my-puid TO puid my-space + rtas-config-w@ r> TO puid ; : config-l@ puid >r my-puid TO puid my-space + rtas-config-l@ r> TO puid ; : config-b! puid >r my-puid TO puid my-space + rtas-config-b! r> TO puid ; : config-w! puid >r my-puid TO puid my-space + rtas-config-w! r> TO puid ; : config-l! puid >r my-puid TO puid my-space + rtas-config-l! r> TO puid ; : config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ; : open puid >r \ save the old puid my-puid TO puid \ set up the puid to the devices Hostbridge pci-master-enable \ And enable Bus Master, IO and MEM access again. pci-mem-enable \ enable mem access pci-io-enable \ enable io access r> TO puid \ restore puid true ; : close puid >r \ save the old puid my-puid TO puid \ set up the puid pci-device-disable \ and disable the device r> TO puid \ restore puid ; : dma-alloc ( size -- virt ) my-phandle TO calling-child s" dma-alloc" my-phandle parent $call-static 0 TO calling-child ; : dma-free ( virt size -- ) my-phandle TO calling-child s" dma-free" my-phandle parent $call-static 0 TO calling-child ; : dma-map-in ( virt size cacheable? -- devaddr ) my-phandle TO calling-child s" dma-map-in" my-phandle parent $call-static 0 TO calling-child ; : dma-map-out ( virt devaddr size -- ) my-phandle TO calling-child s" dma-map-out" my-phandle parent $call-static 0 TO calling-child ; : devicefile ( -- str len ) s" pci-device_" my-space pci-vendor@ 4 int2str $cat s" _" $cat my-space pci-device@ 4 int2str $cat s" .fs" $cat ; : classfile ( -- str len ) s" pci-class_" my-space pci-class@ 10 rshift 2 int2str $cat s" .fs" $cat ; : setup ( -- ) devicefile romfs-lookup ?dup IF evaluate ELSE classfile romfs-lookup ?dup IF evaluate ELSE my-space pci-class-name type 2a emit cr my-space pci-device-generic-setup THEN THEN ; pci-device-disable pci-error-enable my-space 44 pci-out \ config-addr ascii('D') setup ��`'0pci-bridge.fss" my-puid" $call-parent CONSTANT my-puid pci-bus-number 1+ CONSTANT my-bus s" pci-config-bridge.fs" included : filename ( -- str len ) s" pci-bridge_" my-space pci-vendor@ 4 int2str $cat s" _" $cat my-space pci-device@ 4 int2str $cat s" .fs" $cat ; : setup ( -- ) filename romfs-lookup ?dup IF evaluate ELSE my-space pci-class-name type 2a emit cr my-space pci-bridge-generic-setup my-space pci-reset-2nd THEN ; pci-device-disable pci-error-enable my-space 42 pci-out \ config-addr ascii('B') setup pci-master-enable pci-mem-enable pci-io-enable ��O8pci-properties.fs: pci-class-name-00 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 01 OF s" display" ENDOF dup OF s" unknown-legacy-device" ENDOF ENDCASE ; : pci-class-name-01 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" scsi" ENDOF 01 OF s" ide" ENDOF 02 OF s" fdc" ENDOF 03 OF s" ipi" ENDOF 04 OF s" raid" ENDOF 05 OF s" ata" ENDOF 06 OF s" sata" ENDOF 07 OF s" sas" ENDOF dup OF s" mass-storage" ENDOF ENDCASE ; : pci-class-name-02 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" ethernet" ENDOF 01 OF s" token-ring" ENDOF 02 OF s" fddi" ENDOF 03 OF s" atm" ENDOF 04 OF s" isdn" ENDOF 05 OF s" worldfip" ENDOF 05 OF s" picmg" ENDOF dup OF s" network" ENDOF ENDCASE ; : pci-class-name-03 ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" vga" ENDOF 0001 OF s" 8514-compatible" ENDOF 0100 OF s" xga" ENDOF 0200 OF s" 3d-controller" ENDOF dup OF s" display" ENDOF ENDCASE ; : pci-class-name-04 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" video" ENDOF 01 OF s" sound" ENDOF 02 OF s" telephony" ENDOF dup OF s" multimedia-device" ENDOF ENDCASE ; : pci-class-name-05 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" memory" ENDOF 01 OF s" flash" ENDOF dup OF s" memory-controller" ENDOF ENDCASE ; : pci-class-name-06 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" host" ENDOF 01 OF s" isa" ENDOF 02 OF s" eisa" ENDOF 03 OF s" mca" ENDOF 04 OF s" pci" ENDOF 05 OF s" pcmcia" ENDOF 06 OF s" nubus" ENDOF 07 OF s" cardbus" ENDOF 08 OF s" raceway" ENDOF 09 OF s" semi-transparent-pci" ENDOF 0A OF s" infiniband" ENDOF dup OF s" unkown-bridge" ENDOF ENDCASE ; : pci-class-name-07 ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" serial" ENDOF 0001 OF s" 16450-serial" ENDOF 0002 OF s" 16550-serial" ENDOF 0003 OF s" 16650-serial" ENDOF 0004 OF s" 16750-serial" ENDOF 0005 OF s" 16850-serial" ENDOF 0006 OF s" 16950-serial" ENDOF 0100 OF s" parallel" ENDOF 0101 OF s" bi-directional-parallel" ENDOF 0102 OF s" ecp-1.x-parallel" ENDOF 0103 OF s" ieee1284-controller" ENDOF 01FE OF s" ieee1284-device" ENDOF 0200 OF s" multiport-serial" ENDOF 0300 OF s" modem" ENDOF 0301 OF s" 16450-modem" ENDOF 0302 OF s" 16550-modem" ENDOF 0303 OF s" 16650-modem" ENDOF 0304 OF s" 16750-modem" ENDOF 0400 OF s" gpib" ENDOF 0500 OF s" smart-card" ENDOF dup OF s" communication-controller" ENDOF ENDCASE ; : pci-class-name-08 ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" interrupt-controller" ENDOF 0001 OF s" isa-pic" ENDOF 0002 OF s" eisa-pic" ENDOF 0010 OF s" io-apic" ENDOF 0020 OF s" iox-apic" ENDOF 0100 OF s" dma-controller" ENDOF 0101 OF s" isa-dma" ENDOF 0102 OF s" eisa-dma" ENDOF 0200 OF s" timer" ENDOF 0201 OF s" isa-system-timer" ENDOF 0202 OF s" eisa-system-timer" ENDOF 0300 OF s" rtc" ENDOF 0301 OF s" isa-rtc" ENDOF 0400 OF s" hot-plug-controller" ENDOF 0500 OF s" sd-host-conrtoller" ENDOF dup OF s" system-periphal" ENDOF ENDCASE ; : pci-class-name-09 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" keyboard" ENDOF 01 OF s" pen" ENDOF 02 OF s" mouse" ENDOF 03 OF s" scanner" ENDOF 04 OF s" gameport" ENDOF dup OF s" input-controller" ENDOF ENDCASE ; : pci-class-name-0A ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" dock" ENDOF dup OF s" docking-station" ENDOF ENDCASE ; : pci-class-name-0B ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" 386" ENDOF 01 OF s" 486" ENDOF 02 OF s" pentium" ENDOF 10 OF s" alpha" ENDOF 20 OF s" powerpc" ENDOF 30 OF s" mips" ENDOF 40 OF s" co-processor" ENDOF dup OF s" cpu" ENDOF ENDCASE ; : pci-class-name-0C ( addr -- str len ) pci-class@ FFFF and CASE 0000 OF s" firewire" ENDOF 0100 OF s" access-bus" ENDOF 0200 OF s" ssa" ENDOF 0300 OF s" usb-uhci" ENDOF 0310 OF s" usb-ohci" ENDOF 0320 OF s" usb-ehci" ENDOF 0380 OF s" usb" ENDOF 03FE OF s" usb-device" ENDOF 0400 OF s" fibre-channel" ENDOF 0500 OF s" smb" ENDOF 0600 OF s" infiniband" ENDOF 0700 OF s" ipmi-smic" ENDOF 0701 OF s" ipmi-kbrd" ENDOF 0702 OF s" ipmi-bltr" ENDOF 0800 OF s" sercos" ENDOF 0900 OF s" canbus" ENDOF dup OF s" serial-bus" ENDOF ENDCASE ; : pci-class-name-0D ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" irda" ENDOF 01 OF s" consumer-ir" ENDOF 10 OF s" rf-controller" ENDOF 11 OF s" bluetooth" ENDOF 12 OF s" broadband" ENDOF 20 OF s" enet-802.11a" ENDOF 21 OF s" enet-802.11b" ENDOF dup OF s" wireless-controller" ENDOF ENDCASE ; : pci-class-name-0E ( addr -- str len ) pci-class@ 8 rshift FF and CASE dup OF s" intelligent-io" ENDOF ENDCASE ; : pci-class-name-0F ( addr -- str len ) pci-class@ 8 rshift FF and CASE 01 OF s" satelite-tv" ENDOF 02 OF s" satelite-audio" ENDOF 03 OF s" satelite-voice" ENDOF 04 OF s" satelite-data" ENDOF dup OF s" satelite-devoce" ENDOF ENDCASE ; : pci-class-name-10 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" network-encryption" ENDOF 01 OF s" entertainment-encryption" ENDOF dup OF s" encryption" ENDOF ENDCASE ; : pci-class-name-11 ( addr -- str len ) pci-class@ 8 rshift FF and CASE 00 OF s" dpio" ENDOF 01 OF s" counter" ENDOF 10 OF s" measurement" ENDOF 20 OF s" managment-card" ENDOF dup OF s" data-processing-controller" ENDOF ENDCASE ; : pci-class-name ( addr -- str len ) dup pci-class@ 10 rshift CASE 00 OF pci-class-name-00 ENDOF 01 OF pci-class-name-01 ENDOF 02 OF pci-class-name-02 ENDOF 03 OF pci-class-name-03 ENDOF 04 OF pci-class-name-04 ENDOF 05 OF pci-class-name-05 ENDOF 06 OF pci-class-name-06 ENDOF 07 OF pci-class-name-07 ENDOF 08 OF pci-class-name-08 ENDOF 09 OF pci-class-name-09 ENDOF 0A OF pci-class-name-0A ENDOF 0B OF pci-class-name-0B ENDOF 0C OF pci-class-name-0C ENDOF 0C OF pci-class-name-0D ENDOF 0C OF pci-class-name-0E ENDOF 0C OF pci-class-name-0F ENDOF 0C OF pci-class-name-10 ENDOF 0C OF pci-class-name-11 ENDOF dup OF drop s" unknown" ENDOF ENDCASE ; : pci-bar-size@ ( bar-addr -- bar-size ) -1 over rtas-config-l! rtas-config-l@ ; : pci-bar-size-mem@ ( bar-addr -- mem-size ) pci-bar-size@ -10 and invert 1+ FFFFFFFF and ; : pci-bar-size-io@ ( bar-addr -- io-size ) pci-bar-size@ -4 and invert 1+ FFFFFFFF and ; : pci-bar-size ( bar-addr -- bar-size-raw ) dup rtas-config-l@ swap \ fetch original Value ( bval baddr ) -1 over rtas-config-l! \ make BAR show size ( bval baddr ) dup rtas-config-l@ \ and fetch the size ( bval baddr bsize ) -rot rtas-config-l! \ restore Value ; : pci-bar-size-mem32 ( bar-addr -- bar-size ) pci-bar-size \ fetch raw size -10 and invert 1+ \ calc size FFFFFFFF and \ keep lower 32 bits ; : pci-bar-size-rom ( bar-addr -- bar-size ) pci-bar-size \ fetch raw size FFFFF800 and invert 1+ \ calc size FFFFFFFF and \ keep lower 32 bits ; : pci-bar-size-mem64 ( bar-addr -- bar-size ) dup pci-bar-size \ fetch raw size lower 32 bits swap 4 + pci-bar-size \ fetch raw size upper 32 bits 20 lshift + \ and put them together -10 and invert 1+ \ calc size ; : pci-bar-size-io ( bar-addr -- bar-size ) pci-bar-size \ fetch raw size -4 and invert 1+ \ calc size FFFFFFFF and \ keep lower 32 bits ; : pci-bar-code@ ( bar-addr -- 0|1..4|5 ) rtas-config-l@ dup \ fetch the BaseAddressRegister 1 and IF \ IO BAR ? 2 and IF 0 ELSE 1 THEN \ only '01' is valid ELSE \ Memory BAR ? F and CASE 0 OF 2 ENDOF \ Memory 32 Bit Non-Prefetchable 8 OF 3 ENDOF \ Memory 32 Bit Prefetchable 4 OF 4 ENDOF \ Memory 64 Bit Non-Prefetchable C OF 5 ENDOF \ Memory 64 Bit Prefechtable dup OF 0 ENDOF \ Not a valid BarType ENDCASE THEN ; : assign-var ( size var -- al-mem ) 2dup @ \ ( size var size cur-mem ) read current free mem swap #aligned \ ( size var al-mem ) align the mem to the size dup 2swap -rot + \ ( al-mem var new-mem ) add size to aligned mem swap ! \ ( al-mem ) set variable to new mem ; : assign-bar-value32 ( bar size var -- 4 ) over IF \ IF size > 0 assign-var \ | ( bar al-mem ) set variable to next mem swap rtas-config-l! \ | ( -- ) set the bar to al-mem ELSE \ ELSE 2drop drop \ | clear stack THEN \ FI 4 \ size of the base-address-register ; : assign-bar-value64 ( bar size var -- 8 ) over IF \ IF size > 0 assign-var \ | ( bar al-mem ) set variable to next mem swap \ | ( al-mem addr ) calc config-addr of this bar 2dup rtas-config-l! \ | ( al-mem addr ) set the Lower part of the bar to al-mem 4 + swap 20 rshift \ | ( al-mem>>32 addr ) prepare the upper part of the al-mem swap rtas-config-l! \ | ( -- ) and set the upper part of the bar ELSE \ ELSE 2drop drop \ | clear stack THEN \ FI 8 \ size of the base-address-register ; : assign-mem64-bar ( bar-addr -- 8 ) dup pci-bar-size-mem64 \ fetch size pci-next-mem \ var to change assign-bar-value64 \ and set it all ; : assign-mem32-bar ( bar-addr -- 4 ) dup pci-bar-size-mem32 \ fetch size pci-next-mem \ var to change assign-bar-value32 \ and set it all ; : assign-mmio64-bar ( bar-addr -- 8 ) dup pci-bar-size-mem64 \ fetch size pci-next-mmio \ var to change assign-bar-value64 \ and set it all ; : assign-mmio32-bar ( bar-addr -- 4 ) dup pci-bar-size-mem32 \ fetch size pci-next-mmio \ var to change assign-bar-value32 \ and set it all ; : assign-io-bar ( bar-addr -- 4 ) dup pci-bar-size-io \ fetch size pci-next-io \ var to change assign-bar-value32 \ and set it all ; : assign-rom-bar ( bar-addr -- ) dup pci-bar-size-rom \ fetch size dup IF \ IF size > 0 over >r \ | save bar addr for enable pci-next-mmio \ | var to change assign-bar-value32 \ | and set it drop \ | forget the BAR length r@ rtas-config-l@ \ | fetch BAR 1 or r> rtas-config-l! \ | and enable the ROM ELSE \ ELSE 2drop \ | clear stack THEN ; : assign-bar ( bar-addr -- reg-size ) dup pci-bar-code@ \ calc BAR type dup IF \ IF >0 CASE \ | CASE Setup the right type 1 OF assign-io-bar ENDOF \ | - set up an IO-Bar 2 OF assign-mmio32-bar ENDOF \ | - set up an 32bit MMIO-Bar 3 OF assign-mem32-bar ENDOF \ | - set up an 32bit MEM-Bar (prefetchable) 4 OF assign-mmio64-bar ENDOF \ | - set up an 64bit MMIO-Bar 5 OF assign-mem64-bar ENDOF \ | - set up an 64bit MEM-Bar (prefetchable) ENDCASE \ | ESAC ELSE \ ELSE ABORT \ | Throw an exception THEN \ FI ; : assign-all-device-bars ( configaddr -- ) 28 10 DO \ BARs start at 10 and end at 27 dup i + \ calc config-addr of the BAR assign-bar \ and set it up +LOOP \ add 4 or 8 to the index and loop 30 + assign-rom-bar \ set up the ROM if available ; : assign-all-bridge-bars ( configaddr -- ) 18 10 DO \ BARs start at 10 and end at 17 dup i + \ calc config-addr of the BAR assign-bar \ and set it up +LOOP \ add 4 or 8 to the index and loop 38 + assign-rom-bar \ set up the ROM if available ; : gen-mem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size) over 4 + rtas-config-l@ \ | fetch upper 32 bits ( paddr plen baddr val.lo val.hi R: size) 20 lshift + -10 and >r \ | calc 64 bit value and save it ( paddr plen baddr R: size val ) 83000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ sizeof(BAR) = 8 Bytes ; : gen-pmem64-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch lower 32 bits ( paddr plen baddr val.lo R: size) over 4 + rtas-config-l@ \ | fetch upper 32 bits ( paddr plen baddr val.lo val.hi R: size) 20 lshift + -10 and >r \ | calc 64 bit value and save it ( paddr plen baddr R: size val ) C3000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ sizeof(BAR) = 8 Bytes ; : gen-mem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) -10 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) 82000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ sizeof(BAR) = 4 Bytes ; : gen-pmem32-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) -10 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) C2000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ sizeof(BAR) = 4 Bytes ; : gen-io-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len 4 ) dup pci-bar-size-io \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) -4 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) 81000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ sizeof(BAR) = 4 Bytes ; : gen-rom-bar-prop ( prop-addr prop-len bar-addr -- prop-addr prop-len ) dup pci-bar-size-rom \ fetch BAR Size ( paddr plen baddr bsize ) dup IF \ IF Size > 0 >r dup rtas-config-l@ \ | save size and fetch value ( paddr plen baddr val R: size) FFFFF800 and >r \ | calc 32 bit value and save it ( paddr plen baddr R: size val ) 82000000 or encode-int+ \ | Encode config addr ( paddr plen R: size val ) r> encode-64+ \ | Encode assigned addr ( paddr plen R: size ) r> encode-64+ \ | Encode size ( paddr plen ) ELSE \ ELSE 2drop \ | don't do anything THEN \ FI ; : pci-add-assigned-address ( prop-addr prop-len bar-addr -- prop-addr prop-len bsize ) dup pci-bar-code@ \ calc BAR type ( paddr plen baddr btype) CASE \ CASE for the BAR types ( paddr plen baddr ) 0 OF drop 4 ENDOF \ - not a valid type so do nothing 1 OF gen-io-bar-prop ENDOF \ - IO-BAR 2 OF gen-mem32-bar-prop ENDOF \ - MEM32 3 OF gen-pmem32-bar-prop ENDOF \ - MEM32 prefetchable 4 OF gen-mem64-bar-prop ENDOF \ - MEM64 5 OF gen-pmem64-bar-prop ENDOF \ - MEM64 prefetchable ENDCASE \ ESAC ( paddr plen bsize ) ; : pci-device-assigned-addresses-prop ( addr -- ) encode-start \ provide mem for property ( addr paddr plen ) 2 pick 30 + gen-rom-bar-prop \ assign the rom bar 28 10 DO \ we have 6 possible BARs 2 pick i + \ calc BAR address ( addr paddr plen bar-addr ) pci-add-assigned-address \ and generate the props for the BAR +LOOP \ increase Index by returned len s" assigned-addresses" property drop \ and write it into the device tree ; : pci-bridge-assigned-addresses-prop ( addr -- ) encode-start \ provide mem for property 2 pick 38 + gen-rom-bar-prop \ assign the rom bar 18 10 DO \ we have 2 possible BARs 2 pick i + \ ( addr paddr plen current-addr ) pci-add-assigned-address \ and generate the props for the BAR +LOOP \ increase Index by returned len s" assigned-addresses" property drop \ and write it into the device tree ; : pci-bridge-gen-range ( paddr plen base limit type -- paddr plen ) >r over - \ calc size ( paddr plen base size R:type ) dup 0< IF \ IF Size < 0 ( paddr plen base size R:type ) 2drop r> drop \ | forget values ( paddr plen ) ELSE \ ELSE 1+ swap 2swap \ | adjust stack ( size base paddr plen R:type ) r@ encode-int+ \ | Child type ( size base paddr plen R:type ) 2 pick encode-64+ \ | Child address ( size base paddr plen R:type ) r> encode-int+ \ | Parent type ( size base paddr plen ) rot encode-64+ \ | Parent address ( size paddr plen ) rot encode-64+ \ | Encode size ( paddr plen ) THEN \ FI ; : pci-bridge-gen-mmio-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) 2 pick 20 + rtas-config-l@ \ fetch Value ( addr paddr plen val ) dup 0000FFF0 and 10 lshift \ calc base-address ( addr paddr plen val base ) swap 000FFFFF or \ calc limit-address ( addr paddr plen base limit ) 02000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) ; : pci-bridge-gen-mem-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) 2 pick 24 + rtas-config-l@ \ fetch Value ( addr paddr plen val ) dup 000FFFFF or \ calc limit Bits 31:0 ( addr paddr plen val limit.31:0 ) swap 0000FFF0 and 10 lshift \ calc base Bits 31:0 ( addr paddr plen limit.31:0 base.31:0 ) 4 pick 28 + rtas-config-l@ \ fetch upper Basebits ( addr paddr plen limit.31:0 base.31:0 base.63:32 ) 20 lshift or swap \ and calc Base ( addr paddr plen base.63:0 limit.31:0 ) 4 pick 2C + rtas-config-l@ \ fetch upper Limitbits ( addr paddr plen base.63:0 limit.31:0 limit.63:32 ) 20 lshift or \ and calc Limit ( addr paddr plen base.63:0 limit.63:0 ) 42000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) ; : pci-bridge-gen-io-range ( addr prop-addr prop-len -- addr prop-addr prop-len ) 2 pick 1C + rtas-config-l@ \ fetch Value ( addr paddr plen val ) dup 0000F000 and 00000FFF or \ calc Limit Bits 15:0 ( addr paddr plen val limit.15:0 ) swap 000000F0 and 8 lshift \ calc Base Bits 15:0 ( addr paddr plen limit.15:0 base.15:0 ) 4 pick 30 + rtas-config-l@ \ fetch upper Bits ( addr paddr plen limit.15:0 base.15:0 val ) dup FFFF and 10 lshift rot or \ calc Base ( addr paddr plen limit.15:0 val base.31:0 ) -rot FFFF0000 and or \ calc Limit ( addr paddr plen base.31:0 limit.31:0 ) 01000000 pci-bridge-gen-range \ and generate it ( addr paddr plen ) ; : pci-bridge-range-props ( addr -- ) encode-start \ provide mem for property pci-bridge-gen-mmio-range \ generate the non prefetchable Memory Entry pci-bridge-gen-mem-range \ generate the prefetchable Memory Entry pci-bridge-gen-io-range \ generate the IO Entry dup IF \ IF any space present (propsize>0) s" ranges" property \ | write it into the device tree ELSE \ ELSE 2drop \ | forget the properties THEN \ FI drop \ forget the address ; : pci-bridge-interrupt-map ( -- ) encode-start \ create the property ( paddr plen ) get-node child \ find the first child ( paddr plen handle ) BEGIN dup WHILE \ Loop as long as the handle is non-zero ( paddr plen handle ) dup >r >space \ Get the my-space ( paddr plen addr R: handle ) pci-gen-irq-entry \ and Encode the interrupt settings ( paddr plen R: handle) r> peer \ Get neighbour ( paddr plen handle ) REPEAT \ process next childe node ( paddr plen handle ) drop \ forget the null ( paddr plen ) s" interrupt-map" property \ and set it ( -- ) 1 encode-int s" #interrupt-cells" property \ encode the cell# f800 encode-int 0 encode-int+ 0 encode-int+ \ encode the bit mask for config addr (Dev only) 7 encode-int+ s" interrupt-map-mask" property \ encode IRQ#=7 and generate property ; : encode-mem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 02000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ BAR-Len = 4 (32Bit) ; : encode-pmem32-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 4 ) dup pci-bar-size-mem32 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 42000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ BAR-Len = 4 (32Bit) ; : encode-mem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 03000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ BAR-Len = 8 (64Bit) ; : encode-pmem64-bar ( prop-addr prop-len BAR-addr -- prop-addr prop-len 8 ) dup pci-bar-size-mem64 \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 43000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 8 \ BAR-Len = 8 (64Bit) ; : encode-rom-bar ( prop-addr prop-len configaddr -- prop-addr prop-len ) dup pci-bar-size-rom \ fetch raw BAR-size dup IF \ IF BAR is used >r 02000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | calc and encode the size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI ; : encode-io-bar ( prop-addr prop-len BAR-addr BAR-value -- prop-addr prop-len 4 ) dup pci-bar-size-io \ calc BAR-size ( not changing the BAR ) dup IF \ IF BAR-size > 0 ( paddr plen baddr bsize ) >r 01000000 or encode-int+ \ | save size and encode BAR addr 0 encode-64+ \ | make mid and lo zero r> encode-64+ \ | encode size ELSE \ ELSE 2drop \ | don't do anything THEN \ FI 4 \ BAR-Len = 4 (32Bit) ; : encode-bar ( prop-addr prop-len bar-addr -- prop-addr prop-len bar-len ) dup pci-bar-code@ \ calc BAR type CASE \ CASE for the BAR types ( paddr plen baddr val ) 0 OF drop 4 ENDOF \ - not a valid type so do nothing 1 OF encode-io-bar ENDOF \ - IO-BAR 2 OF encode-mem32-bar ENDOF \ - MEM32 3 OF encode-pmem32-bar ENDOF \ - MEM32 prefetchable 4 OF encode-mem64-bar ENDOF \ - MEM64 5 OF encode-pmem64-bar ENDOF \ - MEM64 prefetchable ENDCASE \ ESAC ( paddr plen blen ) ; : pci-reg-props ( configaddr -- ) dup encode-int \ configuration space ( caddr paddr plen ) 0 encode-64+ \ make the rest 0 0 encode-64+ \ encode the size as 0 2 pick pci-htype@ \ fetch Header Type ( caddr paddr plen type ) 1 and IF \ IF Bridge ( caddr paddr plen ) 18 10 DO \ | loop over all BARs 2 pick i + \ | calc bar-addr ( caddr paddr plen baddr ) encode-bar \ | encode this BAR ( caddr paddr plen blen ) +LOOP \ | increase LoopIndex by the BARlen 2 pick 38 + \ | calc ROM-BAR for a bridge ( caddr paddr plen baddr ) encode-rom-bar \ | encode the ROM-BAR ( caddr paddr plen ) ELSE \ ELSE ordinary device ( caddr paddr plen ) 28 10 DO \ | loop over all BARs 2 pick i + \ | calc bar-addr ( caddr paddr plen baddr ) encode-bar \ | encode this BAR ( caddr paddr plen blen ) +LOOP \ | increase LoopIndex by the BARlen 2 pick 30 + \ | calc ROM-BAR for a device ( caddr paddr plen baddr ) encode-rom-bar \ | encode the ROM-BAR ( caddr paddr plen ) THEN \ FI ( caddr paddr plen ) s" reg" property \ and store it into the property drop ; : pci-common-props ( addr -- ) dup pci-class-name 2dup device-name device-type dup pci-vendor@ encode-int s" vendor-id" property dup pci-device@ encode-int s" device-id" property dup pci-revision@ encode-int s" revision-id" property dup pci-class@ encode-int s" class-code" property 3 encode-int s" #address-cells" property 2 encode-int s" #size-cells" property dup pci-config-ext? IF 1 encode-int s" ibm,pci-config-space-type" property THEN dup pci-status@ dup 9 rshift 3 and encode-int s" devsel-speed" property dup 7 rshift 1 and IF 0 0 s" fast-back-to-back" property THEN dup 6 rshift 1 and IF 0 0 s" 66mhz-capable" property THEN 5 rshift 1 and IF 0 0 s" udf-supported" property THEN dup pci-cache@ ?dup IF encode-int s" cache-line-size" property THEN pci-interrupt@ ?dup IF encode-int s" interrupts" property THEN ; : pci-device-props ( addr -- ) dup pci-common-props dup pci-min-grant@ encode-int s" min-grant" property dup pci-max-lat@ encode-int s" max-latency" property dup pci-sub-device@ ?dup IF encode-int s" subsystem-id" property THEN dup pci-sub-vendor@ ?dup IF encode-int s" subsystem-vendor-id" property THEN dup pci-device-assigned-addresses-prop pci-reg-props ; : pci-bridge-props ( addr -- ) dup pci-bus@ encode-int s" primary-bus" property encode-int s" secondary-bus" property encode-int s" subordinate-bus" property dup pci-bus@ drop encode-int rot encode-int+ s" bus-range" property pci-device-slots encode-int s" slot-names" property dup pci-bridge-range-props dup pci-bridge-assigned-addresses-prop s" interrupt-map" get-node get-property IF pci-bridge-interrupt-map ELSE 2drop THEN pci-reg-props ; : assign-bar-mapping ( bar-offset size var -- ) rot my-unit-64 + -rot assign-bar-value32 drop ; : assigned-addresses-property ( -- ) my-unit-64 dup pci-common-props pci-device-assigned-addresses-prop ; : pci-bridge-generic-setup ( addr -- ) pci-device-slots >r \ save the slot array on return stack dup pci-common-props \ set the common properties before scanning the bus s" pci" device-type \ the type is allways "pci" dup pci-bridge-probe \ find all device connected to it dup assign-all-bridge-bars \ set up all memory access BARs dup pci-set-irq-line \ set the interrupt pin dup pci-set-capabilities \ set up the capabilities pci-bridge-props \ and generate all properties r> TO pci-device-slots \ and reset the slot array ; : pci-device-generic-setup ( config-addr -- ) dup assign-all-device-bars \ calc all BARs dup pci-set-irq-line \ set the interrupt pin dup pci-set-capabilities \ set up the capabilities dup pci-device-props \ and generate all properties drop \ forget the config-addr ; �� ( �8pci-config-bridge.fs: config-xt ( config-addr xt -- data ) puid >r \ Safe puid my-puid TO puid \ Set my-puid swap dup ffff00 AND 0= IF \ Has bus-device-function been specified? my-space OR \ No: use my-space instead THEN swap execute \ Execute the rtas-config-xx function r> TO puid \ Restore previous puid ; : config-b@ ( config-addr -- data ) ['] rtas-config-b@ config-xt ; : config-w@ ( config-addr -- data ) ['] rtas-config-w@ config-xt ; : config-l@ ( config-addr -- data ) ['] rtas-config-l@ config-xt ; : config-b! ( data config-addr -- ) ['] rtas-config-b! config-xt ; : config-w! ( data config-addr -- ) ['] rtas-config-w! config-xt ; : config-l! ( data config-addr -- ) ['] rtas-config-l! config-xt ; : config-dump puid >r my-puid TO puid my-space pci-dump r> TO puid ; : decode-unit ( addr len -- phys.lo ... phys.hi ) 2 hex-decode-unit \ decode string B lshift swap \ shift the devicenumber to the right spot 8 lshift or \ add the functionnumber my-bus 10 lshift or \ add the busnumber 0 0 rot \ make phys.lo = 0 = phys.mid ; : encode-unit ( phys.lo ... phys.hi -- unit-str unit-len ) nip nip \ forget the both zeros dup 8 rshift 7 and swap \ calc Functionnumber B rshift 1F and \ calc Devicenumber over IF \ IF Function!=0 2 hex-encode-unit \ | create string with DevNum,FnNum ELSE \ ELSE nip 1 hex-encode-unit \ | create string with only DevNum THEN \ FI ; : map-in ( phys.lo phys.mid phys.hi size -- virt ) drop nip nip ( phys.hi ) dup FF AND dup 10 28 WITHIN NOT swap 30 <> AND IF cr ." phys.hi = " . cr ABORT" map-in with illegal config space address" THEN 00FFFFFF AND \ Need only bus-dev-fn+register bits dup config-l@ ( phys.hi' bar.lo ) dup 7 AND 4 = IF \ Is it a 64-bit BAR? swap 4 + config-l@ lxjoin \ Add upper part of 64-bit BAR ELSE nip THEN F NOT AND \ Clear indicator bits ; : map-out ( virt size -- ) 2drop ; : dma-alloc ( ... size -- virt ) alloc-mem ; : dma-free ( virt size -- ) free-mem ; : dma-map-in ( ... virt size cacheable? -- devaddr ) 2drop ; : dma-map-out ( virt devaddr size -- ) 2drop drop ; : dma-sync ( virt devaddr size -- ) 2drop drop ; : open true ; : close ; ��0update_flash.fsfalse value flash-new : update-flash-help ( -- ) cr ." update-flash tool to flash host FW " cr ." -f <filename> : Flash from file (e.g. net:\boot_rom.bin)" cr ." -l : Flash from load-base" cr ." -d : Flash from old load base (used by drone)" cr ." -c : Flash from temp to perm" cr ." -r : Flash from perm to temp" cr ; : flash-read-temp ( -- success? ) get-flashside 1 = IF flash-addr load-base over flash-image-size rmove true ELSE false THEN ; : flash-read-perm ( -- success? ) get-flashside 0= IF flash-addr load-base over flash-image-size rmove true ELSE false THEN ; : flash-switch-side ( side -- success? ) set-flashside 0<> IF s" Cannot change flashside" type cr false ELSE true THEN ; : flash-ensure-temp ( -- success? ) get-flashside 0= IF cr ." Cannot flash perm! Switching to temp side!" 1 flash-switch-side ELSE true THEN ; : update-flash ( "text" ) get-flashside >r \ Save old flashside parse-word ( str len ) \ Parse first string drop dup c@ ( str first-char ) [char] - <> IF update-flash-help r> 2drop EXIT THEN 1+ c@ ( second-char ) CASE [char] f OF parse-word cr s" do-load" evaluate flash-ensure-temp TO flash-new ENDOF [char] l OF flash-ensure-temp ENDOF [char] d OF flash-load-base load-base 200000 move flash-ensure-temp ENDOF [char] c OF flash-read-temp 0= flash-new or IF ." Cannot commit temp, need to boot on temp first " cr false ELSE 0 flash-switch-side THEN ENDOF [char] r OF flash-read-perm 0= IF ." Cannot commit perm, need to boot on perm first " cr false ELSE 1 flash-switch-side THEN ENDOF dup OF false ENDOF ENDCASE 0= IF update-flash-help r> drop EXIT THEN load-base flash-write 0= IF ." Flash write failed !! " cr THEN r> set-flashside drop \ Restore old flashside ; ��0�0xmodem.fs01 CONSTANT XM-SOH \ Start of header 04 CONSTANT XM-EOT \ End-of-transmission 06 CONSTANT XM-ACK \ Acknowledge 15 CONSTANT XM-NAK \ Neg. acknowledge 0 VALUE xm-retries \ Retry count 0 VALUE xm-block# : xmodem-get-byte ( timeout -- byte|-1 ) d# 1000 * 0 DO key? IF key UNLOOP EXIT THEN 1 ms LOOP -1 ; : xmodem-rx-packet ( address -- success? ) 1 xmodem-get-byte \ Get block number dup 0 < IF 2drop false EXIT \ Timeout THEN 1 xmodem-get-byte \ Get neg. block number dup 0 < IF 3drop false EXIT \ Timeout THEN rot 0 ( blk# ~blk# address chksum ) 80 0 DO 1 xmodem-get-byte dup 0 < IF ( blk# ~blk# address chksum byte ) 3drop 2drop UNLOOP FALSE EXIT THEN dup 3 pick c! ( blk# ~blk# address chksum byte ) + swap 1+ swap ( blk# ~blk# address+1 chksum' ) LOOP 0ff and 1 xmodem-get-byte <> IF 3drop FALSE EXIT THEN drop ( blk# ~blk# ) over xm-block# <> IF 2drop FALSE EXIT THEN ( blk# ~blk# ) ff xor = ; : (xmodem-load) ( address -- bytes ) 1 to xm-block# 0 to xm-retries dup BEGIN d# 10 xmodem-get-byte dup >r CASE XM-SOH OF dup xmodem-rx-packet IF XM-ACK emit 80 + ( start-addr next-addr R: rx-byte ) 0 to xm-retries \ Reset retry count xm-block# 1+ ff and to xm-block# \ Increase current block# ELSE XM-NAK emit xm-retries 1+ to xm-retries \ Increase retry count THEN ENDOF XM-EOT OF XM-ACK emit ENDOF dup OF XM-NAK emit xm-retries 1+ to xm-retries \ Increase retry count ENDOF ENDCASE r> XM-EOT = xm-retries d# 10 >= OR UNTIL ( start-address end-address ) swap - ( bytes received ) ; : xmodem-load ( -- bytes ) cr ." Waiting for start of XMODEM upload..." cr load-base (xmodem-load) ; ��@8default-font.bin(($$~$$~$$*(( *0H00@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@D884LDL4D8@@@XdDDDDDH0@@@DHPpHDB08T****jX$$$$v""""XdDdX@@@4LDL4xD@@@@$$8$$$$$DDD((*****DD((D"" < < $THDDD((��X0pci-phb.fs0 VALUE phb-debug? ." Populating " pwd cr : decode-unit ( addr len -- phys.lo ... phys.hi ) 2 hex-decode-unit \ decode string b lshift swap \ shift the devicenumber to the right spot 8 lshift or \ add the functionnumber 0 0 rot \ make phys.lo = 0 = phys.mid ; : encode-unit ( phys.lo phys-mid phys.hi -- unit-str unit-len ) nip nip \ forget the phys.lo and phys.mid dup 8 rshift 7 and swap \ calculate function number B rshift 1F and \ calculate device number over IF 2 ELSE nip 1 THEN \ create string with dev#,fn# or dev# only? hex-encode-unit ; 0 VALUE my-puid : setup-puid s" reg" get-node get-property 0= IF decode-64 to my-puid 2drop THEN ; setup-puid : config-b@ puid >r my-puid TO puid rtas-config-b@ r> TO puid ; : config-w@ puid >r my-puid TO puid rtas-config-w@ r> TO puid ; : config-l@ puid >r my-puid TO puid rtas-config-l@ r> TO puid ; : config-b! puid >r my-puid TO puid rtas-config-b! r> TO puid ; : config-w! puid >r my-puid TO puid rtas-config-w! r> TO puid ; : config-l! puid >r my-puid TO puid rtas-config-l! r> TO puid ; : map-in ( phys.lo phys.mid phys.hi size -- virt ) phb-debug? IF cr ." map-in called: " .s cr THEN drop nip nip ( phys.hi ) dup FF AND dup 10 28 WITHIN NOT swap 30 <> AND IF cr ." phys.hi = " . cr ABORT" map-in with illegal config space address" THEN 00FFFFFF AND \ Need only bus-dev-fn+register bits dup config-l@ ( phys.hi' bar.lo ) dup 7 AND 4 = IF \ Is it a 64-bit BAR? swap 4 + config-l@ lxjoin \ Add upper part of 64-bit BAR ELSE nip THEN F NOT AND \ Clear indicator bits translate-my-address phb-debug? IF ." map-in done: " .s cr THEN ; : map-out ( virt size -- ) phb-debug? IF ." map-out called: " .s cr THEN 2drop ; : dma-alloc ( size -- virt ) phb-debug? IF cr ." dma-alloc called: " .s cr THEN fff + fff not and \ Align size to next 4k boundary alloc-mem dup fff and IF ." Warning: dma-alloc got unaligned memory!" cr THEN ; : dma-free ( virt size -- ) phb-debug? IF cr ." dma-free called: " .s cr THEN fff + fff not and \ Align size to next 4k boundary free-mem ; 0 VALUE dma-window-liobn \ Logical I/O bus number 0 VALUE dma-window-base \ Start address of window 0 VALUE dma-window-size \ Size of the window : (init-dma-window-vars) ( -- ) s" ibm,dma-window" calling-child get-property IF s" ibm,dma-window" calling-child parent get-property ABORT" no dma-window property available" THEN decode-int TO dma-window-liobn decode-64 TO dma-window-base decode-64 TO dma-window-size 2drop ; : (clear-dma-window-vars) ( -- ) 0 TO dma-window-liobn 0 TO dma-window-base 0 TO dma-window-size ; : dma-virt2dev ( virt -- devaddr ) dma-window-size mod dma-window-base + ; : dma-map-in ( virt size cachable? -- devaddr ) phb-debug? IF cr ." dma-map-in called: " .s cr THEN (init-dma-window-vars) drop ( virt size ) bounds dup >r ( v+s virt R: virt ) swap fff + fff not and \ Align end to next 4k boundary swap fff not and ( v+s' virt' R: virt ) ?DO dma-window-liobn \ liobn i dma-virt2dev \ ioba i 3 OR \ Make a read- & writeable TCE hv-put-tce ABORT" H_PUT_TCE failed" 1000 +LOOP r> dma-virt2dev (clear-dma-window-vars) ; : dma-map-out ( virt devaddr size -- ) phb-debug? IF cr ." dma-map-out called: " .s cr THEN (init-dma-window-vars) nip ( virt size ) bounds ( v+s virt ) swap fff + fff not and \ Align end to next 4k boundary swap fff not and ( v+s' virt' ) ?DO dma-window-liobn \ liobn i dma-virt2dev \ ioba i \ Lowest bits not set => invalid TCE hv-put-tce ABORT" H_PUT_TCE failed" 1000 +LOOP (clear-dma-window-vars) ; : dma-sync ( virt devaddr size -- ) phb-debug? IF cr ." dma-sync called: " .s cr THEN 3drop ; : open true ; : close ; : phb-parse-ranges ( -- ) 0 pci-next-io ! 0 pci-max-io ! 0 pci-next-mem ! 0 pci-max-mem ! 0 pci-next-mmio ! 0 pci-max-mmio ! s" ranges" get-node get-property 0<> ABORT" ranges property not found" BEGIN dup WHILE decode-int \ Decode phys.hi 3000000 AND \ Filter out address space in phys.hi CASE 1000000 OF \ I/O space? decode-64 dup >r pci-next-io ! \ Decode PCI base address decode-64 drop \ Forget the parent address decode-64 r> + pci-max-io ! \ Decode size & calc max address pci-next-io @ 0= IF pci-next-io @ 10 + pci-next-io ! \ BARs must not be set to zero THEN ENDOF 2000000 OF \ 32-bit memory space? decode-64 pci-next-mem ! \ Decode mem base address decode-64 drop \ Forget the parent address decode-64 2 / dup >r \ Decode and calc size/2 pci-next-mem @ + dup pci-max-mem ! \ and calc max mem address dup pci-next-mmio ! \ which is the same as MMIO base r> + pci-max-mmio ! \ calc max MMIO address ENDOF 3000000 OF \ 64-bit memory space? cr ." Warning: 64-bit PCI space not supported yet! " decode-64 . decode-64 . cr ENDOF ENDCASE REPEAT 2drop phb-debug? IF ." pci-next-io = " pci-next-io @ . cr ." pci-max-io = " pci-max-io @ . cr ." pci-next-mem = " pci-next-mem @ . cr ." pci-max-mem = " pci-max-mem @ . cr ." pci-next-mmio = " pci-next-mmio @ . cr ." pci-max-mmio = " pci-max-mmio @ . cr THEN ; : phb-setup-children puid >r \ Save old value of puid my-puid TO puid \ Set current puid phb-parse-ranges 1 0 (probe-pci-host-bridge) r> TO puid \ Restore previous puid ; phb-setup-children ��h2(rtas.fs4d0 cp STRUCT /l field rtas>token /l field rtas>nargs /l field rtas>nret /l field rtas>args0 /l field rtas>args1 /l field rtas>args2 /l field rtas>args3 /l field rtas>args4 /l field rtas>args5 /l field rtas>args6 /l field rtas>args7 /l C * field rtas>args /l field rtas>bla CONSTANT /rtas-control-block CREATE rtas-cb /rtas-control-block allot rtas-cb /rtas-control-block erase 0 VALUE rtas-base 0 VALUE rtas-size 0 VALUE rtas-entry 0 VALUE rtas-node 4d1 cp : find-qemu-rtas ( -- ) " /rtas" find-device get-node to rtas-node " linux,rtas-base" rtas-node get-package-property IF device-end EXIT THEN drop l@ to rtas-base " linux,rtas-base" delete-property " rtas-size" rtas-node get-package-property IF device-end EXIT THEN drop l@ to rtas-size " linux,rtas-entry" rtas-node get-package-property IF rtas-base to rtas-entry ELSE drop l@ to rtas-entry " linux,rtas-entry" delete-property THEN device-end ; find-qemu-rtas 4d2 cp : enter-rtas ( -- ) rtas-cb rtas-base 0 rtas-entry call-c drop ; : rtas-get-token ( str len -- token | 0 ) rtas-node get-package-property IF 0 ELSE drop l@ THEN ; : rtas-start-cpu ( pid loc r3 -- status ) " start-cpu" rtas-get-token rtas-cb rtas>token l! 3 rtas-cb rtas>nargs l! 1 rtas-cb rtas>nret l! rtas-cb rtas>args2 l! rtas-cb rtas>args1 l! rtas-cb rtas>args0 l! 0 rtas-cb rtas>args3 l! enter-rtas rtas-cb rtas>args3 l@ ; : rtas-set-tce-bypass ( unit enable -- ) " ibm,set-tce-bypass" rtas-get-token rtas-cb rtas>token l! 2 rtas-cb rtas>nargs l! 0 rtas-cb rtas>nret l! rtas-cb rtas>args1 l! rtas-cb rtas>args0 l! enter-rtas ; : rtas-quiesce ( -- ) " quiesce" rtas-get-token rtas-cb rtas>token l! 0 rtas-cb rtas>nargs l! 0 rtas-cb rtas>nret l! enter-rtas ; 0 value puid : rtas-do-config-@ ( config-addr size -- value) " ibm,read-pci-config" rtas-get-token rtas-cb rtas>token l! 4 rtas-cb rtas>nargs l! 2 rtas-cb rtas>nret l! ( addr size ) rtas-cb rtas>args3 l! puid ffffffff and rtas-cb rtas>args2 l! puid 20 rshift rtas-cb rtas>args1 l! ( addr ) rtas-cb rtas>args0 l! enter-rtas rtas-cb rtas>args4 l@ dup IF drop ffffffff ELSE drop rtas-cb rtas>args5 l@ THEN ; : rtas-do-config-! ( value config-addr size ) " ibm,write-pci-config" rtas-get-token rtas-cb rtas>token l! 5 rtas-cb rtas>nargs l! 1 rtas-cb rtas>nret l! ( value addr size ) rtas-cb rtas>args3 l! puid ffffffff and rtas-cb rtas>args2 l! puid 20 rshift rtas-cb rtas>args1 l! ( value addr ) rtas-cb rtas>args0 l! ( value ) rtas-cb rtas>args4 l! enter-rtas rtas-cb rtas>args5 l@ dup IF ." RTAS write config err " . cr ELSE drop THEN ; : rtas-config-b@ ( config-addr -- value ) 1 rtas-do-config-@ ff and ; : rtas-config-b! ( value config-addr -- ) 1 rtas-do-config-! ; : rtas-config-w@ ( config-addr -- value ) 2 rtas-do-config-@ ffff and ; : rtas-config-w! ( value config-addr -- ) 2 rtas-do-config-! ; : rtas-config-l@ ( config-addr -- value ) 4 rtas-do-config-@ ffffffff and ; : rtas-config-l! ( value config-addr -- ) 4 rtas-do-config-! ; : of-start-cpu rtas-start-cpu ; rtas-node set-node : open true ; : close ; : instantiate-rtas ( adr -- entry ) dup rtas-base swap rtas-size move rtas-entry rtas-base - + ; device-end 4d8 cp ��8pci-device_1234_1111.fsmy-space pci-device-generic-setup d# 800 VALUE disp-width d# 600 VALUE disp-height d# 8 VALUE disp-depth 10 config-l@ translate-my-address 3 not AND VALUE fb-base -1 VALUE io-base false VALUE is-installed? : vga-io-xlate ( port -- addr ) io-base -1 = IF dup translate-my-address fff not and to io-base THEN io-base + ; : vga-w! ( value port -- ) vga-io-xlate rw!-le ; : vga-w@ ( port -- value ) vga-io-xlate rw@-le ; : vga-b! ( value port -- ) vga-io-xlate rb! ; : vga-b@ ( port -- value ) vga-io-xlate rb@ ; : vbe! ( value index -- ) 1ce vga-w! 1d0 vga-w! ; : vbe@ ( index -- value ) 1ce vga-w! 1d0 vga-w@ ; : draw-rectangle ( adr x y w h -- ) is-installed? IF 0 ?DO 4dup ( adr x y w adr x y w ) drop ( adr x y w adr x y ) i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x) frame-buffer-adr + \ add to frame-buffer-adr ( adr x y w adr fb_adr ) 1 pick 3 pick i * + swap 3 pick ( adr x y w adr adr_offs fb_adr w ) rmove \ copy line ( adr x y w adr ) drop ( adr x y w ) LOOP 4drop ELSE 4drop drop THEN ; : fill-rectangle ( number x y w h -- ) is-installed? IF 0 ?DO 4dup ( number x y w number x y w ) drop ( number x y w number x y ) i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x) frame-buffer-adr + \ add to frame-buffer-adr ( number x y w number adr ) 2 pick 2 pick ( number x y w number adr w number ) rfill \ draw line ( number x y w number ) drop ( number x y w ) LOOP 4drop ELSE 4drop drop THEN ; : read-rectangle ( adr x y w h -- ) is-installed? IF 0 ?DO 4dup ( adr x y w adr x y w ) drop ( adr x y w adr x y ) i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x) frame-buffer-adr + \ add to frame-buffer-adr ( adr x y w adr fb_adr ) 1 pick 3 pick i * + 3 pick ( adr x y w adr fb_adr adr_offs w ) rmove \ copy line ( adr x y w adr ) drop ( adr x y w ) LOOP 4drop ELSE 4drop drop THEN ; : color! ( r g b number -- ) 3c8 vga-b! rot 3c9 vga-b! swap 3c9 vga-b! 3c9 vga-b! ; : color@ ( number -- r g b ) 3c8 vga-b! 3c9 vga-b@ 3c9 vga-b@ 3c9 vga-b@ ; : set-colors ( adr number #numbers -- ) over 3c8 vga-b! swap DO rb@ 3c9 vga-b! rb@ 3c9 vga-b! rb@ 3c9 vga-b! LOOP 3drop ; : get-colors ( adr number #numbers -- ) 3drop ; : default-palette 100 0 DO i i i i color! LOOP ; 0 CONSTANT VBE_DISPI_INDEX_ID 1 CONSTANT VBE_DISPI_INDEX_XRES 2 CONSTANT VBE_DISPI_INDEX_YRES 3 CONSTANT VBE_DISPI_INDEX_BPP 4 CONSTANT VBE_DISPI_INDEX_ENABLE 5 CONSTANT VBE_DISPI_INDEX_BANK 6 CONSTANT VBE_DISPI_INDEX_VIRT_WIDTH 7 CONSTANT VBE_DISPI_INDEX_VIRT_HEIGHT 8 CONSTANT VBE_DISPI_INDEX_X_OFFSET 9 CONSTANT VBE_DISPI_INDEX_Y_OFFSET a CONSTANT VBE_DISPI_INDEX_NB 00 CONSTANT VBE_DISPI_DISABLED 01 CONSTANT VBE_DISPI_ENABLED 02 CONSTANT VBE_DISPI_GETCAPS 20 CONSTANT VBE_DISPI_8BIT_DAC 40 CONSTANT VBE_DISPI_LFB_ENABLED 80 CONSTANT VBE_DISPI_NOCLEARMEM : init-mode 0 3c0 vga-b! VBE_DISPI_DISABLED VBE_DISPI_INDEX_ENABLE vbe! 0 VBE_DISPI_INDEX_X_OFFSET vbe! 0 VBE_DISPI_INDEX_Y_OFFSET vbe! disp-width VBE_DISPI_INDEX_XRES vbe! disp-height VBE_DISPI_INDEX_YRES vbe! disp-depth VBE_DISPI_INDEX_BPP vbe! VBE_DISPI_ENABLED VBE_DISPI_8BIT_DAC or VBE_DISPI_INDEX_ENABLE vbe! 0 3c0 vga-b! 20 3c0 vga-b! ; : clear-screen fb-base disp-width disp-height disp-depth 7 + 8 / * * 0 rfill ; : read-settings s" qemu,graphic-width" get-chosen IF decode-int to disp-width 2drop THEN s" qemu,graphic-height" get-chosen IF decode-int to disp-height 2drop THEN s" qemu,graphic-depth" get-chosen IF decode-int nip nip dup 8 = over f = or over 10 = or over 20 = or IF to disp-depth ELSE ." Unsupported bit depth, using 8bpp " drop cr THEN THEN ; : add-legacy-reg s" reg" get-node get-property IF encode-start ELSE encode-bytes THEN my-space a1000000 or encode-int+ \ non-relocatable, aliased I/O space 1ce encode-64+ 4 encode-64+ \ addr size my-space a1000000 or encode-int+ \ non-relocatable, aliased I/O space 3b0 encode-64+ c encode-64+ \ addr size my-space a1000000 or encode-int+ \ non-relocatable, aliased I/O space 3c0 encode-64+ 20 encode-64+ \ addr size my-space a2000000 or encode-int+ \ non-relocatable, <1MB Memory space a0000 encode-64+ 20000 encode-64+ \ addr size s" reg" property \ store "reg" property ; : setup-properties disp-width encode-int s" width" property disp-height encode-int s" height" property disp-width disp-depth 7 + 8 / * encode-int s" linebytes" property disp-depth encode-int s" depth" property s" ISO8859-1" encode-string s" character-set" property \ i hope this is ok... s" display" encode-string s" device_type" property s" qemu,std-vga" encode-string s" compatible" property ; : display-remove ( -- ) ; : display-install ( -- ) is-installed? NOT IF ." Installing QEMU fb" cr fb-base to frame-buffer-adr clear-screen default-font set-font disp-width disp-height disp-width char-width / disp-height char-height / disp-depth 7 + 8 / ( width height #lines #cols depth ) fb-install true to is-installed? THEN ; : dimensions ( -- width height ) disp-width disp-height ; : set-alias s" screen" find-alias 0= IF s" screen" get-node node>path set-alias ELSE drop THEN ; ." qemu vga" cr pci-master-enable pci-mem-enable pci-io-enable add-legacy-reg read-settings init-mode default-palette setup-properties ' display-install is-install ' display-remove is-remove set-alias ��m8pci-device_1013_00b8.fsmy-space pci-device-generic-setup d# 800 VALUE disp-width d# 600 VALUE disp-height d# 8 VALUE disp-depth 10 config-l@ translate-my-address 3 not AND VALUE fb-base -1 VALUE io-base false VALUE is-installed? : vga-io-xlate ( port -- addr ) io-base -1 = IF dup translate-my-address fff not and to io-base THEN io-base + ; : vga-w! ( value port -- ) vga-io-xlate rw!-le ; : vga-w@ ( port -- value ) vga-io-xlate rw@-le ; : vga-b! ( value port -- ) vga-io-xlate rb! ; : vga-b@ ( port -- value ) vga-io-xlate rb@ ; : vga-crt@ ( index -- value ) 3d4 vga-b! 3d5 vga-b@ ; : vga-crt! ( value index -- ) 3d4 vga-b! 3d5 vga-b! ; : vga-seq@ ( index -- value ) 3c4 vga-b! 3c5 vga-b@ ; : vga-seq! ( value index -- ) 3c4 vga-b! 3c5 vga-b! ; : vga-att@ ( index -- value ) 3c0 vga-b! 3c1 vga-b@ ; : vga-att! ( value index -- ) 3c0 vga-b! 3c0 vga-b! ; : vga-gfx@ ( index -- value ) 3ce vga-b! 3cf vga-b@ ; : vga-gfx! ( value index -- ) 3ce vga-b! 3cf vga-b! ; : draw-rectangle ( adr x y w h -- ) is-installed? IF 0 ?DO 4dup ( adr x y w adr x y w ) drop ( adr x y w adr x y ) i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x) frame-buffer-adr + \ add to frame-buffer-adr ( adr x y w adr fb_adr ) 1 pick 3 pick i * + swap 3 pick ( adr x y w adr adr_offs fb_adr w ) rmove \ copy line ( adr x y w adr ) drop ( adr x y w ) LOOP 4drop ELSE 4drop drop THEN ; : fill-rectangle ( number x y w h -- ) is-installed? IF 0 ?DO 4dup ( number x y w number x y w ) drop ( number x y w number x y ) i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x) frame-buffer-adr + \ add to frame-buffer-adr ( number x y w number adr ) 2 pick 2 pick ( number x y w number adr w number ) rfill \ draw line ( number x y w number ) drop ( number x y w ) LOOP 4drop ELSE 4drop drop THEN ; : read-rectangle ( adr x y w h -- ) is-installed? IF 0 ?DO 4dup ( adr x y w adr x y w ) drop ( adr x y w adr x y ) i + screen-width * + \ calculate offset into framebuffer ((y + i) * screen_width + x) frame-buffer-adr + \ add to frame-buffer-adr ( adr x y w adr fb_adr ) 1 pick 3 pick i * + 3 pick ( adr x y w adr fb_adr adr_offs w ) rmove \ copy line ( adr x y w adr ) drop ( adr x y w ) LOOP 4drop ELSE 4drop drop THEN ; : color! ( r g b number -- ) 3c8 vga-b! rot 2 >> 3c9 vga-b! swap 2 >> 3c9 vga-b! 2 >> 3c9 vga-b! ; : color@ ( number -- r g b ) 3c8 vga-b! 3c9 vga-b@ 2 << 3c9 vga-b@ 2 << 3c9 vga-b@ 2 << ; : set-colors ( adr number #numbers -- ) over 3c8 vga-b! swap DO rb@ 2 >> 3c9 vga-b! rb@ 2 >> 3c9 vga-b! rb@ 2 >> 3c9 vga-b! LOOP 3drop ; : get-colors ( adr number #numbers -- ) 3drop ; : default-palette 100 0 DO i i i i color! LOOP ; : init-mode 3da vga-b@ drop \ reset flip flop 0f 3c2 vga-b! \ color mode, ram enable, ... 12 06 vga-seq! \ unlock extensions 05 06 vga-gfx! \ graphic mode disp-depth CASE \ set depth 8 OF 01 07 vga-seq! ENDOF f OF 07 07 vga-seq! ENDOF 10 OF 07 07 vga-seq! ENDOF 20 OF 09 07 vga-seq! ENDOF ENDCASE ff 02 vga-seq! \ enable plane write 0a 04 vga-seq! \ memory mode 03 17 vga-crt! \ disable display disp-width disp-depth 7 + 8 / * 3 >> dup ff and 13 vga-crt! \ bottom bits 4 >> 10 and 1b vga-crt! \ top bit disp-width 3 >> 1 - 01 vga-crt! \ H_DISP disp-height 1 - ff and 12 vga-crt! \ V_DISP disp-height 1 - 7 >> 2 and disp-height 1 - 3 >> 40 and or 10 or 07 vga-crt! \ OFLOW ff 18 vga-crt! \ LINE_COMPARE 40 09 vga-crt! \ MAX_SCAN 08 04 vga-crt! \ SYNC_START 0f 02 vga-crt! \ BLANK_START 00 0c vga-crt! 00 0d vga-crt! 40 05 vga-gfx! \ gfx mode 83 17 vga-crt! \ enable display 33 3c0 vga-b! \ gfx in ar index 00 3c0 vga-b! 01 01 vga-seq! \ enable seq ; : clear-screen fb-base disp-width disp-height disp-depth 7 + 8 / * * 0 rfill ; : read-settings s" qemu,graphic-width" get-chosen IF decode-int to disp-width 2drop THEN s" qemu,graphic-height" get-chosen IF decode-int to disp-height 2drop THEN s" qemu,graphic-depth" get-chosen IF decode-int nip nip dup 8 = over f = or over 10 = or over 20 = or IF to disp-depth ELSE ." Unsupported bit depth, using 8bpp " drop cr THEN THEN ; : add-legacy-reg s" reg" get-node get-property IF encode-start ELSE encode-bytes THEN my-space a1000000 or encode-int+ \ non-relocatable, aliased I/O space 1ce encode-64+ 4 encode-64+ \ addr size my-space a1000000 or encode-int+ \ non-relocatable, aliased I/O space 3b0 encode-64+ c encode-64+ \ addr size my-space a1000000 or encode-int+ \ non-relocatable, aliased I/O space 3c0 encode-64+ 20 encode-64+ \ addr size my-space a2000000 or encode-int+ \ non-relocatable, <1MB Memory space a0000 encode-64+ 20000 encode-64+ \ addr size s" reg" property \ store "reg" property ; : setup-properties disp-width encode-int s" width" property disp-height encode-int s" height" property disp-width disp-depth 7 + 8 / * encode-int s" linebytes" property disp-depth encode-int s" depth" property s" ISO8859-1" encode-string s" character-set" property \ i hope this is ok... s" display" encode-string s" device_type" property ; : display-remove ( -- ) ; : display-install ( -- ) is-installed? NOT IF ." Installing QEMU fb" cr fb-base to frame-buffer-adr default-font set-font disp-width disp-height disp-width char-width / disp-height char-height / disp-depth 7 + 8 / ( width height #lines #cols depth ) fb-install true to is-installed? THEN ; : dimensions ( -- width height ) disp-width disp-height ; : set-alias s" screen" find-alias 0= IF s" screen" get-node node>path set-alias ELSE drop THEN ; ." cirrus vga" cr pci-master-enable pci-mem-enable pci-io-enable add-legacy-reg read-settings init-mode clear-screen default-palette setup-properties ' display-install is-install ' display-remove is-remove set-alias ��E0pci-class_02.fss" network [ " type my-space pci-class-name type s" ]" type my-space pci-device-generic-setup my-space pci-alias-net s" network" device-type cr INSTANCE VARIABLE obp-tftp-package : open ( -- okay? ) open IF \ enables PCI mem, io and Bus master and returns TRUE my-args s" obp-tftp" $open-package obp-tftp-package ! true ELSE false THEN ; : close ( -- ) obp-tftp-package @ close-package close ; \ disables PCI mem, io and Bus master : load ( addr -- len ) s" load" obp-tftp-package @ $call-method ; : ping ( -- ) s" ping" obp-tftp-package @ $call-method ; ��8�0pci-class_0c.fss" serial bus [ " type my-space pci-class-name type s" ]" type cr my-space pci-device-generic-setup : handle-usb-ohci-class ( -- ) 4 config-w@ 110 or 4 config-w! pci-master-enable \ set PCI Bus master bit and pci-mem-enable \ memory space enable for USB scan set-ohci-alias ; : handle-sbc-subclass ( -- ) my-space pci-class@ ffff and CASE \ get PCI sub-class and interface 0310 OF handle-usb-ohci-class ENDOF \ USB OHCI controller ENDCASE ; handle-sbc-subclass ��X�X�0usb-ohci.fss" usb" device-type 1 encode-int s" #address-cells" property 0 encode-int s" #size-cells" property : encode-unit ( port -- unit-str unit-len ) 1 hex-encode-unit ; : decode-unit ( addr len -- port ) 1 hex-decode-unit ; STRUCT /l field td>tattr /l field td>cbptr /l field td>ntd /l field td>bfrend CONSTANT /tdlen STRUCT /l field ed>eattr /l field ed>tdqtp /l field ed>tdqhp /l field ed>ned CONSTANT /edlen STRUCT /l field hc>hcattr /l field hc>hcdone CONSTANT /hclen : get-base-address ( -- baseaddr ) s" assigned-addresses" get-node get-property ABORT" Could not get OHCI base address" decode-int drop ( addr len ) decode-64 nip nip ( n ) translate-my-address ; get-base-address CONSTANT baseaddrs baseaddrs CONSTANT HcRevision baseaddrs 4 + CONSTANT hccontrol baseaddrs 8 + CONSTANT hccomstat baseaddrs 0c + CONSTANT hcintstat baseaddrs 14 + CONSTANT hcintdsbl baseaddrs 18 + CONSTANT hchccareg baseaddrs 20 + CONSTANT hcctrhead baseaddrs 24 + CONSTANT hccurcont baseaddrs 28 + CONSTANT hcbulkhead baseaddrs 2c + CONSTANT hccurbulk baseaddrs 30 + CONSTANT hcdnehead baseaddrs 34 + CONSTANT hcintrval baseaddrs 40 + CONSTANT HcPeriodicStart baseaddrs 48 + CONSTANT hcrhdescA baseaddrs 4c + CONSTANT hcrhdescB baseaddrs 50 + CONSTANT HcRhStatus baseaddrs 54 + CONSTANT hcrhpstat baseaddrs 58 + CONSTANT hcrhpstat2 baseaddrs 5c + CONSTANT hcrhpstat3 usb-debug-flag IF 0 config-l@ ." - VENDOR: " 8 .r cr 40 config-l@ ." - PMC : " 8 .r 44 config-l@ ." PMCSR : " 8 .r cr E0 config-l@ ." - EXT1 : " 8 .r E4 config-l@ ." EXT2 : " 8 .r cr THEN 2 CONSTANT WDH 1 CONSTANT RHP-CCS \ Current Connect Status 2 CONSTANT RHP-PES \ Port Enable Status 10 CONSTANT RHP-PRS \ Port Reset Status 100 CONSTANT RHP-PPS \ Port Power Status 10000 CONSTANT RHP-CSC \ Connect Status Changed 100000 CONSTANT RHP-PRSC \ Port Reset Status Changed 0 CONSTANT OHCI-DP-SETUP 1 CONSTANT OHCI-DP-OUT 2 CONSTANT OHCI-DP-IN 3 CONSTANT OHCI-DP-INVALID 8006000100001200 CONSTANT get-ddescp 8006000200000900 CONSTANT get-cdescp 8006000400000900 CONSTANT get-idescp 8006000500000700 CONSTANT get-edescp A006000000001000 CONSTANT get-hdescp 0009010000000000 CONSTANT set-cdescp 2303010004000000 CONSTANT hpenable-set 2303040001000000 CONSTANT hp1rst-set 2303040002000000 CONSTANT hp2rst-set 2303040003000000 CONSTANT hp3rst-set 2303040004000000 CONSTANT hp4rst-set 2303080001000000 CONSTANT hp1pwr-set 2303080002000000 CONSTANT hp2pwr-set 2303080003000000 CONSTANT hp3pwr-set 2303080004000000 CONSTANT hp4pwr-set A003000000000400 CONSTANT hstatus-get A300000001000400 CONSTANT hp1sta-get A300000002000400 CONSTANT hp2sta-get A300000003000400 CONSTANT hp3sta-get A300000004000400 CONSTANT hp4sta-get 8008000000000100 CONSTANT get-config A1FE000000000100 CONSTANT GET-MAX-LUN 2 18 lshift CONSTANT DATA0-TOGGLE 3 18 lshift CONSTANT DATA1-TOGGLE 0f 1c lshift CONSTANT CC-FRESH-TD 8 CONSTANT STD-REQUEST-SETUP-SIZE 0 13 lshift CONSTANT TD-DP-SETUP 1 13 lshift CONSTANT TD-DP-OUT 2 13 lshift CONSTANT TD-DP-IN 400001 CONSTANT ed-cntatr 400002 CONSTANT ed-cntatr1 80081 CONSTANT ed-hubatr 80000 CONSTANT ed-defatr 0f0e40000 CONSTANT td-attr 00 VALUE ptr 0 VALUE instance-count 200 CONSTANT MAX-TDS 0 VALUE td-freelist-head 0 VALUE td-freelist-tail 0 VALUE num-free-tds 0 VALUE max-rh-ports 0 VALUE current-stat VARIABLE td-list-region VARIABLE td-list-region-dma 14 CONSTANT MAX-EDS 0 VALUE ed-freelist-head 0 VALUE num-free-eds VARIABLE ed-list-region VARIABLE ed-list-region-dma 0 VALUE usb-address 0 VALUE initial-hub-address 0 VALUE new-device-address 0 VALUE mps 0 VALUE DEBUG-TDS 0 VALUE case-failed \ available for general use to see IF a CASE statement 0 VALUE WHILE-failed \ available for general use to see IF a WHILE LOOP 8 CONSTANT DEFAULT-CONTROL-MPS 12 CONSTANT DEVICE-DESCRIPTOR-LEN 1 CONSTANT DEVICE-DESCRIPTOR-TYPE 1 CONSTANT DEVICE-DESCRIPTOR-TYPE-OFFSET 4 CONSTANT DEVICE-DESCRIPTOR-DEVCLASS-OFFSET 7 CONSTANT DEVICE-DESCRIPTOR-MPS-OFFSET 20 CONSTANT BULK-CONFIG-DESCRIPTOR-LEN 9 CONSTANT HUB-DEVICE-CLASS 0 CONSTANT NO-CLASS 0 VALUE temp1 0 VALUE temp2 0 VALUE temp3 0 VALUE extra-bytes 0 VALUE num-td 0 VALUE current 0 VALUE device-speed 0 VALUE setup-packet \ 8 bytes for setup packet 0 VALUE ch-buffer \ 1 byte character buffer VARIABLE dd-buffer VARIABLE dd-buffer-dma VARIABLE cd-buffer VARIABLE cd-buffer-dma 109 CONSTANT OHCI-GLOBAL-DMA-BUF-SIZE 0 VALUE hchcca 0 VALUE hchcca-dma : (init-global-dma-bufs) OHCI-GLOBAL-DMA-BUF-SIZE dma-alloc TO hchcca hchcca OHCI-GLOBAL-DMA-BUF-SIZE 0 dma-map-in TO hchcca-dma hchcca ff and IF s" Warning: hchcca not aligned!" usb-debug-print THEN hchcca 8 + TO setup-packet setup-packet 1 + TO ch-buffer s" hchcca = " hchcca usb-debug-print-val ; (init-global-dma-bufs) 84 hchcca + CONSTANT hchccadneq \ HccaDoneHead hchcca-dma hchcca - CONSTANT virt2phys-offset : virt2phys ( virt -- phys ) dup 0<> IF virt2phys-offset + THEN ; : phys2virt ( phys -- virt ) dup 0<> IF virt2phys-offset - THEN ; : Show-OHCI-Register ." -> OHCI-Register: " cr ." - HcControl : " hccontrol rl@-le 8 .r ." CmdStat : " hccomstat rl@-le 8 .r ." HcInterr. : " hcintstat rl@-le 8 .r cr ." - HcFmIntval: " hcintrval rl@-le 8 .r ." Per. Start: " HcPeriodicStart rl@-le 8 .r cr ." - PortStat-1: " hcrhpstat rl@-le 8 .r ." PortStat-2: " hcrhpstat2 rl@-le 8 .r ." PortStat-3: " hcrhpstat3 rl@-le 8 .r cr ." Descr-A : " hcrhdescA rl@-le 8 .r ." Descr-B : " hcrhdescB rl@-le 8 .r ." HcRhStat : " HcRhStatus rl@-le 8 .r cr ; : display-ed ( ED-ADDRESS -- ) TO temp1 usb-debug-flag IF s" Dump OF ED " type temp1 u. cr s" eattr : " type temp1 ed>eattr l@-le u. cr s" tdqhp : " type temp1 ed>tdqhp l@-le u. cr s" tdqtp : " type temp1 ed>tdqtp l@-le u. cr s" ned : " type temp1 ed>ned l@-le u. cr THEN ; : display-td ( TD-ADDRESS -- ) TO temp1 usb-debug-flag IF s" TD " type temp1 u. s" dump: " type cr s" td>tattr : " type temp1 td>tattr l@-le u. cr s" td>cbptr : " type temp1 td>cbptr l@-le u. cr s" td>ntd : " type temp1 td>ntd l@-le u. cr s" td>bfrend : " type temp1 td>bfrend l@-le u. cr THEN ; : display-descriptors ( ED-ADDRESS -- ) 10 1- not and ( ED-ADDRESS~ ) dup display-ed ed>tdqhp l@-le phys2virt ( ED-ADDRESS~ ) BEGIN 10 1- not and ( ED-ADDRESS~ ) dup 0<> ( ED-ADDRESS~ TRUE | FALSE ) WHILE dup display-td td>ntd l@-le phys2virt ( ED-ADDRESS~ ) REPEAT drop ; : zero-out-a-td-except-link ( td -- ) dup 0 swap td>tattr l!-le ( td ) dup 0 swap td>cbptr l!-le ( td ) dup 0 swap td>bfrend l!-le ( td ) drop ; : initialize-td-free-list ( -- ) MAX-TDS 0= IF EXIT THEN td-list-region @ 0= IF EXIT THEN td-list-region @ TO temp1 0 TO temp2 BEGIN temp1 zero-out-a-td-except-link temp1 /tdlen + dup virt2phys temp1 td>ntd l!-le TO temp1 temp2 1+ TO temp2 temp2 MAX-TDS = ( TRUE | FALSE ) UNTIL temp1 /tdlen - dup 0 swap td>ntd l!-le TO td-freelist-tail td-list-region @ TO td-freelist-head MAX-TDS TO num-free-tds ; : allocate-td-list ( n -- head tail ) dup 0= IF drop 0 0 EXIT THEN ( 0 0 ) dup num-free-tds > IF drop 0 0 EXIT THEN ( 0 0 ) dup num-free-tds = IF ( n ) drop td-freelist-head td-freelist-tail ( td-freelist-head td-freelist-tail ) 0 TO td-freelist-head ( td-freelist-head td-freelist-tail ) 0 TO td-freelist-tail ( td-freelist-head td-freelist-tail ) 0 TO num-free-tds ( td-freelist-head td-freelist-tail ) EXIT THEN dup num-free-tds swap - TO num-free-tds ( n ) td-freelist-head ( n td-list-head ) dup TO temp1 ( n td-list-head ) swap ( td-list-head n ) 0 DO ( td-list-head ) temp1 TO temp2 ( td-list-head ) temp1 td>ntd l@-le phys2virt TO temp1 ( td-list-head ) LOOP ( td-list-head ) temp2 ( td-list-head td-list-tail ) dup td>ntd 0 swap l!-le ( td-list-head td-list-tail ) temp1 TO td-freelist-head ( td-list-head td-list-tail ) ; : find-td-list-tail-and-size ( head -- tail n ) TO temp1 0 TO temp2 0 TO temp3 DEBUG-TDS IF s" BEGIN find-td-list-tail-and-size: " usb-debug-print THEN BEGIN temp1 0<> ( TRUE|FALSE ) WHILE DEBUG-TDS IF temp1 u. cr THEN temp1 TO temp3 temp1 td>ntd l@-le phys2virt TO temp1 temp2 1+ TO temp2 REPEAT temp3 temp2 ( tail n ) DEBUG-TDS IF s" END find-td-list-tail-and-size" usb-debug-print THEN ; : (free-td-list) ( head -- ) dup find-td-list-tail-and-size num-free-tds + TO num-free-tds ( head tail ) td-freelist-tail 0= IF ( head tail ) dup TO td-freelist-tail ( head tail ) THEN ( head tail ) td>ntd td-freelist-head virt2phys swap l!-le ( head ) TO td-freelist-head ; : zero-out-an-ed-except-link ( ed -- ) dup 0 swap ed>eattr l!-le ( ed ) dup 0 swap ed>tdqtp l!-le ( ed ) dup 0 swap ed>tdqhp l!-le ( ed ) drop ; : initialize-ed-free-list ( -- ) MAX-EDS 0= IF EXIT THEN ed-list-region @ 0= IF s" init-ed-list: ed-list-region is not allocated!" usb-debug-print EXIT THEN ed-list-region @ TO temp1 0 TO temp2 BEGIN temp1 zero-out-an-ed-except-link usb-debug-flag IF ." ED " temp2 . ." v: " temp1 . ." p: " temp1 virt2phys . cr THEN temp1 /edlen + dup virt2phys temp1 ed>ned l!-le TO temp1 temp2 1+ TO temp2 temp2 MAX-EDS = UNTIL temp1 /edlen - ed>ned 0 swap l!-le ed-list-region @ TO ed-freelist-head MAX-EDS TO num-free-eds ; : allocate-ed ( -- ed-ptr ) num-free-eds 0= IF 0 EXIT THEN ed-freelist-head ( ed-freelist-head ) ed-freelist-head ed>ned ( ed-freelist-head ned ) l@-le phys2virt TO ed-freelist-head ( ed-freelist-head ) num-free-eds 1- TO num-free-eds ( ed-freelist-head ) dup ed>ned 0 swap l!-le \ Terminate the Link. ( ed-freelist-head ) ; : free-ed ( ed-ptr -- ) dup zero-out-an-ed-except-link ( ed-ptr ) dup ed>ned ed-freelist-head virt2phys swap l!-le ( ed-ptr ) TO ed-freelist-head num-free-eds 1+ TO num-free-eds ; : (allocate-mem) ( -- ) /tdlen MAX-TDS * 10 + dup dma-alloc ( td-region-size td-list-region-ptr ) dup td-list-region ! dup f and IF s" Warning: td-list-region not aligned!" usb-debug-print THEN swap 0 dma-map-in td-list-region-dma ! initialize-td-free-list /edlen MAX-EDS * 10 + dup dma-alloc ( ed-region-size ed-list-region-ptr ) dup ed-list-region ! dup f and IF s" Warning: ed-list-region not aligned!" usb-debug-print THEN swap 0 dma-map-in ed-list-region-dma ! initialize-ed-free-list DEVICE-DESCRIPTOR-LEN chars dup dma-alloc dup dd-buffer ! ( dd-len dd-buf ) swap 0 dma-map-in dd-buffer-dma ! BULK-CONFIG-DESCRIPTOR-LEN chars dup dma-alloc dup cd-buffer ! ( cd-len cd-buf ) swap 0 dma-map-in cd-buffer-dma ! s" td-list-region = " td-list-region @ usb-debug-print-val s" ed-list-region = " ed-list-region @ usb-debug-print-val s" dd-buffer = " dd-buffer @ usb-debug-print-val s" cd-buffer-dma = " cd-buffer-dma @ usb-debug-print-val ; : (de-allocate-mem) ( -- ) td-list-region @ ?dup IF /tdlen MAX-TDS * 10 + ( td-list-region td-region-size ) 2dup td-list-region-dma @ swap dma-map-out dma-free 0 td-list-region ! 0 td-list-region-dma ! THEN ed-list-region @ ?dup IF /edlen MAX-EDS * 10 + 2dup ed-list-region-dma @ swap dma-map-out dma-free 0 ed-list-region ! 0 ed-list-region-dma ! THEN dd-buffer @ ?dup IF DEVICE-DESCRIPTOR-LEN 2dup dd-buffer-dma @ swap dma-map-out dma-free 0 dd-buffer ! 0 dd-buffer-dma ! THEN cd-buffer @ ?dup IF BULK-CONFIG-DESCRIPTOR-LEN 2dup cd-buffer-dma @ swap dma-map-out dma-free 0 cd-buffer ! 0 cd-buffer-dma ! THEN ; : hc-quiesce ( -- ) 00C3 hccontrol rl!-le \ Suspend USB host controller hchcca hchcca-dma OHCI-GLOBAL-DMA-BUF-SIZE dma-map-out hchcca OHCI-GLOBAL-DMA-BUF-SIZE dma-free ; ' hc-quiesce add-quiesce-xt \ Assert that HC will be supsended : open ( -- TRUE|FALSE ) instance-count dup 0= IF s" OHCI First open" usb-debug-print (allocate-mem) THEN 1 + TO instance-count s" OHCI Open instance count now: " instance-count usb-debug-print-val TRUE ; : close ( -- ) instance-count dup 1 = IF s" OHCI Last close" usb-debug-print (de-allocate-mem) THEN 1 - TO instance-count s" OHCI Close instance count now: " instance-count usb-debug-print-val ; : HC-enable-control-list-processing ( -- ) hccomstat dup rl@-le 02 or swap rl!-le hccontrol dup rl@-le 10 or swap rl!-le ; : HC-enable-bulk-list-processing ( -- ) hccomstat dup rl@-le 04 or swap rl!-le hccontrol dup rl@-le 20 or swap rl!-le ; : HC-enable-interrupt-list-processing ( -- ) hccontrol dup rl@-le 04 or swap rl!-le ; : (HC-ACK-WDH) ( -- ) WDH hcintstat rl!-le ; : (HC-CHECK-WDH) ( -- updated? ) hcintstat rl@-le WDH and 0<> ; : disable-control-list-processing ( -- ) hccontrol dup rl@-le ffffffef and swap rl!-le hccomstat dup rl@-le fffffffd and swap rl!-le ; : disable-bulk-list-processing ( -- ) hccontrol dup rl@-le ffffffdf and swap rl!-le hccomstat dup rl@-le fffffffb and swap rl!-le ; : disable-interrupt-list-processing ( -- ) hccontrol dup rl@-le fffffffb and swap rl!-le ; 0 VALUE current-toggle : fill-TD-list ( start-toggle addr dlen dp MPS TD-List-Head -- ) TO temp1 ( start-toggle addr dlen dp MPS ) TO temp2 ( start-toggle addr dlen dp ) CASE ( start-toggle addr dlen ) OHCI-DP-SETUP OF TD-DP-SETUP TO temp3 ENDOF ( start-toggle addr dlen ) OHCI-DP-IN OF TD-DP-IN TO temp3 ENDOF ( start-toggle addr dlen ) OHCI-DP-OUT OF TD-DP-OUT TO temp3 ENDOF ( start-toggle addr dlen ) dup OF -1 TO temp3 ( start-toggle addr dlen ) s" fill-TD-list: Invalid DP specified" usb-debug-print ENDOF ENDCASE temp3 -1 = IF EXIT THEN ( start-toggle addr dlen ) rot ( addr dlen start-toggle ) TO current-toggle swap ( dlen addr ) BEGIN over temp2 >= ( dlen addr TRUE|FALSE ) WHILE ( dlen addr ) dup virt2phys temp1 td>cbptr l!-le ( dlen addr ) current-toggle 18 lshift ( dlen addr current-toggle~ ) DATA0-TOGGLE ( dlen addr current-toggle~ toggle ) CC-FRESH-TD temp3 or or or ( dlen addr or-result ) temp1 td>tattr l!-le ( dlen addr~ ) dup temp2 1- + virt2phys temp1 td>bfrend l!-le ( dlen addr~ ) temp2 + ( dlen next-addr ) swap temp2 - swap temp1 td>ntd l@-le phys2virt TO temp1 ( dlen next-addr ) current-toggle ( dlen next-addr current-toggle ) CASE 0 OF 1 TO current-toggle ENDOF 1 OF 0 TO current-toggle ENDOF ENDCASE REPEAT ( dlen addr ) over 0<> IF dup virt2phys temp1 td>cbptr l!-le ( dlen addr ) current-toggle 18 lshift ( dlen addr curent-toggle~ ) DATA0-TOGGLE ( dlen addr curent-toggle~ toggle ) CC-FRESH-TD temp3 or or or ( dlen addr or-result ) temp1 td>tattr l!-le ( dlen addr ) + 1- virt2phys temp1 td>bfrend l!-le ELSE 2drop THEN ; : (td-list-status) ( PointerToTDlist -- failingTD CCode TRUE | 0 ) BEGIN ( PointerToTDlist ) dup 0<> ( PointerToTDlist TRUE|FALSE ) IF ( PointerToTDlist ) dup td>tattr l@-le f0000000 and 1c rshift dup 0= TRUE swap ELSE drop FALSE dup ( FALSE ) THEN WHILE drop drop td>ntd l@-le phys2virt REPEAT ; : (wait-for-done-q) ( timeout -- TD-list TRUE | FALSE ) BEGIN ( timeout ) dup 0<> ( timeout TRUE|FALSE ) (HC-CHECK-WDH) NOT ( timeout TRUE|FALSE TRUE|FALSE ) AND \ not timed out AND WDH-bit not set WHILE 1 ms \ wait 1- ( timeout ) dup ff and 0= IF show-proceed THEN REPEAT ( timeout ) drop hchccadneq l@-le phys2virt \ read last HcDoneHead (RAM) (HC-CHECK-WDH) \ HcDoneHead was updated ? IF (HC-ACK-WDH) \ clear register bit: WDH TRUE ( td-list TRUE ) ELSE FALSE THEN ; : debug-td ( -- ) s" Num Free TDs = " num-free-tds usb-debug-print-val ; : HC-reset ( -- ) hcrhdescA rl@-le ff and ( total-rh-ports ) to max-rh-ports hcrhpstat TO current-stat \ start with first port status reg 0 \ port status default max-rh-ports 0 \ checking all ports ?DO current-stat rl@-le or \ OR-ing all stats 200 current-stat rl!-le \ Clear Port Power (CPP) current-stat 4 + TO current-stat \ check next RH-Port LOOP 100 and 0<> \ any of the ports had power ? IF d# 750 wait-proceed \ wait for power discharge THEN hccomstat dup rl@-le 01 or swap rl!-le \ issue HC reset BEGIN hccomstat rl@-le 01 and 0<> \ wait for reset end WHILE REPEAT 23f02edf hcintrval rl!-le \ frame-interval register hchcca-dma hchccareg rl!-le \ HC communication area 0000 hcctrhead rl!-le \ control transfer head 0000 hcbulkhead rl!-le \ bulk transfer head 0ffff hcintdsbl rl!-le \ interrupt disable reg. 83 hccontrol rl!-le \ set USBOPERATIONAL 23f02edf hcintrval rl!-le \ frame-interval register hchcca-dma hchccareg rl!-le \ HC communication area d# 50 ms hcrhpstat TO current-stat \ start with first port status reg max-rh-ports 0 ?DO 102 current-stat rl!-le \ power on and enable hcrhdescA rl@-le 18 rshift 2 * ms \ startup delay 30 ms (2 * POTPGT) current-stat 4 + TO current-stat \ check next RH-Port LOOP d# 500 wait-proceed \ STEC device needs 300 ms ; : error-recovery ( -- ) initialize-td-free-list initialize-ed-free-list HC-reset ; : store-initial-usb-hub-address ( -- ) usb-address TO initial-hub-address ; : reset-to-initial-usb-hub-address ( -- ) initial-hub-address TO usb-address ; : allocate-usb-address ( -- usb-address ) usb-address 7f <> ( TRUE|FALSE ) IF usb-address 1+ TO usb-address \ RISK: Check to see IF it overflows 127 usb-address ( usb-address ) THEN ( usb-address ) ; s" usb-support.fs" INCLUDED : control-std-set-address ( speedbit -- usb-address TRUE | FALSE ) >r ( R: speedbit ) 0005000000000000 setup-packet ! allocate-usb-address dup setup-packet 2 + c! ( usb-addr R: speedbit ) s" USB set-address: " 2 pick usb-debug-print-val ( usb-addr R: speedbit ) 0 0 0 setup-packet 8 r> controlxfer ( usb-addr TRUE | FALSE ) IF ( TRUE | FALSE ) TRUE ( TRUE ) ELSE drop FALSE \ PENDING: Return the allocated address back. ( FALSE ) THEN ( TRUE | FALSE ) ; : control-std-get-device-descriptor 8006000100000000 setup-packet ! 2 pick setup-packet 6 + w!-le setup-packet -rot ( data-buffer data-len setup-packet MPS fa ) >r >r >r >r >r 0 r> r> r> r> r> controlxfer ( TRUE | FALSE ) ; : control-std-get-configuration-descriptor TO temp1 ( data-buffer data-len MPS ) TO temp2 ( data-buffer data-len ) TO temp3 ( data-buffer ) 8006000200000000 setup-packet ! temp3 setup-packet 6 + w!-le 0 swap temp3 setup-packet temp2 temp1 controlxfer ; : control-std-get-maxlun ( MPS fun-addr dir data-buff data-len -- TRUE | FALSE ) GET-MAX-LUN setup-packet ! ( MPS fun-addr dir data-buff data-len ) setup-packet 5 pick 5 pick controlxfer ( MPS fun-addr TRUE | FALSE ) nip nip ( TRUE | FALSE ) ; : control-bulk-reset ( MPS fun-addr dir data-buff data-len -- TRUE | FALSE ) 21FF000000000000 setup-packet ! ( MPS fun-addr dir data-buff data-len ) setup-packet 5 pick 5 pick controlxfer ( MPS fun-addr TRUE | FALSE ) nip nip ( TRUE | FALSE ) ; : control-std-get-string-descriptor TO temp1 ( StringIndex data-buffer data-len MPS ) TO temp2 ( StringIndex data-buffer data-len ) TO temp3 ( StringIndex ) 8006000300000000 setup-packet ! temp3 setup-packet 6 + w!-le 409 setup-packet 4 + w!-le \ US English Language code. swap ( data buffer StringIndex ) setup-packet 2 + c! ( data-buffer ) 0 swap temp3 setup-packet temp2 temp1 controlxfer ( TRUE | FALSE ) ; : control-std-set-configuration ( configvalue FuncAddr -- TRUE|FALSE ) TO temp1 ( configvalue ) TO temp2 0009000000000000 setup-packet ! \ RISK: Endian and 64-bit assumptions temp2 setup-packet 2 + w!-le 0 0 0 setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer ; 0 VALUE port-number s" usb-enumerate.fs" INCLUDED : rhport-enumerate ( port-num -- ) TO port-number device-speed control-std-set-address ( usb-addr TRUE | FALSE ) IF device-speed or ( usb-addr+speedbit ) TO new-device-address dd-buffer @ 8 erase dd-buffer @ DEFAULT-CONTROL-MPS DEFAULT-CONTROL-MPS ( buffer mps mps ) new-device-address control-std-get-device-descriptor ( TRUE | FALSE ) IF ELSE s" USB: Read Dev Descriptor failed" usb-debug-print EXIT THEN dd-buffer @ DEVICE-DESCRIPTOR-TYPE-OFFSET + c@ ( Descriptor-type ) DEVICE-DESCRIPTOR-TYPE <> IF s" USB: Error Reading Device Descriptor" usb-debug-print s" Read descriptor is not of the right type" usb-debug-print s" Aborting enumeration" usb-debug-print EXIT THEN dd-buffer @ DEVICE-DESCRIPTOR-MPS-OFFSET + c@ TO mps create-usb-device-tree ELSE s" Set address failed on port " port-number usb-debug-print-val s" Aborting Enumeration." usb-debug-print EXIT THEN ; : rhport-initialize ( -- ) hcrhpstat TO current-stat \ start with first port status reg max-rh-ports 1+ 1 ?DO usb-debug-flag IF ." Initializing RH port " i . cr THEN current-stat rl@-le RHP-CCS and 0<> ( TRUE|FALSE ) IF s" Device connected to this port!" usb-debug-print RHP-PRS current-stat rl!-le \ issue a port reset BEGIN current-stat rl@-le RHP-PRS AND \ wait for reset end WHILE REPEAT hcrhdescA rl@-le 18 rshift 2 * ms \ startup delay 30 ms (POTPGT) d# 100 ms current-stat rl@-le 200 and 4 lshift to device-speed \ store speed bit RHP-CSC RHP-PRSC or current-stat rl!-le I ['] rhport-enumerate CATCH IF \ Scan port s" USB scan failed on root hub port: " rot usb-debug-print-val reset-to-initial-usb-hub-address THEN ELSE s" No device detected at this port." usb-debug-print current-stat rl@-le 80000 and 0<> \ is over-current detected ? IF s" Warning: Overcurrent indicated" usb-debug-print THEN THEN current-stat 4 + TO current-stat \ check next RH-Port LOOP ; : enumerate ( -- ) HC-reset store-initial-usb-hub-address rhport-initialize \ Probe all available RH ports reset-to-initial-usb-hub-address ; ��=<�0usb-support.fs0 value NEXT-TD 0 VALUE num-tds 0 VALUE td-retire-count 0 VALUE saved-tail 0 VALUE poll-timer VARIABLE controlxfer-cmd : (ed-prepare) ( dir addr dlen setup-packet MPS ep-fun -- FALSE | dir addr dlen ed-ptr setup-ptr ) allocate-ed ?dup 0= IF s" allocate-ed failed!" usb-debug-print 4drop 2drop FALSE EXIT ( FALSE ) THEN ( dir addr dlen setup-packet MPS ep-fun ed-ptr ) TO temp1 ( dir addr dlen setup-packet MPS ep-fun ) temp1 zero-out-an-ed-except-link ( dir addr dlen setup-packet MPS ep-fun ) temp1 ed>eattr l@-le or temp1 ed>eattr l!-le ( dir addr dlen setup-ptr MPS ) dup TO temp2 10 lshift temp1 ed>eattr l@-le or temp1 ed>eattr l!-le temp1 swap TRUE ( dir addr dlen ed-ptr setup-ptr TRUE ) ; : (td-prepare) ( dir addr dlen ed-ptr setup-ptr -- dir FALSE | dir addr dlen ed-ptr setup-ptr td-head td-tail ) 2 pick ( dir addr dlen ed-ptr setup-ptr dlen ) temp2 ( dir addr dlen ed-ptr setup-ptr dlen MPS ) /mod ( dir addr dlen ed-ptr setup-ptr rem quo ) swap 0<> IF ( dir addr dlen ed-ptr setup-ptr quo ) 1+ THEN 2+ dup TO num-tds ( dir addr dlen ed-ptr setup-ptr quo+2 ) allocate-td-list dup 0= IF ( dir addr dlen ed-ptr setup-ptr quo+2 ) 2drop ( dir addr dlen ed-ptr setup-ptr ) drop ( dir addr dlen ed-ptr ) free-ed ( dir addr dlen ) 2drop ( dir ) FALSE ( dir FALSE ) EXIT THEN TRUE ; : (td-ready) ( ed-ptr setup-ptr td-head td-tail -- ed-ptr setup-ptr ) swap virt2phys swap virt2phys \ Convert td-head and td-tail to physical 3 pick ( ed-ptr s-ptr td-head' td-tail' ed-ptr ) tuck ( ed-ptr s-ptr td-head' ed-ptr td-tail' ed-ptr ) ed>tdqtp l!-le ( ed-ptr s-ptr td-head' ed-ptr ) ed>tdqhp l!-le ( ed-ptr s-ptr ) over ed>ned 0 swap l!-le ( ed-ptr s-ptr ) ; : (td-setup-status) ( dir addr dlen ed-ptr setup-ptr -- dir addr dlen ed-ptr ) over ed>tdqhp l@-le phys2virt ( dir addr dlen ed-ptr setup-ptr td-head ) dup zero-out-a-td-except-link ( dir addr dlen ed-ptr setup-ptr td-head ) dup td>tattr DATA0-TOGGLE CC-FRESH-TD or swap l!-le 2dup swap virt2phys swap td>cbptr l!-le 2dup td>bfrend swap STD-REQUEST-SETUP-SIZE 1- + virt2phys swap l!-le 2drop ( dir addr dlen ed-ptr ) ; : (td-tailpointer) ( dir addr dlen ed-ptr -- dir addr dlen ed-ptr ) dup ed>tdqtp l@-le phys2virt ( dir addr dlen ed-ptr td-tail ) dup zero-out-a-td-except-link ( dir addr dlen ed-ptr td-tail ) dup td>tattr dup l@-le DATA1-TOGGLE CC-FRESH-TD or or swap l!-le 4 pick 0= ( dir addr dlen ed-ptr td-tail flag ) 3 pick 0<> ( dir addr dlen ed-ptr td-tail flag flag ) and IF ( dir addr dlen ed-ptr td-tail ) dup td>tattr dup l@-le TD-DP-OUT or swap l!-le ELSE dup td>tattr dup l@-le TD-DP-IN or swap l!-le THEN drop ( dir addr dlen ed-ptr ) ; : (td-data) ( dir addr dlen ed-ptr -- ed-ptr ) -rot ( dir ed-ptr addr dlen ) dup 0<> IF ( dir ed-ptr addr dlen ) >r >r >r TO temp1 r> r> r> temp1 ( ed-ptr addr dlen dir ) 3 pick ( ed-ptr addr dlen dir ed-ptr ) ed>tdqhp l@-le phys2virt ( ed-ptr addr dlen dir tdqhp ) td>ntd l@-le phys2virt ( ed-ptr addr dlen dir td-datahead ) 4 pick ( ed-ptr addr dlen dir td-datahead ed-ptr ) td>tattr l@-le 10 rshift ( ed-ptr addr dlen dir td-head-data MPS ) swap ( ed-ptr addr dlen dir MPS td-head-data ) >r >r >r >r >r 1 r> r> r> r> r> >r >r 0= IF ( ed-ptr 1 addr dlen dir ) OHCI-DP-IN ( ed-ptr 1 addr dlen dir OHCI-DP-IN ) ELSE OHCI-DP-OUT ( ed-ptr 1 addr dlen dir OHCI-DP-OUT ) THEN r> r> ( ed-ptr 1 addr dlen dir OHCI-DP- MPS td-head-data ) fill-TD-list ELSE 2drop nip ( ed-ptr ) THEN ; 10 CONSTANT max-retire-td : (transfer-wait-for-doneq) ( ed-ptr -- TRUE | FALSE ) dup virt2phys ( ed-ptr ed-ptr-dma ) hcctrhead rl!-le ( ed-ptr ) HC-enable-control-list-processing ( ed-ptr ) 0 TO td-retire-count ( ed-ptr ) 0 TO poll-timer ( ed-ptr ) BEGIN td-retire-count num-tds <> ( ed-ptr TRUE | FALSE ) poll-timer max-retire-td < and ( ed-ptr TRUE | FALSE ) WHILE (HC-CHECK-WDH) ( ed-ptr updated? ) IF hchccadneq l@-le phys2virt find-td-list-tail-and-size nip ( ed-ptr n ) td-retire-count + TO td-retire-count ( ed-ptr ) hchccadneq l@-le phys2virt dup ( ed-ptr done-td done-td ) (td-list-status) ( ed-ptr done-td failed-td CCcode ) IF dup >r s" (transfer-wait-for-doneq: USB device communication error." usb-debug-print ( ed-ptr done-td failed-td CCcode R: CCcode ) dup 4 = swap dup 5 = rot or ( ed-ptr done-td failed-td CCcode R: CCcode ) IF max-retire-td TO poll-timer ( ed-ptr done-td failed-td CCcode R: CCcode ) THEN usb-debug-flag IF s" CC code ->" type . cr s" Failing TD contents:" type cr display-td ELSE 2drop THEN ( ed-ptr done-td R: CCcode ) controlxfer-cmd @ GET-MAX-LUN = r> 4 = and IF s" (transfer-wait-for-doneq): GET-MAX-LUN ControlXfer STALLed" usb-debug-print ELSE drop 5030 error" (USB) Device communication error." ABORT THEN THEN ( ed-ptr done-td ) (free-td-list) ( ed-ptr ) 0 hchccadneq l!-le ( ed-ptr ) (HC-ACK-WDH) \ TDs were written to done queue. ACK the HC. THEN poll-timer 1+ TO poll-timer 4 ms \ longer 1 ms REPEAT ( ed-ptr ) disable-control-list-processing ( ed-ptr ) td-retire-count num-tds <> ( ed-ptr ) IF dup display-descriptors ( ed-ptr ) s" maximum of retire " usb-debug-print THEN free-ed td-retire-count num-tds <> IF FALSE ( FALSE ) ELSE TRUE ( TRUE ) THEN ; : controlxfer ( dir addr dlen setup-packet MPS ep-fun -- TRUE | FALSE ) 2 pick @ controlxfer-cmd ! (ed-prepare) ( FALSE | dir addr dlen ed-ptr setup-ptr ) invert IF FALSE EXIT THEN (td-prepare) ( pt ed-type toggle buffer length mps head ) invert IF FALSE EXIT THEN (td-ready) ( dir addr dlen ed-ptr setup-ptr ) (td-setup-status) ( dir addr dlen ed-ptr ) (td-tailpointer) ( dir addr dlen ed-ptr ) (td-data) ( ed-ptr ) dup ed>tdqtp l@-le phys2virt TO saved-tail ( ed-ptr ) dup ed>tdqtp 0 swap l!-le ( ed-ptr ) (transfer-wait-for-doneq) ( TRUE | FALSE ) ; 0201000000000000 CONSTANT CLEARHALTFEATURE 0 VALUE endpt-num 0 VALUE usb-addr-contr-req : control-std-clear-feature ( endpoint-nr usb-addr -- TRUE|FALSE ) TO usb-addr-contr-req \ usb address TO endpt-num \ endpoint number CLEARHALTFEATURE setup-packet ! endpt-num setup-packet 4 + c! \ endpoint number 0 0 0 setup-packet DEFAULT-CONTROL-MPS usb-addr-contr-req controlxfer ; 21FF000000000000 CONSTANT BULK-RESET : control-std-bulk-reset ( usb-addr -- TRUE|FALSE ) TO usb-addr-contr-req BULK-RESET setup-packet ! 0 0 0 setup-packet DEFAULT-CONTROL-MPS usb-addr-contr-req controlxfer ; : bulk-reset-recovery-procedure ( bulk-out-endp bulk-in-endp usb-addr -- ) >r ( bulk-out-endp bulk-in-endp R: usb-addr ) r@ control-std-bulk-reset IF s" bulk reset OK" ELSE s" bulk reset failed" THEN usb-debug-print 80 or r@ control-std-clear-feature IF s" control-std-clear IN endpoint OK" ELSE s" control-std-clear-IN endpoint failed" THEN usb-debug-print r@ control-std-clear-feature IF s" control-std-clear OUT endpoint OK" ELSE s" control-std-clear-OUT endpoint failed" THEN usb-debug-print r> drop ; 0 VALUE saved-rw-ed 0 VALUE num-rw-tds 0 VALUE num-rw-retired-tds 0 VALUE saved-rw-start-toggle 0 VALUE saved-list-type : (ed-prepare-rw) ( pt ed-type toggle buffer length mps address ed-ptr -- FALSE | pt ed-type toggle buffer length mps TRUE ) allocate-ed dup 0= IF drop 2drop 2drop 2drop drop saved-rw-start-toggle FALSE EXIT ( toggle FALSE ) THEN TO saved-rw-ed ( pt ed-type toggle buffer length mps address ) saved-rw-ed zero-out-an-ed-except-link saved-rw-ed ed>eattr l!-le ( pt ed-type toggle buffer length mps ) dup 10 lshift saved-rw-ed ed>eattr l@-le or saved-rw-ed ed>eattr l!-le TRUE ( pt ed-type toggle buffer length mps TRUE ) ; : (td-prepare-rw) ( pt ed-type toggle buffer length mps -- FALSE | pt ed-type toggle buffer length mps head TRUE ) 2dup ( pt ed-type toggle buffer length mps length mps ) /mod ( pt ed-type toggle buffer length mps num-tds rem ) swap 0<> IF ( pt ed-type toggle buffer length mps num-tds ) 1+ ( pt ed-type toggle buffer length mps num-tds+1 ) THEN dup TO num-rw-tds ( pt ed-type toggle buffer length mps num-tds ) allocate-td-list ( pt ed-type toggle buffer length mps head tail ) dup 0= IF 2drop 2drop 2drop 2drop saved-rw-ed free-ed ." rw-endpoint: TD list allocation failed" cr saved-rw-start-toggle FALSE ( FALSE ) EXIT THEN drop TRUE ( pt ed-type toggle buffer length mps head TRUE ) ; : (td-data-rw) 6 pick ( pt ed-type toggle buffer length mps head pt ) FALSE TO case-failed CASE 0 OF OHCI-DP-IN ENDOF 1 OF OHCI-DP-OUT ENDOF 2 OF OHCI-DP-SETUP ENDOF dup OF TRUE TO case-failed ." rw-endpoint: Invalid Packet Type!" cr ENDOF ENDCASE ( pt ed-type toggle buffer length mps head dp ) case-failed IF saved-rw-ed free-ed ( pt ed-type toggle buffer length mps head dp ) drop (free-td-list) ( pt ed-type toggle buffer length mps head ) 2drop 2drop 2drop saved-rw-start-toggle FALSE ( FALSE ) EXIT ( FALSE ) THEN -rot ( pt ed-type toggle buffer length dp mps head ) dup >r ( pt ed-type toggle buffer length dp mps head ) fill-TD-list r> TRUE ( pt et head TRUE ) ; : (ed-ready-rw) ( pt et -- - | toggle FALSE ) nip ( et ) FALSE TO case-failed CASE 0 OF \ Control List. Queue the ED to control list 0 TO saved-list-type saved-rw-ed virt2phys hcctrhead rl!-le HC-enable-control-list-processing ENDOF 1 OF \ Bulk List. Queue the ED to bulk list 1 TO saved-list-type saved-rw-ed virt2phys hcbulkhead rl!-le HC-enable-bulk-list-processing ENDOF 2 OF \ Interrupt List. 2 TO saved-list-type saved-rw-ed virt2phys hchccareg rl@-le phys2virt rl!-le HC-enable-interrupt-list-processing ENDOF dup OF saved-rw-ed ed>tdqhp l@-le phys2virt (free-td-list) saved-rw-ed free-ed TRUE TO case-failed ENDOF ENDCASE case-failed IF saved-rw-start-toggle FALSE ( toggle FALSE ) EXIT THEN TRUE ( TRUE ) ; : (wait-td-retire) ( -- ) 0 TO num-rw-retired-tds FALSE TO while-failed BEGIN num-rw-retired-tds num-rw-tds < ( TRUE | FALSE ) while-failed FALSE = and ( TRUE | FALSE ) WHILE d# 5000 (wait-for-done-q) ( TD-list TRUE|FALSE ) IF dup find-td-list-tail-and-size nip ( td-list size ) num-rw-retired-tds + TO num-rw-retired-tds ( td-list ) dup (td-list-status) ( td-list failed-TD CC ) IF dup 4 = IF saved-list-type CASE 0 OF 0 0 control-std-clear-feature s" clear feature " usb-debug-print ENDOF 1 OF \ clean bulk stalled s" clear bulk when stalled " usb-debug-print disable-bulk-list-processing \ disable procesing saved-rw-ed ed>eattr l@-le dup \ extract 780 and 7 rshift 80 or \ endpoint and swap 7f and \ usb addr control-std-clear-feature ENDOF 2 OF 0 saved-rw-ed ed>eattr l@-le control-std-clear-feature ENDOF dup OF s" unknown status " usb-debug-print ENDOF ENDCASE ELSE ( td-list failed-TD CC ) ." TD failed " 5b emit .s 5d emit cr 5040 error" (USB) device transaction error (wait-td-retire)." ABORT THEN 2drop drop TRUE TO while-failed \ transaction failed NEXT-TD 0<> \ clean the TD if we IF NEXT-TD (free-td-list) \ had a stalled THEN THEN (free-td-list) ELSE drop \ drop td-list pointer scan-time? IF 2e emit THEN \ show proceeding dots TRUE TO while-failed s" time out wait for done" usb-debug-print 20 ms \ wait for bad device THEN REPEAT ; : (process-retired-td) ( -- TRUE | FALSE ) saved-list-type CASE 0 OF disable-control-list-processing ENDOF 1 OF disable-bulk-list-processing ENDOF 2 OF disable-interrupt-list-processing ENDOF ENDCASE saved-rw-ed ed>tdqhp l@-le 2 and 0<> IF 1 s" retired 1" usb-debug-print ELSE 0 s" retired 0" usb-debug-print THEN WHILE-failed IF FALSE ( FALSE ) ELSE TRUE ( TRUE ) THEN saved-rw-ed free-ed ; : (do-rw-endpoint) 4 pick ( pt ed-type toggle buffer length mps address toggle ) TO saved-rw-start-toggle ( pt ed-type toggle buffer length mps address ) (ed-prepare-rw) ( FALSE | pt ed-type toggle buffer length mps TRUE ) invert IF FALSE EXIT THEN (td-prepare-rw) ( FALSE | pt ed-type toggle buffer length mps head TRUE ) invert IF FALSE EXIT THEN (td-data-rw) ( FALSE | pt et head TRUE ) invert IF FALSE EXIT THEN virt2phys saved-rw-ed ed>tdqhp l!-le ( pt et ) saved-rw-ed ed>tdqhp l@-le phys2virt td>ntd l@-le phys2virt TO NEXT-TD \ save for a stalled (ed-ready-rw) invert IF FALSE EXIT THEN (wait-td-retire) (process-retired-td) ( TRUE | FALSE ) ; 0 VALUE transfer-len 0 VALUE mps-current 0 VALUE addr-current 0 VALUE usb-addr 0 VALUE toggle-current 0 VALUE type-current 0 VALUE pt-current 0 VALUE read-status 0 VALUE counter 0 VALUE residue : rw-endpoint 2 pick TO transfer-len ( pt ed-type toggle buffer length mps address ) 1 pick TO mps-current ( pt ed-type toggle buffer length mps address ) TRUE TO read-status ( pt ed-type toggle buffer length mps address ) transfer-len mps-current num-free-tds * <= IF (do-rw-endpoint) ( toggle TRUE | toggle FALSE ) TO read-status ( toggle ) TO toggle-current ELSE TO usb-addr ( pt ed-type toggle buffer length mps ) 2drop ( pt ed-type toggle buffer ) TO addr-current ( pt ed-type toggle ) TO toggle-current ( pt ed-type ) TO type-current ( pt ) TO pt-current transfer-len mps-current num-free-tds * /mod ( residue count ) TO counter ( residue ) TO residue mps-current num-free-tds * TO transfer-len BEGIN counter 0 > ( TRUE | FALSE ) read-status TRUE = and ( TRUE | FALSE ) WHILE pt-current type-current toggle-current ( pt ed-type toggle ) addr-current transfer-len ( pt ed-type toggle buffer length ) mps-current ( pt ed-type toggle buffer length mps ) usb-addr (do-rw-endpoint) ( toggle TRUE | toggle FALSE ) TO read-status ( toggle ) TO toggle-current addr-current transfer-len + TO addr-current counter 1- TO counter REPEAT residue 0<> ( TRUE |FALSE ) read-status TRUE = and IF residue TO transfer-len pt-current type-current toggle-current ( pt ed-type toggle ) addr-current transfer-len ( pt ed-type toggle buffer length ) mps-current ( pt ed-type toggle buffer length mps ) usb-addr (do-rw-endpoint) ( toggle TRUE | toggle FALSE ) TO read-status TO toggle-current THEN THEN read-status invert IF THEN toggle-current ( toggle ) read-status ( TRUE | FALSE ) ; �� 0usb-hub.fss" hub" device-name s" usb" device-type 1 encode-int s" #address-cells" property 0 encode-int s" #size-cells" property : encode-unit ( port-addr -- unit-str unit-len ) 1 hex-encode-unit ; : decode-unit ( addr len -- port-addr ) 1 hex-decode-unit ; 0 VALUE new-device-address 0 VALUE port-number 0 VALUE MPS-DCP 0 VALUE mps 0 VALUE my-usb-address 00 value device-speed : mps-property-set ( -- ) s" HUB Compiling mps-property-set " usb-debug-print s" USB-ADDRESS" get-my-property ( TRUE | prop-addr prop-len FALSE ) IF s" notpossible" usb-debug-print ELSE decode-int nip nip to my-usb-address THEN s" MPS-DCP" get-my-property ( TRUE | prop-addr prop-len FALSE ) IF s" MPS-DCP property not found Assuming 8 as MAX PACKET SIZE" ( str len ) usb-debug-print s" for the default control pipe" usb-debug-print 8 to MPS-DCP ELSE s" MPS-DCP property found!!" usb-debug-print ( prop-addr prop-len FALSE ) decode-int nip nip to MPS-DCP THEN ; 2303080000000000 CONSTANT hppwr-set 2301080000000000 CONSTANT hppwr-clear 2303040000000000 CONSTANT hprst-set A300000000000400 CONSTANT hpsta-get 2303010000000000 CONSTANT hpena-set A006002900000000 CONSTANT hubds-get 8 CONSTANT DEFAULT-CONTROL-MPS 12 CONSTANT DEVICE-DESCRIPTOR-LEN 9 CONSTANT CONFIG-DESCRIPTOR-LEN 20 CONSTANT BULK-CONFIG-DESCRIPTOR-LEN 1 CONSTANT DEVICE-DESCRIPTOR-TYPE 1 CONSTANT DEVICE-DESCRIPTOR-TYPE-OFFSET 4 CONSTANT DEVICE-DESCRIPTOR-DEVCLASS-OFFSET 7 CONSTANT DEVICE-DESCRIPTOR-MPS-OFFSET 9 CONSTANT HUB-DEVICE-CLASS 0 CONSTANT NO-CLASS 00 VALUE temp1 00 VALUE temp2 00 VALUE temp3 00 VALUE po2pg \ Power On to Power Good : dma-alloc s" dma-alloc" $call-parent ; : dma-map-in s" dma-map-in" $call-parent ; : dma-map-out s" dma-map-out" $call-parent ; : dma-free s" dma-free" $call-parent ; 0 INSTANCE VALUE setup-packet \ 8 bytes for setup packet 0 INSTANCE VALUE ch-buffer \ 1 byte character buffer INSTANCE VARIABLE dd-buffer INSTANCE VARIABLE cd-buffer STRUCT 8 FIELD >setup-packet \ 8 bytes for setup packet DEVICE-DESCRIPTOR-LEN FIELD >dd-buffer BULK-CONFIG-DESCRIPTOR-LEN FIELD >cd-buffer 8 chars FIELD >status-buffer 9 chars FIELD >hd-buffer 1 chars FIELD >ch-buffer \ character buffer CONSTANT /hub-buf 0 INSTANCE VALUE hub-buf 0 INSTANCE VALUE hub-buf-phys : (allocate-mem) ( -- ) /hub-buf dma-alloc TO hub-buf hub-buf /hub-buf 0 dma-map-in TO hub-buf-phys hub-buf >setup-packet TO setup-packet hub-buf >ch-buffer TO ch-buffer hub-buf >dd-buffer dd-buffer ! hub-buf >cd-buffer cd-buffer ! s" hub-buf = " hub-buf usb-debug-print-val ; : (de-allocate-mem) ( -- ) hub-buf hub-buf-phys /hub-buf dma-map-out hub-buf /hub-buf dma-free 0 TO hub-buf 0 TO hub-buf-phys 0 TO setup-packet 0 TO ch-buffer 0 dd-buffer ! 0 cd-buffer ! ; : open ( -- TRUE ) (allocate-mem) TRUE ; : close ( -- ) (de-allocate-mem) ; : controlxfer ( dir addr dlen setup-packet MPS ep-fun -- TRUE|FALSE ) s" controlxfer" $call-parent ; : control-std-set-address ( speedbit -- usb-address TRUE|FALSE ) s" control-std-set-address" $call-parent ; : control-std-get-device-descriptor s" control-std-get-device-descriptor" $call-parent ; : control-std-get-configuration-descriptor s" control-std-get-configuration-descriptor" $call-parent ; : control-std-get-maxlun s" control-std-get-maxlun" $call-parent ; : control-std-set-configuration s" control-std-set-configuration" $call-parent ; : control-std-get-string-descriptor s" control-std-get-string-descriptor" $call-parent ; : rw-endpoint s" rw-endpoint" $call-parent ; : debug-td ( -- ) s" debug-td" $call-parent ; : control-bulk-reset ( MPS fun-addr dir data-buff data-len -- TRUE | FALSE ) s" control-bulk-reset" $call-parent ; : control-hub-port-power-set ( port# -- TRUE|FALSE ) hppwr-set setup-packet ! ( port#) setup-packet 4 + c! 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE | FALSE ) ; : control-hub-port-power-clear ( port#-- TRUE|FALSE ) hppwr-clear setup-packet ! ( port#) setup-packet 4 + c! 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE ) ; : control-hub-port-reset-set ( port# -- TRUE|FALSE ) hprst-set setup-packet ! ( port# ) setup-packet 4 + c! 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE ) ; : control-hub-port-enable ( port# -- TRUE|FALSE ) hpena-set setup-packet ! ( port# ) setup-packet 4 + c! 0 0 0 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE ) ; : control-hub-port-status-get ( buffer port# -- TRUE|FALSE ) hpsta-get setup-packet ! ( buffer port# ) setup-packet 4 + c! ( buffer ) 0 swap 4 setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE ) ; : control-get-hub-descriptor ( buffer buffer-length -- TRUE|FALSE ) hubds-get setup-packet ! dup setup-packet 6 + w!-le ( buffer buffer-length ) 0 -rot setup-packet MPS-DCP my-usb-address controlxfer ( TRUE|FALSE ) ; s" usb-enumerate.fs" INCLUDED : hub-configure-port ( port# -- ) BEGIN ( port# ) hub-buf >status-buffer 4 erase ( port# ) hub-buf >status-buffer over control-hub-port-status-get drop ( port# ) hub-buf >status-buffer w@-le 102 and 0= ( port# TRUE|FALSE ) WHILE ( port# ) REPEAT ( port# ) po2pg 3 * ms \ wait for bPwrOn2PwrGood*3 ms dup control-hub-port-reset-set drop ( port# ) BEGIN ( port# ) hub-buf >status-buffer 4 erase ( port# ) hub-buf >status-buffer over control-hub-port-status-get drop ( port# ) hub-buf >status-buffer w@-le 10 and ( port# TRUE|FALSE ) WHILE ( port# ) REPEAT ( port# ) hub-buf >status-buffer 4 erase ( port# ) hub-buf >status-buffer over control-hub-port-status-get drop ( port# ) hub-buf >status-buffer w@-le 103 and 103 <> ( port# TRUE|FALSE ) s" Port status bits: " hub-buf >status-buffer w@-le usb-debug-print-val IF ( port# ) drop s" Connect status: No device connected " usb-debug-print EXIT THEN hub-buf >status-buffer w@-le 200 and 4 lshift \ get speed bit dup to device-speed \ store speed bit control-std-set-address ( port# usb-addr TRUE|FALSE ) 50 ms ( port# usb-addr TRUE|FALSE ) debug-td ( port# usb-addr TRUE|FALSE ) IF ( port# usb-addr ) device-speed or ( port# usb-addr+speedbit ) to new-device-address ( port# ) to port-number dd-buffer @ DEVICE-DESCRIPTOR-LEN erase dd-buffer @ DEFAULT-CONTROL-MPS DEFAULT-CONTROL-MPS new-device-address control-std-get-device-descriptor ( TRUE|FALSE ) IF dd-buffer @ DEVICE-DESCRIPTOR-TYPE-OFFSET + c@ ( descriptor-type ) DEVICE-DESCRIPTOR-TYPE <> ( TRUE|FALSE ) IF s" HUB: ERROR!! Invalid Device Descriptor for the new device" usb-debug-print ELSE dd-buffer @ DEVICE-DESCRIPTOR-MPS-OFFSET + c@ to mps dd-buffer @ DEVICE-DESCRIPTOR-LEN erase dd-buffer @ DEVICE-DESCRIPTOR-LEN mps new-device-address control-std-get-device-descriptor invert IF s" ** reading dev-descriptor failed ** " usb-debug-print THEN create-usb-device-tree THEN ELSE s" ERROR!! Failed to get device descriptor" usb-debug-print THEN ELSE ( port# ) s" USB Set Adddress failed!!" usb-debug-print ( port# ) s" Clearing Port Power..." usb-debug-print ( port# ) control-hub-port-power-clear ( TRUE|FALSE ) IF s" Port power down " usb-debug-print ELSE s" Unable to clear port power!!!" usb-debug-print THEN THEN ; : hub-enumerate ( -- ) cd-buffer @ CONFIG-DESCRIPTOR-LEN erase cd-buffer @ CONFIG-DESCRIPTOR-LEN MPS-DCP my-usb-address control-std-get-configuration-descriptor drop cd-buffer @ 1+ c@ 2 <> IF s" Unable to read configuration descriptor" usb-debug-print EXIT THEN cd-buffer @ 4 + c@ 1 <> IF s" Not a valid HUB config descriptor" usb-debug-print EXIT THEN cd-buffer @ 5 + c@ to temp1 \ Store the configuration in temp1 temp1 my-usb-address control-std-set-configuration drop my-usb-address to temp1 hub-buf >hd-buffer 9 erase hub-buf >hd-buffer 9 control-get-hub-descriptor drop hub-buf >hd-buffer 2 + c@ to temp2 \ number of downstream ports s" HUB: Found " usb-debug-print s" number of downstream hub ports! : " temp2 usb-debug-print-val hub-buf >hd-buffer 5 + c@ to po2pg \ get bPwrOn2PwrGood temp2 1+ 1 DO i control-hub-port-power-set drop d# 20 ms LOOP d# 200 ms \ some devices need a long time (10s) temp2 1+ 1 DO s" hub-configure-port: " i usb-debug-print-val i hub-configure-port LOOP ; (allocate-mem) mps-property-set hub-enumerate (de-allocate-mem) ��8usb-enumerate.fs: (hub-create) ( -- ) mps port-number new-device-address port-number new-device set-space ( mps port-number usb-address ) encode-int s" USB-ADDRESS" property ( mps port-number ) s" Address Set" usb-debug-print encode-int s" reg" property ( mps ) s" Port Number Set" usb-debug-print encode-int s" MPS-DCP" property s" MPS Set" usb-debug-print s" usb-hub.fs" INCLUDED finish-device ; : (atapi-scsi-property-set) ( -- ) dd-buffer @ e + c@ ( Manuf ) dd-buffer @ f + c@ ( Manuf Prod ) dd-buffer @ 10 + c@ ( Manuf Prod Serial-Num ) cd-buffer @ 16 + w@-le ( Manuf Prod Serial-Num ep-mps ) cd-buffer @ 14 + c@ ( Manuf Prod Serial-Num ep-mps ep-addr ) cd-buffer @ 1d + w@-le ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ) cd-buffer @ 1b + c@ ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr ) mps port-number new-device-address port-number ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr mps port-num usb-addr port-num ) new-device set-space ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr mps port-num usb-addr ) encode-int s" USB-ADDRESS" property ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr mps port-num ) encode-int s" reg" property ( Manuf Prod Serial-Num ep-mps ep-addr ep-mps ep-addr mps ) encode-int s" MPS-DCP" property 2 0 DO dup 80 and IF 7f and encode-int s" BULK-IN-EP-ADDR" property encode-int s" MPS-BULKIN" property ELSE encode-int s" BULK-OUT-EP-ADDR" property encode-int s" MPS-BULKOUT" property THEN LOOP ( Manuf Prod Serial-Num ) encode-int s" iSerialNumber" property ( Manuf Prod ) encode-int s" iProduct" property ( Manuf ) encode-int s" iManufacturer" property ; : (device-classify) cd-buffer @ BULK-CONFIG-DESCRIPTOR-LEN erase cd-buffer @ BULK-CONFIG-DESCRIPTOR-LEN mps new-device-address control-std-get-configuration-descriptor IF cd-buffer @ 1+ c@ ( Descriptor-type ) 2 = IF cd-buffer @ 10 + c@ ( protocol ) cd-buffer @ f + c@ ( protocol subclass ) cd-buffer @ e + c@ ( protocol subclass class ) TRUE ELSE s" Not a valid configuration descriptor!!" usb-debug-print FALSE THEN ELSE s" Unable to read configuration descriptor!!" usb-debug-print FALSE THEN ; : (atapi-8020-create) ( -- ) (atapi-scsi-property-set) s" usb-storage.fs" INCLUDED finish-device ; : (atapi-8070-create) ( -- ) (atapi-scsi-property-set) s" usb-storage.fs" INCLUDED finish-device ; : (scsi-create) ( -- ) s" SCSI-CREATE " usb-debug-print dd-buffer @ 8 + w@-le 4b4 = \ VendorID = CYPRESS ? IF dd-buffer @ a + w@-le 6830 = \ Device = CY7C68300 ? IF d# 20 ms mps new-device-address 0 0 0 ( MPS fun-addr dir data-buff data-len ) control-bulk-reset ( TRUE|FALSE ) d# 100 ms mps new-device-address 0 0 0 ( TRUE|FALSE MPS fun-addr dir data-buff data-len ) control-bulk-reset ( TRUE|FALSE TRUE|FALSE ) and invert IF ." ** BULK-RESET failed **" cr THEN d# 20 ms THEN THEN 0 ch-buffer c! \ preset a clean response mps new-device-address 0 ch-buffer 1 control-std-get-maxlun ( TRUE|FALSE ) IF ELSE s" ERROR in GET-MAX-LUN " usb-debug-print 0 ch-buffer c! \ clear invalid numbers cd-buffer @ 5 + c@ to temp1 temp1 new-device-address control-std-set-configuration drop THEN 0 ( counter ) begin dup 8 < ( counter flag ) \ max 8 * 500 ms ch-buffer c@ f > ( counter flag flag ) \ is MuxLUN above limit ? AND ( counter flag ) while d# 500 ms \ this device is not yet ready 0 ch-buffer c! \ preset a clean response mps new-device-address 0 ch-buffer 1 control-std-get-maxlun ( TRUE|FALSE ) not IF s" ** ERROR in GET-MAX-LUN ** " usb-debug-print drop 10 \ replace counter to force loop end THEN 1+ ( counter+1 ) repeat drop ch-buffer c@ dup 0= swap f > or IF s" + LUN: " ch-buffer c@ usb-debug-print-val (atapi-scsi-property-set) s" usb-storage.fs" INCLUDED finish-device ELSE s" - LUN: " ch-buffer c@ usb-debug-print-val (atapi-scsi-property-set) s" usb-storage-wrapper.fs" INCLUDED finish-device THEN ; : (classify-storage) ( interface-protocol interface-subclass -- ) s" USB: Mass Storage Device Found!" usb-debug-print swap 50 <> IF s" USB storage: Protocol is not 50." usb-debug-print drop EXIT THEN CASE 02 OF (atapi-8020-create) s" ATAPI Interface " usb-debug-print ENDOF 05 OF (atapi-8070-create) s" ATAPI Interface " usb-debug-print ENDOF 06 OF (scsi-create) s" SCSI Interface " usb-debug-print ENDOF dup OF s" USB storage: Unsupported sub-class code." usb-debug-print ENDOF ENDCASE ; : (keyboard-create) ( -- ) cd-buffer @ 1f + c@ ( ep-mps ) cd-buffer @ 1d + c@ ( ep-mps ep-addr ) mps port-number new-device-address port-number new-device set-space ( ep-mps ep-addr mps port-num usb-addr ) encode-int s" USB-ADDRESS" property ( ep-mps ep-addr mps port-num ) encode-int s" reg" property ( ep-mps ep-addr mps ) encode-int s" MPS-DCP" property ( ep-mps ep-addr ) 7f and encode-int s" INT-IN-EP-ADDR" property encode-int s" MPS-INTIN" property new-device-address \ device-speed s" usb-keyboard.fs" INCLUDED finish-device ; : (mouse-create) ( -- ) mps port-number new-device-address port-number new-device set-space ( mps port-num usb-addr ) encode-int s" USB-ADDRESS" property ( mps port-num ) encode-int s" reg" property ( mps ) encode-int s" MPS-DCP" property s" usb-mouse.fs" INCLUDED finish-device ; : (classify-by-interface) ( -- ) (device-classify) IF CASE 08 OF (classify-storage) ENDOF 03 OF s" USB: HID Found!" usb-debug-print 01 = IF case 01 of s" USB keyboard!" usb-debug-print (keyboard-create) endof 02 of s" USB mouse!" usb-debug-print (mouse-create) endof dup of s" USB: unsupported HID!" usb-debug-print endof endcase ELSE s" USB: unsupported HID protocol " rot usb-debug-print-val THEN ENDOF dup OF s" USB: unsupported interface type." usb-debug-print 2drop ENDOF ENDCASE THEN ; : create-usb-device-tree ( -- ) dd-buffer @ DEVICE-DESCRIPTOR-DEVCLASS-OFFSET + c@ ( Device-class ) CASE HUB-DEVICE-CLASS OF s" USB: HUB found" usb-debug-print (hub-create) ENDOF NO-CLASS OF (classify-by-interface) ENDOF DUP OF s" USB: Unknown device found." usb-debug-print ENDOF ENDCASE ; ��2P20usb-storage.fss" entered usb-storage.fs" usb-debug-print s" storage" device-name s" block" device-type 2 encode-int s" #address-cells" property 0 encode-int s" #size-cells" property 8 VALUE mps-bulk-out 8 VALUE mps-bulk-in 8 VALUE mps-dcp 0 VALUE bulk-in-ep 0 VALUE bulk-out-ep 0 VALUE bulk-in-toggle 0 VALUE bulk-out-toggle 0 VALUE lun 0 VALUE my-usb-address INSTANCE VARIABLE ihandle-bulk INSTANCE VARIABLE ihandle-deblocker INSTANCE VARIABLE flag INSTANCE VARIABLE count 4000 CONSTANT max-transfer 200 VALUE block-size \ default (512 Bytes) -1 VALUE max-block-num \ highest reported block-number 0f CONSTANT SCSI-COMMAND-OFFSET STRUCT max-transfer FIELD >read-buffer 80 FIELD >response-buffer 40 FIELD >command-buffer 10 FIELD >csw-buffer 8 FIELD >cfg-buffer CONSTANT /dma-buf 0 VALUE dma-buf 0 VALUE dma-buf-phys : (dma-buf-init) ( -- ) /dma-buf s" dma-alloc" $call-parent TO dma-buf dma-buf /dma-buf 0 s" dma-map-in" $call-parent TO dma-buf-phys s" storage dma-buf = " dma-buf usb-debug-print-val ; : (dma-buf-free) ( -- ) dma-buf dma-buf-phys /dma-buf s" dma-map-out" $call-parent dma-buf /dma-buf s" dma-free" $call-parent 0 TO dma-buf 0 TO dma-buf-phys ; s" usb-storage-support.fs" INCLUDED 0 VALUE bulk-cnt 0 VALUE bulk-cmd-len 0 VALUE itest 0 VALUE resp-buffer 0 VALUE resp-size : do-bulk-command ( resp-buffer resp-size -- TRUE | FALSE ) TO resp-size TO resp-buffer usb-debug-flag IF dma-buf >command-buffer 0E + c@ TO bulk-cmd-len s" cmd-length: " bulk-cmd-len usb-debug-print-val dma-buf >command-buffer bulk-cmd-len 0E + dump cr THEN 6 TO bulk-cnt \ 2 old value FALSE dup BEGIN 0= WHILE drop 1 1 bulk-out-toggle dma-buf >command-buffer 1f mps-bulk-out my-usb-address bulk-out-ep 7 lshift or rw-endpoint swap ( TRUE toggle | FALSE toggle ) to bulk-out-toggle ( TRUE | FALSE ) IF s" resp-size : " resp-size usb-debug-print-val resp-size 0<> IF \ do we need a response ?! 0 1 bulk-in-toggle resp-buffer resp-size mps-bulk-in my-usb-address bulk-in-ep 7 lshift or rw-endpoint swap ( TRUE toggle | FALSE toggle ) to bulk-in-toggle ( TRUE | FALSE ) ELSE TRUE THEN IF \ read the bulk CSW 0 1 bulk-in-toggle dma-buf >csw-buffer D mps-bulk-in my-usb-address bulk-in-ep 7 lshift or rw-endpoint swap ( TRUE toggle | FALSE toggle ) to bulk-in-toggle ( TRUE | FALSE ) IF s" Command successful." usb-debug-print TRUE dup ELSE s" Command failed in CSW stage" usb-debug-print FALSE dup THEN ELSE s" Command failed while receiving DATA... read CSW..." usb-debug-print 0 1 bulk-in-toggle dma-buf >csw-buffer D mps-bulk-in my-usb-address bulk-in-ep 7 lshift or rw-endpoint swap ( TRUE toggle | FALSE toggle ) to bulk-in-toggle ( TRUE | FALSE ) IF s" OK evaluate the CSW ..." usb-debug-print dma-buf >csw-buffer c + c@ dup TO itest s" CSW Status: " itest usb-debug-print-val dup 2 = IF \ Phase Error s" Phase error do a bulk reset-recovery ..." usb-debug-print bulk-out-ep bulk-in-ep my-usb-address bulk-reset-recovery-procedure THEN 1 = IF \ Command failed s" Command Failed do a bulk-reset-recovery" usb-debug-print bulk-out-ep bulk-in-ep my-usb-address bulk-reset-recovery-procedure THEN THEN FALSE dup THEN ELSE s" Command failed while Sending CBW ..." usb-debug-print FALSE dup THEN bulk-cnt 1 - TO bulk-cnt bulk-cnt 0= IF 2drop FALSE dup THEN REPEAT ; scsi-open usb-debug-flag to scsi-param-debug \ copy debug flag 24 CONSTANT inquiry-length \ was 20 : inquiry ( -- ) s" usb-storage: inquiry" usb-debug-print dma-buf >command-buffer 1 inquiry-length 80 lun scsi-length-inquiry build-cbw inquiry-length dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( alloc-len address ) scsi-build-inquiry dma-buf >response-buffer inquiry-length erase \ provide clean buffer dma-buf >response-buffer inquiry-length do-bulk-command IF s" Successfully read INQUIRY data" usb-debug-print 0d emit space space dma-buf >response-buffer c@ \ get 'Peripheral Device Type' (PDT) CASE 0 OF ." BLOCK-DEV: " ENDOF \ SCSI Block Device 5 OF ." CD-ROM : " ENDOF 7 OF ." OPTICAL : " ENDOF e OF ." RED-BLOCK: " ENDOF \ SCSI Reduced Block Device dup dup OF ." ? (" . 8 emit 29 emit 2 spaces ENDOF ENDCASE space dma-buf >response-buffer 8 + 16 encode-string s" ident-str" property dma-buf >response-buffer .inquiry-text ELSE 5040 error" (USB) Device transaction error. (inquiry)" ABORT THEN ; : read-capacity ( -- ) s" usb-storage: read-capacity" usb-debug-print dma-buf >command-buffer 1 8 80 lun scsi-length-read-cap-10 build-cbw dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( address ) scsi-build-read-cap-10 lun 5 lshift dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( address ) read-cap-10>reserved1 c! dma-buf >response-buffer 8 erase \ provide clean buffer dma-buf >response-buffer 8 do-bulk-command IF s" Successfully read READ CAPACITY data" usb-debug-print ELSE 5040 error" (USB) Device transaction error. (capacity)" ABORT THEN ; : test-unit-ready ( -- TRUE | FALSE ) dma-buf >command-buffer 1 0 80 lun scsi-length-test-unit-ready \ was: 0c build-cbw dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( address ) scsi-build-test-unit-ready ( cdb -- ) dma-buf >response-buffer 0 do-bulk-command IF s" Successfully read test unit ready data" usb-debug-print s" Test Unit STATUS availabe in dma-buf >csw-buffer" usb-debug-print dma-buf >csw-buffer 0c + c@ 0= IF s" Test Unit Command Successfully Executed" usb-debug-print TRUE ( TRUE ) ELSE s" Test Unit Command Failed to execute" usb-debug-print FALSE ( FALSE ) THEN ELSE 5040 error" (USB) Device transaction error. (test-unit-ready)" ABORT THEN ; : wait-for-unit-ready ( -- TRUE|FALSE ) s" --> WAIT: test-unit-ready ... " usb-debug-print d# 100 ( count ) \ up to 10 seconds BEGIN ( count ) dup 0> ( count flag ) test-unit-ready \ dup IF 2b ELSE 2d THEN emit not and ( count flag ) WHILE 1- ( count ) d# 100 wait-proceed \ wait 100 ms REPEAT ( count ) 0= IF s" ** Device not ready ** " usb-debug-print FALSE ELSE TRUE THEN ; : request-sense ( -- ) s" request-sense: Command ready." usb-debug-print dma-buf >command-buffer 1 12 80 lun scsi-length-request-sense build-cbw 12 dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( alloc-len cdb ) scsi-build-request-sense ( alloc-len cdb -- ) dma-buf >response-buffer 12 do-bulk-command IF s" Read Sense data successfully" usb-debug-print ELSE 5040 error" (USB) Device transaction error. (request-sense)" ABORT THEN ; : start ( -- ) dma-buf >command-buffer 1 0 80 lun scsi-length-start-stop-unit build-cbw dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( cdb ) scsi-const-start scsi-build-start-stop-unit ( state# cdb -- ) dma-buf >response-buffer 0 do-bulk-command IF s" Start successfully" usb-debug-print ELSE 5040 error" (USB) Device transaction error. (start)" ABORT THEN ; : stop ( -- ) dma-buf >command-buffer 1 0 80 lun scsi-length-start-stop-unit build-cbw dma-buf >command-buffer SCSI-COMMAND-OFFSET + ( cdb ) scsi-const-stop scsi-build-start-stop-unit ( state# cdb -- ) dma-buf >response-buffer 0 do-bulk-command IF s" Stop successfully" usb-debug-print ELSE 5040 error" (USB) Device transaction error. (stop)" ABORT THEN ; 0 VALUE temp1 0 VALUE temp2 0 VALUE temp3 : seek ( pos-lo pos-hi -- status ) 2dup lxjoin max-block-num block-size * > IF ." ** Seek Error: pos too large (" dup . over . ." -> " max-block-num block-size * . ." ) ** " cr -1 \ see spec-1275 page 183 ELSE s" seek" ihandle-deblocker @ $call-method THEN ; : read ( address length -- actual ) s" read" ihandle-deblocker @ $call-method ; : read-blocks ( address block# #blocks -- #read-blocks ) 2dup + max-block-num > IF ." ** Requested block too large " 2dup + ." (" .d ." -> " max-block-num .d bs emit ." ) ... read aborted **" cr nip nip \ leave #blocks on stack ELSE block-size * dma-buf >command-buffer ( address block# transfer-len command-buffer ) 1 2 pick 80 lun 0c build-cbw ( address block# transfer-len ) dup to temp1 ( address block# transfer-len ) block-size / ( address block# #blocks ) dma-buf >command-buffer ( address block# #blocks command-addr ) SCSI-COMMAND-OFFSET + ( address block# #blocks cdb ) scsi-build-read? ( address cdblength ) dma-buf >command-buffer 0e + c! \ update bCBWCBLength-field with resulting CDB length dma-buf >read-buffer temp1 ( address read-buffer transfer-len ) do-bulk-command ( address ) IF dma-buf >read-buffer swap temp1 ( read-buffer address transfer-len ) move s" Read data successfully" usb-debug-print ELSE drop 5040 error" (USB) Device transaction error. (read-blocks)" ABORT THEN temp1 block-size / ( #read-blocks ) THEN ; d# 800 CONSTANT media-ready-retry : make-media-ready ( -- ) s" usb-storage: make-media-ready" usb-debug-print 0 flag ! 0 count ! BEGIN flag @ 0= WHILE test-unit-ready IF s" Media ready for access." usb-debug-print 1 flag ! ELSE count @ 1 + count ! count @ media-ready-retry = IF 1 flag ! 5000 error" (USB) Media or drive not ready for this blade." ABORT THEN request-sense dma-buf >response-buffer scsi-get-sense-ID? ( addr -- false | sense-ID true ) IF ffff00 AND \ remaining: sense-key ASC CASE 023a00 OF \ MEDIUM NOT PRESENT (02 3a 00) 5010 error" (USB) No Media found! Check for the drawer/inserted media." ABORT ENDOF 020400 OF \ LOGICAL DRIVE NOT READY - INITIALIZATION REQUIRED 5010 error" (USB) No Media found! Check for the drawer/inserted media." ABORT ENDOF 033000 OF \ CANNOT READ MEDIUM - UNKNOWN FORMAT 5020 error" (USB) Unknown media format." ABORT ENDOF ENDCASE THEN THEN d# 10 ms \ wait maximum 10ms * 800 (=8s) REPEAT usb-debug-flag IF ." make-media-ready finished after " count @ decimal . hex ." tries." cr THEN ; : .showcap space test-unit-ready drop \ initial command request-sense dma-buf >response-buffer scsi-get-sense-ID? ( addr -- false | sense-ID true ) IF dup FFFF00 and 023a00 = ( sense-id flag ) IF 023a02 = \ see sense-codes SPC-3 clause 4.5.6 IF ." Tray Open!" ELSE ." No Media" THEN ELSE ( sense-id ) drop wait-for-unit-ready IF read-capacity dma-buf >response-buffer scsi-get-capacity-10 space .capacity-text ELSE request-sense dma-buf >response-buffer scsi-get-sense-ID? ( addr -- false | sense-ID true ) IF dup ff0000 and 040000 = \ sense-code = 4 ? IF ." *HW-ERROR*" ELSE CASE 023a00 OF ." No Media " ENDOF 023a02 OF ." Tray Open! " ENDOF dup OF ." ? " ENDOF ENDCASE THEN THEN THEN THEN ELSE ." ?? " THEN ; : init-dev-ready test-unit-ready drop 4 >r \ loop-counter 0 0 BEGIN 2drop request-sense dma-buf >response-buffer scsi-get-sense-data ( ascq asc sense-key ) 0<> r> 1- dup >r 0<> AND \ loop-counter or sense-key WHILE REPEAT 2drop r> drop ; scsi-close \ no further scsi words required : (init-block-size) read-capacity dma-buf >response-buffer l@ dup 0<> IF to max-block-num \ highest block-number ELSE -1 to max-block-num \ indeterminate THEN dma-buf >response-buffer 4 + l@ to block-size s" usb-storage: block-size=" block-size usb-debug-print-val ; : open ( -- TRUE ) s" usb-storage: open" usb-debug-print (dma-buf-init) ihandle-bulk s" bulk" (open-package) make-media-ready (init-block-size) \ Init block-size before opening the deblocker ihandle-deblocker s" deblocker" (open-package) s" disk-label" find-package IF ( phandle ) usb-debug-flag IF ." my-args for disk-label = " my-args swap . . cr THEN my-args rot interpose THEN TRUE ( TRUE ) ; : close ( -- ) ihandle-deblocker (close-package) ihandle-bulk (close-package) (dma-buf-free) ; : (init-device-name) ( -- ) init-dev-ready inquiry dma-buf >response-buffer c@ CASE 1 OF .showcap s" tape" device-name ENDOF 5 OF .showcap s" cdrom" device-name s" CDROM found" usb-debug-print ENDOF 0 OF .showcap s" sbc-dev" device-name s" SBC Direct access device" usb-debug-print ENDOF 7 OF .showcap s" optical" device-name s" Optical memory found" usb-debug-print ENDOF 0E OF .showcap s" rbc-dev" device-name s" RBC direct acces device found" usb-debug-print ENDOF ENDCASE ; : (initial-setup) (dma-buf-init) ihandle-bulk s" bulk" (open-package) device-init (init-device-name) set-drive-alias 200 to block-size \ Default block-size, will be overwritten in "open" ihandle-bulk (close-package) (dma-buf-free) ; (initial-setup) s" leaving usb-storage.fs" usb-debug-print �� 8usb-storage-support.fss" entered usb-storage-support.fs" usb-debug-print : rw-endpoint s" rw-endpoint" $call-parent ; : controlxfer ( dir addr dlen setup-packet MPS ep-fun --- TRUE|FALSE ) s" controlxfer" $call-parent ; : control-std-get-configuration-descriptor s" control-std-get-configuration-descriptor" $call-parent ; : control-std-set-configuration ( configvalue FuncAddr -- TRUE | FALSE ) s" control-std-set-configuration" $call-parent ( TRUE | FALSE ) ; : bulk-reset-recovery-procedure ( bulk-out-endp bulk-in-endp usb-addr -- ) s" bulk-reset-recovery-procedure" $call-parent ; : build-cbw ( address tag transfer-len direction lun command-len -- ) s" build-cbw" ihandle-bulk @ $call-method ; : analyze-csw ( address -- residue tag TRUE | reason FALSE ) s" analyze-csw" ihandle-bulk @ $call-method ; : device-init ( -- ) s" Starting to initialize usb-storage device" usb-debug-print s" USB-ADDRESS" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" not possible" usb-debug-print ELSE decode-int nip nip to my-usb-address THEN s" MPS-BULKOUT" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" not possible" usb-debug-print ELSE decode-int nip nip to mps-bulk-out THEN s" MPS-BULKIN" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" not possible" usb-debug-print ELSE decode-int nip nip to mps-bulk-in THEN s" BULK-IN-EP-ADDR" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" not possible" usb-debug-print ELSE decode-int nip nip to bulk-in-ep THEN s" BULK-OUT-EP-ADDR" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" not possible" usb-debug-print ELSE decode-int nip nip to bulk-out-ep THEN s" MPS-DCP" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" Not possible" usb-debug-print ELSE decode-int nip nip to mps-dcp THEN s" LUN" get-my-property ( TRUE | propaddr proplen FALSE ) IF s" NOT Possible to extract LUN" usb-debug-print ELSE decode-int nip nip to lun THEN s" Extracted properties inherited from parent." usb-debug-print dma-buf >cfg-buffer 8 mps-dcp my-usb-address ( buffer len mps fun-addr ) control-std-get-configuration-descriptor ( TRUE | FALSE ) drop s" Configuration descriptor extracted." usb-debug-print dma-buf >cfg-buffer 5 + c@ my-usb-address ( configvalue fun-addr ) control-std-set-configuration ( TRUE | FALSE ) s" usb-storage: Set config returned: " rot usb-debug-print-val ; : (open-package) ( ihandle-var name-str name-len -- ) find-package IF ( ihandle-var phandle ) 0 0 rot open-package ( ihandle-var ihandle ) swap ! ELSE s" Support package not found" usb-debug-print THEN ; : (close-package) ( ihandle-var -- ) dup @ close-package 0 swap ! ; s" leaving usb-storage-support.fs" usb-debug-print ��x38usb-storage-wrapper.fss" scsi" device-name s" block-type" device-type 1 encode-int s" #address-cells" property 0 encode-int s" #size-cells" property : encode-unit 1 hex-encode-unit ; : decode-unit 1 hex-decode-unit ; 1 chars alloc-mem VALUE ch-buffer 8 VALUE mps-dcp 0 VALUE port-number 0 VALUE my-usb-address : control-std-get-maxlun s" control-std-get-maxlun" $call-parent ; : control-std-get-configuration-descriptor s" control-std-get-configuration-descriptor" $call-parent ; : rw-endpoint s" rw-endpoint" $call-parent ; : controlxfer ( dir addr dlen setup-packet MPS ep-fun -- TRUE|FALSE ) s" controlxfer" $call-parent ; : control-std-set-configuration s" control-std-set-configuration" $call-parent ; : extract-properties ( -- ) s" USB-ADDRESS" get-inherited-property ( prop-addr prop-len FALSE | TRUE ) IF s" notpossible" usb-debug-print ELSE decode-int nip nip to my-usb-address THEN s" MPS-DCP" get-inherited-property ( prop-addr prop-len FALSE | TRUE ) IF s" MPS-DCP property not found.Assume 8 as MAX PACKET SIZE" usb-debug-print s" for the default control pipe" usb-debug-print 8 to mps-dcp ELSE s" MPS-DCP property found!!" usb-debug-print decode-int nip nip to mps-dcp THEN s" reg" get-inherited-property ( prop-addr prop-len FLASE | TRUE ) IF s" notpossible" usb-debug-print ELSE decode-int nip nip to port-number THEN ; : create-tree ( -- ) mps-dcp my-usb-address 0 ch-buffer 1 ( MPS fun-addr dir data-buff data-len ) control-std-get-maxlun ( TRUE | FALSE ) IF s" GET-MAX-LUN IS WORKING :" usb-debug-print ELSE s" ERROR in GET-MAX-LUN " usb-debug-print THEN ch-buffer c@ 1 + 0 ( max-lun+1 0 ) DO s" iManufacturer" get-inherited-property drop ( prop-addr prop-len TRUE ) decode-int nip nip ( iManu ) s" iProduct" get-inherited-property drop decode-int nip nip ( iManu iProd ) s" iSerialNumber" get-inherited-property drop decode-int nip nip ( iManu iProd iSerNum ) s" MPS-BULKOUT" get-inherited-property drop decode-int nip nip ( iManu iProd iSerNum MPS-BULKOUT ) s" BULK-OUT-EP-ADDR" get-inherited-property drop decode-int nip nip ( iManu iProd iSerNum MPS-BULKOUT BULK-OUT-EP-ADDR ) s" MPS-BULKIN" get-inherited-property drop ( iManu iProd iSerNum MPS-BULKOUT BULK-OUT-EP-ADDR prop-addr prop-len TRUE | FALSE ) decode-int nip nip s" BULK-IN-EP-ADDR" get-inherited-property drop ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN prop-addr prop-len TRUE | FALSE ) decode-int nip nip ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR ) mps-dcp port-number my-usb-address I ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR mps-dcp port-address my-usb-address lun-number ) new-device ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR mps-dcp port-address my-usb-address lun-number ) set-space ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR mps-dcp port-number my-usb-address ) encode-int s" USB-ADDRESS" property ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR mps-dcp port-number ) encode-int s" reg" property encode-int s" MPS-DCP" property ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR ) I encode-int s" LUN" property ( iManu iProd iSernum MPS-BULKOUT BULK-OUT-EP-ADDR MPS-BULKIN BULKIN-EP-ADDR ) encode-int s" BULK-IN-EP-ADDR" property encode-int s" MPS-BULKIN" property encode-int s" BULK-OUT-EP-ADDR" property encode-int s" MPS-BULKOUT" property ( iManu iProd iSerNum ) encode-int s" iSerialNumber" property ( iManu iProd ) encode-int s" iProduct" property ( iManu ) encode-int s" iManufacturer" property ( -- ) s" usb-storage.fs" INCLUDED finish-device LOOP ; extract-properties \ Extract the properties from parent create-tree \ this method creates the node for every lun with properties ��.-�0usb-keyboard.fss" keyboard" device-name s" keyboard" device-type ." USB Keyboard" cr 3 encode-int s" assigned-addresses" property 1 encode-int s" reg" property 1 encode-int s" configuration#" property s" EN" encode-string s" language" property 1 constant NumLk 2 constant CapsLk 4 constant ScrLk TRUE VALUE use-interrupt-transfers? s" model" s" /" find-node get-property 0= IF 2dup s" qemu" find-substr = TO use-interrupt-transfers? drop THEN 00 value kbd-addr to kbd-addr \ save speed bit 8 value mps-dcp 8 constant DEFAULT-CONTROL-MPS 0 value multi-key 0 value led-state 0 value temp1 0 value temp2 0 value temp3 0 value ret 0 value scancode 0 value kbd-shift 0 value kbd-scan 0 value key-old 0 value expire-ms 0 value mps-int-in 0 value int-in-ep 0 value int-in-toggle STRUCT 80 FIELD kb>cfg \ For config descriptors etc, size 0x80 8 FIELD kb>report \ For keyboard report, size 8 8 FIELD kb>setup-packet \ For setup-packet, size 8 4 FIELD kb>data \ Various data, size 4 CONSTANT /kbd-buf 0 VALUE kbd-buf 0 VALUE kbd-buf-dma : (kbd-buf-init) ( -- ) /kbd-buf s" dma-alloc" $call-parent TO kbd-buf kbd-buf /kbd-buf 0 s" dma-map-in" $call-parent TO kbd-buf-dma s" kbd-buf = " kbd-buf usb-debug-print-val ; : (kbd-buf-free) ( -- ) kbd-buf kbd-buf-dma /kbd-buf s" dma-map-out" $call-parent kbd-buf /kbd-buf s" dma-free" $call-parent 0 TO kbd-buf 0 TO kbd-buf-dma ; s" usb-kbd-device-support.fs" included : control-cls-set-report ( reportvalue FuncAddr -- TRUE|FALSE ) to temp1 to temp2 2109000200000100 kbd-buf kb>setup-packet ! temp2 kbd-buf kb>data l!-le 1 kbd-buf kb>data 1 kbd-buf kb>setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer ; : control-cls-get-report ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE ) to temp1 to temp2 to temp3 a101000100000000 kbd-buf kb>setup-packet ! temp3 kbd-buf kb>setup-packet 6 + w!-le 0 swap temp3 kbd-buf kb>setup-packet temp2 temp1 controlxfer ; : int-get-report ( -- ) \ get report for interrupt transfer 0 2 int-in-toggle kbd-buf kb>report 8 mps-int-in kbd-addr int-in-ep 7 lshift or rw-endpoint \ get report swap to int-in-toggle IF kbd-buf kb>report @ ff00000000000000 and 38 rshift to kbd-shift \ store shift status kbd-buf kb>report @ 0000ffffffffffff and to kbd-scan \ store scan codes ELSE 0 to kbd-shift \ clear shift status 0 to kbd-scan \ clear scan code buffer THEN ; : ctl-get-report ( -- ) \ get report for control transfer kbd-buf kb>report 8 8 kbd-addr control-cls-get-report IF \ get report kbd-buf kb>report @ ff00000000000000 and 38 rshift to kbd-shift \ store shift status kbd-buf kb>report @ 0000ffffffffffff and to kbd-scan \ store scan codes ELSE 0 to kbd-shift \ clear shift status 0 to kbd-scan \ clear scan code buffer THEN ; : kbd-get-report ( -- ) use-interrupt-transfers? IF int-get-report ELSE ctl-get-report THEN ; : set-led ( led -- ) dup to led-state kbd-addr control-cls-set-report drop ; : is-shift ( -- true|false ) kbd-shift 22 and if true else false then ; : is-alt ( -- true|false ) kbd-shift 44 and if true else false then ; : is-ctrl ( -- true|false ) kbd-shift 11 and if true else false then ; : ctrl_alt_del_key ( char -- ) is-ctrl if \ ctrl is pressed? is-alt if \ alt is pressed? 4c = if \ del is pressed? s" reboot.... " usb-debug-print drop false \ invalidate del key on top of stack then false \ dummy for last drop then then drop \ clear stack ; : get-ukbd-char ( ScanCode -- char|false ) dup ctrl_alt_del_key \ check ctrl+alt+del dup to scancode \ store scan code case \ translate scan code --> char 04 of [char] a endof 05 of [char] b endof 06 of [char] c endof 07 of [char] d endof 08 of [char] e endof 09 of [char] f endof 0a of [char] g endof 0b of [char] h endof 0c of [char] i endof 0d of [char] j endof 0e of [char] k endof 0f of [char] l endof 10 of [char] m endof 11 of [char] n endof 12 of [char] o endof 13 of [char] p endof 14 of [char] q endof 15 of [char] r endof 16 of [char] s endof 17 of [char] t endof 18 of [char] u endof 19 of [char] v endof 1a of [char] w endof 1b of [char] x endof 1c of [char] y endof 1d of [char] z endof 1e of [char] 1 endof 1f of [char] 2 endof 20 of [char] 3 endof 21 of [char] 4 endof 22 of [char] 5 endof 23 of [char] 6 endof 24 of [char] 7 endof 25 of [char] 8 endof 26 of [char] 9 endof 27 of [char] 0 endof 28 of 0d endof \ Enter 29 of 1b endof \ ESC 2a of 08 endof \ Backsace 2b of 09 endof \ Tab 2c of 20 endof \ Space 2d of [char] - endof 2e of [char] = endof 2f of [char] [ endof 30 of [char] ] endof 31 of [char] \ endof 33 of [char] ; endof 34 of [char] ' endof 35 of [char] ` endof 36 of [char] , endof 37 of [char] . endof 38 of [char] / endof 39 of led-state CapsLk xor set-led false endof \ CapsLk 3a of 1b 7e31315b to multi-key endof \ F1 3b of 1b 7e32315b to multi-key endof \ F2 3c of 1b 7e33315b to multi-key endof \ F3 3d of 1b 7e34315b to multi-key endof \ F4 3e of 1b 7e35315b to multi-key endof \ F5 3f of 1b 7e37315b to multi-key endof \ F6 40 of 1b 7e38315b to multi-key endof \ F7 41 of 1b 7e39315b to multi-key endof \ F8 42 of 1b 7e30315b to multi-key endof \ F9 43 of 1b 7e31315b to multi-key endof \ F10 44 of 1b 7e33315b to multi-key endof \ F11 45 of 1b 7e34315b to multi-key endof \ F12 47 of led-state ScrLk xor set-led false endof \ ScrLk 49 of 1b 7e315b to multi-key endof \ Ins 4a of 1b 7e325b to multi-key endof \ Home 4b of 1b 7e335b to multi-key endof \ PgUp 4c of 1b 7e345b to multi-key endof \ Del 4d of 1b 7e355b to multi-key endof \ End 4e of 1b 7e365b to multi-key endof \ PgDn 4f of 1b 435b to multi-key endof \ R-arrow 50 of 1b 445b to multi-key endof \ L-arrow 51 of 1b 425b to multi-key endof \ D-arrow 52 of 1b 415b to multi-key endof \ U-arrow 53 of led-state NumLk xor set-led false endof \ NumLk 54 of [char] / endof \ keypad / 55 of [char] * endof \ keypad * 56 of [char] - endof \ keypad - 57 of [char] + endof \ keypad + 58 of 0d endof \ keypad Enter 89 of [char] \ endof \ japanese yen dup of false endof \ other keys are false endcase to ret \ store char led-state CapsLk and 0 <> if \ if CapsLk is on scancode 03 > if \ from a to z ? scancode 1e < if ret 20 - to ret \ to Upper case then then then is-shift if \ if shift is on scancode 03 > if \ from a to z ? scancode 1e < if ret 20 - to ret \ to Upper case else scancode case \ translate scan code --> char 1e of [char] ! endof 1f of [char] @ endof 20 of [char] # endof 21 of [char] $ endof 22 of [char] % endof 23 of [char] ^ endof 24 of [char] & endof 25 of [char] * endof 26 of [char] ( endof 27 of [char] ) endof 2d of [char] _ endof 2e of [char] + endof 2f of [char] { endof 30 of [char] } endof 31 of [char] | endof 33 of [char] : endof 34 of [char] " endof 35 of [char] ~ endof 36 of [char] < endof 37 of [char] > endof 38 of [char] ? endof dup of ret endof \ other keys are no change endcase to ret \ overwrite new char then then then led-state NumLk and 0 <> if \ if NumLk is on scancode case \ translate scan code --> char 59 of [char] 1 endof 5a of [char] 2 endof 5b of [char] 3 endof 5c of [char] 4 endof 5d of [char] 5 endof 5e of [char] 6 endof 5f of [char] 7 endof 60 of [char] 8 endof 61 of [char] 9 endof 62 of [char] 0 endof 63 of [char] . endof \ keypad . dup of ret endof \ other keys are no change endcase to ret \ overwrite new char then ret \ return char ; : key-available? ( -- true|false ) multi-key 0 <> IF true \ multi scan code key was pressed... so key is available EXIT \ done THEN kbd-scan 0 = IF \ if no kbd-scan code is currently available kbd-get-report \ check for new scan codes THEN kbd-scan 0 <> \ if a kbd-scan is available, report true, else false ; : usb-kread ( -- char|false ) \ usb key read for control transfer multi-key 0 <> if \ if multi scan code key is pressed multi-key ff and \ read one byte from buffer multi-key 8 rshift to multi-key \ move to next byte else \ normal key check kbd-scan 0 = IF kbd-get-report \ read scan-code report THEN kbd-scan 0 <> if \ scan code exist? begin kbd-scan ff and dup 00 = while \ get a last scancode in report buffer kbd-scan 8 rshift to kbd-scan \ This algorithm is wrong --> must be fixed! drop \ KBD doesn't set scancode in pressed order!!! repeat ff and dup to kbd-scan \ we can only digest one key at a time dup key-old <> if \ if the scancode is new dup to key-old \ save current scan code get-ukbd-char \ translate scan code --> char milliseconds fa + to expire-ms \ set typematic delay 250ms else \ scan code is not changed milliseconds expire-ms > if \ if timer is expired ... should be considered timer carry over get-ukbd-char \ translate scan code --> char milliseconds 21 + to expire-ms \ set typematic rate 30cps else \ timer is not expired drop false \ do nothing then then kbd-scan 8 rshift to kbd-scan \ handled scan-code else 0 to key-old \ clear privious key false \ no scan code --> return false then then ; : key-read ( -- char ) 0 begin drop usb-kread dup 0 <> until \ read key input (Interrupt transfer) ; : read ( addr len -- actual ) 0= IF drop 0 EXIT THEN usb-kread ?dup IF swap c! 1 ELSE 0 swap c! -2 THEN ; (kbd-buf-init) kbd-init \ keyboard initialize milliseconds to expire-ms \ Timer initialize 0 to multi-key \ multi key buffer clear 7 set-led \ flash leds 250 ms 0 set-led (kbd-buf-free) s" keyboard" get-node node>path set-alias : open ( -- true ) (kbd-buf-init) 7 set-led 100 ms 3 set-led 100 ms 1 set-led 100 ms usb-kread drop 0 set-led true ; : close (kbd-buf-free) ; s" Keyboard init done" usb-debug-print �� @usb-kbd-device-support.fs: rw-endpoint s" rw-endpoint" $call-parent ; : controlxfer s" controlxfer" $call-parent ; : control-std-get-device-descriptor s" control-std-get-device-descriptor" $call-parent ; : control-std-get-configuration-descriptor s" control-std-get-configuration-descriptor" $call-parent ; : control-std-set-configuration s" control-std-set-configuration" $call-parent ; : control-cls-set-protocol ( reportvalue FuncAddr -- TRUE|FALSE ) to temp1 to temp2 210b000000000100 kbd-buf kb>setup-packet ! temp2 kbd-buf kb>data l!-le 1 kbd-buf kb>data 1 kbd-buf kb>setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer ; : control-cls-set-idle ( reportvalue FuncAddr -- TRUE|FALSE ) to temp1 to temp2 210a000000000000 kbd-buf kb>setup-packet ! temp2 kbd-buf kb>data l!-le 0 kbd-buf kb>data 0 kbd-buf kb>setup-packet DEFAULT-CONTROL-MPS temp1 controlxfer ; : control-std-get-report-descriptor ( data-buffer data-len MPS FuncAddr -- TRUE|FALSE ) to temp1 to temp2 to temp3 8106002200000000 kbd-buf kb>setup-packet ! temp3 kbd-buf kb>setup-packet 6 + w!-le 0 swap temp3 kbd-buf kb>setup-packet temp2 temp1 controlxfer ; : kbd-init s" Starting to initialize keyboard" usb-debug-print s" MPS-INTIN" get-my-property if s" not possible" usb-debug-print else decode-int nip nip to mps-int-in then s" INT-IN-EP-ADDR" get-my-property if s" not possible" usb-debug-print else decode-int nip nip to int-in-ep then kbd-buf kb>cfg 12 8 kbd-addr \ get device descriptor control-std-get-device-descriptor drop kbd-buf kb>cfg 9 8 kbd-addr \ get config descriptor control-std-get-configuration-descriptor drop kbd-buf kb>cfg 5 + c@ kbd-addr \ set configuration control-std-set-configuration drop s" KBDS: Set config returned" usb-debug-print 0 kbd-addr control-cls-set-idle drop \ set idle s" KBDS: Set idle returned" usb-debug-print kbd-buf kb>cfg 3f 8 kbd-addr \ get report descriptor control-std-get-report-descriptor drop s" Finished initializing keyboard" usb-debug-print ; ��`'0usb-mouse.fss" mouse" device-name s" mouse" device-type ." USB Mouse" cr 1 encode-int s" configuration#" property 2 encode-int s" #buttons" property 4 encode-int s" assigned-addresses" property 2 encode-int s" reg" property : open true ; : close ; : get-event ( msec -- pos.x pos.y buttons true|false ) ; ��KHK 0scsi-support.fsvocabulary scsi-words \ create new word list named 'scsi-words' also scsi-words definitions \ place next definitions into new list false value scsi-param-debug \ common debugging flag d# 0 value scsi-param-size \ length of CDB processed last h# 0 value scsi-param-control \ control word for CDBs as defined in SAM-4 d# 0 value scsi-param-errors \ counter for detected errors : scsi-inc-errors scsi-param-errors 1 + to scsi-param-errors ; 00 CONSTANT scsi-cmd-test-unit-ready STRUCT /c FIELD test-unit-ready>operation-code \ 00h 4 FIELD test-unit-ready>reserved \ unused /c FIELD test-unit-ready>control \ control byte as specified in SAM-4 CONSTANT scsi-length-test-unit-ready : scsi-build-test-unit-ready ( cdb -- ) dup scsi-length-test-unit-ready erase ( cdb ) scsi-param-control swap test-unit-ready>control c! ( ) scsi-length-test-unit-ready to scsi-param-size \ update CDB length ; 03 CONSTANT scsi-cmd-request-sense STRUCT /c FIELD request-sense>operation-code \ 03h 3 FIELD request-sense>reserved \ unused /c FIELD request-sense>allocation-length \ buffer-length for data response /c FIELD request-sense>control \ control byte as specified in SAM-4 CONSTANT scsi-length-request-sense : scsi-build-request-sense ( alloc-len cdb -- ) >r ( alloc-len ) ( R: -- cdb ) r@ scsi-length-request-sense erase ( alloc-len ) scsi-cmd-request-sense r@ ( alloc-len cmd cdb ) request-sense>operation-code c! ( alloc-len ) dup d# 252 > \ buffer length too big ? IF scsi-inc-errors drop d# 252 \ replace with 252 ELSE dup d# 18 < \ allocated buffer too small ? IF scsi-inc-errors drop 0 \ reject return data THEN THEN ( alloclen ) r@ request-sense>allocation-length c! ( ) scsi-param-control r> request-sense>control c! ( alloc-len cdb ) ( R: cdb -- ) scsi-length-request-sense to scsi-param-size \ update CDB length ; 70 CONSTANT scsi-response(request-sense-0) 71 CONSTANT scsi-response(request-sense-1) STRUCT /c FIELD sense-data>response-code \ 70h (current errors) or 71h (deferred errors) /c FIELD sense-data>obsolete /c FIELD sense-data>sense-key \ D3..D0 = sense key, D7 = EndOfMedium /l FIELD sense-data>info /c FIELD sense-data>alloc-length \ <= 244 (for max size) /l FIELD sense-data>command-info /c FIELD sense-data>asc \ additional sense key /c FIELD sense-data>ascq \ additional sense key qualifier /c FIELD sense-data>unit-code 3 FIELD sense-data>key-specific /c FIELD sense-data>add-sense-bytes \ start of appended extra bytes CONSTANT scsi-length-sense-data : scsi-get-sense-data ( addr -- ascq asc sense-key ) >r ( R: -- addr ) r@ sense-data>response-code c@ 7f and 72 >= IF r@ 3 + c@ ( ascq ) r@ 2 + c@ ( ascq asc ) r> 1 + c@ 0f and ( ascq asc sense-key ) ELSE r@ sense-data>ASCQ c@ ( ascq ) r@ sense-data>ASC c@ ( ascq asc ) r> sense-data>sense-key c@ 0f and ( ascq asc sense-key ) ( R: addr -- ) THEN ; : scsi-get-sense-data? ( addr -- false | ascq asc sense-key true ) dup sense-data>response-code c@ 7e AND 70 = \ Response code (some devices have MSB set) IF scsi-get-sense-data TRUE ELSE drop FALSE \ drop addr THEN ; : scsi-get-sense-ID? ( addr -- false | ascq asc sense-key true ) dup sense-data>response-code c@ 7e AND 70 = \ Response code (some devices have MSB set) IF scsi-get-sense-data ( ascq asc sense-key ) 10 lshift ( ascq asc sense-key16 ) swap 8 lshift or ( ascq sense-key+asc ) swap or \ 24-bit sense-ID ( sense-key+asc+ascq ) TRUE ELSE drop FALSE \ drop addr THEN ; 12 CONSTANT scsi-cmd-inquiry STRUCT /c FIELD inquiry>operation-code \ 0x12 /c FIELD inquiry>reserved \ + EVPD-Bit (vital product data) /c FIELD inquiry>page-code \ page code for vital product data (if used) /w FIELD inquiry>allocation-length \ length of Data-In-Buffer /c FIELD inquiry>control \ control byte as specified in SAM-4 CONSTANT scsi-length-inquiry : scsi-build-inquiry ( alloc-len cdb -- ) dup scsi-length-inquiry erase \ 6 bytes CDB scsi-cmd-inquiry over ( alloc-len cdb cmd cdb ) inquiry>operation-code c! ( alloc-len cdb ) scsi-param-control over inquiry>control c! ( alloc-len cdb ) inquiry>allocation-length w! \ size of Data-In Buffer scsi-length-inquiry to scsi-param-size \ update CDB length ; STRUCT /c FIELD inquiry-data>peripheral \ qualifier and device type /c FIELD inquiry-data>reserved1 /c FIELD inquiry-data>version \ supported SCSI version (1,2,3) /c FIELD inquiry-data>data-format /c FIELD inquiry-data>add-length \ total block length - 4 /c FIELD inquiry-data>flags1 /c FIELD inquiry-data>flags2 /c FIELD inquiry-data>flags3 d# 8 FIELD inquiry-data>vendor-ident \ vendor string d# 16 FIELD inquiry-data>product-ident \ device string /l FIELD inquiry-data>product-revision \ revision string d# 20 FIELD inquiry-data>vendor-specific \ optional params CONSTANT scsi-length-inquiry-data 25 CONSTANT scsi-cmd-read-capacity-10 \ command code STRUCT \ SCSI 10-byte CDB structure /c FIELD read-cap-10>operation-code /c FIELD read-cap-10>reserved1 /l FIELD read-cap-10>lba /w FIELD read-cap-10>reserved2 /c FIELD read-cap-10>reserved3 /c FIELD read-cap-10>control CONSTANT scsi-length-read-cap-10 : scsi-build-read-cap-10 ( cdb -- ) dup scsi-length-read-cap-10 erase ( cdb ) scsi-cmd-read-capacity-10 over ( cdb cmd cdb ) read-cap-10>operation-code c! ( cdb ) scsi-param-control swap read-cap-10>control c! ( ) scsi-length-read-cap-10 to scsi-param-size \ update CDB length ; STRUCT /l FIELD read-cap-10-data>max-lba /l FIELD read-cap-10-data>block-size CONSTANT scsi-length-read-cap-10-data : scsi-get-capacity-10 ( addr -- block-size #blocks ) >r ( addr -- ) ( R: -- addr ) r@ read-cap-10-data>block-size l@ ( block-size ) r> read-cap-10-data>max-lba l@ ( block-size #blocks ) ( R: addr -- ) ; 9e CONSTANT scsi-cmd-read-capacity-16 \ command code STRUCT \ SCSI 16-byte CDB structure /c FIELD read-cap-16>operation-code /c FIELD read-cap-16>service-action /l FIELD read-cap-16>lba-high /l FIELD read-cap-16>lba-low /l FIELD read-cap-16>allocation-length \ should be 32 /c FIELD read-cap-16>reserved /c FIELD read-cap-16>control CONSTANT scsi-length-read-cap-16 : scsi-build-read-cap-16 ( cdb -- ) >r r@ ( R: -- cdb ) scsi-length-read-cap-16 erase ( ) scsi-cmd-read-capacity-16 ( code ) r@ read-cap-16>operation-code c! ( ) 10 r@ read-cap-16>service-action c! d# 32 \ response size 32 bytes r@ read-cap-16>allocation-length l! ( ) scsi-param-control r> read-cap-16>control c! ( R: cdb -- ) scsi-length-read-cap-16 to scsi-param-size \ update CDB length ; STRUCT /l FIELD read-cap-16-data>max-lba-high \ upper quadlet of Max-LBA /l FIELD read-cap-16-data>max-lba-low \ lower quadlet of Max-LBA /l FIELD read-cap-16-data>block-size \ logical block length in bytes /c FIELD read-cap-16-data>protect \ type of protection (4 bits) /c FIELD read-cap-16-data>exponent \ logical blocks per physical blocks /w FIELD read-cap-16-data>lowest-aligned \ first LBA of a phsy. block 10 FIELD read-cap-16-data>reserved \ 16 reserved bytes CONSTANT scsi-length-read-cap-16-data \ results in 32 : scsi-get-capacity-16 ( addr -- block-size #blocks ) >r ( R: -- addr ) r@ read-cap-16-data>block-size l@ ( block-size ) r@ read-cap-16-data>max-lba-high l@ ( block-size #blocks-high ) d# 32 lshift ( block-size #blocks-upper ) r> read-cap-16-data>max-lba-low l@ + ( block-size #blocks ) ( R: addr -- ) ; 5a CONSTANT scsi-cmd-mode-sense-10 STRUCT /c FIELD mode-sense-10>operation-code /c FIELD mode-sense-10>res-llbaa-dbd-res /c FIELD mode-sense-10>pc-page-code \ page code + page control /c FIELD mode-sense-10>sub-page-code 3 FIELD mode-sense-10>reserved2 /w FIELD mode-sense-10>allocation-length /c FIELD mode-sense-10>control CONSTANT scsi-length-mode-sense-10 : scsi-build-mode-sense-10 ( alloc-len subpage page cdb -- ) >r ( alloc-len subpage page ) ( R: -- cdb ) r@ scsi-length-mode-sense-10 erase \ 10 bytes CDB scsi-cmd-mode-sense-10 ( alloc-len subpage page cmd ) r@ mode-sense-10>operation-code c! ( alloc-len subpage page ) 10 r@ mode-sense-10>res-llbaa-dbd-res c! \ long LBAs accepted r@ mode-sense-10>pc-page-code c! ( alloc-len subpage ) r@ mode-sense-10>sub-page-code c! ( alloc-len ) r@ mode-sense-10>allocation-length w! ( ) scsi-param-control r> mode-sense-10>control c! ( R: cdb -- ) scsi-length-mode-sense-10 to scsi-param-size \ update CDB length ; STRUCT /w FIELD mode-sense-10-data>head-length /c FIELD mode-sense-10-data>head-medium /c FIELD mode-sense-10-data>head-param /c FIELD mode-sense-10-data>head-longlba /c FIELD mode-sense-10-data>head-reserved /w FIELD mode-sense-10-data>head-descr-len CONSTANT scsi-length-mode-sense-10-data : .mode-sense-data ( addr -- ) cr dup mode-sense-10-data>head-length w@ ." Mode Length: " .d space dup mode-sense-10-data>head-medium c@ ." / Medium Type: " .d space dup mode-sense-10-data>head-longlba c@ ." / Long LBA: " .d space mode-sense-10-data>head-descr-len w@ ." / Descr. Length: " .d ; 08 CONSTANT scsi-cmd-read-6 STRUCT /c FIELD read-6>operation-code \ 08h /c FIELD read-6>block-address-msb \ upper 5 bits /w FIELD read-6>block-address \ lower 16 bits /c FIELD read-6>length \ number of blocks to read /c FIELD read-6>control \ CDB control CONSTANT scsi-length-read-6 : scsi-build-read-6 ( block# #blocks cdb -- ) >r ( block# #blocks ) ( R: -- cdb ) r@ scsi-length-read-6 erase \ 6 bytes CDB scsi-cmd-read-6 r@ read-6>operation-code c! ( block# #blocks ) dup d# 255 > \ #blocks exceeded limit ? IF scsi-inc-errors drop 1 \ replace with any valid number THEN r@ read-6>length c! \ set #blocks to read dup 1fffff > \ check address upper limit IF scsi-inc-errors drop \ remove original block# 1fffff \ replace with any valid address THEN dup d# 16 rshift r@ read-6>block-address-msb c! \ set upper 5 bits ffff and r@ read-6>block-address w! \ set lower 16 bits scsi-param-control r> read-6>control c! ( R: cdb -- ) scsi-length-read-6 to scsi-param-size \ update CDB length ; 28 CONSTANT scsi-cmd-read-10 STRUCT /c FIELD read-10>operation-code /c FIELD read-10>protect /l FIELD read-10>block-address \ logical block address (32bits) /c FIELD read-10>group /w FIELD read-10>length \ transfer length (16-bits) /c FIELD read-10>control CONSTANT scsi-length-read-10 : scsi-build-read-10 ( block# #blocks cdb -- ) >r ( block# #blocks ) ( R: -- cdb ) r@ scsi-length-read-10 erase \ 10 bytes CDB scsi-cmd-read-10 r@ read-10>operation-code c! ( block# #blocks ) r@ read-10>length w! ( block# ) r@ read-10>block-address l! ( ) scsi-param-control r> read-10>control c! ( R: cdb -- ) scsi-length-read-10 to scsi-param-size \ update CDB length ; a8 CONSTANT scsi-cmd-read-12 STRUCT /c FIELD read-12>operation-code \ code: a8 /c FIELD read-12>protect \ RDPROTECT, DPO, FUA, FUA_NV /l FIELD read-12>block-address \ lba /l FIELD read-12>length \ transfer length (32bits) /c FIELD read-12>group \ group number /c FIELD read-12>control CONSTANT scsi-length-read-12 : scsi-build-read-12 ( block# #blocks cdb -- ) >r ( block# #blocks ) ( R: -- cdb ) r@ scsi-length-read-12 erase \ 12 bytes CDB scsi-cmd-read-12 r@ read-12>operation-code c! ( block# #blocks ) r@ read-12>length l! ( block# ) r@ read-12>block-address l! ( ) scsi-param-control r> read-12>control c! ( R: cdb -- ) scsi-length-read-12 to scsi-param-size \ update CDB length ; : scsi-build-read? ( block# #blocks cdb -- length ) over ( block# #blocks cdb #blocks ) fffe > \ tx-length (#blocks) exceeds 16-bit limit ? IF scsi-build-read-12 ( block# #blocks cdb -- ) scsi-length-read-12 ( length ) ELSE ( block# #blocks cdb ) scsi-build-read-10 ( block# #blocks cdb -- ) scsi-length-read-10 ( length ) THEN ; 1b CONSTANT scsi-cmd-start-stop-unit STRUCT /c FIELD start-stop-unit>operation-code /c FIELD start-stop-unit>immed /w FIELD start-stop-unit>reserved /c FIELD start-stop-unit>pow-condition /c FIELD start-stop-unit>control CONSTANT scsi-length-start-stop-unit f1 CONSTANT scsi-const-active-power \ param used for start-stop-unit f2 CONSTANT scsi-const-idle-power \ param used for start-stop-unit f3 CONSTANT scsi-const-standby-power \ param used for start-stop-unit 3 CONSTANT scsi-const-load \ param used for start-stop-unit 2 CONSTANT scsi-const-eject \ param used for start-stop-unit 1 CONSTANT scsi-const-start 0 CONSTANT scsi-const-stop : scsi-build-start-stop-unit ( state# cdb -- ) >r ( state# ) ( R: -- cdb ) r@ scsi-length-start-stop-unit erase \ 6 bytes CDB scsi-cmd-start-stop-unit r@ start-stop-unit>operation-code c! dup 3 > IF 4 lshift \ shift to upper nibble THEN ( state ) r@ start-stop-unit>pow-condition c! ( ) scsi-param-control r> start-stop-unit>control c! ( R: cdb -- ) scsi-length-start-stop-unit to scsi-param-size \ update CDB length ; 2b CONSTANT scsi-cmd-seek STRUCT /c FIELD seek>operation-code /c FIELD seek>reserved1 /l FIELD seek>lba 3 FIELD seek>reserved2 /c FIELD seek>control CONSTANT scsi-length-seek : scsi-build-seek ( lba cdb -- ) >r ( lba ) ( R: -- cdb ) r@ scsi-length-seek erase \ 10 bytes CDB scsi-cmd-seek r@ seek>operation-code c! r> seek>lba l! ( ) ( R: cdb -- ) scsi-length-seek to scsi-param-size \ update CDB length ; STRUCT /w FIELD media-event-data-len /c FIELD media-event-nea-class /c FIELD media-event-supp-class /l FIELD media-event-data CONSTANT scsi-length-media-event : scsi-build-get-media-event ( cdb -- ) dup c erase ( cdb ) 4a over c! ( cdb ) 01 over 1 + c! 10 over 4 + c! 08 over 8 + c! drop ; : .sense-text ( scode -- ) case 0 OF s" OK" ENDOF 1 OF s" RECOVERED ERR" ENDOF 2 OF s" NOT READY" ENDOF 3 OF s" MEDIUM ERROR" ENDOF 4 OF s" HARDWARE ERR" ENDOF 5 OF s" ILLEGAL REQUEST" ENDOF 6 OF s" UNIT ATTENTION" ENDOF 7 OF s" DATA PROTECT" ENDOF 8 OF s" BLANK CHECK" ENDOF 9 OF s" VENDOR SPECIFIC" ENDOF a OF s" COPY ABORTED" ENDOF b OF s" ABORTED COMMAND" ENDOF d OF s" VOLUME OVERFLOW" ENDOF e OF s" MISCOMPARE" ENDOF dup OF s" UNKNOWN" ENDOF endcase 5b emit type 5d emit ; : .status-text ( stat -- ) case 00 OF s" GOOD" ENDOF 02 OF s" CHECK CONDITION" ENDOF 04 OF s" CONDITION MET" ENDOF 08 OF s" BUSY" ENDOF 18 OF s" RESERVATION CONFLICT" ENDOF 28 OF s" TASK SET FULL" ENDOF 30 OF s" ACA ACTIVE" ENDOF 40 OF s" TASK ABORTED" ENDOF dup OF s" UNKNOWN" ENDOF endcase 5b emit type 5d emit ; : .dec3-2 ( prenum postnum -- ) swap base @ >r \ save actual base setting decimal \ show decimal values 4 .r 2e emit dup 9 <= IF 30 emit THEN .d \ 3 pre-decimal, right aligned r> base ! \ restore base ; : .capacity-text ( block-size #blocks -- ) scsi-param-debug \ debugging flag set ? IF \ show additional info 2dup cr ." LBAs: " .d \ highest logical block number ." / Block-Size: " .d ." / Total Capacity: " THEN * \ calculate total capacity dup d# 1000000000000 >= \ check terabyte limit IF d# 1000000000000 /mod swap d# 10000000000 / \ limit remainder to two digits .dec3-2 ." TB" \ show terabytes as xxx.yy ELSE dup d# 1000000000 >= \ check gigabyte limit IF d# 1000000000 /mod swap d# 10000000 / .dec3-2 ." GB" \ show gigabytes as xxx.yy ELSE dup d# 1000000 >= IF d# 1000000 /mod \ check mega byte limit swap d# 10000 / .dec3-2 ." MB" \ show megabytes as xxx.yy ELSE dup d# 1000 >= \ check kilo byte limit IF d# 1000 /mod swap d# 10 / .dec3-2 ." kB" ELSE .d ." Bytes" THEN THEN THEN THEN ; : .inquiry-text ( addr -- ) 22 emit \ enclose text with " dup inquiry-data>vendor-ident 8 type space dup inquiry-data>product-ident 10 type space inquiry-data>product-revision 4 type 22 emit ; : scsi-supp-init ( -- ) false to scsi-param-debug \ no debug strings h# 0 to scsi-param-size h# 0 to scsi-param-control \ common CDB control byte d# 0 to scsi-param-errors \ local errors (param limits) ; 0 VALUE scsi-context \ addr of word list on top : scsi-init ( -- ) also scsi-words \ append scsi word-list context to scsi-context \ save for close process scsi-supp-init \ preset all scsi-param-xxx values scsi-param-debug IF space ." SCSI-SUPPORT OPENED" cr .wordlists THEN ; : scsi-close ( -- ) scsi-param-debug IF space ." Closing SCSI-SUPPORT .. " cr THEN context scsi-context = \ scsi word list still active ? IF scsi-param-errors 0<> \ any errors occured ? IF cr ." ** WARNING: " scsi-param-errors .d ." SCSI Errors occured ** " cr THEN previous \ remove scsi word list on top 0 to scsi-context \ prevent from being misinterpreted ELSE cr ." ** WARNING: Trying to close non-open SCSI-SUPPORT (1) ** " cr THEN scsi-param-debug IF .wordlists THEN ; s" scsi-init" $find drop \ return execution pointer, when included previous \ remove scsi word list from search path definitions \ place next definitions into previous list ��y8pci-device_1af4_1000.fss" virtio [ net ]" type cr my-space pci-device-generic-setup pci-io-enable s" virtio-net.fs" included pci-device-disable ��`8pci-device_1af4_1001.fss" virtio [ block ]" type cr my-space pci-device-generic-setup pci-master-enable pci-mem-enable pci-io-enable s" virtio-block.fs" included virtiodev 0 virtio-get-qsize virtio-vring-size 1000 CLAIM VALUE queue-addr queue-addr c rshift virtiodev vd>base @ 8 + rl!-le pci-device-disable ��`8pci-device_1af4_1009.fss" virtio [ network ]" type cr my-space pci-device-generic-setup pci-master-enable pci-mem-enable pci-io-enable s" virtio-fs.fs" included virtiodev 0 virtio-get-qsize virtio-vring-size 1000 CLAIM VALUE queue-addr queue-addr c rshift virtiodev vd>base @ 8 + rl!-le pci-device-disable ��x0vio-hvterm.fs." Populating " pwd cr : open true ; : close ; : write ( adr len -- actual ) tuck 0 ?DO dup c@ my-unit SWAP hv-putchar 1 + LOOP drop ; : read ( adr len -- actual ) 0= IF drop 0 EXIT THEN my-unit hv-haschar 0= IF 0 swap c! -2 EXIT THEN my-unit hv-getchar swap c! 1 ; : setup-alias " hvterm" find-alias 0= IF " hvterm" get-node node>path set-alias ELSE drop THEN ; setup-alias ��,8+�0vio-vscsi.fs." Populating " pwd 0 CONSTANT vscsi-debug 0 VALUE vscsi-unit : l2dma ( laddr - dma_addr) ; 0 VALUE crq-base 0 VALUE crq-dma 0 VALUE crq-offset 1000 CONSTANT CRQ-SIZE CREATE crq 10 allot : crq-alloc ( -- ) CRQ-SIZE alloc-mem to crq-base 0 to crq-offset crq-base l2dma to crq-dma ; : crq-free ( -- ) vscsi-unit hv-free-crq crq-base CRQ-SIZE free-mem 0 to crq-base ; : crq-init ( -- res ) crq-alloc vscsi-debug IF ." VSCSI: allocated crq at " crq-base . cr THEN crq-base CRQ-SIZE erase vscsi-unit crq-dma CRQ-SIZE hv-reg-crq dup 0 <> IF ." VSCSI: Error " . ." registering CRQ !" cr crq-free THEN ; : crq-cleanup ( -- ) crq-base 0 = IF EXIT THEN vscsi-debug IF ." VSCSI: freeing crq at " crq-base . cr THEN crq-free ; : crq-send ( msgaddr -- true | false ) vscsi-unit swap hv-send-crq 0 = ; : crq-poll ( -- true | false) crq-offset crq-base + dup vscsi-debug IF ." VSCSI: crq poll " dup . THEN c@ vscsi-debug IF ." value=" dup . cr THEN 80 and 0 <> IF dup crq 10 move 0 swap c! crq-offset 10 + dup CRQ-SIZE >= IF drop 0 THEN to crq-offset true ELSE drop false THEN ; : crq-wait ( -- true | false) 0 BEGIN drop crq-poll dup not WHILE d# 1 ms REPEAT dup not IF ." VSCSI: Timeout waiting response !" cr EXIT ELSE vscsi-debug IF ." VSCSI: got crq: " crq dup l@ . ." " 4 + dup l@ . ." " 4 + dup l@ . ." " 4 + l@ . cr THEN THEN ; 01 CONSTANT VIOSRP_SRP_FORMAT 02 CONSTANT VIOSRP_MAD_FORMAT 03 CONSTANT VIOSRP_OS400_FORMAT 04 CONSTANT VIOSRP_AIX_FORMAT 06 CONSTANT VIOSRP_LINUX_FORMAT 07 CONSTANT VIOSRP_INLINE_FORMAT struct 1 field >crq-valid 1 field >crq-format 1 field >crq-reserved 1 field >crq-status 2 field >crq-timeout 2 field >crq-iu-len 8 field >crq-iu-data-ptr constant /crq : srp-send-crq ( addr len -- ) 80 crq >crq-valid c! VIOSRP_SRP_FORMAT crq >crq-format c! 0 crq >crq-reserved c! 0 crq >crq-status c! 0 crq >crq-timeout w! ( len ) crq >crq-iu-len w! ( addr ) l2dma crq >crq-iu-data-ptr x! crq crq-send not IF ." VSCSI: Error sending CRQ !" cr THEN ; : srp-wait-crq ( -- [tag true] | false ) crq-wait not IF false EXIT THEN crq >crq-format c@ VIOSRP_SRP_FORMAT <> IF ." VSCSI: Unsupported SRP response: " crq >crq-format c@ . cr false EXIT THEN crq >crq-iu-data-ptr x@ true ; scsi-open 0 VALUE >srp_opcode 00 CONSTANT SRP_LOGIN_REQ 01 CONSTANT SRP_TSK_MGMT 02 CONSTANT SRP_CMD 03 CONSTANT SRP_I_LOGOUT c0 CONSTANT SRP_LOGIN_RSP c1 CONSTANT SRP_RSP c2 CONSTANT SRP_LOGIN_REJ 80 CONSTANT SRP_T_LOGOUT 81 CONSTANT SRP_CRED_REQ 82 CONSTANT SRP_AER_REQ 41 CONSTANT SRP_CRED_RSP 42 CONSTANT SRP_AER_RSP 02 CONSTANT SRP_BUF_FORMAT_DIRECT 04 CONSTANT SRP_BUF_FORMAT_INDIRECT struct 1 field >srp-login-opcode 3 + 8 field >srp-login-tag 4 field >srp-login-req-it-iu-len 4 + 2 field >srp-login-req-buf-fmt 1 field >srp-login-req-flags 5 + 10 field >srp-login-init-port-ids 10 field >srp-login-trgt-port-ids constant /srp-login struct 1 field >srp-lresp-opcode 3 + 4 field >srp-lresp-req-lim-delta 8 field >srp-lresp-tag 4 field >srp-lresp-max-it-iu-len 4 field >srp-lresp-max-ti-iu-len 2 field >srp-lresp-buf-fmt 1 field >srp-lresp-flags constant /srp-login-resp struct 1 field >srp-lrej-opcode 3 + 4 field >srp-lrej-reason 8 field >srp-lrej-tag 8 + 2 field >srp-lrej-buf-fmt constant /srp-login-rej 00 CONSTANT SRP_NO_DATA_DESC 01 CONSTANT SRP_DATA_DESC_DIRECT 02 CONSTANT SRP_DATA_DESC_INDIRECT struct 1 field >srp-cmd-opcode 1 field >srp-cmd-sol-not 3 + 1 field >srp-cmd-buf-fmt 1 field >srp-cmd-dout-desc-cnt 1 field >srp-cmd-din-desc-cnt 8 field >srp-cmd-tag 4 + 8 field >srp-cmd-lun 1 + 1 field >srp-cmd-task-attr 1 + 1 field >srp-cmd-add-cdb-len 10 field >srp-cmd-cdb 0 field >srp-cmd-cdb-add constant /srp-cmd struct 1 field >srp-rsp-opcode 1 field >srp-rsp-sol-not 2 + 4 field >srp-rsp-req-lim-delta 8 field >srp-rsp-tag 2 + 1 field >srp-rsp-flags 1 field >srp-rsp-status 4 field >srp-rsp-dout-res-cnt 4 field >srp-rsp-din-res-cnt 4 field >srp-rsp-sense-len 4 field >srp-rsp-resp-len 0 field >srp-rsp-data constant /srp-rsp CREATE srp 100 allot 0 VALUE srp-len : srp-prep-cmd-nodata ( id lun -- ) srp /srp-cmd erase SRP_CMD srp >srp-cmd-opcode c! 1 srp >srp-cmd-tag x! srp >srp-cmd-lun 1 + c! \ lun 80 or \ select logical unit addressing method srp >srp-cmd-lun c! \ id /srp-cmd to srp-len ; : srp-prep-cmd-io ( addr len id lun -- ) srp-prep-cmd-nodata ( addr len ) swap l2dma ( len dmaaddr ) srp srp-len + ( len dmaaddr descaddr ) dup >r x! r> 8 + ( len descaddr+8 ) dup 0 swap l! 4 + ( len descaddr+c ) l! srp-len 10 + to srp-len ; : srp-prep-cmd-read ( addr len id lun -- ) srp-prep-cmd-io 01 srp >srp-cmd-buf-fmt c! \ in direct buffer 1 srp >srp-cmd-din-desc-cnt c! ; : srp-prep-cmd-write ( addr len id lun -- ) srp-prep-cmd-io 10 srp >srp-cmd-buf-fmt c! \ out direct buffer 1 srp >srp-cmd-dout-desc-cnt c! ; : srp-send-cmd ( -- ) vscsi-debug IF ." VSCSI: Sending SCSI cmd " srp >srp-cmd-cdb c@ . cr THEN srp srp-len srp-send-crq ; : srp-rsp-find-sense ( -- addr ) srp >srp-rsp-data ; : srp-wait-rsp ( -- true | [ ascq asc sense-key false ] ) srp-wait-crq not IF false EXIT THEN dup 1 <> IF ." VSCSI: Invalid CRQ response tag, want 1 got " . cr false EXIT THEN drop srp >srp-rsp-tag x@ dup 1 <> IF ." VSCSI: Invalid SRP response tag, want 1 got " . cr false EXIT THEN drop srp >srp-rsp-status c@ vscsi-debug IF ." VSCSI: Got response status: " dup .status-text cr THEN 0 <> IF srp-rsp-find-sense scsi-get-sense-data vscsi-debug IF ." VSCSI: Sense key: " dup .sense-text cr THEN false EXIT THEN true ; CREATE sector d# 512 allot 0 INSTANCE VALUE current-id 0 INSTANCE VALUE current-lun : test-unit-ready ( -- true | [ ascq asc sense-key false ] ) current-id current-lun srp-prep-cmd-nodata srp >srp-cmd-cdb scsi-build-test-unit-ready srp-send-cmd srp-wait-rsp ; : inquiry ( -- true | false ) sector ff current-id current-lun srp-prep-cmd-read ff srp >srp-cmd-cdb scsi-build-inquiry srp-send-cmd srp-wait-rsp dup not IF nip nip nip EXIT THEN \ swallow sense ; : read-capacity ( -- true | false ) sector scsi-length-read-cap-10 current-id current-lun srp-prep-cmd-read srp >srp-cmd-cdb scsi-build-read-cap-10 srp-send-cmd srp-wait-rsp dup not IF nip nip nip EXIT THEN \ swallow sense ; : start-stop-unit ( state# -- true | false ) current-id current-lun srp-prep-cmd-nodata srp >srp-cmd-cdb scsi-build-start-stop-unit srp-send-cmd srp-wait-rsp dup not IF nip nip nip EXIT THEN \ swallow sense ; : get-media-event ( -- true | false ) sector scsi-length-media-event current-id current-lun srp-prep-cmd-read srp >srp-cmd-cdb scsi-build-get-media-event srp-send-cmd srp-wait-rsp dup not IF nip nip nip EXIT THEN \ swallow sense ; : read-blocks ( -- addr block# #blocks blksz -- [ #read-blocks true ] | false ) over * ( addr block# #blocks len ) >r rot r> ( block# #blocks addr len ) 5 0 DO 2dup current-id current-lun srp-prep-cmd-read ( block# #blocks addr len ) 2swap ( addr len block# #blocks ) 2dup srp >srp-cmd-cdb scsi-build-read-10 ( addr len block# #blocks ) 2swap ( block# #blocks addr len ) srp-send-cmd srp-wait-rsp IF 2drop nip true UNLOOP EXIT THEN srp >srp-rsp-status c@ 8 <> IF nip nip nip 2drop 2drop false EXIT THEN 3drop 100 ms LOOP 2drop 2drop false ; : vscsi-cleanup crq-cleanup vscsi-unit 0 rtas-set-tce-bypass ; : vscsi-init ( -- true | false ) ." VSCSI: Initializing" cr " reg" get-node get-package-property IF ." VSCSI: Not reg property !!!" 0 THEN decode-int to vscsi-unit 2drop vscsi-unit 1 rtas-set-tce-bypass crq-init 0 <> IF false EXIT THEN " "(C0 01 00 00 00 00 00 00 00 00 00 00 00 00 00 00)" drop crq-send not IF ." VSCSI: Error sending init command" crq-cleanup false EXIT THEN crq-wait not IF crq-cleanup false EXIT THEN crq c@ c0 <> crq 1 + c@ 02 <> or IF ." VSCSI: Initial handshake failed" crq-cleanup false EXIT THEN ['] vscsi-cleanup add-quiesce-xt true ; : set-address ( lun id -- ) to current-id to current-lun ; : dev-max-transfer ( -- n ) 10000 \ Larger value seem to have problems with some CDROMs ; : dev-get-capacity ( -- blocksize #blocks ) sector 10 erase read-capacity not IF 0 0 EXIT THEN sector scsi-get-capacity-10 ; : dev-read-blocks ( -- addr block# #blocks blksize -- #read-blocks ) read-blocks ; : initial-test-unit-ready ( -- true | [ ascq asc sense-key false ] ) 0 0 0 false 3 0 DO 2drop 2drop test-unit-ready dup IF UNLOOP EXIT THEN LOOP ; : compare-sense ( ascq asc key ascq2 asc2 key2 -- true | false ) 3 pick = ( ascq asc key ascq2 asc2 keycmp ) swap 4 pick = ( ascq asc key ascq2 keycmp asccmp ) rot 5 pick = ( ascq asc key keycmp asccmp ascqcmp ) and and nip nip nip ; 0 CONSTANT CDROM-READY 1 CONSTANT CDROM-NOT-READY 2 CONSTANT CDROM-NO-DISK 3 CONSTANT CDROM-TRAY-OPEN 4 CONSTANT CDROM-INIT-REQUIRED 5 CONSTANT CDROM-TRAY-MAYBE-OPEN : cdrom-status ( -- status ) initial-test-unit-ready IF CDROM-READY EXIT THEN vscsi-debug IF ." TestUnitReady sense: " 3dup . . . cr THEN 3dup 1 4 2 compare-sense IF 3drop CDROM-NOT-READY EXIT THEN get-media-event IF sector w@ 4 >= IF sector 2 + c@ 04 = IF sector 5 + c@ dup 02 and 0<> IF drop 3drop CDROM-READY EXIT THEN dup 01 and 0<> IF drop 3drop CDROM-TRAY-OPEN EXIT THEN drop 3drop CDROM-NO-DISK EXIT THEN THEN THEN 3dup 2 4 2 compare-sense IF 3drop CDROM-INIT-REQUIRED EXIT THEN over 4 = over 2 = and IF 3drop CDROM-READY EXIT THEN over 3a = IF 3drop CDROM-NO-DISK EXIT THEN 3drop CDROM-TRAY-MAYBE-OPEN ; : cdrom-try-close-tray ( -- ) scsi-const-load start-stop-unit drop ; : cdrom-must-close-tray ( -- ) scsi-const-load start-stop-unit not IF ." Tray open !" cr -65 throw THEN ; : dev-prep-cdrom ( -- ) 5 0 DO cdrom-status CASE CDROM-READY OF UNLOOP EXIT ENDOF CDROM-NO-DISK OF ." No medium !" cr -65 THROW ENDOF CDROM-TRAY-OPEN OF cdrom-must-close-tray ENDOF CDROM-INIT-REQUIRED OF cdrom-try-close-tray ENDOF CDROM-TRAY-MAYBE-OPEN OF cdrom-try-close-tray ENDOF ENDCASE d# 1000 ms LOOP ." Drive not ready !" cr -65 THROW ; : dev-prep-disk ( -- ) initial-test-unit-ready 0= IF ." Disk not ready!" cr 3drop THEN ; : vscsi-create-disk ( lun id -- ) " disk" 0 " vio-vscsi-device.fs" included ; : vscsi-create-cdrom ( lun id -- ) " cdrom" 1 " vio-vscsi-device.fs" included ; : wrapped-inquiry ( -- true | false ) inquiry not IF false EXIT THEN sector inquiry-data>peripheral c@ e0 and 0 = ; 8 CONSTANT #dev : vscsi-find-disks ( -- ) ." VSCSI: Looking for disks" cr #dev 0 DO \ check 8 devices (no LUNs) 0 i set-address wrapped-inquiry IF ." SCSI ID " i . sector inquiry-data>peripheral c@ CASE 0 OF ." DISK : " 0 i vscsi-create-disk ENDOF 5 OF ." CD-ROM : " 0 i vscsi-create-cdrom ENDOF 7 OF ." OPTICAL : " 0 i vscsi-create-cdrom ENDOF e OF ." RED-BLOCK: " 0 i vscsi-create-disk ENDOF dup dup OF ." ? (" . 8 emit 29 emit 5 spaces ENDOF ENDCASE sector .inquiry-text cr THEN LOOP ; scsi-close : setup-alias " scsi" find-alias 0= IF " scsi" get-node node>path set-alias ELSE drop THEN ; : vscsi-init-and-scan ( -- ) 0 0 get-node open-node ?dup 0= IF EXIT THEN my-self >r dup to my-self vscsi-init IF vscsi-find-disks setup-alias THEN close-node r> to my-self ; vscsi-init-and-scan ��_8vio-vscsi-device.fsnew-device VALUE is_cdrom 2swap ( $name lun id ) 2dup set-unit encode-phys " reg" property 2dup device-name 2dup find-alias 0= IF get-node node>path set-alias ELSE 3drop THEN s" block" device-type 0 INSTANCE VALUE block-size 0 INSTANCE VALUE max-block-num 0 INSTANCE VALUE max-transfer : read-blocks ( addr block# #blocks -- #read ) block-size " dev-read-blocks" $call-parent not IF ." Read blocks failed !" cr -1 throw THEN ; INSTANCE VARIABLE deblocker : open ( -- true | false ) my-unit " set-address" $call-parent is_cdrom IF " dev-prep-cdrom" ELSE " dev-prep-disk" THEN $call-parent " dev-max-transfer" $call-parent to max-transfer " dev-get-capacity" $call-parent to max-block-num to block-size max-block-num 0= block-size 0= OR IF ." Failed to get disk capacity!" cr FALSE EXIT THEN 0 0 " deblocker" $open-package dup deblocker ! dup IF " disk-label" find-package IF my-args rot interpose THEN THEN 0<> ; : close ( -- ) deblocker @ close-package ; : seek ( pos.lo pos.hi -- status ) s" seek" deblocker @ $call-method ; : read ( addr len -- actual ) s" read" deblocker @ $call-method ; finish-device ��@0vio-veth.fs." Populating " pwd cr " network" device-type INSTANCE VARIABLE obp-tftp-package : open ( -- okay? ) my-unit 1 rtas-set-tce-bypass my-args s" obp-tftp" $open-package obp-tftp-package ! true ; : close ( -- ) s" close" obp-tftp-package @ $call-method my-unit 0 rtas-set-tce-bypass ; : load ( addr -- len ) s" load" obp-tftp-package @ $call-method ; : ping ( -- ) s" ping" obp-tftp-package @ $call-method ; : setup-alias " net" find-alias 0= IF " net" get-node node>path set-alias ELSE drop THEN ; setup-alias ��0virtio-net.fss" network" device-type INSTANCE VARIABLE obp-tftp-package /vd-len BUFFER: virtiodev virtiodev virtio-setup-vd : open ( -- okay? ) open IF my-args s" obp-tftp" $open-package obp-tftp-package ! true ELSE false THEN ; : close ( -- ) s" close" obp-tftp-package @ $call-method close ; : load ( addr -- len ) s" load" obp-tftp-package @ $call-method ; : ping ( -- ) s" ping" obp-tftp-package @ $call-method ; 6 BUFFER: local-mac : setup-mac ( -- ) 6 0 DO virtiodev i 1 virtio-get-config local-mac i + c! LOOP local-mac 6 encode-bytes s" local-mac-address" property ; setup-mac : setup-alias ( -- ) s" net" find-alias 0= IF s" net" get-node node>path set-alias ELSE drop THEN ; setup-alias ��0virtio-block.fss" block" device-type FALSE VALUE initialized? 200 CONSTANT block-size 8000 CONSTANT max-transfer INSTANCE VARIABLE deblocker /vd-len BUFFER: virtiodev virtiodev virtio-setup-vd : shutdown ( -- ) virtiodev virtio-blk-shutdown FALSE to initialized? ; : init ( -- ) virtiodev virtio-blk-init TRUE to initialized? ['] shutdown add-quiesce-xt ; : read-blocks ( addr block# #blocks -- #read ) virtiodev virtio-blk-read ; : open ( -- okay? ) open 0= IF false EXIT THEN 0 0 s" deblocker" $open-package dup deblocker ! dup IF s" disk-label" find-package IF my-args rot interpose THEN THEN dup initialized? 0= AND IF init THEN 0<> ; : close ( -- ) deblocker @ close-package close ; : seek ( pos.lo pos.hi -- status ) s" seek" deblocker @ $call-method ; : read ( addr len -- actual ) s" read" deblocker @ $call-method ; : (set-alias) s" disk" find-alias 0= IF s" disk" get-node node>path set-alias ELSE drop THEN ; (set-alias) ��H 0virtio-fs.fs." Populating " pwd cr s" network" device-type 0 VALUE virtfs-rx-buffer 0 VALUE virtfs-tx-buffer FALSE VALUE initialized? 2000 CONSTANT VIRTFS-BUF-SIZE \ 8k /vd-len BUFFER: virtiodev virtiodev virtio-setup-vd : shutdown ( -- ) initialized? 0= IF EXIT THEN virtiodev virtio-fs-shutdown virtfs-rx-buffer VIRTFS-BUF-SIZE free-mem virtfs-tx-buffer VIRTFS-BUF-SIZE free-mem FALSE to initialized? ; : init ( -- success ) VIRTFS-BUF-SIZE alloc-mem to virtfs-rx-buffer VIRTFS-BUF-SIZE alloc-mem to virtfs-tx-buffer virtiodev ( dev ) virtfs-tx-buffer ( dev tx ) virtfs-rx-buffer ( reg tx rx ) VIRTFS-BUF-SIZE ( reg tx rx size ) virtio-fs-init ( success ) dup IF TRUE to initialized? ['] shutdown add-quiesce-xt THEN ; : open ( -- okay? ) open 0= IF false EXIT THEN initialized? 0= IF init 0= IF false EXIT THEN THEN true ; : load ( addr -- len ) virtiodev swap ( dev addr ) my-args ( dev addr str strlen ) 1 + \ hack to make the following allocate 1 more byte \-to-/ \ convert path elements 1 - 2dup + 0 swap c! drop virtio-fs-load ( length ) ; : close ( -- ) initialized? IF shutdown THEN close ; : ping ( -- ) cr s" ping not supported for this device" type cr cr ; : (set-alias) " virtfs" find-alias 0= IF " virtfs" get-node node>path set-alias ELSE THEN ; (set-alias) ��F0build_info.imgprintf t[CC]t%sn build_info.img; /opt/cross/gcc-4.4.5-nolibc/powerpc64-linux/bin/powerpc64-linux-gcc -m64 Using built-in specs. Target: powerpc64-linux Configured with: /home/tony/buildall/src/gcc/configure --target=powerpc64-linux --enable-targets=all --prefix=/home/tony/buildall/cross.x86_64/gcc-4.4.5-nolibc/powerpc64-linux/ --enable-languages=c --with-newlib --without-headers --with-system-libunwind --disable-nls --disable-threads --disable-shared --disable-libmudflap --disable-libssp --disable-libgomp --disable-decimal-float --enable-checking=release --with-mpfr=/home/tony/buildall/src/sys-x86_64 --with-gmp=/home/tony/buildall/src/sys-x86_64 --disable-bootstrap Thread model: single gcc version 4.4.5 (GCC) GNU ld (GNU Binutils) 2.20.1.20100303 Supported emulations: elf64ppc elf32ppclinux elf32ppc elf32ppcsim ��Ը

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