head     56.3;
access   paws bayes jws quist brad dew jwh cfb;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.16.56;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.11.58.25;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.09.53.59;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.29.21;  author jwh;  state Exp;
branches ;
next     54.4;

54.4
date     91.08.21.10.32.51;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.09.37.55;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.13.10.40.37;  author jws;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.31.34;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.31.28;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.16.05;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.15.37;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.30.10;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.13.56;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.20.15;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.04.29;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.51.36;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.59.32;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.16.38;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.09.02;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.53.25;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.35.40;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.56.57;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.41.44;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.33.34;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.47.20;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.25.01;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.40.17;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.15.33;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.47.11;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.56.05;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.17.08;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.13.54.11;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.38.50;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.05.07;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.47.45;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.13.27.20;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.40.53;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.09.07;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.10.50.36;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.33.48;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.17.24;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.29.30;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.08.42.09;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.15.46.37;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.10.53.45;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.04.27;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.09.43.33;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.15.51.21;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.48.01;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.40.22;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.07.07;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.21.39;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.04.15;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.15.43;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.23.43;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.19.53;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.08.02;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.04.38;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.14.56;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.03.04;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.16.18.09;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@* ADDED BOOTROM SOURCE FOR ADDRESSES $2000-$3FFF        CFB 14JUN91

		rorg 0

		nosyms
* This file contains hardware dependent addresses for the
*
*                   manufacturing unit
*
*                       Chipmunks

* USED TO BE IN THE BOOT ROM
*
*  BOOTROM2
*
*  8/14/81        - Andy Goris
*
*  This is the second half of the 9826A/B boot ROM.
*
*       RORG       $2000
*       SPRINT
*
* CRT CHARACTER SET
*
* Removed from TRAILMIX on 1/11/90                              {dfk}
*
*       RORG       $3000
*       SPRINT
*
* tables for conversion between base 10k and bdc
*
*
BIN2BCD dc.b $00,$01,$02,$03,$04
	dc.b $05,$06,$07,$08,$09
	dc.b $10,$11,$12,$13,$14
	dc.b $15,$16,$17,$18,$19
	dc.b $20,$21,$22,$23,$24
	dc.b $25,$26,$27,$28,$29
	dc.b $30,$31,$32,$33,$34
	dc.b $35,$36,$37,$38,$39
	dc.b $40,$41,$42,$43,$44
	dc.b $45,$46,$47,$48,$49
	dc.b $50,$51,$52,$53,$54
	dc.b $55,$56,$57,$58,$59
	dc.b $60,$61,$62,$63,$64
	dc.b $65,$66,$67,$68,$69
	dc.b $70,$71,$72,$73,$74
	dc.b $75,$76,$77,$78,$79
	dc.b $80,$81,$82,$83,$84
	dc.b $85,$86,$87,$88,$89
	dc.b $90,$91,$92,$93,$94
	dc.b $95,$96,$97,$98,$99
*
bcd2bin dc.b 00,01,02,03,04,05,06,07,08,09,0,0,0,0,0,1
	dc.b 10,11,12,13,14,15,16,17,18,19,0,0,0,0,0,0
	dc.b 20,21,22,23,24,25,26,27,28,29,0,0,0,0,0,0
	dc.b 30,31,32,33,34,35,36,37,38,39,0,0,0,0,0,0
	dc.b 40,41,42,43,44,45,46,47,48,49,0,0,0,0,0,0
	dc.b 50,51,52,53,54,55,56,57,58,59,0,0,0,0,0,0
	dc.b 60,61,62,63,64,65,66,67,68,69,0,0,0,0,0,0
	dc.b 70,71,72,73,74,75,76,77,78,79,0,0,0,0,0,0
	dc.b 80,81,82,83,84,85,86,87,88,89,0,0,0,0,0,0
	dc.b 90,91,92,93,94,95,96,97,98,99
	PAGE
*------------------------------------------
*     PASCAL support routines    Rev 1.1
*     written by: Bob Roeder
*                 Brad Ritter
*------------------------------------------
	DEF asm_rmovel
*------------------------------------------
M@@VEL           EQU             *
		MOVEA.L         (SP)+,A2       SAVE RETURN ADDRESS
		MOVE.L          (SP)+,D0       LENGTH
		MOVEA.L         (SP)+,A0       DESTINATION ADDRESS
		MOVEA.L         (SP)+,A1       SOURCE ADDRESS
		MOVE.L          A2,-(SP)       RESTORE RETURN ADDRESS
asm_rmovel      EQU             *          ENTRY POINT FOR OPERANDS IN REGISTERS
		TST.L           D0
		BLE.S           DONEE
		MOVE.W          A0,D1
		MOVE.W          A1,D2
		ANDI.B          #1,D1
		ANDI.B          #1,D2
		EOR.B           D2,D1      ARE BOTH ADDRESSES ON EVEN OR BOTH ON
*                                          ODD BOUNDARIES?
		BEQ.S           FAANCY
LOOOP           EQU             *
		MOVE.B          (A1)+,(A0)+
		SUBQ.L          #1,D0
		BGT.S           LOOOP
		BRA.S           DONEE
FAANCY          EQU             *
		TST.B           D2
		BEQ.S           SKIIP1
		MOVE.B          (A1)+,(A0)+    MOVE ONE BYTE TO GET TO AN EVEN
*                                              BYTE ADDRESS
		SUBQ.L          #1,D0
		BLE.S           DONEE
SKIIP1          EQU             *
		MOVE.L          D0,D1        PERFORM COUNT DIV 4 LONG WORD MOVES
		LSR.L           #2,D1
		BEQ.S           SKIIP2
LOOOP2          EQU             *
		MOVE.L          (A1)+,(A0)+
		SUBQ.L          #1,D1
		BGT.S           LOOOP2
SKIIP2          EQU             *
		ANDI.B          #3,D0
		MOVE.B          D0,D1
		LSR.B           #1,D1
		BEQ.S           SKIIP3
		MOVE.W          (A1)+,(A0)+
SKIIP3          EQU             *
		ANDI.B          #1,D0
		BEQ.S           DONEE
		MOVE.B          (A1)+,(A0)+
DONEE           EQU             *
		RTS

	  PAGE
*------------------------------------------
	DEF asm_rmover
*------------------------------------------
M@@VER           EQU             *
		MOVEA.L         (SP)+,A2       SAVE RETURN ADDRESS
		MOVE.L          (SP)+,D0       LENGTH
		MOVEA.L         (SP)+,A0       DESTINATION ADDRESS
		MOVEA.L         (SP)+,A1       SOURCE ADDRESS
		MOVE.L          A2,-(SP)       RESTORE RETURN ADDRESS
asm_rmover      EQU             *          ENTRY POINT FOR OPERANDS IN REGISTERS
		TST.L           D0
		BLE.S           DONE
		ADDA.L          D0,A0
		ADDA.L          D0,A1
		MOVE.W          A0,D1
		MOVE.W          A1,D2
		ANDI.B          #1,D1
		ANDI.B          #1,D2
		EOR.B           D2,D1      ARE BOTH ADDRESSES ON EVEN OR BOTH ON
*                                          ODD BOUNDARIES?
		BEQ.S           FANCY
LOOP            EQU             *
		MOVE.B          -(A1),-(A0)
		SUBQ.L          #1,D0
		BGT.S           LOOP
		BRA.S           DONE
FANCY           EQU             *
		TST.B           D2
		BEQ.S           SKIP1
		MOVE.B          -(A1),-(A0)     MOVE ONE BYTE TO GET TO AN EVEN
*                                               BYTE ADDRESS
		SUBQ.L          #1,D0
		BLE.S           DONE
SKIP1           EQU             *
		MOVE.L          D0,D1        PERFORM COUNT DIV 4 LONG WORD MOVES
		LSR.L           #2,D1
		BEQ.S           SKIP2
LOOP2           EQU             *
		MOVE.L          -(A1),-(A0)
		SUBQ.L          #1,D1
		BGT.S           LOOP2
SKIP2           EQU             *
		ANDI.B          #3,D0
		MOVE.B          D0,D1
		LSR.B           #1,D1
		BEQ.S           SKIP3
		MOVE.W          -(A1),-(A0)
SKIP3           EQU             *
		ANDI.B          #1,D0
		BEQ.S           DONE
		MOVE.B          -(A1),-(A0)
DONE            EQU             *
		RTS
	 PAGE
*------------------------------------------
	DEF asm_mpy
*------------------------------------------
asm_mpy         equ             *
		movem.l         (sp)+,d0/d1/d2  get return addr and operands
		movea.w         d1,a0
		cmpa.l          d1,a0           test for 16 bit 2's compl
		bne.s           not_wd1
		movea.w         d2,a0
		cmpa.l          d2,a0           test for 16 bit 2's compl
		bne.s           twoXone
		muls            d1,d2           signed multiply
		move.l          d2,-(sp)        push result
		movea.l         d0,a0           fake rts
		jmp             (a0)
*
not_wd1         movea.w         d2,a0           test for 16 bit 2's compl
		cmpa.l          d2,a0
		bne.s           twoXtwo         branch to 32 x 32 bit mult
		exg             d1,d2           put 16 bit value in d1
*
twoXone         move.w          d2,d3
		mulu            d1,d3           low order partial product
		move.l          d2,d4
		swap            d4
		mulu            d1,d4           high order partial product
		swap            d3
		moveq           #0,d5           clear high word
		move.w          d3,d5
		add.l           d5,d4           add middle products
		tst.w           d1              sign of multiplier ???
		bpl.s           mcand
		sub.l           d2,d4           subtract multiplicand
mcand           tst.l           d2              sign of multiplicand ???
		bpl.s           out
		move.w          d1,d5           if negative
		swap            d5
		sub.l           d5,d4           subtract multiplier
out             movea.w         d4,a0
		cmpa.l          d4,a0           test for overflow
		bne.s           ovflow
		swap            d3
		move.w          d3,-(sp)        store low  order part
		move.w          d4,-(sp)        store high order part
		movea.l         d0,a0           fake rts
		jmp             (a0)
*
twoXtwo         equ             *
		move.l          d1,d3           look at multiplier
		moveq           #0,d7           clear flag
		asr.l           #1,d3           divide by 2
		bcc.s           even1           catch LSB
		move.l          d2,d7           use multiplicand in flag
even1           movea.w         d3,a0           check for 16 bit 2's compl
		cmp.l           a0,d3
		beq             soneXtwo
		move.l          d2,d3           otherwise try multiplicand
		moveq           #0,d7           clear flag
		asr.l           #1,d3           divide by 2
		bcc.s           even2           catch LSB
		move.l          d1,d7           use multiplier in flag
even2           movea.w         d3,a0           check for 16 bit 2's compl
		cmp.l           a0,d3
		bne             ovflow
		move.l          d1,d2
soneXtwo        lea             muldone,a1
		exg             a1,d0           use twoXone mult routine
		move.l          d3,d1
		bra.s           twoXone
muldone         addq            #4,sp           clean up stack
		add.w           d3,d3           multiply product by 2
		addx.l          d4,d4
		add.w           d7,d3           add flag
		swap            d7
		ext.l           d7
		addx.l          d7,d4
		swap            d3              put d3 in wrong order for out
		move.l          a1,d0           put return address in d0
		bra.s           out
ovflow          trap            #4
		PAGE
*------------------------------------------
 DEF E@@DIV
 DEF E@@MOD
*------------------------------------------
*               register usage
*               d0 - return address
*               d1 - divisor
*               d2 - dividend and quotient
*               d3 - remainder
*               d4 - loop counter
*               d5 - sign of remainder
*               d6 - sign of quotent
*               d7 - mod/div flag
*
E@@MOD           moveq           #1,d7           set mod flag
		bra.s           d_start
E@@DIV           moveq           #0,d7           clear mod flag
d_start         movem.l         (sp)+,d0/d1/d2  read return addr and operands
		tst.l           d1              divide by zero?
		beq.s           zerodiv
		movea.w         d1,a0           is divisor a
		cmp.l           a0,d1           16 bit integer?
		bne.s           do_full
		move.l          d2,d3           try signed divide
		divs            d1,d3
		bvs.s           do_full         did it work?
		tst.w           d7              mod or div?
		beq.s           div_1
		swap            d3
div_1           ext.l           d3
dm_out          move.l          d3,-(sp)        push result
		movea.l         d0,a0
		jmp             (a0)            fake return
zerodiv         trap            #5
*
*               convert divisor and dividend to sign magnitude
*
do_full         moveq           #15,d4          loop count - 1
		moveq           #0,d6           sign of quotient
		moveq           #0,d5           sign of remainder
		tst.l           d1              divisor negative?
		bpl.s           divend
		neg.l           d1
		bvs.s           max_neg_dvsr
		not.w           d6              set sign flag
divend          tst.l           d2              divedend negative
		bpl.s           rmndr
		neg.l           d2              complement quotient sign
		bvc.s           not_special
		cmp.l           #-1,d1
		beq.s           ovflow
not_special     not             d6              flag
		not             d5              negative remainder
rmndr           moveq           #0,d3           clear remainder
		swap            d1              is divisor <= 16 bits
		tst.w           d1
		bne.s           big_div
		swap            d2
		swap            d1
		move.w          d2,d3           get high order dividend
		divu            d1,d3           high part of divide
		move.w          d3,d2           high quotient to d2
		swap            d2
		move.w          d2,d3           divide low order
		divu            d1,d3           dividend by divisor
		move.w          d3,d2           quotient in d2
		clr.w           d3
		swap            d3              remainder in d3
*               put in correct sigh for quotient and remainder
dm_fixup        tst.w           d6
		bpl.s           chk_rem
		neg.l           d2
chk_rem         tst.w           d5
		bpl.s           dm_store
		neg.l           d3
dm_store        tst.w           d7              div or mod?
		bne.s           dm_out
		exg             d2,d3
		bra.s           dm_out
*
*               handle maximum negative divisor
*
max_neg_dvsr    neg.l           d2
		bvs.s           max_max         test for max neg dividend
		move.l          d2,d3
		neg.l           d3
		moveq           #0,d2
		bra.s           dm_store
max_max         moveq           #1,d2
		moveq           #0,d3
		bra.s           dm_store
*
*               32 bit divisor
*
big_div         swap            d1              restore divisor
		swap            d2              move high order
		move.w          d2,d3           dividend to remainder
		clr.w           d2              shift dividend 16 bits left
		sub.l           d1,d3           subtract divisor from rem.
		movea.l         d1,a0           divisor in a0
		neg.l           d1              minus divisor in d1
*
*               co-routine for negative remainder
*
m_top           add.l           d2,d2           shift dividend and quotient
		addx.l          d3,d3           shift remainder
		add.l           a0,d3           add divisor
		bpl.s           p_bottom        remainder positive?
m_bottom        dbra            d4,m_top        loop 16 times
		add.l           a0,d3           restore remainder
		add.l           d2,d2           shift in last bit of quotient
		bra.s           dm_fixup
*
*               co-routine for positive remainder
*
p_top           addx.l          d2,d2           shift dividend and quotient
		addx.l          d3,d3           shift remainder
		add.l           d1,d3           subtract divisor
		bmi.s           m_bottom        remainder negative?
p_bottom        dbra            d4,p_top        loop 16 times
		addx.l          d2,d2           shift in last bit of quotient
		bra.s           dm_fixup
	    PAGE
*------------------------------------------
	    DEF asm_equal
	    DEF asm_nequal
*------------------------------------------
asm_nequal    EQU *
	    move.b     #1,-(sp)
	    move.b     #0,-(sp)
	    bra.s        strrt
asm_equal     EQU *
	    move.b     #0,-(sp)
	    move.b     #1,-(sp)
* obtain sets from stack
strrt       movea.l    8(sp),a3           address of right op
	    movea.l    12(sp),a4          address of left op
* place minimum size in d5
	    move.w     (a3)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin
LEFTMIN     move.w     d6,d5
	    bra.s        nulltest           REI 7/3/80
RIGHTMIN    move.w     d7,d5
nulltest    beq.s        restof             REI 7/3/80

* perform set comparison
LONG        asr.w      #2,d5              determine size in long words
	    bcc.s        even               even number of long words
	    cmpm.w     (a3)+,(a4)+        compare "odd" word
	    bne.s        nope
	    tst.w      d5                 min size single word?
	    beq.s        restof
EVEN        cmpm.l     (a3)+,(a4)+        compare long words
	    bne.s        nope
	    subq.w     #1,d5
	    bgt.s        even
* if operands of unequal size, test rest of longer -
*   if all "extra" bits not 0, sets are unequal
RESTOF      sub.w      d6,d7              size of right op-size of left op
	    beq.s        yep                equal size
	    bpl.s        right              right op longer
	    neg.w      d7                 d7 = # bytes longer
LEFT        tst.w      (a4)+              left op longer, test it
	    bne.s        nope
	    subq.w     #2,d7              2 bytes tested
	    bgt.s        left
	    bra.s        yep
RIGHT       tst.w      (a3)+              test right op
	    bne.s        nope
	    subq.w     #2,d7              2 bytes tested
	    bgt.s        right
* move true or false value to result
YEP         move.b     (sp),14(sp)
	    bra.s        fnsh
NOPE        move.b     2(sp),14(sp)
fnsh        move.l     4(sp),10(sp)       put return address at the right place
	    adda.l     #10,sp             eliminate extra bytes in stack
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_assign
*------------------------------------------
asm_assign    EQU *
* obtain sets from stack
	    movea.l    4(sp),a3          address of source
	    movea.l    8(sp),a4          address of dest
* place size in d7
	    move.w     (a3)+,d7          size of source
	    move.w     d7,(a4)+          store size in dest
	    beq.s      done2             check for zero length set
* perform assignment
	    asr.w      #2,d7              determine size in long words
	    bcc.s        evenn              even number of long words
	    move.w     (a3)+,(a4)+        move "odd" word
	    tst.w      d7                 min size single word?
	    beq.s        done2
EVENN       move.l     (a3)+,(a4)+        move long words
	    subq.w     #1,d7
	    bgt.s        evenn
DONE2       move.l     (sp),8(sp)         eliminate extra bytes in stack
	    addq.l     #8,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_union
*------------------------------------------
asm_union     EQU *
* obtain sets from stack
	    movea.l    4(sp),a2           address of right op
	    movea.l    8(sp),a4           address of left op
	    movea.l    12(sp),a3          address of result
* place minimum size in d5
	    move.w     (a2)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin2
LEFTMIN2    move.w     d6,d5
	    move.w     d7,(a3)+           result size is max op size
	    bra.s        nulltest2          REI 7/3
RIGHTMIN2   move.w     d7,d5
	    move.w     d6,(a3)+           result size is max op size
nulltest2   tst.w      d5                 REI 7/3
	    beq.s        restof2            REI 7/3

* perform set union
LONG3       asr.w      #2,d5              determine size in long words
	    bcc.s        even3              even number of long words
	    move.w     (a2)+,d4           union "odd" word
	    or.w       (a4)+,d4
	    move.w     d4,(a3)+
	    tst.w      d5                 min size single word?
	    beq.s        restof2
EVEN3       move.l     (a2)+,d4           union long words
	    or.l       (a4)+,d4
	    move.l     d4,(a3)+
	    subq.w     #1,d5
	    bgt.s        even3
* move rest of longer operand
RESTOF2     sub.w      d6,d7              size of right op-size of left op
	    beq.s        done3              equal size
	    bpl.s        right2             right op longer
	    neg.w      d7                 d7 = # bytes longer
