* QL WORLD DIY TOOLKIT - MSEARCH flexible memory scanner * Version 0.8, Copyright 1993,1994 Simon N Goodwin. * Updated to match [ \ ] ^ _ ` even at start of string * initialise lea.l define,a1 movea.w $110.w,a2 BP.INIT vector jmp (a2) * * address = MSEARCH ( address, length, string$ ) * msearch lea.l 3*8(a3),a0 Three parameters are required cmpa.l a0,a5 bne bad_param Otherwise report 'bad parameter' move.l $58(a6),d7 Save BV.RIP, maths stack pointer subq.l #8,a5 Conceal the last parameter, for now movea.w $118.w,a0 Fetch the CA.GTLIN vector jsr (a0) Try to get two long integers bne bad_exit movea.l 0(a1,a6.l),a4 Fetch address parameter move.l 4(a1,a6.l),d5 Fetch search length parameter ble.s bad_param This must be greater than zero! move.l a5,a3 Prior end is new start addq.l #8,a5 Retrieve last parameter movea.w $116.w,a2 Fetch the CA.GTSTR vector jsr (a2) Get the string onto the RI stack bne.s bad_exit move.w 0(a1,a6.l),d2 Fetch string length ble.s bad_param Reject null or inplausible pattern (>32K) ext.l d2 move.l d5,d3 Copy the target length for checking sub.l d2,d3 D3 counts possible match positions bcs.s bad_search Pattern is longer than target! movea.l a4,a0 A0 points to memory to be scanned moveq #0,d6 Presume no letters in pattern move.b 2(a1,a6.l),d1 Pick up the first character bsr.s check_case pick_scan subq.l #2,d2 D2 is remaining pattern length for DBRA bmi scan_just1 lea.l 3(a1),a3 Point A3 at the second character move.b d1,d5 Save first byte for later move.w d2,d0 Copy count for pattern case conversion case_lock move.b 3(a1,a6.l),d1 Pick up each pattern byte after first bsr.s check_case move.b d1,3(a1,a6.l) Store corrected code addq.l #1,a1 Advance to the next dbra d0,case_lock Scan all the rest of the pattern tst.b d6 Were there any letters? beq.s multiscan No, so we can rush ahead * * Case-independent scanner for patterns of more than one byte * subq.l #1,a3 Check entire string if quick test OK move.b d5,(a3,a6.l) Store corrected first byte ori.b #32,d5 ** 0.8 ** Ensure case bit is set addq.w #1,d2 Add one to length for later checks lea.l slow_scan,a4 Record top of loop for later retries slow_scan moveq #32,d1 Ensure the case bit is set or.b (a0)+,d1 Mask in a byte from memory cmp.b d5,d1 slow_retry dbeq d3,slow_scan Loop till first byte seems to match bne searched No match yet; scan complete? movea.l a3,a1 A1 points to the text lea.l -1(a0),a2 A2 points to the possible match move.w d2,d4 Temporary count variable check_rest move.b (a2)+,d1 bsr.s check_case Slow but sure cmp.b 0(a1,a6.l),d1 addq.l #1,a1 Advance through the pattern dbne d4,check_rest Check all characters after the first bne.s slow_retry Mismatch, start again bra.s found * bad_param moveq #-15,d0 BAD PARAMETER error code bad_exit rts * bad_search moveq #0,d1 Return zero, pattern not found bra.s end_search * * Check case of D1, set D6 if alphabetic, convert if necessary * check_case cmpi.b #'A',d1 Check for capitals or greater bmi.s not_alpha No, get on cmpi.b #171,d1 Past OE, end of second caps/lower block? bhi.s not_alpha 58% of codes excluded so far! tst.b d1 Separate out codes >127 bmi.s eight_bit cmpi.b #'Z',d1 ASCII capital letter? bls.s fix_case cmpi.b #'a',d1 bcs.s not_alpha One of the set [ \ ] _ ^ ` cmpi.b #'z',d1 bls.s flag_text It's lower case not_alpha rts * * If we get this far, the code is in the range 128 to 171 * eight_bit cmpi.b #160,d1 At or after A umlaut? bcc.s flag_text Leave the case bit set cmpi.b #139,d1 bhi.s not_alpha Code has no upper case equivalent fix_case ori.w #32,d1 Set the bit determining letter case flag_text moveq #1,d6 Indicate that a letter was found rts * * Exact scan for patterns of more than one byte * multiscan lea.l scanner,a4 Record top of loop for later retries scanner cmp.b (a0)+,d5 Check for the first byte retry dbeq d3,scanner bne searched No match yet; scan complete? movea.l a3,a1 A1 points to the rest of the text movea.l a0,a2 Save point reached for retry later move.w d2,d4 Temporary count variable for the rest scan_rest move.b (a2)+,d0 cmp.b 0(a1,a6.l),d0 addq.l #1,a1 Advance through the pattern dbne d4,scan_rest Check all characters after the first bne.s retry Mismatch, start again found move.l a0,d1 Eureka! subq.l #1,d1 Compensate for increment in SCANNER end_search subq.l #6,d7 Make room for a floating-point value move.l d7,$58(a6) Tidy the BV.RIP maths stack movea.l d7,a1 * * Convert D1.L to a floating point value in space on RI stack * return_fp move.w d1,d4 D4 will be exponent move.l d1,d5 D5 will be mantissa beq.s stack_fp Zero is a trivial case move.w #2079,d4 First guess at exponent add.l d1,d1 Already normalised? bvs.s stack_fp subq.w #1,d4 No, halve exponent weight move.l d1,d5 Double mantissa to match moveq #16,d0 Try a 16 bit shift * normalise move.l d5,d1 Take copy of mantissa asl.l d0,d1 Shift mantissa D0 places bvs.s too_far Overflow; must shift less sub.w d0,d4 Correct exponent for shift move.l d1,d5 New mantissa is more normal too_far asr.w #1,d0 Halve shift distance bne.s normalise Try shift of 8, 4, 2 and 1 stack_fp move.l d5,2(a1,a6.l) Stack mantissa move.w d4,0(a1,a6.l) Stack exponent moveq #2,d4 Floating point result moveq #0,d0 rts * * Search for the byte in D1 from A0 onwards for D3+1 bytes * scan_just1 tst.b d6 Does letter case matter? beq.s scan_exact No, so go extra-quickly lea.l scan_one,a4 scan_one moveq #32,d0 Load the mask to ignore the case bit or.b (a0)+,d0 Mask in the memory contents cmp.b d0,d1 Does it SEEM to match? dbeq d3,scan_one bne.s searched D3 count exhausted, try another 64K? move.b d1,d0 We'd better make a more certain test move.b -1(a0),d1 Pick up the unadulterated code bsr check_case Convert it the hard way cmp.b d0,d1 Does it STILL match? beq.s found A genuine match, return its position jmp (a4) Try again, hope springs eternal... * * Search through memory from A0 onwards for the exact byte in D1 * scan_exact lea.l scan_fast,a4 scan_fast cmp.b (a0)+,d1 dbeq d3,scan_fast beq.s found A match, return its position searched addq.w #1,d3 Clear low word (previously -1) tst.l d3 Is there more to be done? beq bad_search No - so the search was fruitless subq.l #1,d3 Decrement high word & restore low word jmp (a4) Look through another 64K * define dc.w 0 No procedures dc.w 0 End of procedures dc.w 1 One function dc.w msearch-* dc.b 7,'XSEARCH' dc.w 0 End of functions end