* QL WORLD DIY TOOLKIT - SET & SET# extensions - RESIDENT CONSTANTS * Version 1.4, Copyright 1991 Simon N Goodwin; thanks to Luca Pivato * lump_size equ 1008 RAM lump size taken from Common Heap call_code equ 20153 680XX OPCODE for JSR .L string equ 1 SuperBASIC type code of a string float equ 2 Type code for floating-point values integer equ 3 16 bit signed integer type code * start lea.l define,a1 Point to the table of details move.w $110\w,a2 Find BP.INIT (a word vector) jmp (a2) Add SET to SuperBASIC * * Internal variables, not for ROM; could be made a QPAC or Argos THING * heap_lump dc.w lump_size SET memory allocation size, 16-32760 sentinel dc.l 0 Heap pointer (NOT suited to ROM!) * * These value-fetching routines are shared by all SET functions * read_int moveq #2,d1 Extra space needed bsr.s checker Allocate room on the stack move.l (a7)+,a0 A0 -> Result move.w (a0),0(a1,a6.l) Fetch and stack the result moveq #integer,d4 Indicate INT result rts Return D0 set by CHECKER * read_ptr moveq #6,d1 Extra space needed bsr.s checker move.l (a7)+,a0 A0 -> Result move.w (a0),d3 Checked for even-ness earlier moveq #0,d0 MT.INF trap key (be sure) trap #1 Find the system variables move.l 0(a0,d3.w),d2 Read the system vector move.l d2,d1 D1 will be the exponent beq.s normalised Job done, if D2 & D1=0; result 0 * * This optional block normalises typical SYSVAR addresses extra-quickly!! * It replaces sequential shifts and checks with one fast shift if the value * is in the first 64K of QL RAM (often true for system table pointers). It * is about seven times faster than the binary method normally used in DIY * Toolkit. The bitwise loop is about 30 per cent slower than the binary * method, even though this version only works with positive numbers and * grows especially slow on very small values, like 1. * * swap d1 Inspect the high word of D1 * subq.w #2,d1 Is D1 between 128K..192K-1 ? * bne.s slow_loop No, so normalise D2 slowly * moveq #13,d1 Bit Shift count for D2 * lsl.l d1,d2 Normalise D2 in one step! * move.w #2066,d1 Set exponent for 131072-262143 * bra.s normalised * slow_loop move.w #2080,d1 Guess at the exponent + 1 normaloop subq.w #1,d1 Halve the weight of the guess add.l d2,d2 Double the mantissa bpl.s normaloop Does it still fit? lsr.l #1,d2 Whoops, ensure sign=0 (+ve) normalised move.w d1,0(a1,a6.l) Exponent move.l d2,2(a1,a6.l) Mantissa moveq #float,d4 Indicate FLOAT result rts * read_float moveq #6,d1 Extra space needed bsr.s checker move.l (a7)+,a0 A0 -> Result move.w (a0)+,0(a1,a6.l) move.l (a0),2(a1,a6.l) Transfer mantissa moveq #float,d4 Floating-point result rts * read_str move.l (a7)+,a0 A0 -> Address of Result (length.W) move.l (a0),a0 Pick up string value address moveq #3,d1 Room for length & odd byte add.w (a0),d1 Add room needed for text bclr #0,d1 Count in whole words bsr.s checker Check there's room lsr.w #1,d4 D4 := D4 DIV 2, # text words subq.w #1,d4 Adjust word count for DBRA move.l a1,a2 A2 is the offset of stacked words copy_text move.w (a0)+,0(a2,a6.l) Stack one word from the heap addq.l #2,a2 Advance up the maths stack dbra d4,copy_text Copy words till all are done got_string moveq #string,d4 Result datatype is STRING rts * * Check for D1.L RI Stack bytes; alters D1-3, D4=old D1, A1=RI.SP * checker move.l d1,d4 Save size for use later tst.b $54(a6) Turbo/Supercharged code? bmi.s found_room Assume there's enough room move.w $11A\w,a1 BV.CHRIX checks space jsr (a1) D1 bytes are needed found_room move.l $58(a6),a1 A1 := (new?) BV.RIP sub.l d4,a1 Grab the bytes move.l a1,$58(a6) Update BV.RIP to suit moveq #0,d0 rts * * SET [#] unset_name TO value - parse two parameters * set lea.l 16(a3),a4 Check for 2 parameters cmp.l a4,a5 bne.s bad_param * * Make A4 -> SuperBASIC (task 0,0) for Name Table access, etc. * moveq #0,d2 Search entire task tree moveq #0,d1 Look for SuperBASIC moveq #2,d0 MT.JINF Trap key trap #1 A0 := base of task 0,0 move.l a0,a4 * * D5.B is the type to be SET, or 0 for VECTOR type. This code does * not NEED to support three types - it could have strings all through - * but it is much faster and probably more concise with INTS & FLOATS. * move.b 1(a3,a6.l),d5 Get first NT entry type beq.s bad_param Strange, and best avoided btst #7,d5 Is there a # at the start? beq.s normal_set moveq #0,d5 Flag a special data type normal_set move.b 0(a3,a6.l),d1 Get the name type too beq notyetset Handle an unset name * ** New code will be added here next month * bad_param moveq #-15,d0 ERR.BP report code bad_exit rts Return error code in D0 * notyetset move.w 2(a3,a6.l),d7 Get parameter name NT index ble.s bad_param ext.l d7 lsl.l #3,d7 Scale for 8 byte NT entries add.l 24(a6),d7 Add offset from Basic base to NT next_param addq.l #8,a3 Advance to the next parameter * * A4 -> SuperBasic, A3 & A5 -> Parameter #2, D7 is Basic NT entry offset * D5.B is the data-type, 1-3, or 0 for a 'vector' * Evaluate the expression at (A3,A5), type D5.B, onto the Maths Stack * got_name and.b #3,d5 Is this SET # ? move.b d5,d4 Make a temporary copy of the type bne.s not_vector moveq #3,d4 Integer parameters suit SET# not_vector ext.w d4 Type Word := 1 , 2 , 3 add.w d4,d4 Now type code is 2, 4 or 6.W suba.l a0,a0 Clear A0 quickly sub.w d4,a0 Remember the implicit EXT.L lea.l $118(a0),a0 Now A0 := $116, $114, $112 movea.w (a0),a0 Pick up appropriate vector jsr (a0) Put parameter value on stack bne.s bad_exit trap #0 Prevent multi-tasking temporarily * * More extra code will appear here next month; for now... * * find room for the new value * generate code * connect the NT entry at (A4,D7.L) to the code * return * no_release moveq #16,d1 Size = 4(LEN) + 6(JMP) + 6?(DATA) cmp.b #string,d5 Strings have special requirements beq.s new_string cmp.b #float,d5 Floating point? (6 bytes DATA) beq.s space_set Yes, D1 was guessed right moveq #12,d1 No, integer, D1 should be 4+6+2 bra.s space_set * new_string addq.l #6,d1 Allow for string spacer & long header add.w 0(a1,a6.l),d1 Still works if the total overflows 32K space_set move.l d1,d4 Save the required size for later alloc_d1 lea.l sentinel,a0 Find the start of the user heap move.w $D8\w,a2 Get MM.ALLOC vector jsr (a2) Find D1 bytes tst.l d0 beq.s count_up Set them, if they were found * * Find more room for data in my heap; clobbers D0-3, A0-3 * find_more move.w heap_lump,a0 Implicitly EXT.L A0 move.l d4,d1 D1 is space required cmp.l a0,d1 Will it fit the next lump? bhi.s get_plenty If not, get room PLUS a lump moveq #0,d1 No extra needed... get_plenty add.l a0,d1 Find the space needed moveq #0,d2 Get RAM owned by SuperBASIC moveq #24,d0 Set MT.ALCHP trap key trap #1 Ask for Common Heap space tst.l d0 Did we get it? bne.s super_stop moveq #16,d2 Forget the 16 byte ALCHP header sub.l d2,d1 D1 is the size of the available space lea.l sentinel,a1 move.w $DA\w,a2 Get MM.LNKFR vector jsr (a2) Link the new space into the heap move.l d4,d1 Remember what we originally wanted bra.s alloc_d1 Go back for it * * Count data words to be copied from RI stack to my heap, and make code * bad_vector moveq #-15,d0 Reject odd vector parameter values bra.s super_stop * make_ptr btst #0,1(a1,a6.l) Check it's an even word! bne.s bad_vector lea.l read_ptr,a2 bra.s word_count * make_nums lea.l read_int,a2 Point to integer code cmp.b #integer,d5 But is it an integer? beq.s word_count Phew... lea.l read_float,a2 No, FLOAT is Hobson's choice bra.s word_count * count_up move.l $58(a6),a1 Find the parameter stack again cmp.b #string,d5 Check the data-type bcs.s make_ptr If less than one presume 0, VECTOR bhi.s make_nums It's higher than 1, FLOAT or INTEGER lea.l read_str,a2 Point to string-fetching code sub.w #9,d4 Round up & forget extra string data word_count lsr.w #1,d4 Count words not bytes subq.w #6,d4 Discount 5 prefix words + 1 for DBRA * * Generate code and data * make_value move.l (a0)+,d1 Recall the total heap block length move.l a0,4(a4,d7.l) Set a Task 0 Name Table code pointer move.w #call_code,(a0)+ Store a JSR.L instruction move.l a2,(a0)+ Store the address of the data fetcher move.w #$0900,0(a4,d7.l) Mark this Name as a Resident Function subq.b #string,d5 Is this a string? bne.s data_store If not, we have almost finished lea.l 10(a0),a2 Find address of string (4+2+4 later) move.l a2,(a0)+ Put it after the call addq.l #2,a0 Skip to the next user heap block moveq #16,d2 Size of the first part sub.l d2,d1 D1 is size of the remaining part move.l d1,(a0)+ Store the block size of part 2 data_store move.w 0(a1,a6.l),(a0)+ Copy data words to my heap addq.l #2,a1 Advance up this task's RI stack dbra d4,data_store Count the data word(s) super_stop andi #$D8FF,sr Return to multi-tasking user mode rts * define dc.w 1 One procedure dc.w set-* dc.b 3,'SET' dc.w 0,0 End of Procs, no FNs (yet!) dc.w 0 End of functions * end