LEFT2       move.w     (a4)+,(a3)+        left op longer, move it
	    subq.w     #2,d7              2 bytes moved
	    bgt.s        left2
	    bra.s        done3
RIGHT2      move.w     (a2)+,(a3)+        move right op
	    subq.w     #2,d7              2 bytes moved
	    bgt.s        right2
DONE3       move.l     (sp),12(sp)        eliminate extra bytes in stack
	    adda.l     #12,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_inclusion
*------------------------------------------
asm_inclusion EQU *
* obtain sets from stack
	    movea.l    4(sp),a3           address of right op
	    movea.l    8(sp),a4           address of left op
* place minimum size in d5
	    move.w     (a3)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin3
LEFTMIN3    move.w     d6,d5
	    bra.s        nulltest3          REI 7/3
RIGHTMIN3   move.w     d7,d5
nulltest3   beq.s        restof3            REI 7/3

* perform inclusion test
LONG4       asr.w      #2,d5              determine size in long words
	    bcc.s        even4              even number of long words
	    move.w     (a3)+,d4           "odd" word inclusion
	    not.w      d4
	    and.w      (a4)+,d4
	    bne.s        nope2
	    tst.w      d5                 min size single word?
	    beq.s        restof3
EVEN4       move.l     (a3)+,d4           long word inclusion
	    not.l      d4
	    and.l      (a4)+,d4
	    bne.s        nope2
	    subq.w     #1,d5
	    bgt.s        even4
* if left operand longer, test "extra" portion
RESTOF3     sub.w      d7,d6              size of left op-size of right op
	    ble.s        yep2               left op not longer
LEFT3       tst.w      (a4)+              left op longer, test it
	    bne.s        nope2
	    subq.w     #2,d6              2 bytes tested
	    bgt.s        left3
* move boolean value to result
YEP2        move.b     #1,10(sp)          true
	    bra.s        cleanup
NOPE2       move.b     #0,10(sp)          false
CLEANUP     move.l     (sp),6(sp)         eliminate extra bytes in stack
	    addq.l     #6,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_intersect
*------------------------------------------
asm_intersect EQU *
* obtain sets from stack
	    movea.l    4(sp),a2           address of right op
	    movea.l    8(sp),a4           address of left op
	    movea.l    12(sp),a3          address of result
* place minimum size in d7
	    move.w     (a2)+,d7           size of right op
	    cmp.w      (a4)+,d7           compare with size of left op
	    ble.s        setsize
LEFTMIN4    move.w     -2(a4),d7
SETSIZE     move.w     d7,(a3)+           result size = min op size
	    beq.s        done4              REI 7/3

* perform set intersection
	    asr.w      #2,d7              determine size in long words
	    bcc.s        even5              even number of long words
	    move.w     (a2)+,d6           intersect "odd" word
	    and.w      (a4)+,d6
	    move.w     d6,(a3)+
	    tst.w      d7                 min size single word?
	    beq.s        done4
EVEN5       move.l     (a2)+,d6           intersect long words
	    and.l      (a4)+,d6
	    move.l     d6,(a3)+
	    subq.w     #1,d7
	    bgt.s        even5
DONE4       move.l     (sp),12(sp)
	    adda.l     #12,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_difference
*------------------------------------------
asm_difference EQU *
* obtain sets from stack
	    movea.l    4(sp),a2           address of right op
	    movea.l    8(sp),a4           address of left op
	    movea.l    12(sp),a3          address of result
* place minimum size in d5
	    move.w     (a2)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin5
LEFTMIN5    move.w     d6,d5
	    bra.s        setsize2
RIGHTMIN5   move.w     d7,d5
SETSIZE2    move.w     d6,(a3)+           result size = size of left op
	    tst.w      d5                 REI 7/3
	    beq.s        restof4            REI 7/3

* perform difference
	    asr.w      #2,d5              determine size in long words
	    bcc.s        even6              even number of long words
	    move.w     (a2)+,d4           difference of "odd" word
	    not.w      d4
	    and.w      (a4)+,d4
	    move.w     d4,(a3)+
	    tst.w      d5                 min size single word?
	    beq.s        restof4
EVEN6       move.l     (a2)+,d4           long word difference
	    not.l      d4
	    and.l      (a4)+,d4
	    move.l     d4,(a3)+
	    subq.w     #1,d5
	    bgt.s        even6
* if left operand longer, move to result
RESTOF4     sub.w      d7,d6              size of left op-size of right op
	    ble.s        done5
LEFT4       move.w     (a4)+,(a3)+        left op longer, move it
	    subq.w     #2,d6              2 bytes moved
	    bgt.s        left4
DONE5       move.l     (sp),12(sp)        eliminate extra bytes in stack
	    adda.l     #12,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_in
*------------------------------------------
asm_in  movea.l         (sp)+,a0        return address
	movea.l         (sp)+,a1        set address
	move.l          (sp)+,d0        selector value
	blt.s           lfalse          selector<0?
	divs            #8,d0
	cmp.w           (a1),d0         selector>setsize?
	bge.s           lfalse
	move.l          d0,d1
	swap d1
	move.b          2(a1,d0),d0     get selected byte
	lsl.b           d1,d0           construct Boolean result
	lsr.b           #7,d0
	move.b          d0,-(sp)        push the result
	jmp             (a0)
lfalse  clr.b           -(sp)
	jmp             (a0)
	PAGE
*------------------------------------------
	   DEF  E@@DDELEMENT
*------------------------------------------
E@@DDELEMENT EQU         *
	movea.l         (sp)+,a0         return address
	move.w          (sp)+,d0        element number to add to set
	movea.l         (sp)+,a1        source address
	movea.l         (sp),a2         destination address
	move.w          (a1)+,d7        get set size of source
	move.w          d7,(a2)+        store size value
	cmpa.l          a2,a1           see if source and destination are equal
	beq.s           insert1
* copy source set to the destination set
setcopy movea.l         a2,a3           save destination address
	move.w          d7,d6           save size for destination
	ble.s           insert1         check for size of zero
rept    move.w          (a1)+,(a3)+     sets are always an even number of bytes
	subq.w          #2,d6
	bgt.s           rept
* insert an element in a set, adjusting the size of the destination if needed
insert1 ext.l           d0
	divs            #16,d0           byte offset in low word
	move.l          d0,d5
	swap            d5              bit offset from left of byte
	sub.w           #15,d5
	neg.w           d5              bit offset from right
	asl             #1,d0           make d0 a byte offset
	move.w          d0,d1           compute final size into d1
	addq.w          #2,d1           put zeros in the two bytes containing
	move.w          d1,d2           the new bit if it is beyond current size
	sub.w           -2(a2),d1
	ble.s           exxiit
	move.w          d2,-2(a2)       store appropriate size for set
	lea             0(a2,d2),a3
zerout  clr.w           -(a3)
	subq.w          #2,d1
	bgt.s           zerout
exxiit  bclr            #3,d5           { received upgrade 9/9 }
	beq.s           skiipp
	bset            d5,0(a2,d0)
	jmp             (a0)
skiipp  bset            d5,1(a2,d0)
	jmp             (a0)
	PAGE
*------------------------------------------
*       procedure SCOPY (var destination, source: string;
*                        index, length: integer);
*       procedure SAPPEND (var destination, source: string);
*       procedure INSERT (var source, destination: string; index: integer);
*       procedure DELETE (var destination: string; index, length: integer);
*       function  POS (var target, source: string): integer;
*
	DEF E@@SCOPY
	DEF E@@SAPPEND
	DEF E@@INSERT
	DEF E@@DELETE
	DEF asm_pos

	NOSYMS

DESTINATION     EQU A4
SOURCE          EQU A3
RETURN          EQU A2
PTR             EQU A1
PTR2            EQU A0
TARGET          EQU DESTINATION

INDEX           EQU D7
LENGTH          EQU D6
DLEN            EQU D5
SLEN            EQU D4
ONRIGHT         EQU D3
COUNT           EQU D2
PTEMP           EQU D1
CHAR            EQU D0
TLEN            EQU DLEN

E@@SAPPEND       EQU *
SAPPEND         EQU *
	MOVEM.L (SP)+,RETURN/SOURCE/DESTINATION     RETURN ADDRESS, PARAMETERS
	CLR     SLEN
	MOVE.B  (SOURCE)+,SLEN          LENGTH OF SOURCE
	BEQ.S   L2                      FINISH EARLY IF NULL
	CLR     DLEN
	MOVE.B  (DESTINATION),DLEN      LENGTH OF DESTINATION
	LEA     1(DESTINATION,DLEN.W),PTR       START AT DEST[DLEN+1]
	ADD.B   SLEN,DLEN               COMPUTE LENGTH OF RESULT
	BCS.S   L2                      ABORT IF TOO LONG
	MOVE.B  DLEN,(DESTINATION)
	SUBQ    #1,SLEN
L1      MOVE.B  (SOURCE)+,(PTR)+        TRANSFER BYTES
	DBRA    SLEN,L1
L2      JMP     (RETURN)                END

E@@INSERT        EQU *
INSERT          EQU *
	MOVEA.L (SP)+,RETURN
	MOVE.L  (SP)+,INDEX             GET PARAMETERS
	MOVEA.L (SP)+,DESTINATION
	MOVEA.L (SP)+,SOURCE
	BLE.S   L6                      ERROR EXIT IF NOT (INDEX > 0 )
	CLR     SLEN
	MOVE.B  (SOURCE)+,SLEN
	BEQ.S   L6                      EXIT IF SOURCE IS NULL
	CLR     DLEN
	MOVE.B  (DESTINATION),DLEN
	LEA     1(DESTINATION,DLEN.W),PTR       POINT TO "TAIL" OF DESTINATION
	MOVE    DLEN,ONRIGHT            (SAVE DLEN FOR LATER)
	ADD.B   SLEN,DLEN               NEW LENGTH OF DESTINATION
	BCS.S   L6                      EXIT IF TOO LONG
	MOVE.B  DLEN,(DESTINATION)
	SUB     INDEX,ONRIGHT           NUMBER OF BYTES TO SHIFT RIGHT (LESS 1)
	BGE.S   L3
	ADDQ    #1,ONRIGHT              TEST FOR EXACTLY ZERO
	BEQ.S   L5
	JMP     (RETURN)                ERROR EXIT (INDEX > DLEN + 1)
L3      LEA     0(PTR,SLEN.W),PTR2      MAKE ROOM FOR SOURCE
L4      MOVE.B  -(PTR),-(PTR2)          BY SHIFTING RIGHT
	DBRA    ONRIGHT,L4
	SUBQ    #1,SLEN
L5      MOVE.B  (SOURCE)+,(PTR)+        TRANSFER BYTES
	DBRA    SLEN,L5
L6      JMP     (RETURN)                END

E@@SCOPY         EQU *
SCOPY           EQU *
	MOVEA.L (SP)+,RETURN
	MOVE.L  (SP)+,LENGTH            GET PARAMETERS
	MOVE.L  (SP)+,INDEX
	MOVEA.L (SP)+,SOURCE
	MOVEA.L (SP)+,DESTINATION
	BLE.S   L9                      EXIT IF NOT (INDEX > 0)
	TST.L   LENGTH
	BLT.S   L9                      ERROR IF REQUESTED LENGTH < 0
	CLR     SLEN
	MOVE.B  (SOURCE),SLEN
	ADDQ    #1,SLEN
	SUB     INDEX,SLEN              LENGTH OF SUBSTRING
	BLT.S   L9                      ERROR IF (INDEX > SLEN + 1)
	CMP     SLEN,LENGTH             TAKE MINIMUM OF SLEN, LENGTH
	BLE.S   L7
	MOVE    SLEN,LENGTH             SUBSTRING LENGTH IS SMALLER
L7      MOVE.B  LENGTH,(DESTINATION)+   SET LENGTH INTO DESTINATION
	SUBQ    #1,LENGTH
	BLT.S   L9
	LEA     0(SOURCE,INDEX.W),PTR
L8      MOVE.B  (PTR)+,(DESTINATION)+   COPY THE BYTES
	DBRA    LENGTH,L8
L9      JMP     (RETURN)

E@@DELETE        EQU *
DELETE          EQU *
	MOVEA.L (SP)+,RETURN
	MOVE.L  (SP)+,LENGTH            GET PARAMETERS
	MOVE.L  (SP)+,INDEX
	MOVEA.L (SP)+,DESTINATION
	BLE.S   L11                     EXIT IF NOT (INDEX > 0)
	TST.L   LENGTH
	BLE.S   L11                     EXIT IF LENGTH <= 0
	CLR     DLEN
	MOVE.B  (DESTINATION),DLEN
	SUB     LENGTH,DLEN             NEW LENGTH OF STRING
	BLT.S   L11                     ERROR IF < 0
	MOVE    DLEN,ONRIGHT
	ADDQ    #1,ONRIGHT
	SUB     INDEX,ONRIGHT           NUMBER OF CHARACTERS TO MOVE
	BLT.S   L11                     ERROR IF NEGATIVE
	MOVE.B  DLEN,(DESTINATION)      SET NEW LENGTH
	SUBQ    #1,ONRIGHT
	BLT.S   L11                     FINISH EARLY IF NO BYTES TO MOVE
	LEA     0(DESTINATION,INDEX.W),PTR
	LEA     0(PTR,LENGTH.W),PTR2
L10     MOVE.B  (PTR2)+,(PTR)+
	DBRA    ONRIGHT,L10
L11     JMP     (RETURN)

asm_pos         EQU *
POS             EQU *
	MOVEM.L (SP)+,RETURN/SOURCE/TARGET
	CLR.L   (SP)                    POS WILL BE 0 IF SEARCH FAILS
	CLR     TLEN
	MOVE.B  (TARGET)+,TLEN
	BEQ.S   L16                     POS IS 0 IF TARGET IS NULL
	CLR.L   SLEN
	MOVE.B  (SOURCE)+,SLEN
	SUB     TLEN,SLEN               NUMBER OF POSSIBLE PLACES (LESS 1)
	BLT.S   L16                     POS IS 0 IF TARGET LONGER THAN SRC
	MOVE.B  (TARGET)+,CHAR          FIRST CHARACTER OF TARGET
	SUBQ    #2,TLEN                 LENGTH OF REST OF TARGET (LESS 1)
	MOVE.L  SLEN,PTEMP              TENTATIVE VALUE OF POS

L12     CMP.B   (SOURCE)+,CHAR
L13     DBEQ    SLEN,L12                LOOP TILL FIND FIRST BYTE OF TARGET
	BNE.S   L16                     POS IS 0 IF DIDN'T FIND IT
	MOVE    TLEN,COUNT              REMAINING CHARACTERS (LESS 1)
	BLT.S   L15                     FOUND IT IF LENGTH(TARGET) IS 1
	LEA     (TARGET),PTR            ELSE COMPARE REMAINING CHARS
	LEA     (SOURCE),PTR2
L14     CMPM.B  (PTR)+,(PTR2)+          LOOP TILL MATCH OR MISMATCH
	DBNE    COUNT,L14
	BNE.S   L13                     IF MISMATCH, CONTINUE SCAN
L15     SUB     SLEN,PTEMP              FOUND IT, SO FIGURE HOW FAR
	ADDQ    #1,PTEMP                        WE ADVANCED
	MOVE.L  PTEMP,(SP)              RETURN INDEX VALUE
L16     JMP     (RETURN)
*****************************************************************************
*
*  These are the power-of-ten tables that are used in the
*  decimal <--> real conversions.
*
*  Decimal / real numbers in the range [10^(-64),10^(64)]
*  convert into real / decimal numbers with one real
*  multiply while all other decimal <--> real conversions require
*  2 real multiplies and the use of the table tb_auxpt.
*
*  For a complete description of the conversion algorithms, see the
*  Math IRS.
*
*  The table contains the real values:
*  10^(-80),10^(-79),...,10^(0),.10^(1),...,10^(64).
*
tb_pwt   dc.l    $2F52F8AC,$174D6123,$2F87B6D7,$1D20B96C
	 dc.l    $2FBDA48C,$E468E7C7,$2FF286D8,$0EC190DC
	 dc.l    $3027288E,$1271F513,$305CF2B1,$970E7258
	 dc.l    $309217AE,$FE690777,$30C69D9A,$BE034955
tb_pwt8  dc.l    $30FC4501,$6D841BAA,$3131AB20,$E472914A
	 dc.l    $316615E9,$1D8F359D,$319B9B63,$64F30304
tb_pwt4  dc.l    $31D1411E,$1F17E1E3,$32059165,$A6DDDA5B
	 dc.l    $323AF5BF,$109550F2,$3270D997,$6A5D5297
