Source code for fig-forth-68000
Revision | 3f1a4274944559b7e0e8b82ddd019a3be5528fc9 (tree) |
---|---|
Time | 2023-01-20 21:54:29 |
Author | Joel Matthew Rees <joel.rees@gmai...> |
Commiter | Joel Matthew Rees |
variations on two loops
@@ -608,8 +608,6 @@ ZBYES MOVE.L (IP)+,D0 | ||
608 | 608 | |
609 | 609 | * ######>> screen 16 << |
610 | 610 | |
611 | -******* Continue from the LOOP variables ******** | |
612 | - | |
613 | 611 | * ======>> 6 << |
614 | 612 | * ( --- ) ( limit index *** limit index+1) C |
615 | 613 | * ( limit index *** ) |
@@ -633,7 +631,7 @@ XLOOP DC.L *+NATWID | ||
633 | 631 | MOVEQ #1,D0 ; Borrowing from BIF-6809. |
634 | 632 | XLOOPA ADD.L (RP),D0 ; No return address to dodge. |
635 | 633 | MOVE.L D0,(RP) |
636 | - SUB.L NATWID(RP),D0 | |
634 | + SUB.L NATWID(RP),D0 ; Here's why we want the new count in a register. | |
637 | 635 | BMI.S ZBYES ; pseudo-signed-unsigned |
638 | 636 | XLOOPN LEA NATWID(IP),IP |
639 | 637 | LEA 2*NATWID(RP),RP ; Clean up the index and limit. |
@@ -650,6 +648,25 @@ AXLUPN LEA NATWID(IP),IP | ||
650 | 648 | MOVEM.L (RP)+,LUPLIM/LUPCT ; restore possible outer loop controls |
651 | 649 | BRA.W NEXT |
652 | 650 | * |
651 | +* DXLUP DC.L *+NATWID | |
652 | +* MOVEQ #1,D0 ; Borrowing from BIF-6809. | |
653 | +* DXLUPA ADD.L D0,(RP) ; No return address to dodge. | |
654 | +* MOVE.L NATWID(RP),D0 | |
655 | +* CMP.L D0,(RP) ; Here's why we wanted the new count in a register. | |
656 | +* BMI.S ZBYES ; pseudo-signed-unsigned | |
657 | +* DXLUPN LEA NATWID(IP),IP | |
658 | +* LEA 2*NATWID(RP),RP ; Clean up the index and limit. | |
659 | +* BRA.W NEXT | |
660 | +* | |
661 | +RXLUP DC.L *+NATWID | |
662 | + MOVE.L #1,-(PSP) ; Inc value on stack | |
663 | +RXLUPA ADD.L (PSP)+,LUPCT | |
664 | + CMP.L LUPLIM,LUPCT | |
665 | + BMI.S ZBYES ; pseudo-signed-unsigned | |
666 | +RXLUPN LEA NATWID(IP),IP | |
667 | + MOVEM.L (RP)+,LUPLIM/LUPCT ; restore possible outer loop controls | |
668 | + BRA.W NEXT | |
669 | +* | |
653 | 670 | * ======>> 7 << |
654 | 671 | * ( n --- ) ( limit index *** limit index+n ) C |
655 | 672 | * ( limit index *** ) |
@@ -687,6 +704,14 @@ AXPLUP DC.L *+NATWID ; Loop counter and limit in registers. | ||
687 | 704 | BPL.S ZBYES ; pseudo-signed-unsigned |
688 | 705 | BRA.S AXLUPN ; This path might be less time-sensitive. |
689 | 706 | * |
707 | +RXPLUP DC.L *+NATWID ; Loop counter and limit in registers. | |
708 | + TST.L (PSP) | |
709 | + BPL.S RXLUPA ; Steal plain loop code for forward count. | |
710 | + ADD.L D0,LUPCT | |
711 | + CMP.L LUPLIM,LUPCT | |
712 | + BPL.S ZBYES ; pseudo-signed-unsigned | |
713 | + BRA.S AXLUPN ; This path might be less time-sensitive. | |
714 | +* | |
690 | 715 | * ######>> screen 17 << |
691 | 716 | * ======>> 8 << |
692 | 717 | * ( limit index --- ) ( *** limit index ) |
@@ -716,16 +741,83 @@ AXDO DC.L *+NATWID ; This is the alternate register RUNTIME DO, not the COMPILIN | ||
716 | 741 | DC.B 'I'|$80 I |
717 | 742 | DC.L XDO-5-NATWID |
718 | 743 | I DC.L *+NATWID |
719 | - MOVE.L (RP),D0 ; No return address to dodge. | |
720 | - MOVE.L D0,-(PSP) | |
744 | + MOVE.L (RP),-(PSP) ; No return address to dodge. | |
721 | 745 | BRA.W NEXT |
722 | 746 | * |
723 | 747 | * This is NOT a synonym for R. |
724 | 748 | ALTI DC.L *+NATWID |
725 | 749 | MOVE.L LUPCT,-(PSP) ; nothing to dodge |
726 | 750 | BRA.W NEXT |
727 | - | |
728 | - | |
751 | +* | |
752 | +* ######>> screen 25 << | |
753 | +* ======>> 20 << | |
754 | +* ( n1 n2 --- n ) | |
755 | +* Bitwise and the top two integers. | |
756 | + EVEN | |
757 | + DC.B $83 | |
758 | + DC.B 'AN' ; 'AND' | |
759 | + DC.B "D"|$80 | |
760 | + DC.L I-2-NATWIDTH ; ***** debug link ***** | |
761 | +* DC.L USLASH-3-NATWID ; correct link | |
762 | +AND DC.L *+NATWID | |
763 | + MOVE.L (PSP)+,D0 | |
764 | + AND.L D0,(PSP) | |
765 | + BRA.W NEXT | |
766 | +* | |
767 | +* ======>> 21 << | |
768 | +* ( n1 n2 --- n ) | |
769 | +* Bitwise or the top two integers. | |
770 | + EVEN | |
771 | + DC.B 0 | |
772 | + DC.B $82 | |
773 | + DC.B 'O' ; 'OR' | |
774 | + DC.B 'R'|$80 | |
775 | + DC.L AND-4-NATWID | |
776 | +OR DC.L *+NATWID | |
777 | + MOVE.L (PSP)+,D0 | |
778 | + OR.L D0,(PSP) | |
779 | + BRA.W NEXT | |
780 | +* | |
781 | +* ======>> 22 << | |
782 | +* ( n1 n2 --- n ) | |
783 | +* Bitwise exclusive or the top two integers. | |
784 | + EVEN | |
785 | + DC.B $83 | |
786 | + DC.B 'XO' ; 'XOR' | |
787 | + DC.B 'R'|$80 | |
788 | + DC.L OR-3-NATWID | |
789 | +XOR DC.L *+NATWID | |
790 | + MOVE.L (PSP)+,D0 | |
791 | + EOR.L D0,(PSP) | |
792 | + BRA.W NEXT | |
793 | +* | |
794 | +* ######>> screen 26 << | |
795 | +* ======>> 23 << | |
796 | +* ( --- adr ) | |
797 | +* Fetch the parameter stack pointer (before it is pushed). | |
798 | +* This points at whatever was on the top of stack before. | |
799 | + EVEN | |
800 | + DC.B $83 | |
801 | + DC.B 'SP' ; 'SP@' | |
802 | + DC.B '@'|$80 | |
803 | + DC.L XOR-4-NATWID | |
804 | +SPAT DC.L *+NATWID | |
805 | + MOVE.L PSP,-(PSP) | |
806 | + BRA.W NEXT | |
807 | +* | |
808 | +* ======>> 24 << | |
809 | +* ( whatever --- nothing ) | |
810 | +* Initialize the parameter stack pointer from the USER variable S0. | |
811 | +* Effectively clears the stack. | |
812 | + EVEN | |
813 | + DC.B $83 | |
814 | + DC.B 'SP' ; 'SP!' | |
815 | + DC.B $A1 | |
816 | + DC.L SPAT-4-NATWID | |
817 | +SPSTOR DC.L *+NATWID | |
818 | + MOVE.L XSPZER-UORIG(UP),PSP | |
819 | + BRA.W NEXT | |
820 | +* | |
729 | 821 | |
730 | 822 | * Fix these later: |
731 | 823 |
@@ -1576,100 +1668,6 @@ USLR LEAU NATWID,U | ||
1576 | 1668 | * LEAS 1,S ; |
1577 | 1669 | * JMP SWAP+4 reverse quotient & remainder |
1578 | 1670 | * |
1579 | -* ######>> screen 25 << | |
1580 | -* ======>> 20 << | |
1581 | -* ( n1 n2 --- n ) | |
1582 | -* Bitwise and the top two integers. | |
1583 | - FCB $83 | |
1584 | - FCC 'AN' ; 'AND' | |
1585 | - FCB $C4 | |
1586 | - FDB USLASH-5 | |
1587 | -AND FDB *+NATWID | |
1588 | - PULU A,B | |
1589 | - ANDB 1,U | |
1590 | - ANDA ,U | |
1591 | - STD ,U | |
1592 | - LBRA NEXT | |
1593 | -* PULS A ; | |
1594 | -* PULS B ; | |
1595 | -* TFR S,X ; TSX : | |
1596 | -* ANDB 1,X | |
1597 | -* ANDA 0,X | |
1598 | -* JMP STD0X | |
1599 | -* | |
1600 | -* ======>> 21 << | |
1601 | -* ( n1 n2 --- n ) | |
1602 | -* Bitwise or the top two integers. | |
1603 | - FCB $82 | |
1604 | - FCC 'O' ; 'OR' | |
1605 | - FCB $D2 | |
1606 | - FDB AND-6 | |
1607 | -OR FDB *+NATWID | |
1608 | - PULU A,B | |
1609 | - ORB 1,U | |
1610 | - ORA ,U | |
1611 | - STD ,U | |
1612 | - LBRA NEXT | |
1613 | -* PULS A ; | |
1614 | -* PULS B ; | |
1615 | -* TFR S,X ; TSX : | |
1616 | -* ORB 1,X | |
1617 | -* ORA 0,X | |
1618 | -* JMP STD0X | |
1619 | -* | |
1620 | -* ======>> 22 << | |
1621 | -* ( n1 n2 --- n ) | |
1622 | -* Bitwise exclusive or the top two integers. | |
1623 | - FCB $83 | |
1624 | - FCC 'XO' ; 'XOR' | |
1625 | - FCB $D2 | |
1626 | - FDB OR-5 | |
1627 | -XOR FDB *+NATWID | |
1628 | - PULU A,B | |
1629 | - EORB 1,U | |
1630 | - EORA ,U | |
1631 | - STD ,U | |
1632 | - LBRA NEXT | |
1633 | -* PULS A ; | |
1634 | -* PULS B ; | |
1635 | -* TFR S,X ; TSX : | |
1636 | -* EORB 1,X | |
1637 | -* EORA 0,X | |
1638 | -* JMP STD0X | |
1639 | -* | |
1640 | -* ######>> screen 26 << | |
1641 | -* ======>> 23 << | |
1642 | -* ( --- adr ) | |
1643 | -* Fetch the parameter stack pointer (before it is pushed). | |
1644 | -* This points at whatever was on the top of stack before. | |
1645 | - FCB $83 | |
1646 | - FCC 'SP' ; 'SP@' | |
1647 | - FCB $C0 | |
1648 | - FDB XOR-6 | |
1649 | -SPAT FDB *+NATWID | |
1650 | - TFR U,X | |
1651 | - PSHU X | |
1652 | - LBRA NEXT | |
1653 | -* TFR S,X ; TSX : | |
1654 | -* STX N scratch area | |
1655 | -* LDX #N | |
1656 | -* JMP GETX | |
1657 | -* | |
1658 | -* ======>> 24 << | |
1659 | -* ( whatever --- nothing ) | |
1660 | -* Initialize the parameter stack pointer from the USER variable S0. | |
1661 | -* Effectively clears the stack. | |
1662 | - FCB $83 | |
1663 | - FCC 'SP' ; 'SP!' | |
1664 | - FCB $A1 | |
1665 | - FDB SPAT-6 | |
1666 | -SPSTOR FDB *+NATWID | |
1667 | - LDU <XSPZER | |
1668 | - LBRA NEXT | |
1669 | -* LDX UP | |
1670 | -* LDX XSPZER-UORIG,X | |
1671 | -* TFR X,S ; TXS : watch it ! X and S are not equal on 6800. | |
1672 | -* JMP NEXT | |
1673 | 1671 | * ======>> 25 << |
1674 | 1672 | * ( whatever *** nothing ) |
1675 | 1673 | * Initialize the return stack pointer from the initialization table |