F.I.G. Forth

* FIG FORTH FOR SERIES-16 MACHINES PAGE 101

4394 * 4395 * **** M/ **** 4396 * HEAD FNUL,M/,MSLA 4397 004552 TLNK SET * 4398 04552 001315 VFD 1,0,1,FNUL,6,2,8,'315 4399 * =<FNUL,2>,'M' 4400 04553 027400 VFD 8,'057 ='/' 4401 04554 0 004520 DAC LINK 4402 004552 LINK SET TLNK 4403 004555 MSLA EQU * 4404 IFZ HSA 4405 JST SSDV 4406 * 4407 * NEXT 4408 IRS IP 4409 JMP* IP 4410 ELSE 4411 04555 1 02 00002 LDA 2,1 MS WORD OF DIVIDEND 4412 04556 0415 77 ALS 1 SHIFT UP ONE BIT 4413 04557 100001 SRC OVERFLOW? 4414 04560 0 01 04604 JMP DVS2 YES, DO SOFTWARE DIVIDE 4415 04561 000201 IAB 4416 04562 1 02 00003 LDA 3,1 LS WORD OF DIVIDEND 4417 04563 140320 CSA TOP BIT TO CARRY 4418 04564 000201 IAB 4419 04565 141216 ACA 2^15 BIT INTO A, LSB 4420 * 4421 * AT THIS POINT KNOW THAT WE HAVE A 4422 * A VALID 31-BIT DIVIDEND, SO CAN USE H/W INSTRUCTION 4423 04566 1 17 00001 DIV 1,1 4424 04567 0 12 00000 IRS 0 DISCARD DIVISOR 4425 04570 100001 SRC OVERFLOW? 4426 04571 0 01 04577 JMP DVS1 4427 04572 1 04 00001 STA 1,1 QUOTIENT 4428 04573 000201 IAB 4429 04574 1 04 00002 STA 2,1 REMAINDER 4430 * 4431 * NEXT 4432 04575 0 12 00100 IRS IP 4433 04576 -0 01 00100 JMP* IP 4434 04577 140040 DVS1 CRA 4435 04600 1 04 00001 STA 1,1 QUOTIENT 4436 04601 1 04 00002 STA 2,1 REMAINDER 4437 * 4438 * NEXT 4439 04602 0 12 00100 IRS IP 4440 04603 -0 01 00100 JMP* IP 4441 * 4442 04604 0 10 04607 DVS2 JST SSDV 4443 *