tb_pwtt  dc.l    $32A50FFD,$44F4A73D,$32DA53FC,$9631D10D
	 dc.l    $3310747D,$DDDF22A8,$3344919D,$5556EB52
	 dc.l    $3379B604,$AAACA626,$33B011C2,$EAABE7D8
	 dc.l    $33E41633,$A556E1CE,$34191BC0,$8EAC9A41
	 dc.l    $344F62B0,$B257C0D2,$34839DAE,$6F76D883
	 dc.l    $34B8851A,$0B548EA4,$34EEA660,$8E29B24D
	 dc.l    $352327FC,$58DA0F70,$3557F1FB,$6F10934C
	 dc.l    $358DEE7A,$4AD4B81F,$35C2B50C,$6EC4F313
	 dc.l    $35F7624F,$8A762FD8,$362D3AE3,$6D13BBCE
	 dc.l    $366244CE,$242C5561,$3696D601,$AD376AB9
	 dc.l    $36CC8B82,$18854567,$3701D731,$4F534B61
	 dc.l    $37364CFD,$A3281E39,$376BE03D,$0BF225C7
	 dc.l    $37A16C26,$2777579C,$37D5C72F,$B1552D83
	 dc.l    $380B38FB,$9DAA78E4,$3841039D,$428A8B8F
	 dc.l    $38754484,$932D2E72,$38AA95A5,$B7F87A0F
	 dc.l    $38E09D87,$92FB4C49,$3914C4E9,$77BA1F5C
	 dc.l    $3949F623,$D5A8A733,$398039D6,$65896880
	 dc.l    $39B4484B,$FEEBC2A0,$39E95A5E,$FEA6B347
	 dc.l    $3A1FB0F6,$BE506019,$3A53CE9A,$36F23C10
	 dc.l    $3A88C240,$C4AECB14,$3ABEF2D0,$F5DA7DD9
	 dc.l    $3AF357C2,$99A88EA7,$3B282DB3,$4012B251
	 dc.l    $3B5E3920,$10175EE6,$3B92E3B4,$0A0E9B4F
	 dc.l    $3BC79CA1,$0C924223,$3BFD83C9,$4FB6D2AC
	 dc.l    $3C32725D,$D1D243AC,$3C670EF5,$4646D497
	 dc.l    $3C9CD2B2,$97D889BC,$3CD203AF,$9EE75616
	 dc.l    $3D06849B,$86A12B9B,$3D3C25C2,$68497682
	 dc.l    $3D719799,$812DEA11,$3DA5FD7F,$E1796495
	 dc.l    $3DDB7CDF,$D9D7BDBB,$3E112E0B,$E826D695
	 dc.l    $3E45798E,$E2308C3A,$3E7AD7F2,$9ABCAF48
	 dc.l    $3EB0C6F7,$A0B5ED8D,$3EE4F8B5,$88E368F1
	 dc.l    $3F1A36E2,$EB1C432D,$3F50624D,$D2F1A9FC
	 dc.l    $3F847AE1,$47AE147B,$3FB99999,$9999999A
	 dc.l    $3FF00000,$00000000
	 dc.l    $40240000,$00000000,$40590000,$00000000
	 dc.l    $408F4000,$00000000,$40C38800,$00000000
	 dc.l    $40F86A00,$00000000,$412E8480,$00000000
	 dc.l    $416312D0,$00000000,$4197D784,$00000000
	 dc.l    $41CDCD65,$00000000,$4202A05F,$20000000
	 dc.l    $42374876,$E8000000,$426D1A94,$A2000000
	 dc.l    $42A2309C,$E5400000,$42D6BCC4,$1E900000
	 dc.l    $430C6BF5,$26340000,$4341C379,$37E08000
	 dc.l    $43763457,$85D8A000,$43ABC16D,$674EC800
	 dc.l    $43E158E4,$60913D00,$4415AF1D,$78B58C40
	 dc.l    $444B1AE4,$D6E2EF50,$4480F0CF,$064DD592
	 dc.l    $44B52D02,$C7E14AF6,$44EA7843,$79D99DB4
	 dc.l    $45208B2A,$2C280291,$4554ADF4,$B7320335
	 dc.l    $4589D971,$E4FE8402,$45C027E7,$2F1F1281
	 dc.l    $45F431E0,$FAE6D721,$46293E59,$39A08CEA
	 dc.l    $465F8DEF,$8808B024,$4693B8B5,$B5056E17
	 dc.l    $46C8A6E3,$2246C99C,$46FED09B,$EAD87C03
	 dc.l    $47334261,$72C74D82,$476812F9,$CF7920E3
	 dc.l    $479E17B8,$4357691B,$47D2CED3,$2A16A1B1
	 dc.l    $48078287,$F49C4A1D,$483D6329,$F1C35CA5
	 dc.l    $48725DFA,$371A19E7,$48A6F578,$C4E0A061
	 dc.l    $48DCB2D6,$F618C879,$4911EFC6,$59CF7D4C
	 dc.l    $49466BB7,$F0435C9E,$497C06A5,$EC5433C6
	 dc.l    $49B18427,$B3B4A05C,$49E5E531,$A0A1C873
	 dc.l    $4A1B5E7E,$08CA3A8F,$4A511B0E,$C57E649A
	 dc.l    $4A8561D2,$76DDFDC0,$4ABABA47,$14957D30
	 dc.l    $4AF0B46C,$6CDD6E3E,$4B24E187,$8814C9CE
	 dc.l    $4B5A19E9,$6A19FC41,$4B905031,$E2503DA9
	 dc.l    $4BC4643E,$5AE44D13,$4BF97D4D,$F19D6057
	 dc.l    $4C2FDCA1,$6E04B86D,$4C63E9E4,$E4C2F344
	 dc.l    $4C98E45E,$1DF3B015,$4CCF1D75,$A5709C1B
	 dc.l    $4D037269,$87666191,$4D384F03,$E93FF9F5

*****************************************************************************
*
*  This table is used to convert those decimal numbers outside the
*  range of [10^(-64),10^(64)] to real numbers. It is also used
*  to map real numbers into the aforementioned range in the
*  real --> decimal conversion.
*
*  For a complete description of the conversion algorithms, see the
*  Math IRS.
*
*  The table contains the real values:
*  10(^-256),10^(-192),...,10^(0),10^(64),...,10^(256).
*
tb_auxpt dc.l    $0AC80628,$64AC6F43,$18123FF0,$6EEA847A
	 dc.l    $255BBA08,$CF8C979D,$32A50FFD,$44F4A73D
	 dc.l    $3FF00000,$00000000
	 dc.l    $4D384F03,$E93FF9F5,$5A827748,$F9301D32
	 dc.l    $67CC0E1E,$F1A724EB,$75154FDD,$7F73BF3C

*****************************************************************************
*
*  The next table is used in converting pairs of decimal mantissa digits
*  into their binary value in the decimal --> real conversion. The
*  two decimal digits are treated as an offset into the table, where their
*  binary is stored.
*
tb_bcd   dc.b    0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0
	 dc.b    10,11,12,13,14,15,16,17,18,19,0,0,0,0,0,0
	 dc.b    20,21,22,23,24,25,26,27,28,29,0,0,0,0,0,0
	 dc.b    30,31,32,33,34,35,36,37,38,39,0,0,0,0,0,0
	 dc.b    40,41,42,43,44,45,46,47,48,49,0,0,0,0,0,0
	 dc.b    50,51,52,53,54,55,56,57,58,59,0,0,0,0,0,0
	 dc.b    60,61,62,63,64,65,66,67,68,69,0,0,0,0,0,0
	 dc.b    70,71,72,73,74,75,76,77,78,79,0,0,0,0,0,0
	 dc.b    80,81,82,83,84,85,86,87,88,89,0,0,0,0,0,0
	 dc.b    90,91,92,93,94,95,96,97,98,99

*****************************************************************************
*
*  The next table is used in converting an 8 bit integer into a pair of
*  decimal digits in the real --> decimal conversion. The 8 bit
*  integer is used as an offset into the table, where the 2 decimal digits
*  are stored.
*
tb_bin   dc.l     $00010203,$04050607,$08091011,$12131415
	 dc.l     $16171819,$20212223,$24252627,$28293031
	 dc.l     $32333435,$36373839,$40414243,$44454647
	 dc.l     $48495051,$52535455,$56575859,$60616263
	 dc.l     $64656667,$68697071,$72737475,$76777879
	 dc.l     $80818283,$84858687,$88899091,$92939495,$96979899

*****************************************************************************
*
*  The following are coefficients used in the function evaluations.
*  They were all converted from decimal to reals using 80 bit math
*  and 20 significant decimal digits, and then rounded to the 64 bit
*  format. Only the 16 most significant decimal digits are displayed.
*
cff_loga dc.l     $bfe94415,$b356bd29          -0.7895611288749126 E +00
	 dc.l     $4030624a,$2016afed           0.1638394356302153 E +02
	 dc.l     $c05007ff,$12b3b59a          -0.6412494342374558 E +02
*
cff_logb dc.l     $c041d580,$4b67ce0f          -0.3566797773903465 E +02
	 dc.l     $40738083,$fa15267e           0.3120322209192453 E +03
	 dc.l     $c0880bfe,$9c0d9077          -0.7694993210849488 E +03

*****************************************************************************

cff_expp dc.l     $3f008b44,$2ae6921e           0.3155519276568465 E -04
	 dc.l     $3f7f074b,$f22a12a6           0.7575318015942278 E -02
	 dc.l     $3fd00000,$00000000           0.2500000000000000 E +00
*
cff_expq dc.l     $3ea93363,$0ce50455           0.7510402839987005 E -06
	 dc.l     $3f44af0c,$5c28d4df           0.6312189437439850 E -03
	 dc.l     $3fad1728,$51dfd9ff           0.5681730269855122 E -01
	 dc.l     $3fe00000,$00000000           0.5000000000000000 E +00

*****************************************************************************

cff_sin  dc.l     $3ce880ff,$6993df95           0.2720479095788886 E -14
	 dc.l     $bd6ae420,$dc08499c          -0.7642917806891047 E -12
	 dc.l     $3de6123c,$686ad430           0.1605893649037159 E -09
	 dc.l     $be5ae645,$4b5dc0ab          -0.2505210679827458 E -07
	 dc.l     $3ec71de3,$a524f063           0.2755731921015276 E -05
	 dc.l     $bf2a01a0,$1a013e1a          -0.1984126984120184 E -03
	 dc.l     $3f811111,$111110b0           0.8333333333333165 E -02
	 dc.l     $bfc55555,$55555555          -0.1666666666666667 E +00

*****************************************************************************

cff_tanp dc.l     $bef2bab7,$2ea2c724          -0.1786170734225443 E -04
	 dc.l     $3f6c0e82,$a63baadf           0.3424887823589059 E -02
	 dc.l     $bfc112b5,$e54d0900          -0.1333835000642196 E +00
	 dc.l     $3ff00000,$00000000           0.1000000000000000 E +01
*
cff_tanq dc.l     $3ea0b774,$f07678e9           0.4981943399378651 E -06
	 dc.l     $bf346f64,$99094841          -0.3118153190701003 E -03
	 dc.l     $3f9a479e,$a17e2159           0.2566383228944011 E -01
	 dc.l     $bfdddeb0,$47fbd9d5          -0.4667168333975529 E +00
	 dc.l     $3ff00000,$00000000           0.1000000000000000 E +01

*****************************************************************************

cff_asnp dc.l     $bfe64bbd,$b5e61e65          -0.6967457344735065 E +00
	 dc.l     $40244e17,$64ec3927           0.1015252223380646 E +02
	 dc.l     $c043d82c,$a9a6da9f          -0.3968886299750488 E +02
	 dc.l     $404c9aa7,$360ad48a           0.5720822787789173 E +02
	 dc.l     $c03b5e55,$a83a0a62          -0.2736849452416426 E +02
*
cff_asnq dc.l     $c037d2e8,$6ef9861f          -0.2382385915376024 E +02
	 dc.l     $4062de7c,$96591c70           0.1509527084103060 E +03
	 dc.l     $c077ddce,$fc56a848          -0.3818630336175015 E +03
	 dc.l     $407a124f,$101eb843           0.4171443024826041 E +03
	 dc.l     $c06486c0,$3e2b87cc          -0.1642109671449856 E +03

*****************************************************************************

cff_atnp dc.l     $bfeacd7a,$d9b187bd          -0.8375829936815006 E +00
	 dc.l     $c020fd3f,$5c8d6a63          -0.8494624035132068 E +01
	 dc.l     $c034817f,$b9e2bccb          -0.2050585519586165 E +02
	 dc.l     $c02b60a6,$51061ce2          -0.1368876889419193 E +02
*
cff_atnq dc.l     $402e0c49,$e14ac710           0.1502400116002858 E +02
	 dc.l     $404dca0a,$320da3d7           0.5957843614259734 E +02
	 dc.l     $40558a12,$040b6da5           0.8615734959713024 E +02
	 dc.l     $4044887c,$bcc495a9           0.4106630668257578 E +02

*****************************************************************************

cff_powp dc.l     $3f3c78fd,$db4afc28           0.4344577567216312 E -03
	 dc.l     $3f624924,$2e278dac           0.2232142128592426 E -02
	 dc.l     $3f899999,$999e080e           0.1250000000050380 E -01
	 dc.l     $3fb55555,$5555554d           0.8333333333333321 E -01
*
cff_powq dc.l     $3eef4edd,$e392cc80           0.1492885268059561 E -04
	 dc.l     $3f242f7a,$e0384c74           0.1540029044098976 E -03
	 dc.l     $3f55d87e,$18d7cd9f           0.1333354131358578 E -02
	 dc.l     $3f83b2ab,$6e131d98           0.9618129059517242 E -02
	 dc.l     $3fac6b08,$d703026d           0.5550410866408560 E -01
	 dc.l     $3fcebfbd,$ff82c4ce           0.2402265069590954 E +00
	 dc.l     $3fe62e42,$fefa39ef           0.6931471805599453 E +00
*
tb_a1    dc.l     $00000000,$00000000           Dummy entry for indexing
	 dc.l     $3ff00000,000000000,$3feea4af,$a2a490da
	 dc.l     $3fed5818,$dcfba487,$3fec199b,$dd85529c
	 dc.l     $3feae89f,$995ad3ad,$3fe9c491,$82a3f090
	 dc.l     $3fe8ace5,$422aa0db,$3fe7a114,$73eb0187
	 dc.l     $3fe6a09e,$667f3bcd,$3fe5ab07,$dd485429
	 dc.l     $3fe4bfda,$d5362a27,$3fe3dea6,$4c123422
	 dc.l     $3fe306fe,$0a31b715,$3fe2387a,$6e756238
	 dc.l     $3fe172b8,$3c7d517b,$3fe0b558,$6cf9890f
	 dc.l     $3fe00000,$00000000
*
tb_a2    dc.l     $00000000,$00000000           Dummy entry for indexing
	 dc.l     $bc7e9c23,$179c0000,$3c611065,$89500000
	 dc.l     $3c5c7c46,$b0700000,$bc641577,$ee040000
	 dc.l     $3c76324c,$05460000,$3c6ada09,$11f00000
	 dc.l     $3c79b07e,$b6c80000,$3c78a62e,$4adc0000

*****************************************************************************

stkoper  rts
	 end



	    end

@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 1119
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1119
* ADDED BOOTROM SOURCE FOR ADDRESSES $2000-$3FFF        CFB 14JUN91

		rorg 0

		nosyms
* This file contains hardware dependent addresses for the
*
*                   manufacturing unit
*
*                       Chipmunks

* USED TO BE IN THE BOOT ROM
*
*  BOOTROM2
*
*  8/14/81        - Andy Goris
*
*  This is the second half of the 9826A/B boot ROM.
*
*       RORG       $2000
*       SPRINT
*
* CRT CHARACTER SET
*
* Removed from TRAILMIX on 1/11/90                              {dfk}
*
*       RORG       $3000
*       SPRINT
*
* tables for conversion between base 10k and bdc
*
*
BIN2BCD dc.b $00,$01,$02,$03,$04
	dc.b $05,$06,$07,$08,$09
	dc.b $10,$11,$12,$13,$14
	dc.b $15,$16,$17,$18,$19
	dc.b $20,$21,$22,$23,$24
	dc.b $25,$26,$27,$28,$29
	dc.b $30,$31,$32,$33,$34
	dc.b $35,$36,$37,$38,$39
	dc.b $40,$41,$42,$43,$44
	dc.b $45,$46,$47,$48,$49
	dc.b $50,$51,$52,$53,$54
	dc.b $55,$56,$57,$58,$59
	dc.b $60,$61,$62,$63,$64
	dc.b $65,$66,$67,$68,$69
	dc.b $70,$71,$72,$73,$74
	dc.b $75,$76,$77,$78,$79
	dc.b $80,$81,$82,$83,$84
	dc.b $85,$86,$87,$88,$89
	dc.b $90,$91,$92,$93,$94
	dc.b $95,$96,$97,$98,$99
*
bcd2bin dc.b 00,01,02,03,04,05,06,07,08,09,0,0,0,0,0,1
	dc.b 10,11,12,13,14,15,16,17,18,19,0,0,0,0,0,0
	dc.b 20,21,22,23,24,25,26,27,28,29,0,0,0,0,0,0
	dc.b 30,31,32,33,34,35,36,37,38,39,0,0,0,0,0,0
	dc.b 40,41,42,43,44,45,46,47,48,49,0,0,0,0,0,0
	dc.b 50,51,52,53,54,55,56,57,58,59,0,0,0,0,0,0
	dc.b 60,61,62,63,64,65,66,67,68,69,0,0,0,0,0,0
	dc.b 70,71,72,73,74,75,76,77,78,79,0,0,0,0,0,0
	dc.b 80,81,82,83,84,85,86,87,88,89,0,0,0,0,0,0
	dc.b 90,91,92,93,94,95,96,97,98,99
	PAGE
*------------------------------------------
*     PASCAL support routines    Rev 1.1
*     written by: Bob Roeder
*                 Brad Ritter
*------------------------------------------
	DEF asm_rmovel
*------------------------------------------
M@@VEL           EQU             *
		MOVEA.L         (SP)+,A2       SAVE RETURN ADDRESS
		MOVE.L          (SP)+,D0       LENGTH
		MOVEA.L         (SP)+,A0       DESTINATION ADDRESS
		MOVEA.L         (SP)+,A1       SOURCE ADDRESS
		MOVE.L          A2,-(SP)       RESTORE RETURN ADDRESS
asm_rmovel      EQU             *          ENTRY POINT FOR OPERANDS IN REGISTERS
		TST.L           D0
		BLE.S           DONEE
		MOVE.W          A0,D1
		MOVE.W          A1,D2
		ANDI.B          #1,D1
		ANDI.B          #1,D2
		EOR.B           D2,D1      ARE BOTH ADDRESSES ON EVEN OR BOTH ON
*                                          ODD BOUNDARIES?
		BEQ.S           FAANCY
LOOOP           EQU             *
		MOVE.B          (A1)+,(A0)+
		SUBQ.L          #1,D0
		BGT.S           LOOOP
		BRA.S           DONEE
FAANCY          EQU             *
		TST.B           D2
		BEQ.S           SKIIP1
		MOVE.B          (A1)+,(A0)+    MOVE ONE BYTE TO GET TO AN EVEN
*                                              BYTE ADDRESS
		SUBQ.L          #1,D0
		BLE.S           DONEE
SKIIP1          EQU             *
		MOVE.L          D0,D1        PERFORM COUNT DIV 4 LONG WORD MOVES
		LSR.L           #2,D1
		BEQ.S           SKIIP2
LOOOP2          EQU             *
		MOVE.L          (A1)+,(A0)+
		SUBQ.L          #1,D1
		BGT.S           LOOOP2
SKIIP2          EQU             *
		ANDI.B          #3,D0
		MOVE.B          D0,D1
		LSR.B           #1,D1
		BEQ.S           SKIIP3
		MOVE.W          (A1)+,(A0)+
SKIIP3          EQU             *
		ANDI.B          #1,D0
		BEQ.S           DONEE
		MOVE.B          (A1)+,(A0)+
DONEE           EQU             *
		RTS

	  PAGE
*------------------------------------------
	DEF asm_rmover
*------------------------------------------
M@@VER           EQU             *
		MOVEA.L         (SP)+,A2       SAVE RETURN ADDRESS
		MOVE.L          (SP)+,D0       LENGTH
		MOVEA.L         (SP)+,A0       DESTINATION ADDRESS
		MOVEA.L         (SP)+,A1       SOURCE ADDRESS
		MOVE.L          A2,-(SP)       RESTORE RETURN ADDRESS
asm_rmover      EQU             *          ENTRY POINT FOR OPERANDS IN REGISTERS
		TST.L           D0
		BLE.S           DONE
		ADDA.L          D0,A0
		ADDA.L          D0,A1
		MOVE.W          A0,D1
		MOVE.W          A1,D2
		ANDI.B          #1,D1
		ANDI.B          #1,D2
		EOR.B           D2,D1      ARE BOTH ADDRESSES ON EVEN OR BOTH ON
*                                          ODD BOUNDARIES?
		BEQ.S           FANCY
LOOP            EQU             *
		MOVE.B          -(A1),-(A0)
		SUBQ.L          #1,D0
		BGT.S           LOOP
		BRA.S           DONE
FANCY           EQU             *
		TST.B           D2
		BEQ.S           SKIP1
		MOVE.B          -(A1),-(A0)     MOVE ONE BYTE TO GET TO AN EVEN
*                                               BYTE ADDRESS
		SUBQ.L          #1,D0
		BLE.S           DONE
SKIP1           EQU             *
		MOVE.L          D0,D1        PERFORM COUNT DIV 4 LONG WORD MOVES
		LSR.L           #2,D1
		BEQ.S           SKIP2
LOOP2           EQU             *
		MOVE.L          -(A1),-(A0)
		SUBQ.L          #1,D1
		BGT.S           LOOP2
