F.I.G. Forth

* FIG FORTH FOR SERIES-16 MACHINES PAGE 34

1365 ORG NXTX AFTER START-UP CODE 1366 * **** U* **** 1367 * ( N1 N2 --- D ). PRODUCT IS 32-BIT DOUBLE INTEGER, 1368 * HEAD FNUL,U*,USTR 1369 001115 TLNK SET * 1370 01115 001325 VFD 1,0,1,FNUL,6,2,8,'325 1371 * =<FNUL,2>,'U' 1372 01116 025000 VFD 8,'052 ='*' 1373 01117 0 000665 DAC LINK 1374 001115 LINK SET TLNK 1375 001120 USTR EQU * 1376 IFZ HSA 1377 * SOFTWARE UNSIGNED MULTIPLY 1378 LDA =-16 COUNTER 1379 STA T1 1380 CRA CLEAR ACCUMULATOR 1381 IAB 1382 CRA 1383 STA T3 MS WORD OF MULTIPLIER 1384 UST1 LLL 1 SHIFT ACCUMULATOR LEFT 1385 IMA 2,1 GET MULTIPLICAND 1386 LGL 1 TOP BIT TO CARRY 1387 IMA 2,1 GET ACCUMULATOR BACK 1388 SSC CARRY SET? 1389 JMP UST2 NO 1390 IAB YES - LS WORD TO A 1391 STA T2 SAVE VALUE 1392 ADD 1,1 ADD MULIPLIER 1393 IMA T2 SAVE SUM, GET FIRST INPUT 1394 SRC CARRY (OVERFLOW!) SET? 1395 CHS YES - XOR IT INTO MSB 1396 ERA 1,1 XOR IN SECOND 1397 ERA T2 XOR IN SUM, CARRY NOW IN MSB 1398 CSA PUT IN CBIT 1399 LDA T2 GET SUM BACK 1400 IAB GET MS BITS BACK 1401 ACA ADD IN ANY CARRY NEEDED 1402 ADD T3 ADD IN MS WORD (FOR SIGNED MULTIPLY) 1403 UST2 IRS T1 1404 JMP UST1 1405 STA 1,1 MS WORD 1406 IAB 1407 STA 2,1 LS WORD 1408 * 1409 * NEXT 1410 IRS IP 1411 JMP* IP 1412 ELSE 1413 EJCT