F.I.G. Forth

* FIG FORTH FOR SERIES-16 MACHINES PAGE 44

1772 * **** 0< **** 1773 * ( N --- N ) 1774 * HEAD FNUL,0<,ZLES 1775 001432 TLNK SET * 1776 01432 001260 VFD 1,0,1,FNUL,6,2,8,'260 1777 * =<FNUL,2>,'0' 1778 01433 036000 VFD 8,'074 ='<' 1779 01434 0 001420 DAC LINK 1780 001432 LINK SET TLNK 1781 001435 ZLES EQU * 1782 01435 1 02 00001 LDA 1,1 1783 01436 101400 SMI 1784 01437 0 01 01430 JMP ZEQ0 1785 01440 0 01 01426 JMP ZEQ1 1786 * 1787 * **** + **** 1788 * ( N N --- N ) 1789 * HEAD FNUL,+,PLUS 1790 001441 TLNK SET * 1791 01441 000453 VFD 1,0,1,FNUL,6,1,8,'053 1792 * =<FNUL,1>,'+' 1793 01442 0 001432 DAC LINK 1794 001441 LINK SET TLNK 1795 001443 PLUS EQU * 1796 01443 1 02 00001 LDA 1,1 1797 01444 1 06 00002 ADD 2,1 1798 01445 0 01 00124 JMP BINA 1799 * 1800 * **** D+ **** 1801 * ( D D --- D ) 1802 * HEAD FNUL,D+,DPLS 1803 001446 TLNK SET * 1804 01446 001304 VFD 1,0,1,FNUL,6,2,8,'304 1805 * =<FNUL,2>,'D' 1806 01447 025400 VFD 8,'053 ='+' 1807 01450 0 001441 DAC LINK 1808 001446 LINK SET TLNK 1809 001451 DPLS EQU * 1810 01451 1 02 00004 LDA 4,1 ADD LOWER WORDS 1811 01452 1 06 00002 ADD 2,1 1812 01453 1 13 00004 IMA 4,1 GET BACK FIRST INPUT, SAVE SUM 1813 01454 100001 SRC CARRY (OVERFLOW!) SET? 1814 01455 140024 CHS YES - XOR IT INTO MSB 1815 01456 1 05 00002 ERA 2,1 XOR IN SECOND 1816 01457 1 05 00004 ERA 4,1 XOR IN SUM 1817 * TOP BIT IS NOW CARRY 1818 01460 140320 CSA PLACE IN CARRY 1819 01461 1 02 00003 LDA 3,1 ADD UPPER WORDS 1820 01462 141216 ACA CARRY FROM LOWER 1821 01463 1 06 00001 ADD 1,1