SKIP2           EQU             *
		ANDI.B          #3,D0
		MOVE.B          D0,D1
		LSR.B           #1,D1
		BEQ.S           SKIP3
		MOVE.W          -(A1),-(A0)
SKIP3           EQU             *
		ANDI.B          #1,D0
		BEQ.S           DONE
		MOVE.B          -(A1),-(A0)
DONE            EQU             *
		RTS
	 PAGE
*------------------------------------------
	DEF asm_mpy
*------------------------------------------
asm_mpy         equ             *
		movem.l         (sp)+,d0/d1/d2  get return addr and operands
		movea.w         d1,a0
		cmpa.l          d1,a0           test for 16 bit 2's compl
		bne.s           not_wd1
		movea.w         d2,a0
		cmpa.l          d2,a0           test for 16 bit 2's compl
		bne.s           twoXone
		muls            d1,d2           signed multiply
		move.l          d2,-(sp)        push result
		movea.l         d0,a0           fake rts
		jmp             (a0)
*
not_wd1         movea.w         d2,a0           test for 16 bit 2's compl
		cmpa.l          d2,a0
		bne.s           twoXtwo         branch to 32 x 32 bit mult
		exg             d1,d2           put 16 bit value in d1
*
twoXone         move.w          d2,d3
		mulu            d1,d3           low order partial product
		move.l          d2,d4
		swap            d4
		mulu            d1,d4           high order partial product
		swap            d3
		moveq           #0,d5           clear high word
		move.w          d3,d5
		add.l           d5,d4           add middle products
		tst.w           d1              sign of multiplier ???
		bpl.s           mcand
		sub.l           d2,d4           subtract multiplicand
mcand           tst.l           d2              sign of multiplicand ???
		bpl.s           out
		move.w          d1,d5           if negative
		swap            d5
		sub.l           d5,d4           subtract multiplier
out             movea.w         d4,a0
		cmpa.l          d4,a0           test for overflow
		bne.s           ovflow
		swap            d3
		move.w          d3,-(sp)        store low  order part
		move.w          d4,-(sp)        store high order part
		movea.l         d0,a0           fake rts
		jmp             (a0)
*
twoXtwo         equ             *
		move.l          d1,d3           look at multiplier
		moveq           #0,d7           clear flag
		asr.l           #1,d3           divide by 2
		bcc.s           even1           catch LSB
		move.l          d2,d7           use multiplicand in flag
even1           movea.w         d3,a0           check for 16 bit 2's compl
		cmp.l           a0,d3
		beq             soneXtwo
		move.l          d2,d3           otherwise try multiplicand
		moveq           #0,d7           clear flag
		asr.l           #1,d3           divide by 2
		bcc.s           even2           catch LSB
		move.l          d1,d7           use multiplier in flag
even2           movea.w         d3,a0           check for 16 bit 2's compl
		cmp.l           a0,d3
		bne             ovflow
		move.l          d1,d2
soneXtwo        lea             muldone,a1
		exg             a1,d0           use twoXone mult routine
		move.l          d3,d1
		bra.s           twoXone
muldone         addq            #4,sp           clean up stack
		add.w           d3,d3           multiply product by 2
		addx.l          d4,d4
		add.w           d7,d3           add flag
		swap            d7
		ext.l           d7
		addx.l          d7,d4
		swap            d3              put d3 in wrong order for out
		move.l          a1,d0           put return address in d0
		bra.s           out
ovflow          trap            #4
		PAGE
*------------------------------------------
 DEF E@@DIV
 DEF E@@MOD
*------------------------------------------
*               register usage
*               d0 - return address
*               d1 - divisor
*               d2 - dividend and quotient
*               d3 - remainder
*               d4 - loop counter
*               d5 - sign of remainder
*               d6 - sign of quotent
*               d7 - mod/div flag
*
E@@MOD           moveq           #1,d7           set mod flag
		bra.s           d_start
E@@DIV           moveq           #0,d7           clear mod flag
d_start         movem.l         (sp)+,d0/d1/d2  read return addr and operands
		tst.l           d1              divide by zero?
		beq.s           zerodiv
		movea.w         d1,a0           is divisor a
		cmp.l           a0,d1           16 bit integer?
		bne.s           do_full
		move.l          d2,d3           try signed divide
		divs            d1,d3
		bvs.s           do_full         did it work?
		tst.w           d7              mod or div?
		beq.s           div_1
		swap            d3
div_1           ext.l           d3
dm_out          move.l          d3,-(sp)        push result
		movea.l         d0,a0
		jmp             (a0)            fake return
zerodiv         trap            #5
*
*               convert divisor and dividend to sign magnitude
*
do_full         moveq           #15,d4          loop count - 1
		moveq           #0,d6           sign of quotient
		moveq           #0,d5           sign of remainder
		tst.l           d1              divisor negative?
		bpl.s           divend
		neg.l           d1
		bvs.s           max_neg_dvsr
		not.w           d6              set sign flag
divend          tst.l           d2              divedend negative
		bpl.s           rmndr
		neg.l           d2              complement quotient sign
		bvc.s           not_special
		cmp.l           #-1,d1
		beq.s           ovflow
not_special     not             d6              flag
		not             d5              negative remainder
rmndr           moveq           #0,d3           clear remainder
		swap            d1              is divisor <= 16 bits
		tst.w           d1
		bne.s           big_div
		swap            d2
		swap            d1
		move.w          d2,d3           get high order dividend
		divu            d1,d3           high part of divide
		move.w          d3,d2           high quotient to d2
		swap            d2
		move.w          d2,d3           divide low order
		divu            d1,d3           dividend by divisor
		move.w          d3,d2           quotient in d2
		clr.w           d3
		swap            d3              remainder in d3
*               put in correct sigh for quotient and remainder
dm_fixup        tst.w           d6
		bpl.s           chk_rem
		neg.l           d2
chk_rem         tst.w           d5
		bpl.s           dm_store
		neg.l           d3
dm_store        tst.w           d7              div or mod?
		bne.s           dm_out
		exg             d2,d3
		bra.s           dm_out
*
*               handle maximum negative divisor
*
max_neg_dvsr    neg.l           d2
		bvs.s           max_max         test for max neg dividend
		move.l          d2,d3
		neg.l           d3
		moveq           #0,d2
		bra.s           dm_store
max_max         moveq           #1,d2
		moveq           #0,d3
		bra.s           dm_store
*
*               32 bit divisor
*
big_div         swap            d1              restore divisor
		swap            d2              move high order
		move.w          d2,d3           dividend to remainder
		clr.w           d2              shift dividend 16 bits left
		sub.l           d1,d3           subtract divisor from rem.
		movea.l         d1,a0           divisor in a0
		neg.l           d1              minus divisor in d1
*
*               co-routine for negative remainder
*
m_top           add.l           d2,d2           shift dividend and quotient
		addx.l          d3,d3           shift remainder
		add.l           a0,d3           add divisor
		bpl.s           p_bottom        remainder positive?
m_bottom        dbra            d4,m_top        loop 16 times
		add.l           a0,d3           restore remainder
		add.l           d2,d2           shift in last bit of quotient
		bra.s           dm_fixup
*
*               co-routine for positive remainder
*
p_top           addx.l          d2,d2           shift dividend and quotient
		addx.l          d3,d3           shift remainder
		add.l           d1,d3           subtract divisor
		bmi.s           m_bottom        remainder negative?
p_bottom        dbra            d4,p_top        loop 16 times
		addx.l          d2,d2           shift in last bit of quotient
		bra.s           dm_fixup
	    PAGE
*------------------------------------------
	    DEF asm_equal
	    DEF asm_nequal
*------------------------------------------
asm_nequal    EQU *
	    move.b     #1,-(sp)
	    move.b     #0,-(sp)
	    bra.s        strrt
asm_equal     EQU *
	    move.b     #0,-(sp)
	    move.b     #1,-(sp)
* obtain sets from stack
strrt       movea.l    8(sp),a3           address of right op
	    movea.l    12(sp),a4          address of left op
* place minimum size in d5
	    move.w     (a3)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin
LEFTMIN     move.w     d6,d5
	    bra.s        nulltest           REI 7/3/80
RIGHTMIN    move.w     d7,d5
nulltest    beq.s        restof             REI 7/3/80

* perform set comparison
LONG        asr.w      #2,d5              determine size in long words
	    bcc.s        even               even number of long words
	    cmpm.w     (a3)+,(a4)+        compare "odd" word
	    bne.s        nope
	    tst.w      d5                 min size single word?
	    beq.s        restof
EVEN        cmpm.l     (a3)+,(a4)+        compare long words
	    bne.s        nope
	    subq.w     #1,d5
	    bgt.s        even
* if operands of unequal size, test rest of longer -
*   if all "extra" bits not 0, sets are unequal
RESTOF      sub.w      d6,d7              size of right op-size of left op
	    beq.s        yep                equal size
	    bpl.s        right              right op longer
	    neg.w      d7                 d7 = # bytes longer
LEFT        tst.w      (a4)+              left op longer, test it
	    bne.s        nope
	    subq.w     #2,d7              2 bytes tested
	    bgt.s        left
	    bra.s        yep
RIGHT       tst.w      (a3)+              test right op
	    bne.s        nope
	    subq.w     #2,d7              2 bytes tested
	    bgt.s        right
* move true or false value to result
YEP         move.b     (sp),14(sp)
	    bra.s        fnsh
NOPE        move.b     2(sp),14(sp)
fnsh        move.l     4(sp),10(sp)       put return address at the right place
	    adda.l     #10,sp             eliminate extra bytes in stack
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_assign
*------------------------------------------
asm_assign    EQU *
* obtain sets from stack
	    movea.l    4(sp),a3          address of source
	    movea.l    8(sp),a4          address of dest
* place size in d7
	    move.w     (a3)+,d7          size of source
	    move.w     d7,(a4)+          store size in dest
	    beq.s      done2             check for zero length set
* perform assignment
	    asr.w      #2,d7              determine size in long words
	    bcc.s        evenn              even number of long words
	    move.w     (a3)+,(a4)+        move "odd" word
	    tst.w      d7                 min size single word?
	    beq.s        done2
EVENN       move.l     (a3)+,(a4)+        move long words
	    subq.w     #1,d7
	    bgt.s        evenn
DONE2       move.l     (sp),8(sp)         eliminate extra bytes in stack
	    addq.l     #8,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_union
*------------------------------------------
asm_union     EQU *
* obtain sets from stack
	    movea.l    4(sp),a2           address of right op
	    movea.l    8(sp),a4           address of left op
	    movea.l    12(sp),a3          address of result
* place minimum size in d5
	    move.w     (a2)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin2
LEFTMIN2    move.w     d6,d5
	    move.w     d7,(a3)+           result size is max op size
	    bra.s        nulltest2          REI 7/3
RIGHTMIN2   move.w     d7,d5
	    move.w     d6,(a3)+           result size is max op size
nulltest2   tst.w      d5                 REI 7/3
	    beq.s        restof2            REI 7/3

* perform set union
LONG3       asr.w      #2,d5              determine size in long words
	    bcc.s        even3              even number of long words
	    move.w     (a2)+,d4           union "odd" word
	    or.w       (a4)+,d4
	    move.w     d4,(a3)+
	    tst.w      d5                 min size single word?
	    beq.s        restof2
EVEN3       move.l     (a2)+,d4           union long words
	    or.l       (a4)+,d4
	    move.l     d4,(a3)+
	    subq.w     #1,d5
	    bgt.s        even3
* move rest of longer operand
RESTOF2     sub.w      d6,d7              size of right op-size of left op
	    beq.s        done3              equal size
	    bpl.s        right2             right op longer
	    neg.w      d7                 d7 = # bytes longer
LEFT2       move.w     (a4)+,(a3)+        left op longer, move it
	    subq.w     #2,d7              2 bytes moved
	    bgt.s        left2
	    bra.s        done3
RIGHT2      move.w     (a2)+,(a3)+        move right op
	    subq.w     #2,d7              2 bytes moved
	    bgt.s        right2
DONE3       move.l     (sp),12(sp)        eliminate extra bytes in stack
	    adda.l     #12,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_inclusion
*------------------------------------------
asm_inclusion EQU *
* obtain sets from stack
	    movea.l    4(sp),a3           address of right op
	    movea.l    8(sp),a4           address of left op
* place minimum size in d5
	    move.w     (a3)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin3
LEFTMIN3    move.w     d6,d5
	    bra.s        nulltest3          REI 7/3
RIGHTMIN3   move.w     d7,d5
nulltest3   beq.s        restof3            REI 7/3

* perform inclusion test
LONG4       asr.w      #2,d5              determine size in long words
	    bcc.s        even4              even number of long words
	    move.w     (a3)+,d4           "odd" word inclusion
	    not.w      d4
	    and.w      (a4)+,d4
	    bne.s        nope2
	    tst.w      d5                 min size single word?
	    beq.s        restof3
EVEN4       move.l     (a3)+,d4           long word inclusion
	    not.l      d4
	    and.l      (a4)+,d4
	    bne.s        nope2
	    subq.w     #1,d5
	    bgt.s        even4
* if left operand longer, test "extra" portion
RESTOF3     sub.w      d7,d6              size of left op-size of right op
	    ble.s        yep2               left op not longer
LEFT3       tst.w      (a4)+              left op longer, test it
	    bne.s        nope2
	    subq.w     #2,d6              2 bytes tested
	    bgt.s        left3
* move boolean value to result
YEP2        move.b     #1,10(sp)          true
	    bra.s        cleanup
NOPE2       move.b     #0,10(sp)          false
CLEANUP     move.l     (sp),6(sp)         eliminate extra bytes in stack
	    addq.l     #6,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_intersect
*------------------------------------------
asm_intersect EQU *
* obtain sets from stack
	    movea.l    4(sp),a2           address of right op
	    movea.l    8(sp),a4           address of left op
	    movea.l    12(sp),a3          address of result
* place minimum size in d7
	    move.w     (a2)+,d7           size of right op
	    cmp.w      (a4)+,d7           compare with size of left op
	    ble.s        setsize
LEFTMIN4    move.w     -2(a4),d7
SETSIZE     move.w     d7,(a3)+           result size = min op size
	    beq.s        done4              REI 7/3

* perform set intersection
	    asr.w      #2,d7              determine size in long words
	    bcc.s        even5              even number of long words
	    move.w     (a2)+,d6           intersect "odd" word
	    and.w      (a4)+,d6
	    move.w     d6,(a3)+
	    tst.w      d7                 min size single word?
	    beq.s        done4
EVEN5       move.l     (a2)+,d6           intersect long words
	    and.l      (a4)+,d6
	    move.l     d6,(a3)+
	    subq.w     #1,d7
	    bgt.s        even5
DONE4       move.l     (sp),12(sp)
	    adda.l     #12,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_difference
*------------------------------------------
asm_difference EQU *
* obtain sets from stack
	    movea.l    4(sp),a2           address of right op
	    movea.l    8(sp),a4           address of left op
	    movea.l    12(sp),a3          address of result
* place minimum size in d5
	    move.w     (a2)+,d7           size of right op
	    move.w     (a4)+,d6           size of left op
	    cmp.w      d6,d7
	    ble.s        rightmin5
LEFTMIN5    move.w     d6,d5
	    bra.s        setsize2
RIGHTMIN5   move.w     d7,d5
SETSIZE2    move.w     d6,(a3)+           result size = size of left op
	    tst.w      d5                 REI 7/3
	    beq.s        restof4            REI 7/3

* perform difference
	    asr.w      #2,d5              determine size in long words
	    bcc.s        even6              even number of long words
	    move.w     (a2)+,d4           difference of "odd" word
	    not.w      d4
	    and.w      (a4)+,d4
	    move.w     d4,(a3)+
	    tst.w      d5                 min size single word?
	    beq.s        restof4
EVEN6       move.l     (a2)+,d4           long word difference
	    not.l      d4
	    and.l      (a4)+,d4
	    move.l     d4,(a3)+
	    subq.w     #1,d5
	    bgt.s        even6
* if left operand longer, move to result
RESTOF4     sub.w      d7,d6              size of left op-size of right op
	    ble.s        done5
LEFT4       move.w     (a4)+,(a3)+        left op longer, move it
	    subq.w     #2,d6              2 bytes moved
	    bgt.s        left4
DONE5       move.l     (sp),12(sp)        eliminate extra bytes in stack
	    adda.l     #12,sp
	    rts
	    PAGE
*------------------------------------------
	    DEF asm_in
*------------------------------------------
asm_in  movea.l         (sp)+,a0        return address
	movea.l         (sp)+,a1        set address
	move.l          (sp)+,d0        selector value
	blt.s           lfalse          selector<0?
	divs            #8,d0
	cmp.w           (a1),d0         selector>setsize?
	bge.s           lfalse
	move.l          d0,d1
	swap d1
	move.b          2(a1,d0),d0     get selected byte
	lsl.b           d1,d0           construct Boolean result
	lsr.b           #7,d0
	move.b          d0,-(sp)        push the result
	jmp             (a0)
lfalse  clr.b           -(sp)
	jmp             (a0)
	PAGE
*------------------------------------------
	   DEF  E@@DDELEMENT
*------------------------------------------
E@@DDELEMENT EQU         *
	movea.l         (sp)+,a0         return address
	move.w          (sp)+,d0        element number to add to set
	movea.l         (sp)+,a1        source address
	movea.l         (sp),a2         destination address
	move.w          (a1)+,d7        get set size of source
	move.w          d7,(a2)+        store size value
	cmpa.l          a2,a1           see if source and destination are equal
	beq.s           insert1
* copy source set to the destination set
setcopy movea.l         a2,a3           save destination address
	move.w          d7,d6           save size for destination
	ble.s           insert1         check for size of zero
rept    move.w          (a1)+,(a3)+     sets are always an even number of bytes
	subq.w          #2,d6
	bgt.s           rept
* insert an element in a set, adjusting the size of the destination if needed
insert1 ext.l           d0
	divs            #16,d0           byte offset in low word
	move.l          d0,d5
	swap            d5              bit offset from left of byte
	sub.w           #15,d5
	neg.w           d5              bit offset from right
	asl             #1,d0           make d0 a byte offset
	move.w          d0,d1           compute final size into d1
	addq.w          #2,d1           put zeros in the two bytes containing
	move.w          d1,d2           the new bit if it is beyond current size
	sub.w           -2(a2),d1
	ble.s           exxiit
	move.w          d2,-2(a2)       store appropriate size for set
	lea             0(a2,d2),a3
zerout  clr.w           -(a3)
	subq.w          #2,d1
	bgt.s           zerout
exxiit  bclr            #3,d5           { received upgrade 9/9 }
	beq.s           skiipp
	bset            d5,0(a2,d0)
	jmp             (a0)
skiipp  bset            d5,1(a2,d0)
	jmp             (a0)
	PAGE
*------------------------------------------
*       procedure SCOPY (var destination, source: string;
*                        index, length: integer);
*       procedure SAPPEND (var destination, source: string);
*       procedure INSERT (var source, destination: string; index: integer);
*       procedure DELETE (var destination: string; index, length: integer);
*       function  POS (var target, source: string): integer;
*
	DEF E@@SCOPY
	DEF E@@SAPPEND
	DEF E@@INSERT
	DEF E@@DELETE
	DEF asm_pos

	NOSYMS

DESTINATION     EQU A4
SOURCE          EQU A3
RETURN          EQU A2
PTR             EQU A1
PTR2            EQU A0
TARGET          EQU DESTINATION

