* QL WORLD DIY TOOLKIT - ARRAY SEARCH ROUTINES * Version 0.7, Copyright 1992 Simon N Goodwin. * initialise lea.l define,a1 movea.w $110.w,a2 BP.INIT vector jmp (a2) * * INARRAY% ( array [ ,start% ] ,value ) scans arrays FAST * inarray cmpa.l a3,a5 Any parameters? beq.s bad_param cmpi.b #3,0(a3,a6.l) Initial array parameter? bne.s bad_param moveq #3,d5 Mask for known SB types and.b 1(a3,a6.l),d5 Pick up datatype beq.s bad_param Exclude substring type * * D5 = type; A3 = Name Table offset of the array to be searched * movea.l 4(a3,a6.l),a1 A1 -> Array descriptor movea.l 40(a6),a4 Fetch BV.VVBAS offset adda.l a4,a1 A1 is descriptor A6 offset adda.l 0(a1,a6.l),a4 A4 is offset of values move.w 4(a1,a6.l),d0 Get number of dimensions moveq #1,d7 Initial index multiplier cmpi.b #1,d5 Check type; 1 means String bne.s get_index * * Treat two-dimensional character arrays as a special case * subq.w #2,d0 Faster than CMP if volatile bne.s bad_param Wrong number of dimensions move.w 6(a1,a6.l),d7 Maximum element number move.w 8(a1,a6.l),d5 Stride of each string, 4+ bpl.s next_param Disallow negative lengths bra.s bad_param * * Numeric array descriptor; 1..15 dimensions, 1..32768 elements? * get_index move.w 6(a1,a6.l),d2 Fetch maximum index value addq.w #1,d2 Convert to stride mulu d2,d7 Accumulate addq.l #4,a1 Try the next one subq.w #1,d0 Count one less subscript bne.s get_index subq.l #1,d7 Count elements from zero cmp.l #32767,d7 Limit result to 0-32767 bhi.s bad_param Alas the array is too big next_param addq.l #8,a3 cmpa.l a3,a5 Any more parameters? beq.s bad_param swap d7 Save count for later move.w d5,d7 Save type: 2=F, 3=%, 4+=$ * * D7.W = type; D7.H = last element, 0-32767; A4 = initial offset * moveq #0,d5 Assumed start, element zero lea.l 8(a3),a2 Delimit one Name Table entry cmpa.l a2,a5 Is there one parameter left? beq.s pattern If so, D5 is set correctly * * Fetch the optional integer 'first element to scan' in D5.W * move.l a5,d5 Save end of parameters movea.l a2,a5 Delimit the first parameter movea.w $112.w,a2 Read vector to get integers jsr (a2) Call CA.GTINT bne.s bad_exit move.w 0(a1,a6.l),d0 Pick up the value bpl.s good_param It needs to be positive * bad_param moveq #-15,d0 Signal a BAD PARAMETER error bad_exit rts Return the error code in D0 * good_param addq.l #2,$58(a6) Unstack integer from BV.RIP movea.l a5,a3 Step past this parameter movea.l d5,a5 Restore end of list move.w d0,d5 Update D5 to match parameter lea.l 8(a3),a2 Only one parameter left? cmpa.l a2,a5 bne.s bad_param * * Pick up the pattern and look for it in the array * pattern cmpi.w #3,d7 Check type bmi.s floats Type 2 (float) gives -1 bne.s strings Type 3 (integer) gives zero * * Search integer array elements for the final parameter * ints movea.w $112.w,a2 Vector to get integers jsr (a2) CA.GTINT bne.s bad_exit move.w 0(a1,a6.l),d0 Use this RI space later swap d7 D7 is element count move.w d5,d4 Work out start offset ext.l d4 Avoid +/- 32768 quirks add.l d4,d4 Scale D4 for integers adda.l d4,a4 Advance to first element search_int cmp.w d5,d7 bcs.s finished cmp.w 0(a4,a6.l),d0 Extract array element beq.s stack_int Return D5 if D0 matches addq.w #1,d5 addq.l #2,a4 Advance to next element bra.s search_int * * Search a table of floating-point array elements * floats movea.w $114.w,a2 Vector to get floats jsr (a2) CA.GTFP bne.s bad_exit move.w 0(a1,a6.l),d0 Fetch exponent move.l 2(a1,a6.l),d1 Fetch mantissa addq.l #4,$58(a6) BV.RIP for integer result swap d7 D7 is element count ext.l d5 move.l d5,d4 add.l d4,d4 Scale D4 by 6 for floats add.l d5,d4 D4 := D5 * 3 add.l d4,d4 D4 := D5 * 6 adda.l d4,a4 Advance to first element search_fp cmp.w d5,d7 bcs.s finished cmp.w 0(a4,a6.l),d0 Compare exponents bne.s next_float cmp.l 2(a4,a6.l),d1 Compare mantissae beq.s stack_int next_float addq.w #1,d5 addq.l #6,a4 Step to next value bra.s search_fp * * Search string array elements for the last parameter * strings movea.w $116.w,a2 Vector to get strings jsr (a2) CA.GTSTR bne.s exit moveq #1,d0 Allow for the odd byte add.w 0(a1,a6.l),d0 Unstack the text length bclr #0,d0 D0 is length rounded up add.l d0,$58(a6) Leave one word for result move.w d7,d6 D6 is string stride move.w d5,d4 Work out start offset mulu d6,d4 Scale for elements adda.l d4,a4 Advance to first element movea.l a4,a0 Set A0 for UT.CSTR swap d7 Now D7 is element count movea.w $E6.w,a4 Pick up UT.CSTR vector search_str cmp.w d5,d7 Are we past the end? bcs.s finished moveq #3,d0 Sinclair comparison type jsr (a4) Call UT.CSTR beq.s stack_int Return D5 if they match addq.w #1,d5 adda.w d6,a0 Next; Note implicit EXT.L bra.s search_str * * Return location 0-32767, or -7 if the value was not found * finished moveq #-7,d5 NOT FOUND Qdos error code stack_int move.l $58(a6),a1 Retrieve BV.RIP move.w d5,0(a1,a6.l) Stack a one word reply moveq #3,d4 Indicate integer result moveq #0,d0 Signal ERR.OK, it worked exit rts * define dc.w 0,0 No procedures dc.w 2 One long-named function dc.w inarray-* dc.b 8,'INARRAY%' dc.w 0 end