* QL WORLD DIY TOOLKIT - SEARCH_MEM memory scanner
* Version 0.9, Copyright 1993 Simon N Goodwin
* Case-dependent (exact) version of MSEARCH
* A ROMable replacement for Turbo's SEARCH_MEMORY
*
initialise lea.l    define,a1
           movea.w  $110.w,a2         BP.INIT vector
           jmp      (a2)
*
bad_param  moveq     #-15,d0          BAD PARAMETER error code
bad_exit   rts
* address = SEARCH_MEM ( address, length, string$ )
*
msearch    lea.l    3*8(a3),a0        Three parameters are required
           cmpa.l   a0,a5
           bne.s    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.s    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
pick_scan  subq.l   #2,d2             D2 is remaining pattern length for DBRA
           bmi.s    scan_just1
           lea.l    3(a1),a3          Point A3 at the second character
           move.b   d1,d5             Save first byte for later
*
* 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.s    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
*
bad_search moveq     #0,d1            Return zero, pattern not found
           bra.s     end_search
*
* Search for the byte in D1 from A0 onwards for D3+1 bytes
*
scan_just1 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.s    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     2                 One long-named function
           dc.w     msearch-*
           dc.b     10,'SEARCH_MEM'
           dc.w     0                 End of functions
           end