INDEX           EQU D7
LENGTH          EQU D6
DLEN            EQU D5
SLEN            EQU D4
ONRIGHT         EQU D3
COUNT           EQU D2
PTEMP           EQU D1
CHAR            EQU D0
TLEN            EQU DLEN

E@@SAPPEND       EQU *
SAPPEND         EQU *
	MOVEM.L (SP)+,RETURN/SOURCE/DESTINATION     RETURN ADDRESS, PARAMETERS
	CLR     SLEN
	MOVE.B  (SOURCE)+,SLEN          LENGTH OF SOURCE
	BEQ.S   L2                      FINISH EARLY IF NULL
	CLR     DLEN
	MOVE.B  (DESTINATION),DLEN      LENGTH OF DESTINATION
	LEA     1(DESTINATION,DLEN.W),PTR       START AT DEST[DLEN+1]
	ADD.B   SLEN,DLEN               COMPUTE LENGTH OF RESULT
	BCS.S   L2                      ABORT IF TOO LONG
	MOVE.B  DLEN,(DESTINATION)
	SUBQ    #1,SLEN
L1      MOVE.B  (SOURCE)+,(PTR)+        TRANSFER BYTES
	DBRA    SLEN,L1
L2      JMP     (RETURN)                END

E@@INSERT        EQU *
INSERT          EQU *
	MOVEA.L (SP)+,RETURN
	MOVE.L  (SP)+,INDEX             GET PARAMETERS
	MOVEA.L (SP)+,DESTINATION
	MOVEA.L (SP)+,SOURCE
	BLE.S   L6                      ERROR EXIT IF NOT (INDEX > 0 )
	CLR     SLEN
	MOVE.B  (SOURCE)+,SLEN
	BEQ.S   L6                      EXIT IF SOURCE IS NULL
	CLR     DLEN
	MOVE.B  (DESTINATION),DLEN
	LEA     1(DESTINATION,DLEN.W),PTR       POINT TO "TAIL" OF DESTINATION
	MOVE    DLEN,ONRIGHT            (SAVE DLEN FOR LATER)
	ADD.B   SLEN,DLEN               NEW LENGTH OF DESTINATION
	BCS.S   L6                      EXIT IF TOO LONG
	MOVE.B  DLEN,(DESTINATION)
	SUB     INDEX,ONRIGHT           NUMBER OF BYTES TO SHIFT RIGHT (LESS 1)
	BGE.S   L3
	ADDQ    #1,ONRIGHT              TEST FOR EXACTLY ZERO
	BEQ.S   L5
	JMP     (RETURN)                ERROR EXIT (INDEX > DLEN + 1)
L3      LEA     0(PTR,SLEN.W),PTR2      MAKE ROOM FOR SOURCE
L4      MOVE.B  -(PTR),-(PTR2)          BY SHIFTING RIGHT
	DBRA    ONRIGHT,L4
	SUBQ    #1,SLEN
L5      MOVE.B  (SOURCE)+,(PTR)+        TRANSFER BYTES
	DBRA    SLEN,L5
L6      JMP     (RETURN)                END

E@@SCOPY         EQU *
SCOPY           EQU *
	MOVEA.L (SP)+,RETURN
	MOVE.L  (SP)+,LENGTH            GET PARAMETERS
	MOVE.L  (SP)+,INDEX
	MOVEA.L (SP)+,SOURCE
	MOVEA.L (SP)+,DESTINATION
	BLE.S   L9                      EXIT IF NOT (INDEX > 0)
	TST.L   LENGTH
	BLT.S   L9                      ERROR IF REQUESTED LENGTH < 0
	CLR     SLEN
	MOVE.B  (SOURCE),SLEN
	ADDQ    #1,SLEN
	SUB     INDEX,SLEN              LENGTH OF SUBSTRING
	BLT.S   L9                      ERROR IF (INDEX > SLEN + 1)
	CMP     SLEN,LENGTH             TAKE MINIMUM OF SLEN, LENGTH
	BLE.S   L7
	MOVE    SLEN,LENGTH             SUBSTRING LENGTH IS SMALLER
L7      MOVE.B  LENGTH,(DESTINATION)+   SET LENGTH INTO DESTINATION
	SUBQ    #1,LENGTH
	BLT.S   L9
	LEA     0(SOURCE,INDEX.W),PTR
L8      MOVE.B  (PTR)+,(DESTINATION)+   COPY THE BYTES
	DBRA    LENGTH,L8
L9      JMP     (RETURN)

E@@DELETE        EQU *
DELETE          EQU *
	MOVEA.L (SP)+,RETURN
	MOVE.L  (SP)+,LENGTH            GET PARAMETERS
	MOVE.L  (SP)+,INDEX
	MOVEA.L (SP)+,DESTINATION
	BLE.S   L11                     EXIT IF NOT (INDEX > 0)
	TST.L   LENGTH
	BLE.S   L11                     EXIT IF LENGTH <= 0
	CLR     DLEN
	MOVE.B  (DESTINATION),DLEN
	SUB     LENGTH,DLEN             NEW LENGTH OF STRING
	BLT.S   L11                     ERROR IF < 0
	MOVE    DLEN,ONRIGHT
	ADDQ    #1,ONRIGHT
	SUB     INDEX,ONRIGHT           NUMBER OF CHARACTERS TO MOVE
	BLT.S   L11                     ERROR IF NEGATIVE
	MOVE.B  DLEN,(DESTINATION)      SET NEW LENGTH
	SUBQ    #1,ONRIGHT
	BLT.S   L11                     FINISH EARLY IF NO BYTES TO MOVE
	LEA     0(DESTINATION,INDEX.W),PTR
	LEA     0(PTR,LENGTH.W),PTR2
L10     MOVE.B  (PTR2)+,(PTR)+
	DBRA    ONRIGHT,L10
L11     JMP     (RETURN)

asm_pos         EQU *
POS             EQU *
	MOVEM.L (SP)+,RETURN/SOURCE/TARGET
	CLR.L   (SP)                    POS WILL BE 0 IF SEARCH FAILS
	CLR     TLEN
	MOVE.B  (TARGET)+,TLEN
	BEQ.S   L16                     POS IS 0 IF TARGET IS NULL
	CLR.L   SLEN
	MOVE.B  (SOURCE)+,SLEN
	SUB     TLEN,SLEN               NUMBER OF POSSIBLE PLACES (LESS 1)
	BLT.S   L16                     POS IS 0 IF TARGET LONGER THAN SRC
	MOVE.B  (TARGET)+,CHAR          FIRST CHARACTER OF TARGET
	SUBQ    #2,TLEN                 LENGTH OF REST OF TARGET (LESS 1)
	MOVE.L  SLEN,PTEMP              TENTATIVE VALUE OF POS

L12     CMP.B   (SOURCE)+,CHAR
L13     DBEQ    SLEN,L12                LOOP TILL FIND FIRST BYTE OF TARGET
	BNE.S   L16                     POS IS 0 IF DIDN'T FIND IT
	MOVE    TLEN,COUNT              REMAINING CHARACTERS (LESS 1)
	BLT.S   L15                     FOUND IT IF LENGTH(TARGET) IS 1
	LEA     (TARGET),PTR            ELSE COMPARE REMAINING CHARS
	LEA     (SOURCE),PTR2
L14     CMPM.B  (PTR)+,(PTR2)+          LOOP TILL MATCH OR MISMATCH
	DBNE    COUNT,L14
	BNE.S   L13                     IF MISMATCH, CONTINUE SCAN
L15     SUB     SLEN,PTEMP              FOUND IT, SO FIGURE HOW FAR
	ADDQ    #1,PTEMP                        WE ADVANCED
	MOVE.L  PTEMP,(SP)              RETURN INDEX VALUE
L16     JMP     (RETURN)
*****************************************************************************
*
*  These are the power-of-ten tables that are used in the
*  decimal <--> real conversions.
*
*  Decimal / real numbers in the range [10^(-64),10^(64)]
*  convert into real / decimal numbers with one real
*  multiply while all other decimal <--> real conversions require
*  2 real multiplies and the use of the table tb_auxpt.
*
*  For a complete description of the conversion algorithms, see the
*  Math IRS.
*
*  The table contains the real values:
*  10^(-80),10^(-79),...,10^(0),.10^(1),...,10^(64).
*
tb_pwt   dc.l    $2F52F8AC,$174D6123,$2F87B6D7,$1D20B96C
	 dc.l    $2FBDA48C,$E468E7C7,$2FF286D8,$0EC190DC
	 dc.l    $3027288E,$1271F513,$305CF2B1,$970E7258
	 dc.l    $309217AE,$FE690777,$30C69D9A,$BE034955
tb_pwt8  dc.l    $30FC4501,$6D841BAA,$3131AB20,$E472914A
	 dc.l    $316615E9,$1D8F359D,$319B9B63,$64F30304
tb_pwt4  dc.l    $31D1411E,$1F17E1E3,$32059165,$A6DDDA5B
	 dc.l    $323AF5BF,$109550F2,$3270D997,$6A5D5297
tb_pwtt  dc.l    $32A50FFD,$44F4A73D,$32DA53FC,$9631D10D
	 dc.l    $3310747D,$DDDF22A8,$3344919D,$5556EB52
	 dc.l    $3379B604,$AAACA626,$33B011C2,$EAABE7D8
	 dc.l    $33E41633,$A556E1CE,$34191BC0,$8EAC9A41
	 dc.l    $344F62B0,$B257C0D2,$34839DAE,$6F76D883
	 dc.l    $34B8851A,$0B548EA4,$34EEA660,$8E29B24D
	 dc.l    $352327FC,$58DA0F70,$3557F1FB,$6F10934C
	 dc.l    $358DEE7A,$4AD4B81F,$35C2B50C,$6EC4F313
	 dc.l    $35F7624F,$8A762FD8,$362D3AE3,$6D13BBCE
	 dc.l    $366244CE,$242C5561,$3696D601,$AD376AB9
	 dc.l    $36CC8B82,$18854567,$3701D731,$4F534B61
	 dc.l    $37364CFD,$A3281E39,$376BE03D,$0BF225C7
	 dc.l    $37A16C26,$2777579C,$37D5C72F,$B1552D83
	 dc.l    $380B38FB,$9DAA78E4,$3841039D,$428A8B8F
	 dc.l    $38754484,$932D2E72,$38AA95A5,$B7F87A0F
	 dc.l    $38E09D87,$92FB4C49,$3914C4E9,$77BA1F5C
	 dc.l    $3949F623,$D5A8A733,$398039D6,$65896880
	 dc.l    $39B4484B,$FEEBC2A0,$39E95A5E,$FEA6B347
	 dc.l    $3A1FB0F6,$BE506019,$3A53CE9A,$36F23C10
	 dc.l    $3A88C240,$C4AECB14,$3ABEF2D0,$F5DA7DD9
	 dc.l    $3AF357C2,$99A88EA7,$3B282DB3,$4012B251
	 dc.l    $3B5E3920,$10175EE6,$3B92E3B4,$0A0E9B4F
	 dc.l    $3BC79CA1,$0C924223,$3BFD83C9,$4FB6D2AC
	 dc.l    $3C32725D,$D1D243AC,$3C670EF5,$4646D497
	 dc.l    $3C9CD2B2,$97D889BC,$3CD203AF,$9EE75616
	 dc.l    $3D06849B,$86A12B9B,$3D3C25C2,$68497682
	 dc.l    $3D719799,$812DEA11,$3DA5FD7F,$E1796495
	 dc.l    $3DDB7CDF,$D9D7BDBB,$3E112E0B,$E826D695
	 dc.l    $3E45798E,$E2308C3A,$3E7AD7F2,$9ABCAF48
	 dc.l    $3EB0C6F7,$A0B5ED8D,$3EE4F8B5,$88E368F1
	 dc.l    $3F1A36E2,$EB1C432D,$3F50624D,$D2F1A9FC
	 dc.l    $3F847AE1,$47AE147B,$3FB99999,$9999999A
	 dc.l    $3FF00000,$00000000
	 dc.l    $40240000,$00000000,$40590000,$00000000
	 dc.l    $408F4000,$00000000,$40C38800,$00000000
	 dc.l    $40F86A00,$00000000,$412E8480,$00000000
	 dc.l    $416312D0,$00000000,$4197D784,$00000000
	 dc.l    $41CDCD65,$00000000,$4202A05F,$20000000
	 dc.l    $42374876,$E8000000,$426D1A94,$A2000000
	 dc.l    $42A2309C,$E5400000,$42D6BCC4,$1E900000
	 dc.l    $430C6BF5,$26340000,$4341C379,$37E08000
	 dc.l    $43763457,$85D8A000,$43ABC16D,$674EC800
	 dc.l    $43E158E4,$60913D00,$4415AF1D,$78B58C40
	 dc.l    $444B1AE4,$D6E2EF50,$4480F0CF,$064DD592
	 dc.l    $44B52D02,$C7E14AF6,$44EA7843,$79D99DB4
	 dc.l    $45208B2A,$2C280291,$4554ADF4,$B7320335
	 dc.l    $4589D971,$E4FE8402,$45C027E7,$2F1F1281
	 dc.l    $45F431E0,$FAE6D721,$46293E59,$39A08CEA
	 dc.l    $465F8DEF,$8808B024,$4693B8B5,$B5056E17
	 dc.l    $46C8A6E3,$2246C99C,$46FED09B,$EAD87C03
	 dc.l    $47334261,$72C74D82,$476812F9,$CF7920E3
	 dc.l    $479E17B8,$4357691B,$47D2CED3,$2A16A1B1
	 dc.l    $48078287,$F49C4A1D,$483D6329,$F1C35CA5
	 dc.l    $48725DFA,$371A19E7,$48A6F578,$C4E0A061
	 dc.l    $48DCB2D6,$F618C879,$4911EFC6,$59CF7D4C
	 dc.l    $49466BB7,$F0435C9E,$497C06A5,$EC5433C6
	 dc.l    $49B18427,$B3B4A05C,$49E5E531,$A0A1C873
	 dc.l    $4A1B5E7E,$08CA3A8F,$4A511B0E,$C57E649A
	 dc.l    $4A8561D2,$76DDFDC0,$4ABABA47,$14957D30
	 dc.l    $4AF0B46C,$6CDD6E3E,$4B24E187,$8814C9CE
	 dc.l    $4B5A19E9,$6A19FC41,$4B905031,$E2503DA9
	 dc.l    $4BC4643E,$5AE44D13,$4BF97D4D,$F19D6057
	 dc.l    $4C2FDCA1,$6E04B86D,$4C63E9E4,$E4C2F344
	 dc.l    $4C98E45E,$1DF3B015,$4CCF1D75,$A5709C1B
	 dc.l    $4D037269,$87666191,$4D384F03,$E93FF9F5

*****************************************************************************
*
*  This table is used to convert those decimal numbers outside the
*  range of [10^(-64),10^(64)] to real numbers. It is also used
*  to map real numbers into the aforementioned range in the
*  real --> decimal conversion.
*
*  For a complete description of the conversion algorithms, see the
*  Math IRS.
*
*  The table contains the real values:
*  10(^-256),10^(-192),...,10^(0),10^(64),...,10^(256).
*
tb_auxpt dc.l    $0AC80628,$64AC6F43,$18123FF0,$6EEA847A
	 dc.l    $255BBA08,$CF8C979D,$32A50FFD,$44F4A73D
	 dc.l    $3FF00000,$00000000
	 dc.l    $4D384F03,$E93FF9F5,$5A827748,$F9301D32
	 dc.l    $67CC0E1E,$F1A724EB,$75154FDD,$7F73BF3C

*****************************************************************************
*
*  The next table is used in converting pairs of decimal mantissa digits
*  into their binary value in the decimal --> real conversion. The
*  two decimal digits are treated as an offset into the table, where their
*  binary is stored.
*
tb_bcd   dc.b    0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0
	 dc.b    10,11,12,13,14,15,16,17,18,19,0,0,0,0,0,0
	 dc.b    20,21,22,23,24,25,26,27,28,29,0,0,0,0,0,0
	 dc.b    30,31,32,33,34,35,36,37,38,39,0,0,0,0,0,0
	 dc.b    40,41,42,43,44,45,46,47,48,49,0,0,0,0,0,0
	 dc.b    50,51,52,53,54,55,56,57,58,59,0,0,0,0,0,0
	 dc.b    60,61,62,63,64,65,66,67,68,69,0,0,0,0,0,0
	 dc.b    70,71,72,73,74,75,76,77,78,79,0,0,0,0,0,0
	 dc.b    80,81,82,83,84,85,86,87,88,89,0,0,0,0,0,0
	 dc.b    90,91,92,93,94,95,96,97,98,99

*****************************************************************************
*
*  The next table is used in converting an 8 bit integer into a pair of
*  decimal digits in the real --> decimal conversion. The 8 bit
*  integer is used as an offset into the table, where the 2 decimal digits
*  are stored.
*
tb_bin   dc.l     $00010203,$04050607,$08091011,$12131415
	 dc.l     $16171819,$20212223,$24252627,$28293031
	 dc.l     $32333435,$36373839,$40414243,$44454647
	 dc.l     $48495051,$52535455,$56575859,$60616263
	 dc.l     $64656667,$68697071,$72737475,$76777879
	 dc.l     $80818283,$84858687,$88899091,$92939495,$96979899

*****************************************************************************
*
*  The following are coefficients used in the function evaluations.
*  They were all converted from decimal to reals using 80 bit math
*  and 20 significant decimal digits, and then rounded to the 64 bit
*  format. Only the 16 most significant decimal digits are displayed.
*
cff_loga dc.l     $bfe94415,$b356bd29          -0.7895611288749126 E +00
	 dc.l     $4030624a,$2016afed           0.1638394356302153 E +02
	 dc.l     $c05007ff,$12b3b59a          -0.6412494342374558 E +02
*
cff_logb dc.l     $c041d580,$4b67ce0f          -0.3566797773903465 E +02
	 dc.l     $40738083,$fa15267e           0.3120322209192453 E +03
	 dc.l     $c0880bfe,$9c0d9077          -0.7694993210849488 E +03

*****************************************************************************

cff_expp dc.l     $3f008b44,$2ae6921e           0.3155519276568465 E -04
	 dc.l     $3f7f074b,$f22a12a6           0.7575318015942278 E -02
	 dc.l     $3fd00000,$00000000           0.2500000000000000 E +00
*
cff_expq dc.l     $3ea93363,$0ce50455           0.7510402839987005 E -06
	 dc.l     $3f44af0c,$5c28d4df           0.6312189437439850 E -03
	 dc.l     $3fad1728,$51dfd9ff           0.5681730269855122 E -01
	 dc.l     $3fe00000,$00000000           0.5000000000000000 E +00

*****************************************************************************

cff_sin  dc.l     $3ce880ff,$6993df95           0.2720479095788886 E -14
	 dc.l     $bd6ae420,$dc08499c          -0.7642917806891047 E -12
	 dc.l     $3de6123c,$686ad430           0.1605893649037159 E -09
	 dc.l     $be5ae645,$4b5dc0ab          -0.2505210679827458 E -07
	 dc.l     $3ec71de3,$a524f063           0.2755731921015276 E -05
	 dc.l     $bf2a01a0,$1a013e1a          -0.1984126984120184 E -03
	 dc.l     $3f811111,$111110b0           0.8333333333333165 E -02
	 dc.l     $bfc55555,$55555555          -0.1666666666666667 E +00

