F.I.G. Forth

* FIG FORTH FOR SERIES-16 MACHINES PAGE 37

1492 * **** U/ **** 1493 * ( D N --- N1 N2 ) 1494 * UNSIGNED DIVIDE YIELDING REMAINDER AND QUOTIENT 1495 * HEAD FNUL,U/,USLA 1496 001202 TLNK SET * 1497 01202 001325 VFD 1,0,1,FNUL,6,2,8,'325 1498 * =<FNUL,2>,'U' 1499 01203 027400 VFD 8,'057 ='/' 1500 01204 0 001115 DAC LINK 1501 001202 LINK SET TLNK 1502 001205 USLA EQU * 1503 01205 0 10 01210 JST DIVU 1504 * 1505 * NEXT 1506 01206 0 12 00100 IRS IP 1507 01207 -0 01 00100 JMP* IP 1508 * 1509 * UNSIGNED DIVIDE - SUBROUTINE SINCE CALLED 1510 * BY SIGNED DIVIDE 1511 * 1512 01210 0 000000 DIVU DAC ** 1513 01211 0 02 00716 LDA =-16 1514 01212 0 04 00104 STA T1 COUNT 1515 01213 1 02 00001 LDA 1,1 DIVISOR 1516 01214 101040 SNZ 1517 01215 0 01 01267 JMP DVU6 DIVIDE BY ZERO 1518 01216 1 07 00002 SUB 2,1 COMPARE TO DIVIDEND 1519 01217 101040 SNZ 1520 01220 0 01 01267 JMP DVU6 BAD DIVIDE 1521 * DON'T NEED SUM, WANT CARRY 1522 01221 100001 SRC CARRY (OVERFLOW!) SET? 1523 01222 140024 CHS YES - XOR IT INTO MSB 1524 01223 1 05 00001 ERA 1,1 XOR IN FIRST OPERAND 1525 01224 1 05 00002 ERA 2,1 XOR IN SECOND OPERAND, CARRY NOW IN MSB 1526 01225 100400 SPL 1527 01226 0 01 01267 JMP DVU6 BAD DIVIDE 1528 01227 1 02 00003 LDA 3,1 LS WORD 1529 01230 000201 IAB 1530 01231 1 02 00002 LDA 2,1 MS WORD 1531 01232 0410 77 DVU1 LLL 1 SHIFT ACCUMULATOR LEFT 1532 01233 0 04 00105 STA T2 SAVE IN CASE OF RESTORE 1533 01234 100001 SRC TOP BIT WAS SET? 1534 01235 0 01 01264 JMP DVU5 YES 1535 01236 1 07 00001 SUB 1,1 DIVISOR 1536 01237 0 04 00106 STA T3 SAVE SUM 1537 01240 100001 SRC CARRY (OVERFLOW!) SET? 1538 01241 140024 CHS YES - XOR IT INTO MSB 1539 01242 1 05 00001 ERA 1,1 XOR IN SECOND OPERAND 1540 01243 0 05 00105 ERA T2 XOR IN FIRST OPERAND, CARRY NOW IN MSB 1541 01244 100400 SPL