* QL WORLD DIY TOOLKIT - FAST COMPARISON FUNCTIONS * Version 0.8, Copyright 1992 Simon N Goodwin. * initialise lea.l define,a1 movea.w $110.w,a2 BP.INIT vector jmp (a2) * * MININT returns the lowest valid integer of an array or list * minint cmpa.l a3,a5 Any parameters? beq.s lowest If not, return -32768 bsr.s get_ints compare cmp.w 0(a2,a6.l),d0 Is D0 less than (A2,A6) ? ble.s too_much move.w 0(a2,a6.l),d0 No, pick up the new lowest too_much addq.l #2,a2 dbra d3,compare stack_int move.w d0,0(a1,a6.l) Stack the highest found got_int moveq #3,d4 INT result is stacked moveq #0,d0 No error rts * * Return constants -32768 or +32767 if there are no parameters * lowest move.w #$8000,d4 MINIMUM% is -32768 bra.s return_int lots move.w #$7FFF,d4 MAXIMUM% is 32767 return_int moveq #2,d1 No. of bytes needed * * Check there are D1 bytes free for the result on the RI Stack * stk_check move.l d1,d7 Remember the space needed movea.w $11A.w,a0 Read the BV.CHRIX vector jsr (a0) Check for D1 stack bytes stack_num movea.l $58(a6),a1 Get a safe A1 value suba.l d7,a1 Allocate the space move.l a1,$58(a6) Update BV.RIP move.w d4,0(a1,a6.l) Stack one word subq.l #2,d7 Is that enough? beq.s got_int move.l d5,2(a1,a6.l) Stack mantissa bra got_float * * MAXINT finds the highest valid integer it can find * maxint cmpa.l a3,a5 Any parameters? beq.s lots If not, return +32767 bsr.s get_ints Put D3+1 params @ (A6,A2) compare4 cmp.w 0(a2,a6.l),d0 Test one bge.s not_top4 move.w 0(a2,a6.l),d0 Pick up the new highest not_top4 addq.l #2,a2 Advance to the next dbra d3,compare4 bra.s stack_int Return D0 to SuperBASIC * get_ints move.l $58(a6),d7 Save BV.RIP for later movea.l (a7)+,a4 Tidy up return address moveq #2,d5 Number of bytes per value cmp.w #$0303,0(a3,a6.l) Integer array? bne.s misc_ints No, read integer parameters lea.l get_ready,a5 Continue there later * * FIND_ARRAY start with (A3,A6) -> NT Entry, D5 = Element size * Exit @A5 with first word in D0, (A2,A6) -> the 2nd element * find_array movea.l 4(a3,a6.l),a3 A3 -> Array descriptor movea.l 40(a6),a2 Fetch BV.VVBAS offset adda.l a2,a3 A3 is descriptor A6 offset cmp.w #1,4(a3,a6.l) Check number of dimensions bne.s bad_param Require just 1 dimension move.l d5,d1 Ensure RI space for result movea.w $11A.w,a0 Fetch BV.CHRIX vector jsr (a0) No return if this fails move.w 6(a3,a6.l),d3 Fetch maximum index value subq.w #1,d3 Prepare for DBRA later bmi.s bad_param Require 2+ array elements! adda.l 0(a3,a6.l),a2 A2 is A6 offset of values move.w 0(a2,a6.l),d0 Pick up the first word adda.l d5,a2 Advance to the next element jmp (a5) * misc_ints movea.w $112.w,a2 Vector to get integers jsr (a2) CA.GTINT bne.s bad_exit subq.w #2,d3 Only 1 parameter? bmi got_int Easy, it's already stacked move.w 0(a1,a6.l),d0 Pick up the first integer move.l a1,a2 adda.l d5,a2 Point A2 at the next get_ready movea.l d7,a1 Retrieve old BV.RIP suba.l d5,a1 Make room for the result move.l a1,$58(a6) Set BV.RIP for later jmp (a4) Return wherever * bad_param moveq #-15,d0 BAD PARAMETER error bad_exit rts Return error code in D0 * get_floats move.l $58(a6),d7 Save BV.RIP for later movea.l (a7)+,a4 Return point if all's well moveq #6,d5 Allow six bytes per element cmp.w #$0302,0(a3,a6.l) Floating point array? bne.s misc_float lea.l get_mantis,a5 Continue from here later bra.s find_array * misc_float movea.w $114.w,a2 Vector to get floats jsr (a2) CA.GTFP bne.s bad_exit subq.w #2,d3 Only 1 parameter? bmi.s got_float move.w 0(a1,a6.l),d0 Pick up exponent lea.l 6(a1),a2 Point A2 at the next get_mantis move.l -4(a2,a6.l),d1 Don't forget the mantissa bra.s get_ready * * Find MINIMUM floating-point value; constant, array or list * minimum cmpa.l a3,a5 Any parameters? bne.s get_minis move.w #$0FFF,d4 Exponent is 4095 decimal move.l #$80000000,d5 Mantissa has 7 hex zeros bra stk_check MINIMUM is -1.61585 e616 * get_minis bsr.s get_floats Find the parameter(s) compare3 bsr.s compare_fp Is D0 & D1 the lowest ? bcc.s not_least move.w 0(a2,a6.l),d0 Pick up the new lowest move.l 2(a2,a6.l),d1 exponent and mantissa not_least addq.l #6,a2 Advance to the next one dbra d3,compare3 Try up to 65536 times bra.s stack_fp Put D0 and D1 on RI Stack * * Find MAXIMUM floating-point value; constant, array or list * maximum cmpa.l a3,a5 Any parameters? bne.s get_maxes move.w #$0FFF,d4 Exponent is 4095 decimal move.l #$7FFFFFFF,d5 Mantissa has 7 hex 'F's bra stk_check MAXIMUM is +1.61585 e616 * get_maxes bsr.s get_floats Put D3+1 values @ (A2,A6) compare2 bsr.s compare_fp bls.s not_top2 Skip if Z or C flag set move.w 0(a2,a6.l),d0 Pick up the new highest move.l 2(a2,a6.l),d1 Don't forget the mantissa not_top2 addq.l #6,a2 dbra d3,compare2 * stack_fp move.w d0,0(a1,a6.l) Stack the exponent move.l d1,2(a1,a6.l) Stack the mantissa got_float moveq #2,d4 Flag FLOAT result stacked moveq #0,d0 No error rts * * FAST F.P. COMPARE, sets C & Z for 0..5(A2,A6) - D0.W D1.L * compare_fp move.l 2(a2,a6.l),d5 Pick up next mantissa move.l d1,d4 Copy the highest yet eor.l d5,d4 Do the signs match? bpl.s same_sign tst.l d1 No; is best yet -ve ? bmi.s compared add.l d4,d4 Set Carry, since D4<0 rts * same_sign move.w 0(a2,a6.l),d2 Pick up next exponent tst.l d5 Are mantissae positive? bmi.s both_minus If not, bigger means less both_plus cmp.w d0,d2 Compare exponents bne.s compared Easy if they differ cmp.l d1,d5 Else check mantissae compared rts * both_minus cmp.w d2,d0 Compare exponents bne.s compared Exponents give result cmp.l d1,d5 Mantissae give result rts * define dc.w 0,0 No procedures dc.w 5 Four long-named functions dc.w maximum-* dc.b 7,'MAXIMUM' dc.w minimum-* dc.b 7,'MINIMUM' dc.w maxint-* dc.b 8,'MAXIMUM%' dc.w minint-* dc.b 8,'MINIMUM%' dc.w 0 end