*****************************************************************************

cff_tanp dc.l     $bef2bab7,$2ea2c724          -0.1786170734225443 E -04
	 dc.l     $3f6c0e82,$a63baadf           0.3424887823589059 E -02
	 dc.l     $bfc112b5,$e54d0900          -0.1333835000642196 E +00
	 dc.l     $3ff00000,$00000000           0.1000000000000000 E +01
*
cff_tanq dc.l     $3ea0b774,$f07678e9           0.4981943399378651 E -06
	 dc.l     $bf346f64,$99094841          -0.3118153190701003 E -03
	 dc.l     $3f9a479e,$a17e2159           0.2566383228944011 E -01
	 dc.l     $bfdddeb0,$47fbd9d5          -0.4667168333975529 E +00
	 dc.l     $3ff00000,$00000000           0.1000000000000000 E +01

*****************************************************************************

cff_asnp dc.l     $bfe64bbd,$b5e61e65          -0.6967457344735065 E +00
	 dc.l     $40244e17,$64ec3927           0.1015252223380646 E +02
	 dc.l     $c043d82c,$a9a6da9f          -0.3968886299750488 E +02
	 dc.l     $404c9aa7,$360ad48a           0.5720822787789173 E +02
	 dc.l     $c03b5e55,$a83a0a62          -0.2736849452416426 E +02
*
cff_asnq dc.l     $c037d2e8,$6ef9861f          -0.2382385915376024 E +02
	 dc.l     $4062de7c,$96591c70           0.1509527084103060 E +03
	 dc.l     $c077ddce,$fc56a848          -0.3818630336175015 E +03
	 dc.l     $407a124f,$101eb843           0.4171443024826041 E +03
	 dc.l     $c06486c0,$3e2b87cc          -0.1642109671449856 E +03

*****************************************************************************

cff_atnp dc.l     $bfeacd7a,$d9b187bd          -0.8375829936815006 E +00
	 dc.l     $c020fd3f,$5c8d6a63          -0.8494624035132068 E +01
	 dc.l     $c034817f,$b9e2bccb          -0.2050585519586165 E +02
	 dc.l     $c02b60a6,$51061ce2          -0.1368876889419193 E +02
*
cff_atnq dc.l     $402e0c49,$e14ac710           0.1502400116002858 E +02
	 dc.l     $404dca0a,$320da3d7           0.5957843614259734 E +02
	 dc.l     $40558a12,$040b6da5           0.8615734959713024 E +02
	 dc.l     $4044887c,$bcc495a9           0.4106630668257578 E +02

*****************************************************************************

cff_powp dc.l     $3f3c78fd,$db4afc28           0.4344577567216312 E -03
	 dc.l     $3f624924,$2e278dac           0.2232142128592426 E -02
	 dc.l     $3f899999,$999e080e           0.1250000000050380 E -01
	 dc.l     $3fb55555,$5555554d           0.8333333333333321 E -01
*
cff_powq dc.l     $3eef4edd,$e392cc80           0.1492885268059561 E -04
	 dc.l     $3f242f7a,$e0384c74           0.1540029044098976 E -03
	 dc.l     $3f55d87e,$18d7cd9f           0.1333354131358578 E -02
	 dc.l     $3f83b2ab,$6e131d98           0.9618129059517242 E -02
	 dc.l     $3fac6b08,$d703026d           0.5550410866408560 E -01
	 dc.l     $3fcebfbd,$ff82c4ce           0.2402265069590954 E +00
	 dc.l     $3fe62e42,$fefa39ef           0.6931471805599453 E +00
*
tb_a1    dc.l     $00000000,$00000000           Dummy entry for indexing
	 dc.l     $3ff00000,000000000,$3feea4af,$a2a490da
	 dc.l     $3fed5818,$dcfba487,$3fec199b,$dd85529c
	 dc.l     $3feae89f,$995ad3ad,$3fe9c491,$82a3f090
	 dc.l     $3fe8ace5,$422aa0db,$3fe7a114,$73eb0187
	 dc.l     $3fe6a09e,$667f3bcd,$3fe5ab07,$dd485429
	 dc.l     $3fe4bfda,$d5362a27,$3fe3dea6,$4c123422
	 dc.l     $3fe306fe,$0a31b715,$3fe2387a,$6e756238
	 dc.l     $3fe172b8,$3c7d517b,$3fe0b558,$6cf9890f
	 dc.l     $3fe00000,$00000000
*
tb_a2    dc.l     $00000000,$00000000           Dummy entry for indexing
	 dc.l     $bc7e9c23,$179c0000,$3c611065,$89500000
	 dc.l     $3c5c7c46,$b0700000,$bc641577,$ee040000
	 dc.l     $3c76324c,$05460000,$3c6ada09,$11f00000
	 dc.l     $3c79b07e,$b6c80000,$3c78a62e,$4adc0000

*****************************************************************************

stkoper  rts
	 end



	    end

@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.4
log
@
pws2rcs automatic delta on Wed Aug 21 10:27:27 MDT 1991
@
text
@@


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 1119
@


54.2
log
@Changes to handle future BOOT ROMS missing these routines
@
text
@a0 1119
* ADDED BOOTROM SOURCE FOR ADDRESSES $2000-$3FFF        CFB 14JUN91

		rorg 0

		nosyms
* This file contains hardware dependent addresses for the
*
*                   manufacturing unit
*
*                       Chipmunks

* USED TO BE IN THE BOOT ROM
*
*  BOOTROM2
*
*  8/14/81        - Andy Goris
*
*  This is the second half of the 9826A/B boot ROM.
*
*       RORG       $2000
*       SPRINT
*
* CRT CHARACTER SET
*
* Removed from TRAILMIX on 1/11/90                              {dfk}
*
*       RORG       $3000
*       SPRINT
*
* tables for conversion between base 10k and bdc
*
*
BIN2BCD dc.b $00,$01,$02,$03,$04
        dc.b $05,$06,$07,$08,$09
        dc.b $10,$11,$12,$13,$14
        dc.b $15,$16,$17,$18,$19
        dc.b $20,$21,$22,$23,$24
        dc.b $25,$26,$27,$28,$29
        dc.b $30,$31,$32,$33,$34
        dc.b $35,$36,$37,$38,$39
        dc.b $40,$41,$42,$43,$44
        dc.b $45,$46,$47,$48,$49
        dc.b $50,$51,$52,$53,$54
        dc.b $55,$56,$57,$58,$59
        dc.b $60,$61,$62,$63,$64
        dc.b $65,$66,$67,$68,$69
        dc.b $70,$71,$72,$73,$74
        dc.b $75,$76,$77,$78,$79
        dc.b $80,$81,$82,$83,$84
        dc.b $85,$86,$87,$88,$89
        dc.b $90,$91,$92,$93,$94
        dc.b $95,$96,$97,$98,$99
*
bcd2bin dc.b 00,01,02,03,04,05,06,07,08,09,0,0,0,0,0,1
        dc.b 10,11,12,13,14,15,16,17,18,19,0,0,0,0,0,0
        dc.b 20,21,22,23,24,25,26,27,28,29,0,0,0,0,0,0
        dc.b 30,31,32,33,34,35,36,37,38,39,0,0,0,0,0,0
        dc.b 40,41,42,43,44,45,46,47,48,49,0,0,0,0,0,0
        dc.b 50,51,52,53,54,55,56,57,58,59,0,0,0,0,0,0
        dc.b 60,61,62,63,64,65,66,67,68,69,0,0,0,0,0,0
        dc.b 70,71,72,73,74,75,76,77,78,79,0,0,0,0,0,0
        dc.b 80,81,82,83,84,85,86,87,88,89,0,0,0,0,0,0
        dc.b 90,91,92,93,94,95,96,97,98,99
        PAGE
*------------------------------------------
*     PASCAL support routines    Rev 1.1
*     written by: Bob Roeder
*                 Brad Ritter
*------------------------------------------
        DEF asm_rmovel
*------------------------------------------
M@@VEL		EQU		*
		MOVEA.L 	(SP)+,A2       SAVE RETURN ADDRESS
		MOVE.L  	(SP)+,D0       LENGTH
		MOVEA.L 	(SP)+,A0       DESTINATION ADDRESS
		MOVEA.L 	(SP)+,A1       SOURCE ADDRESS
		MOVE.L  	A2,-(SP)       RESTORE RETURN ADDRESS
asm_rmovel 	EQU  		*          ENTRY POINT FOR OPERANDS IN REGISTERS
		TST.L   	D0
		BLE.S   	DONEE
		MOVE.W  	A0,D1
		MOVE.W  	A1,D2
		ANDI.B  	#1,D1
		ANDI.B  	#1,D2
		EOR.B   	D2,D1      ARE BOTH ADDRESSES ON EVEN OR BOTH ON
*                                          ODD BOUNDARIES?
		BEQ.S   	FAANCY
LOOOP   	EQU     	*
        	MOVE.B  	(A1)+,(A0)+
        	SUBQ.L  	#1,D0
        	BGT.S     	LOOOP
        	BRA.S     	DONEE
FAANCY    	EQU 		*
        	TST.B   	D2
        	BEQ.S     	SKIIP1
        	MOVE.B  	(A1)+,(A0)+    MOVE ONE BYTE TO GET TO AN EVEN
*                                              BYTE ADDRESS
        	SUBQ.L  	#1,D0
        	BLE.S     	DONEE
SKIIP1    	EQU 		*
        	MOVE.L  	D0,D1        PERFORM COUNT DIV 4 LONG WORD MOVES
        	LSR.L   	#2,D1
        	BEQ.S     	SKIIP2
LOOOP2    	EQU 		*
        	MOVE.L  	(A1)+,(A0)+
        	SUBQ.L  	#1,D1
        	BGT.S     	LOOOP2
SKIIP2    	EQU 		*
        	ANDI.B  	#3,D0
        	MOVE.B  	D0,D1
        	LSR.B   	#1,D1
        	BEQ.S     	SKIIP3
        	MOVE.W  	(A1)+,(A0)+
SKIIP3    	EQU 		*
        	ANDI.B  	#1,D0
        	BEQ.S     	DONEE
        	MOVE.B  	(A1)+,(A0)+
DONEE     	EQU 		*
        	RTS

          PAGE
*------------------------------------------
        DEF asm_rmover
*------------------------------------------
M@@VER 		EQU 		*
        	MOVEA.L 	(SP)+,A2       SAVE RETURN ADDRESS
        	MOVE.L  	(SP)+,D0       LENGTH
        	MOVEA.L 	(SP)+,A0       DESTINATION ADDRESS
        	MOVEA.L 	(SP)+,A1       SOURCE ADDRESS
        	MOVE.L  	A2,-(SP)       RESTORE RETURN ADDRESS
asm_rmover 	EQU 		*          ENTRY POINT FOR OPERANDS IN REGISTERS
        	TST.L   	D0
        	BLE.S     	DONE
        	ADDA.L  	D0,A0
        	ADDA.L  	D0,A1
        	MOVE.W  	A0,D1
        	MOVE.W  	A1,D2
        	ANDI.B  	#1,D1
        	ANDI.B  	#1,D2
        	EOR.B   	D2,D1      ARE BOTH ADDRESSES ON EVEN OR BOTH ON
*                                          ODD BOUNDARIES?
        	BEQ.S     	FANCY
LOOP     	EQU 		*
        	MOVE.B  	-(A1),-(A0)
        	SUBQ.L  	#1,D0
        	BGT.S     	LOOP
        	BRA.S     	DONE
FANCY    	EQU 		*
        	TST.B   	D2
        	BEQ.S     	SKIP1
        	MOVE.B  	-(A1),-(A0)     MOVE ONE BYTE TO GET TO AN EVEN
*                                               BYTE ADDRESS
        	SUBQ.L  	#1,D0
        	BLE.S     	DONE
SKIP1    	EQU 		*
        	MOVE.L  	D0,D1        PERFORM COUNT DIV 4 LONG WORD MOVES
        	LSR.L   	#2,D1
        	BEQ.S     	SKIP2
LOOP2    	EQU 		*
        	MOVE.L  	-(A1),-(A0)
        	SUBQ.L  	#1,D1
        	BGT.S     	LOOP2
SKIP2    	EQU 		*
        	ANDI.B  	#3,D0
        	MOVE.B  	D0,D1
        	LSR.B   	#1,D1
        	BEQ.S     	SKIP3
        	MOVE.W  	-(A1),-(A0)
SKIP3    	EQU 		*
        	ANDI.B  	#1,D0
        	BEQ.S     	DONE
        	MOVE.B  	-(A1),-(A0)
DONE     	EQU 		*
        	RTS
         PAGE
*------------------------------------------
        DEF asm_mpy
*------------------------------------------
asm_mpy         equ             *
                movem.l         (sp)+,d0/d1/d2  get return addr and operands
                movea.w         d1,a0
                cmpa.l          d1,a0           test for 16 bit 2's compl
                bne.s           not_wd1
                movea.w         d2,a0
                cmpa.l          d2,a0           test for 16 bit 2's compl
                bne.s           twoXone
                muls            d1,d2           signed multiply
                move.l          d2,-(sp)        push result
                movea.l         d0,a0           fake rts
                jmp             (a0)
*
not_wd1         movea.w         d2,a0           test for 16 bit 2's compl
                cmpa.l          d2,a0
                bne.s           twoXtwo         branch to 32 x 32 bit mult
                exg             d1,d2           put 16 bit value in d1
*
twoXone         move.w          d2,d3
                mulu            d1,d3           low order partial product
                move.l          d2,d4
                swap            d4
                mulu            d1,d4           high order partial product
                swap            d3
                moveq           #0,d5           clear high word
                move.w          d3,d5
                add.l           d5,d4           add middle products
                tst.w           d1              sign of multiplier ???
                bpl.s           mcand
                sub.l           d2,d4           subtract multiplicand
mcand           tst.l           d2              sign of multiplicand ???
                bpl.s           out
                move.w          d1,d5           if negative
                swap            d5
                sub.l           d5,d4           subtract multiplier
out             movea.w         d4,a0
                cmpa.l          d4,a0           test for overflow
                bne.s           ovflow
                swap            d3
                move.w          d3,-(sp)        store low  order part
                move.w          d4,-(sp)        store high order part
                movea.l         d0,a0           fake rts
                jmp             (a0)
*
twoXtwo         equ             *
                move.l          d1,d3           look at multiplier
                moveq           #0,d7           clear flag
                asr.l           #1,d3           divide by 2
                bcc.s           even1           catch LSB
                move.l          d2,d7           use multiplicand in flag
even1           movea.w         d3,a0           check for 16 bit 2's compl
                cmp.l           a0,d3
                beq             soneXtwo
                move.l          d2,d3           otherwise try multiplicand
                moveq           #0,d7           clear flag
                asr.l           #1,d3           divide by 2
                bcc.s           even2           catch LSB
                move.l          d1,d7           use multiplier in flag
even2           movea.w         d3,a0           check for 16 bit 2's compl
                cmp.l           a0,d3
                bne             ovflow
                move.l          d1,d2
soneXtwo        lea             muldone,a1
                exg             a1,d0           use twoXone mult routine
                move.l          d3,d1
                bra.s           twoXone
muldone         addq            #4,sp           clean up stack
                add.w           d3,d3           multiply product by 2
                addx.l          d4,d4
                add.w           d7,d3           add flag
                swap            d7
                ext.l           d7
                addx.l          d7,d4
                swap            d3              put d3 in wrong order for out
                move.l          a1,d0           put return address in d0
                bra.s           out
ovflow          trap            #4
                PAGE
*------------------------------------------
 DEF E@@DIV
 DEF E@@MOD
*------------------------------------------
*               register usage
*               d0 - return address
*               d1 - divisor
*               d2 - dividend and quotient
*               d3 - remainder
*               d4 - loop counter
*               d5 - sign of remainder
*               d6 - sign of quotent
*               d7 - mod/div flag
*
E@@MOD           moveq           #1,d7           set mod flag
                bra.s           d_start
E@@DIV           moveq           #0,d7           clear mod flag
d_start         movem.l         (sp)+,d0/d1/d2  read return addr and operands
                tst.l           d1              divide by zero?
                beq.s           zerodiv
                movea.w         d1,a0           is divisor a
                cmp.l           a0,d1           16 bit integer?
                bne.s           do_full
                move.l          d2,d3           try signed divide
                divs            d1,d3
                bvs.s           do_full         did it work?
                tst.w           d7              mod or div?
                beq.s           div_1
                swap            d3
div_1           ext.l           d3
dm_out          move.l          d3,-(sp)        push result
                movea.l         d0,a0
                jmp             (a0)            fake return
zerodiv         trap            #5
*
*               convert divisor and dividend to sign magnitude
*
do_full         moveq           #15,d4          loop count - 1
                moveq           #0,d6           sign of quotient
                moveq           #0,d5           sign of remainder
                tst.l           d1              divisor negative?
                bpl.s           divend
                neg.l           d1
                bvs.s           max_neg_dvsr
                not.w           d6              set sign flag
divend          tst.l           d2              divedend negative
                bpl.s           rmndr
                neg.l           d2              complement quotient sign
                bvc.s           not_special
                cmp.l           #-1,d1
                beq.s           ovflow
not_special     not             d6              flag
                not             d5              negative remainder
rmndr           moveq           #0,d3           clear remainder
                swap            d1              is divisor <= 16 bits
                tst.w           d1
                bne.s           big_div
                swap            d2
                swap            d1
                move.w          d2,d3           get high order dividend
                divu            d1,d3           high part of divide
                move.w          d3,d2           high quotient to d2
                swap            d2
                move.w          d2,d3           divide low order
                divu            d1,d3           dividend by divisor
                move.w          d3,d2           quotient in d2
                clr.w           d3
                swap            d3              remainder in d3
*               put in correct sigh for quotient and remainder
dm_fixup        tst.w           d6
                bpl.s           chk_rem
                neg.l           d2
chk_rem         tst.w           d5
                bpl.s           dm_store
                neg.l           d3
dm_store        tst.w           d7              div or mod?
                bne.s           dm_out
                exg             d2,d3
                bra.s           dm_out
*
*               handle maximum negative divisor
*
max_neg_dvsr    neg.l           d2
                bvs.s           max_max         test for max neg dividend
                move.l          d2,d3
                neg.l           d3
                moveq           #0,d2
                bra.s           dm_store
max_max         moveq           #1,d2
                moveq           #0,d3
                bra.s           dm_store
*
*               32 bit divisor
*
big_div         swap            d1              restore divisor
                swap            d2              move high order
                move.w          d2,d3           dividend to remainder
                clr.w           d2              shift dividend 16 bits left
                sub.l           d1,d3           subtract divisor from rem.
                movea.l         d1,a0           divisor in a0
                neg.l           d1              minus divisor in d1
*
*               co-routine for negative remainder
*
m_top           add.l           d2,d2           shift dividend and quotient
                addx.l          d3,d3           shift remainder
                add.l           a0,d3           add divisor
                bpl.s           p_bottom        remainder positive?
m_bottom        dbra            d4,m_top        loop 16 times
                add.l           a0,d3           restore remainder
                add.l           d2,d2           shift in last bit of quotient
                bra.s           dm_fixup
*
*               co-routine for positive remainder
*
p_top           addx.l          d2,d2           shift dividend and quotient
                addx.l          d3,d3           shift remainder
                add.l           d1,d3           subtract divisor
                bmi.s           m_bottom        remainder negative?
p_bottom        dbra            d4,p_top        loop 16 times
                addx.l          d2,d2           shift in last bit of quotient
                bra.s           dm_fixup
            PAGE
*------------------------------------------
            DEF asm_equal
            DEF asm_nequal
*------------------------------------------
asm_nequal    EQU *
            move.b     #1,-(sp)
            move.b     #0,-(sp)
            bra.s        strrt
asm_equal     EQU *
            move.b     #0,-(sp)
            move.b     #1,-(sp)
* obtain sets from stack
strrt       movea.l    8(sp),a3           address of right op
            movea.l    12(sp),a4          address of left op
* place minimum size in d5
            move.w     (a3)+,d7           size of right op
            move.w     (a4)+,d6           size of left op
            cmp.w      d6,d7
            ble.s        rightmin
LEFTMIN     move.w     d6,d5
            bra.s        nulltest           REI 7/3/80
RIGHTMIN    move.w     d7,d5
nulltest    beq.s        restof             REI 7/3/80

* perform set comparison
LONG        asr.w      #2,d5              determine size in long words
            bcc.s        even               even number of long words
            cmpm.w     (a3)+,(a4)+        compare "odd" word
            bne.s        nope
            tst.w      d5                 min size single word?
            beq.s        restof
EVEN        cmpm.l     (a3)+,(a4)+        compare long words
            bne.s        nope
            subq.w     #1,d5
            bgt.s        even
* if operands of unequal size, test rest of longer -
*   if all "extra" bits not 0, sets are unequal
RESTOF      sub.w      d6,d7              size of right op-size of left op
            beq.s        yep                equal size
            bpl.s        right              right op longer
            neg.w      d7                 d7 = # bytes longer
LEFT        tst.w      (a4)+              left op longer, test it
            bne.s        nope
            subq.w     #2,d7              2 bytes tested
            bgt.s        left
            bra.s        yep
RIGHT       tst.w      (a3)+              test right op
            bne.s        nope
            subq.w     #2,d7              2 bytes tested
            bgt.s        right
* move true or false value to result
YEP         move.b     (sp),14(sp)
            bra.s        fnsh
NOPE        move.b     2(sp),14(sp)
fnsh        move.l     4(sp),10(sp)       put return address at the right place
            adda.l     #10,sp             eliminate extra bytes in stack
            rts
            PAGE
*------------------------------------------
            DEF asm_assign
*------------------------------------------
asm_assign    EQU *
* obtain sets from stack
            movea.l    4(sp),a3          address of source
            movea.l    8(sp),a4          address of dest
* place size in d7
            move.w     (a3)+,d7          size of source
            move.w     d7,(a4)+          store size in dest
            beq.s      done2             check for zero length set
* perform assignment
            asr.w      #2,d7              determine size in long words
            bcc.s        evenn              even number of long words
            move.w     (a3)+,(a4)+        move "odd" word
            tst.w      d7                 min size single word?
            beq.s        done2
EVENN       move.l     (a3)+,(a4)+        move long words
            subq.w     #1,d7
            bgt.s        evenn
DONE2       move.l     (sp),8(sp)         eliminate extra bytes in stack
            addq.l     #8,sp
            rts
            PAGE
*------------------------------------------
            DEF asm_union
*------------------------------------------
asm_union     EQU *
* obtain sets from stack
            movea.l    4(sp),a2           address of right op
            movea.l    8(sp),a4           address of left op
            movea.l    12(sp),a3          address of result
* place minimum size in d5
            move.w     (a2)+,d7           size of right op
            move.w     (a4)+,d6           size of left op
            cmp.w      d6,d7
            ble.s        rightmin2
LEFTMIN2    move.w     d6,d5
            move.w     d7,(a3)+           result size is max op size
            bra.s        nulltest2          REI 7/3
RIGHTMIN2   move.w     d7,d5
            move.w     d6,(a3)+           result size is max op size
nulltest2   tst.w      d5                 REI 7/3
            beq.s        restof2            REI 7/3

* perform set union
LONG3       asr.w      #2,d5              determine size in long words
            bcc.s        even3              even number of long words
            move.w     (a2)+,d4           union "odd" word
            or.w       (a4)+,d4
            move.w     d4,(a3)+
            tst.w      d5                 min size single word?
            beq.s        restof2
EVEN3       move.l     (a2)+,d4           union long words
            or.l       (a4)+,d4
            move.l     d4,(a3)+
            subq.w     #1,d5
            bgt.s        even3
* move rest of longer operand
RESTOF2     sub.w      d6,d7              size of right op-size of left op
            beq.s        done3              equal size
            bpl.s        right2             right op longer
            neg.w      d7                 d7 = # bytes longer
LEFT2       move.w     (a4)+,(a3)+        left op longer, move it
            subq.w     #2,d7              2 bytes moved
            bgt.s        left2
            bra.s        done3
RIGHT2      move.w     (a2)+,(a3)+        move right op
            subq.w     #2,d7              2 bytes moved
            bgt.s        right2
DONE3       move.l     (sp),12(sp)        eliminate extra bytes in stack
            adda.l     #12,sp
            rts
            PAGE
*------------------------------------------
            DEF asm_inclusion
*------------------------------------------
asm_inclusion EQU *
* obtain sets from stack
            movea.l    4(sp),a3           address of right op
            movea.l    8(sp),a4           address of left op
* place minimum size in d5
            move.w     (a3)+,d7           size of right op
            move.w     (a4)+,d6           size of left op
            cmp.w      d6,d7
            ble.s        rightmin3
LEFTMIN3    move.w     d6,d5
            bra.s        nulltest3          REI 7/3
RIGHTMIN3   move.w     d7,d5
nulltest3   beq.s        restof3            REI 7/3

* perform inclusion test
LONG4       asr.w      #2,d5              determine size in long words
            bcc.s        even4              even number of long words
            move.w     (a3)+,d4           "odd" word inclusion
            not.w      d4
            and.w      (a4)+,d4
            bne.s        nope2
            tst.w      d5                 min size single word?
            beq.s        restof3
EVEN4       move.l     (a3)+,d4           long word inclusion
            not.l      d4
            and.l      (a4)+,d4
            bne.s        nope2
            subq.w     #1,d5
            bgt.s        even4
* if left operand longer, test "extra" portion
RESTOF3     sub.w      d7,d6              size of left op-size of right op
            ble.s        yep2               left op not longer
LEFT3       tst.w      (a4)+              left op longer, test it
            bne.s        nope2
            subq.w     #2,d6              2 bytes tested
            bgt.s        left3
* move boolean value to result
YEP2        move.b     #1,10(sp)          true
            bra.s        cleanup
NOPE2       move.b     #0,10(sp)          false
CLEANUP     move.l     (sp),6(sp)         eliminate extra bytes in stack
            addq.l     #6,sp
            rts
            PAGE
*------------------------------------------
            DEF asm_intersect
*------------------------------------------
asm_intersect EQU *
* obtain sets from stack
            movea.l    4(sp),a2           address of right op
            movea.l    8(sp),a4           address of left op
            movea.l    12(sp),a3          address of result
* place minimum size in d7
            move.w     (a2)+,d7           size of right op
            cmp.w      (a4)+,d7           compare with size of left op
            ble.s        setsize
LEFTMIN4    move.w     -2(a4),d7
SETSIZE     move.w     d7,(a3)+           result size = min op size
            beq.s        done4              REI 7/3

* perform set intersection
            asr.w      #2,d7              determine size in long words
            bcc.s        even5              even number of long words
            move.w     (a2)+,d6           intersect "odd" word
            and.w      (a4)+,d6
            move.w     d6,(a3)+
            tst.w      d7                 min size single word?
            beq.s        done4
EVEN5       move.l     (a2)+,d6           intersect long words
            and.l      (a4)+,d6
            move.l     d6,(a3)+
            subq.w     #1,d7
            bgt.s        even5
DONE4       move.l     (sp),12(sp)
            adda.l     #12,sp
            rts
            PAGE
*------------------------------------------
            DEF asm_difference
*------------------------------------------
asm_difference EQU *
* obtain sets from stack
            movea.l    4(sp),a2           address of right op
            movea.l    8(sp),a4           address of left op
            movea.l    12(sp),a3          address of result
* place minimum size in d5
            move.w     (a2)+,d7           size of right op
            move.w     (a4)+,d6           size of left op
            cmp.w      d6,d7
            ble.s        rightmin5
LEFTMIN5    move.w     d6,d5
            bra.s        setsize2
RIGHTMIN5   move.w     d7,d5
SETSIZE2    move.w     d6,(a3)+           result size = size of left op
            tst.w      d5                 REI 7/3
            beq.s        restof4            REI 7/3

* perform difference
            asr.w      #2,d5              determine size in long words
            bcc.s        even6              even number of long words
            move.w     (a2)+,d4           difference of "odd" word
            not.w      d4
            and.w      (a4)+,d4
            move.w     d4,(a3)+
            tst.w      d5                 min size single word?
            beq.s        restof4
EVEN6       move.l     (a2)+,d4           long word difference
            not.l      d4
            and.l      (a4)+,d4
            move.l     d4,(a3)+
            subq.w     #1,d5
            bgt.s        even6
* if left operand longer, move to result
RESTOF4     sub.w      d7,d6              size of left op-size of right op
            ble.s        done5
LEFT4       move.w     (a4)+,(a3)+        left op longer, move it
            subq.w     #2,d6              2 bytes moved
            bgt.s        left4
DONE5       move.l     (sp),12(sp)        eliminate extra bytes in stack
            adda.l     #12,sp
            rts
            PAGE
*------------------------------------------
            DEF asm_in
*------------------------------------------
asm_in  movea.l         (sp)+,a0        return address
        movea.l         (sp)+,a1        set address
        move.l          (sp)+,d0        selector value
        blt.s           lfalse          selector<0?
        divs            #8,d0
        cmp.w           (a1),d0         selector>setsize?
        bge.s           lfalse
        move.l          d0,d1
        swap d1
        move.b          2(a1,d0),d0     get selected byte
        lsl.b           d1,d0           construct Boolean result
        lsr.b           #7,d0
        move.b          d0,-(sp)        push the result
        jmp             (a0)
lfalse  clr.b           -(sp)
        jmp             (a0)
        PAGE
*------------------------------------------
           DEF  E@@DDELEMENT
*------------------------------------------
E@@DDELEMENT EQU         *
        movea.l         (sp)+,a0         return address
        move.w          (sp)+,d0        element number to add to set
        movea.l         (sp)+,a1        source address
        movea.l         (sp),a2         destination address
        move.w          (a1)+,d7        get set size of source
        move.w          d7,(a2)+        store size value
        cmpa.l          a2,a1           see if source and destination are equal
        beq.s           insert1
* copy source set to the destination set
setcopy movea.l         a2,a3           save destination address
        move.w          d7,d6           save size for destination
        ble.s           insert1         check for size of zero
rept    move.w          (a1)+,(a3)+     sets are always an even number of bytes
        subq.w          #2,d6
        bgt.s           rept
* insert an element in a set, adjusting the size of the destination if needed
insert1 ext.l           d0
        divs            #16,d0           byte offset in low word
        move.l          d0,d5
        swap            d5              bit offset from left of byte
        sub.w           #15,d5
        neg.w           d5              bit offset from right
        asl             #1,d0           make d0 a byte offset
        move.w          d0,d1           compute final size into d1
        addq.w          #2,d1           put zeros in the two bytes containing
        move.w          d1,d2           the new bit if it is beyond current size
        sub.w           -2(a2),d1
        ble.s           exxiit
        move.w          d2,-2(a2)       store appropriate size for set
        lea             0(a2,d2),a3
zerout  clr.w           -(a3)
        subq.w          #2,d1
        bgt.s           zerout
exxiit  bclr            #3,d5           { received upgrade 9/9 }
        beq.s           skiipp
        bset            d5,0(a2,d0)
        jmp             (a0)
skiipp  bset            d5,1(a2,d0)
        jmp             (a0)
        PAGE
*------------------------------------------
*       procedure SCOPY (var destination, source: string;
*                        index, length: integer);
*       procedure SAPPEND (var destination, source: string);
*       procedure INSERT (var source, destination: string; index: integer);
*       procedure DELETE (var destination: string; index, length: integer);
*       function  POS (var target, source: string): integer;
*
        DEF E@@SCOPY
        DEF E@@SAPPEND
        DEF E@@INSERT
        DEF E@@DELETE
        DEF asm_pos
        
        NOSYMS

DESTINATION     EQU A4
SOURCE          EQU A3
RETURN          EQU A2
PTR             EQU A1
PTR2            EQU A0
TARGET          EQU DESTINATION

INDEX           EQU D7
LENGTH          EQU D6
DLEN            EQU D5
SLEN            EQU D4
ONRIGHT         EQU D3
COUNT           EQU D2
PTEMP           EQU D1
CHAR            EQU D0
TLEN            EQU DLEN

E@@SAPPEND       EQU *
SAPPEND         EQU *
        MOVEM.L (SP)+,RETURN/SOURCE/DESTINATION     RETURN ADDRESS, PARAMETERS
        CLR     SLEN
        MOVE.B  (SOURCE)+,SLEN          LENGTH OF SOURCE
        BEQ.S   L2                      FINISH EARLY IF NULL
        CLR     DLEN
        MOVE.B  (DESTINATION),DLEN      LENGTH OF DESTINATION
        LEA     1(DESTINATION,DLEN.W),PTR       START AT DEST[DLEN+1]
        ADD.B   SLEN,DLEN               COMPUTE LENGTH OF RESULT
        BCS.S   L2                      ABORT IF TOO LONG
        MOVE.B  DLEN,(DESTINATION)
        SUBQ    #1,SLEN
L1      MOVE.B  (SOURCE)+,(PTR)+        TRANSFER BYTES
        DBRA    SLEN,L1
L2      JMP     (RETURN)                END

E@@INSERT        EQU *
INSERT          EQU *
        MOVEA.L (SP)+,RETURN
        MOVE.L  (SP)+,INDEX             GET PARAMETERS
        MOVEA.L (SP)+,DESTINATION
        MOVEA.L (SP)+,SOURCE
        BLE.S   L6                      ERROR EXIT IF NOT (INDEX > 0 )
        CLR     SLEN
        MOVE.B  (SOURCE)+,SLEN
        BEQ.S   L6                      EXIT IF SOURCE IS NULL
        CLR     DLEN
        MOVE.B  (DESTINATION),DLEN
        LEA     1(DESTINATION,DLEN.W),PTR       POINT TO "TAIL" OF DESTINATION
        MOVE    DLEN,ONRIGHT            (SAVE DLEN FOR LATER)
        ADD.B   SLEN,DLEN               NEW LENGTH OF DESTINATION
        BCS.S   L6                      EXIT IF TOO LONG
        MOVE.B  DLEN,(DESTINATION)
        SUB     INDEX,ONRIGHT           NUMBER OF BYTES TO SHIFT RIGHT (LESS 1)
        BGE.S   L3
        ADDQ    #1,ONRIGHT              TEST FOR EXACTLY ZERO
        BEQ.S   L5
        JMP     (RETURN)                ERROR EXIT (INDEX > DLEN + 1)
L3      LEA     0(PTR,SLEN.W),PTR2      MAKE ROOM FOR SOURCE
L4      MOVE.B  -(PTR),-(PTR2)          BY SHIFTING RIGHT
        DBRA    ONRIGHT,L4
        SUBQ    #1,SLEN
L5      MOVE.B  (SOURCE)+,(PTR)+        TRANSFER BYTES
        DBRA    SLEN,L5
L6      JMP     (RETURN)                END

E@@SCOPY         EQU *
SCOPY           EQU *
        MOVEA.L (SP)+,RETURN
        MOVE.L  (SP)+,LENGTH            GET PARAMETERS
        MOVE.L  (SP)+,INDEX
        MOVEA.L (SP)+,SOURCE
        MOVEA.L (SP)+,DESTINATION
        BLE.S   L9                      EXIT IF NOT (INDEX > 0)
        TST.L   LENGTH
        BLT.S   L9                      ERROR IF REQUESTED LENGTH < 0
        CLR     SLEN
        MOVE.B  (SOURCE),SLEN
        ADDQ    #1,SLEN
        SUB     INDEX,SLEN              LENGTH OF SUBSTRING
        BLT.S   L9                      ERROR IF (INDEX > SLEN + 1)
        CMP     SLEN,LENGTH             TAKE MINIMUM OF SLEN, LENGTH
        BLE.S   L7
        MOVE    SLEN,LENGTH             SUBSTRING LENGTH IS SMALLER
L7      MOVE.B  LENGTH,(DESTINATION)+   SET LENGTH INTO DESTINATION
        SUBQ    #1,LENGTH
        BLT.S   L9
        LEA     0(SOURCE,INDEX.W),PTR
L8      MOVE.B  (PTR)+,(DESTINATION)+   COPY THE BYTES
        DBRA    LENGTH,L8
L9      JMP     (RETURN)

E@@DELETE        EQU *
DELETE          EQU *
        MOVEA.L (SP)+,RETURN
        MOVE.L  (SP)+,LENGTH            GET PARAMETERS
        MOVE.L  (SP)+,INDEX
        MOVEA.L (SP)+,DESTINATION
        BLE.S   L11                     EXIT IF NOT (INDEX > 0)
        TST.L   LENGTH
        BLE.S   L11                     EXIT IF LENGTH <= 0
        CLR     DLEN
        MOVE.B  (DESTINATION),DLEN
        SUB     LENGTH,DLEN             NEW LENGTH OF STRING
        BLT.S   L11                     ERROR IF < 0
        MOVE    DLEN,ONRIGHT
        ADDQ    #1,ONRIGHT
        SUB     INDEX,ONRIGHT           NUMBER OF CHARACTERS TO MOVE
        BLT.S   L11                     ERROR IF NEGATIVE
        MOVE.B  DLEN,(DESTINATION)      SET NEW LENGTH
        SUBQ    #1,ONRIGHT
        BLT.S   L11                     FINISH EARLY IF NO BYTES TO MOVE
        LEA     0(DESTINATION,INDEX.W),PTR
        LEA     0(PTR,LENGTH.W),PTR2
L10     MOVE.B  (PTR2)+,(PTR)+
        DBRA    ONRIGHT,L10
L11     JMP     (RETURN)

asm_pos         EQU *
POS             EQU *
        MOVEM.L (SP)+,RETURN/SOURCE/TARGET
        CLR.L   (SP)                    POS WILL BE 0 IF SEARCH FAILS
        CLR     TLEN
        MOVE.B  (TARGET)+,TLEN
        BEQ.S   L16                     POS IS 0 IF TARGET IS NULL
        CLR.L   SLEN
        MOVE.B  (SOURCE)+,SLEN
        SUB     TLEN,SLEN               NUMBER OF POSSIBLE PLACES (LESS 1)
        BLT.S   L16                     POS IS 0 IF TARGET LONGER THAN SRC
        MOVE.B  (TARGET)+,CHAR          FIRST CHARACTER OF TARGET
        SUBQ    #2,TLEN                 LENGTH OF REST OF TARGET (LESS 1)
        MOVE.L  SLEN,PTEMP              TENTATIVE VALUE OF POS

L12     CMP.B   (SOURCE)+,CHAR
L13     DBEQ    SLEN,L12                LOOP TILL FIND FIRST BYTE OF TARGET
        BNE.S   L16                     POS IS 0 IF DIDN'T FIND IT
        MOVE    TLEN,COUNT              REMAINING CHARACTERS (LESS 1)
        BLT.S   L15                     FOUND IT IF LENGTH(TARGET) IS 1
        LEA     (TARGET),PTR            ELSE COMPARE REMAINING CHARS
        LEA     (SOURCE),PTR2
L14     CMPM.B  (PTR)+,(PTR2)+          LOOP TILL MATCH OR MISMATCH
        DBNE    COUNT,L14
        BNE.S   L13                     IF MISMATCH, CONTINUE SCAN
L15     SUB     SLEN,PTEMP              FOUND IT, SO FIGURE HOW FAR
        ADDQ    #1,PTEMP                        WE ADVANCED
        MOVE.L  PTEMP,(SP)              RETURN INDEX VALUE
L16     JMP     (RETURN)
*****************************************************************************
*
*  These are the power-of-ten tables that are used in the
*  decimal <--> real conversions.
*
*  Decimal / real numbers in the range [10^(-64),10^(64)]
*  convert into real / decimal numbers with one real
*  multiply while all other decimal <--> real conversions require
*  2 real multiplies and the use of the table tb_auxpt.
*
*  For a complete description of the conversion algorithms, see the
*  Math IRS.
*
*  The table contains the real values:
*  10^(-80),10^(-79),...,10^(0),.10^(1),...,10^(64).
*
tb_pwt   dc.l    $2F52F8AC,$174D6123,$2F87B6D7,$1D20B96C
         dc.l    $2FBDA48C,$E468E7C7,$2FF286D8,$0EC190DC
         dc.l    $3027288E,$1271F513,$305CF2B1,$970E7258
         dc.l    $309217AE,$FE690777,$30C69D9A,$BE034955
tb_pwt8  dc.l    $30FC4501,$6D841BAA,$3131AB20,$E472914A
         dc.l    $316615E9,$1D8F359D,$319B9B63,$64F30304
tb_pwt4  dc.l    $31D1411E,$1F17E1E3,$32059165,$A6DDDA5B
         dc.l    $323AF5BF,$109550F2,$3270D997,$6A5D5297
tb_pwtt  dc.l    $32A50FFD,$44F4A73D,$32DA53FC,$9631D10D
         dc.l    $3310747D,$DDDF22A8,$3344919D,$5556EB52
         dc.l    $3379B604,$AAACA626,$33B011C2,$EAABE7D8
         dc.l    $33E41633,$A556E1CE,$34191BC0,$8EAC9A41
         dc.l    $344F62B0,$B257C0D2,$34839DAE,$6F76D883
         dc.l    $34B8851A,$0B548EA4,$34EEA660,$8E29B24D
         dc.l    $352327FC,$58DA0F70,$3557F1FB,$6F10934C
         dc.l    $358DEE7A,$4AD4B81F,$35C2B50C,$6EC4F313
         dc.l    $35F7624F,$8A762FD8,$362D3AE3,$6D13BBCE
         dc.l    $366244CE,$242C5561,$3696D601,$AD376AB9
         dc.l    $36CC8B82,$18854567,$3701D731,$4F534B61
         dc.l    $37364CFD,$A3281E39,$376BE03D,$0BF225C7
         dc.l    $37A16C26,$2777579C,$37D5C72F,$B1552D83
         dc.l    $380B38FB,$9DAA78E4,$3841039D,$428A8B8F
         dc.l    $38754484,$932D2E72,$38AA95A5,$B7F87A0F
         dc.l    $38E09D87,$92FB4C49,$3914C4E9,$77BA1F5C
         dc.l    $3949F623,$D5A8A733,$398039D6,$65896880
         dc.l    $39B4484B,$FEEBC2A0,$39E95A5E,$FEA6B347
         dc.l    $3A1FB0F6,$BE506019,$3A53CE9A,$36F23C10
         dc.l    $3A88C240,$C4AECB14,$3ABEF2D0,$F5DA7DD9
         dc.l    $3AF357C2,$99A88EA7,$3B282DB3,$4012B251
         dc.l    $3B5E3920,$10175EE6,$3B92E3B4,$0A0E9B4F
         dc.l    $3BC79CA1,$0C924223,$3BFD83C9,$4FB6D2AC
         dc.l    $3C32725D,$D1D243AC,$3C670EF5,$4646D497
         dc.l    $3C9CD2B2,$97D889BC,$3CD203AF,$9EE75616
         dc.l    $3D06849B,$86A12B9B,$3D3C25C2,$68497682
         dc.l    $3D719799,$812DEA11,$3DA5FD7F,$E1796495
         dc.l    $3DDB7CDF,$D9D7BDBB,$3E112E0B,$E826D695
         dc.l    $3E45798E,$E2308C3A,$3E7AD7F2,$9ABCAF48
         dc.l    $3EB0C6F7,$A0B5ED8D,$3EE4F8B5,$88E368F1
         dc.l    $3F1A36E2,$EB1C432D,$3F50624D,$D2F1A9FC
         dc.l    $3F847AE1,$47AE147B,$3FB99999,$9999999A
         dc.l    $3FF00000,$00000000
         dc.l    $40240000,$00000000,$40590000,$00000000
         dc.l    $408F4000,$00000000,$40C38800,$00000000
         dc.l    $40F86A00,$00000000,$412E8480,$00000000
         dc.l    $416312D0,$00000000,$4197D784,$00000000
         dc.l    $41CDCD65,$00000000,$4202A05F,$20000000
         dc.l    $42374876,$E8000000,$426D1A94,$A2000000
         dc.l    $42A2309C,$E5400000,$42D6BCC4,$1E900000
         dc.l    $430C6BF5,$26340000,$4341C379,$37E08000
         dc.l    $43763457,$85D8A000,$43ABC16D,$674EC800
         dc.l    $43E158E4,$60913D00,$4415AF1D,$78B58C40
         dc.l    $444B1AE4,$D6E2EF50,$4480F0CF,$064DD592
         dc.l    $44B52D02,$C7E14AF6,$44EA7843,$79D99DB4
         dc.l    $45208B2A,$2C280291,$4554ADF4,$B7320335
         dc.l    $4589D971,$E4FE8402,$45C027E7,$2F1F1281
         dc.l    $45F431E0,$FAE6D721,$46293E59,$39A08CEA
         dc.l    $465F8DEF,$8808B024,$4693B8B5,$B5056E17
         dc.l    $46C8A6E3,$2246C99C,$46FED09B,$EAD87C03
         dc.l    $47334261,$72C74D82,$476812F9,$CF7920E3
         dc.l    $479E17B8,$4357691B,$47D2CED3,$2A16A1B1
         dc.l    $48078287,$F49C4A1D,$483D6329,$F1C35CA5
         dc.l    $48725DFA,$371A19E7,$48A6F578,$C4E0A061
         dc.l    $48DCB2D6,$F618C879,$4911EFC6,$59CF7D4C
         dc.l    $49466BB7,$F0435C9E,$497C06A5,$EC5433C6
         dc.l    $49B18427,$B3B4A05C,$49E5E531,$A0A1C873
         dc.l    $4A1B5E7E,$08CA3A8F,$4A511B0E,$C57E649A
         dc.l    $4A8561D2,$76DDFDC0,$4ABABA47,$14957D30
         dc.l    $4AF0B46C,$6CDD6E3E,$4B24E187,$8814C9CE
         dc.l    $4B5A19E9,$6A19FC41,$4B905031,$E2503DA9
         dc.l    $4BC4643E,$5AE44D13,$4BF97D4D,$F19D6057
         dc.l    $4C2FDCA1,$6E04B86D,$4C63E9E4,$E4C2F344
         dc.l    $4C98E45E,$1DF3B015,$4CCF1D75,$A5709C1B
         dc.l    $4D037269,$87666191,$4D384F03,$E93FF9F5

*****************************************************************************
*
*  This table is used to convert those decimal numbers outside the
*  range of [10^(-64),10^(64)] to real numbers. It is also used
*  to map real numbers into the aforementioned range in the
*  real --> decimal conversion.
*
*  For a complete description of the conversion algorithms, see the
*  Math IRS.
*
*  The table contains the real values:
*  10(^-256),10^(-192),...,10^(0),10^(64),...,10^(256).
*
tb_auxpt dc.l    $0AC80628,$64AC6F43,$18123FF0,$6EEA847A
         dc.l    $255BBA08,$CF8C979D,$32A50FFD,$44F4A73D
         dc.l    $3FF00000,$00000000
         dc.l    $4D384F03,$E93FF9F5,$5A827748,$F9301D32
         dc.l    $67CC0E1E,$F1A724EB,$75154FDD,$7F73BF3C

*****************************************************************************
*
*  The next table is used in converting pairs of decimal mantissa digits
*  into their binary value in the decimal --> real conversion. The
*  two decimal digits are treated as an offset into the table, where their
*  binary is stored.
*
tb_bcd   dc.b    0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0
         dc.b    10,11,12,13,14,15,16,17,18,19,0,0,0,0,0,0
         dc.b    20,21,22,23,24,25,26,27,28,29,0,0,0,0,0,0
         dc.b    30,31,32,33,34,35,36,37,38,39,0,0,0,0,0,0
         dc.b    40,41,42,43,44,45,46,47,48,49,0,0,0,0,0,0
         dc.b    50,51,52,53,54,55,56,57,58,59,0,0,0,0,0,0
         dc.b    60,61,62,63,64,65,66,67,68,69,0,0,0,0,0,0
         dc.b    70,71,72,73,74,75,76,77,78,79,0,0,0,0,0,0
         dc.b    80,81,82,83,84,85,86,87,88,89,0,0,0,0,0,0
         dc.b    90,91,92,93,94,95,96,97,98,99

*****************************************************************************
*
*  The next table is used in converting an 8 bit integer into a pair of
*  decimal digits in the real --> decimal conversion. The 8 bit
*  integer is used as an offset into the table, where the 2 decimal digits
*  are stored.
*
tb_bin   dc.l     $00010203,$04050607,$08091011,$12131415
         dc.l     $16171819,$20212223,$24252627,$28293031
         dc.l     $32333435,$36373839,$40414243,$44454647
         dc.l     $48495051,$52535455,$56575859,$60616263
         dc.l     $64656667,$68697071,$72737475,$76777879
         dc.l     $80818283,$84858687,$88899091,$92939495,$96979899

*****************************************************************************
*
*  The following are coefficients used in the function evaluations.
*  They were all converted from decimal to reals using 80 bit math
*  and 20 significant decimal digits, and then rounded to the 64 bit
*  format. Only the 16 most significant decimal digits are displayed.
*
cff_loga dc.l     $bfe94415,$b356bd29          -0.7895611288749126 E +00
         dc.l     $4030624a,$2016afed           0.1638394356302153 E +02
         dc.l     $c05007ff,$12b3b59a          -0.6412494342374558 E +02
*
cff_logb dc.l     $c041d580,$4b67ce0f          -0.3566797773903465 E +02
         dc.l     $40738083,$fa15267e           0.3120322209192453 E +03
         dc.l     $c0880bfe,$9c0d9077          -0.7694993210849488 E +03

*****************************************************************************

cff_expp dc.l     $3f008b44,$2ae6921e           0.3155519276568465 E -04
         dc.l     $3f7f074b,$f22a12a6           0.7575318015942278 E -02
         dc.l     $3fd00000,$00000000           0.2500000000000000 E +00
*
cff_expq dc.l     $3ea93363,$0ce50455           0.7510402839987005 E -06
         dc.l     $3f44af0c,$5c28d4df           0.6312189437439850 E -03
         dc.l     $3fad1728,$51dfd9ff           0.5681730269855122 E -01
         dc.l     $3fe00000,$00000000           0.5000000000000000 E +00

*****************************************************************************

cff_sin  dc.l     $3ce880ff,$6993df95           0.2720479095788886 E -14
         dc.l     $bd6ae420,$dc08499c          -0.7642917806891047 E -12
         dc.l     $3de6123c,$686ad430           0.1605893649037159 E -09
         dc.l     $be5ae645,$4b5dc0ab          -0.2505210679827458 E -07
         dc.l     $3ec71de3,$a524f063           0.2755731921015276 E -05
         dc.l     $bf2a01a0,$1a013e1a          -0.1984126984120184 E -03
         dc.l     $3f811111,$111110b0           0.8333333333333165 E -02
         dc.l     $bfc55555,$55555555          -0.1666666666666667 E +00

*****************************************************************************

cff_tanp dc.l     $bef2bab7,$2ea2c724          -0.1786170734225443 E -04
         dc.l     $3f6c0e82,$a63baadf           0.3424887823589059 E -02
         dc.l     $bfc112b5,$e54d0900          -0.1333835000642196 E +00
         dc.l     $3ff00000,$00000000           0.1000000000000000 E +01
*
cff_tanq dc.l     $3ea0b774,$f07678e9           0.4981943399378651 E -06
         dc.l     $bf346f64,$99094841          -0.3118153190701003 E -03
         dc.l     $3f9a479e,$a17e2159           0.2566383228944011 E -01
         dc.l     $bfdddeb0,$47fbd9d5          -0.4667168333975529 E +00
         dc.l     $3ff00000,$00000000           0.1000000000000000 E +01

*****************************************************************************

cff_asnp dc.l     $bfe64bbd,$b5e61e65          -0.6967457344735065 E +00
         dc.l     $40244e17,$64ec3927           0.1015252223380646 E +02
         dc.l     $c043d82c,$a9a6da9f          -0.3968886299750488 E +02
         dc.l     $404c9aa7,$360ad48a           0.5720822787789173 E +02
         dc.l     $c03b5e55,$a83a0a62          -0.2736849452416426 E +02
*
cff_asnq dc.l     $c037d2e8,$6ef9861f          -0.2382385915376024 E +02
         dc.l     $4062de7c,$96591c70           0.1509527084103060 E +03
         dc.l     $c077ddce,$fc56a848          -0.3818630336175015 E +03
         dc.l     $407a124f,$101eb843           0.4171443024826041 E +03
         dc.l     $c06486c0,$3e2b87cc          -0.1642109671449856 E +03

*****************************************************************************

cff_atnp dc.l     $bfeacd7a,$d9b187bd          -0.8375829936815006 E +00
         dc.l     $c020fd3f,$5c8d6a63          -0.8494624035132068 E +01
         dc.l     $c034817f,$b9e2bccb          -0.2050585519586165 E +02
         dc.l     $c02b60a6,$51061ce2          -0.1368876889419193 E +02
*
cff_atnq dc.l     $402e0c49,$e14ac710           0.1502400116002858 E +02
         dc.l     $404dca0a,$320da3d7           0.5957843614259734 E +02
         dc.l     $40558a12,$040b6da5           0.8615734959713024 E +02
         dc.l     $4044887c,$bcc495a9           0.4106630668257578 E +02

*****************************************************************************

cff_powp dc.l     $3f3c78fd,$db4afc28           0.4344577567216312 E -03
         dc.l     $3f624924,$2e278dac           0.2232142128592426 E -02
         dc.l     $3f899999,$999e080e           0.1250000000050380 E -01
         dc.l     $3fb55555,$5555554d           0.8333333333333321 E -01
*
cff_powq dc.l     $3eef4edd,$e392cc80           0.1492885268059561 E -04
         dc.l     $3f242f7a,$e0384c74           0.1540029044098976 E -03
         dc.l     $3f55d87e,$18d7cd9f           0.1333354131358578 E -02
         dc.l     $3f83b2ab,$6e131d98           0.9618129059517242 E -02
         dc.l     $3fac6b08,$d703026d           0.5550410866408560 E -01
         dc.l     $3fcebfbd,$ff82c4ce           0.2402265069590954 E +00
         dc.l     $3fe62e42,$fefa39ef           0.6931471805599453 E +00
*
tb_a1    dc.l     $00000000,$00000000           Dummy entry for indexing
         dc.l     $3ff00000,000000000,$3feea4af,$a2a490da
         dc.l     $3fed5818,$dcfba487,$3fec199b,$dd85529c
         dc.l     $3feae89f,$995ad3ad,$3fe9c491,$82a3f090
         dc.l     $3fe8ace5,$422aa0db,$3fe7a114,$73eb0187
         dc.l     $3fe6a09e,$667f3bcd,$3fe5ab07,$dd485429
         dc.l     $3fe4bfda,$d5362a27,$3fe3dea6,$4c123422
         dc.l     $3fe306fe,$0a31b715,$3fe2387a,$6e756238
         dc.l     $3fe172b8,$3c7d517b,$3fe0b558,$6cf9890f
         dc.l     $3fe00000,$00000000
*
tb_a2    dc.l     $00000000,$00000000           Dummy entry for indexing
         dc.l     $bc7e9c23,$179c0000,$3c611065,$89500000
         dc.l     $3c5c7c46,$b0700000,$bc641577,$ee040000
         dc.l     $3c76324c,$05460000,$3c6ada09,$11f00000
         dc.l     $3c79b07e,$b6c80000,$3c78a62e,$4adc0000

*****************************************************************************

stkoper  rts
         end



	    end

@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@d1 2
d12 1
d14 1
a14 2
*  The following are the addresses of the coefficients used in the
*  evaluation of Basic functions.
d16 104
a119 2
cff_loga    equ   $3c26             LOG coefficients
cff_logb    equ   $3c3e
d121 282
a402 2
cff_expp    equ   $3c56             EXP coefficients
cff_expq    equ   $3c6e
d404 78
a481 1
cff_sin     equ   $3c8e             SIN/COS coefficients
d483 45
a527 2
cff_tanp    equ   $3cce             TAN coefficients
cff_tanq    equ   $3cee
d529 45
a573 2
cff_asnp    equ   $3d16             ASN/ACS coefficients
cff_asnq    equ   $3d3e
d575 36
a610 2
cff_atnp    equ   $3d66             ATN coefficients
cff_atnq    equ   $3d86
d612 104
a715 2
cff_powp    equ   $3da6             x^y coefficients
cff_powq    equ   $3dc6
d717 146
d864 2
a865 2
*  The following are address of tables used in the BCD <-> real
*  conversions and in the evaluation of x^y.
d867 84
a950 9
tb_pwt      equ   $3658             BCD <-> real tables
tb_pwt8     equ   $3698
tb_pwt4     equ   $36b8
tb_pwtt     equ   $36d8
tb_auxpt    equ   $3ae0
tb_bcd      equ   $3b28
tb_bin      equ   $3bc2
tb_a1       equ   $3dfe             x^y tables
tb_a2       equ   $3e8e
d952 1
d954 4
a957 2
* The following are compiler support routines
* in the boot rom.
d959 11
a969 6
	def     asm_assign,asm_difference
	def     asm_equal,asm_in,asm_inclusion
	def     asm_intersect,asm_mpy,asm_nequal
	def     asm_union
	def     asm_rmovel,asm_rmover
	def     asm_pos
d971 17
a987 9
asm_assign          equ     $3372
asm_difference      equ     $3488
asm_equal           equ     $330a
asm_in              equ     $34da
asm_inclusion       equ     $33f4
asm_intersect       equ     $344a
asm_mpy             equ     $31a6
asm_nequal          equ     $3300
asm_union           equ     $3398
d989 128
a1116 3
asm_rmovel          equ     $3108
asm_rmover          equ     $315a
asm_pos             equ     $361e
@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
