******************************************************************************** * * ENV - Enviroment variable package for QDOS * * v1.00 08.12.91 - Dave Nash (DFN) - Initial version * * v1.01 2/5/92 - Dave Woodman (DPW) - Revised version and bug fix * * - Minerva compatible - installs as dummy version and * patches name-table * - Does not allow multiple definitions with same name:- * user may now modify previous definitions * - Parameter checking added - illegal definitions * rejected * - Error handling fixed:- will no longer crash machine on * errors being encountered * * 3/5/92 - DPW - Added ENV_LIST keyword * * 8/5/92 - DPW - Added GETENV$ keyword * * v1.02 9/5/92 - DPW - Added ENV_DEL keyword * * v1.03 17/8/92 - Richard Kettlewell (RK) * - Removed need to go into supervisor mode when * initialising + reading strings of RI stack * - Tidied up code by making addq, subq explicit; * replacing cmp #0 with tst, or removing * completely where unnecessary * - Removed explicit adda, cmpi etc - the assembler * is actually capable of working these out * for itself, believe it or not, and they do * do look such a mess * - All in all, reduced code length by 100ish bytes * * v1.04 21/8/92 - Dave Walker * - Added version number message * * v1.05 17/6/93 - Phil Borman * - Fixed fault with ENV_DEL that could cause a crash * due to memory corruption outside ENV area. * * v1.06 01/09/93 - Dave Walker * - Added code to make this work on a QXL. It is not * really clear why this code is needed! * * v1.07 21/01/95 - Dave Walker * - Changed code that is used to identify a SMS based * system. Basically this always assumes that the * QDOS version number is greater than 2.00. This * change was needed because SMSQ v2.47 no longer sets * a value in the system variables to identify it as * SMSQ - but sets the same value as QDOS did. ******************************************************************************* section text bv.chrix equ $11a reserve space on arith stack bv.rip equ $58 pointer to arith stack bp.init equ $110 initialize new procedures & functions ca.gtstr equ $116 get string from SB ca.gtint equ $112 get int from SB ut.mtext equ $d0 send message to channel mt.alchp equ $18 allocate common heap area mt.rechp equ $19 release common heap area io.sbyte equ $5 trap #3 vector to send single byte bv.nlbas equ $20 basic name list base bv.nlp equ $24 basic name list pointer bv.chbas equ $30 base of SB channel table bv.chp equ $34 SB channel tablerunning pointer ch.lench equ $28 SB channel table entry length star equ '*' equals equ '=' lf equ $0a line feed init sub.l a0,a0 channel 0 lea msg,a1 start up message move.w ut.mtext,a2 get vector jsr (a2) ... and do it moveq #0,d0 MT.INF trap #1 ... and do it moveq #0,d7 clear flag cmpi.l #'SMSQ',(a0) System variables identify this as SMS ? beq.s is_sms YES ... jump cmpi.l #'2.00',d2 Version number says SMS ? blt.s init_do ... NO, then we assume not is_sms moveq #1,d7 set flag lea dummy,a0 get special keyword move.b #'*',(a0) change _ to * move.b #'*',4(a0) init_do lea procs,a1 point to procedure definition table move.w bp.init,a2 jsr (a2) add names to name table tst.l d7 QXL card ? bne exit.ok ... yes, exit immediately * * Since the Minerva ROMs will not accept illegal superbasic names for * inclusion in the name table, it is necessary to install the dummy * procedure *ENV* as _ENV_ (or any other acceptable name)and then patch * the name table. * move.l bv.nlbas(a6),a1 a1 points to base of name table move.l bv.nlp(a6),a2 load running pointer in a2 * chk_len subq.l #1,a2 cmp.b #5,(a6,a2.l) check for a string 5 chars long... beq.s chk_nam got one, but is it right ? cmp.l a2,a1 have we done the whole table ? bne.s chk_len if not, carry on * * If we get here, we really have problems:- we couldn't find the entry in the * name list! Return ERR.BP * bra exit.bp * chk_nam lea dummy,a4 set a4 to point at rest of string moveq #4,d2 set loop counter move.l a2,a0 keep copy of pointer to start of string addq.l #1,a2 move past length indicator cmp_str move.b (a4)+,d0 cmp.b (a6,a2.l),d0 bne.s not_it carry on searching if not correct addq.l #1,a2 next pair of characters dbra d2,cmp_str loop back to test the rest of this one * * if we get here, the string has been located... a2 points past the * last '_', and 1(a0) to the first. * move.b #star,1(a6,a0.l) patch the name move.b #star,-1(a6,a2.l) * * bra exit.ok return ; ; Wrong name ; Code as was would get into infinite loop about here if there was a ; give letter name other than _ENV_ (unless _ENV_ found first, of course.) ; not_it move.l a0,a2 bra chk_len ********************************************************************************** * End of installation code * ********************************************************************************** msg dc.w 22 dc.b 'c68 ENV support v1.07',10 procs dc.w 4 # procedures dc.w ENV-* relative start address dc.b 5 length of dummy name dummy dc.b '_ENV_' dummy procedure name dc.w SETENV-* relative start address dc.b 6,'SETENV' procedure name dc.w ENV_LIST-* pointer to ENV_LIST routine dc.b 8,'ENV_LIST' dc.w ENV_DEL-* pointer to RM_ENV routine dc.b 7,'ENV_DEL' dc.w 0 end of procedures dc.w 1 # functions dc.w GETENV-* pointer to GETENV dc.b 7,'GETENV$' name... dc.w 0 end of table * * The pointer to the environment system variables * are stored in a dummy procedure. * ; ; 1) Don't need to align because the dc.w 0 above just did that. ; 2) Also, rts is an instruction and GST assembler will align these ; (and their labels) for us without being asked. ; 3) Same applies in MANY other places throughout file ; ENV rts return if we are called EnvBas dc.l 0 pointer to base of environment string EnvLen dc.l 0 length of environment string * ******************************************************************************* * * * SETENV 'name=value' - set an environment variable * * * ******************************************************************************* SETENV move.w ca.gtstr,a2 get string routine jsr (a2) get parameters onto RI stack cmp.w #1,d3 check number of parameters fetched bne exit.bp exit if not 1 moveq #0,d4 clear d4 move.w (a6,a1.l),d4 get parm length * * Parameter needs to be of the form: [char...]=string where string can be null * cmp.w #2,d4 check we have at least two characters blt exit.bp if not, then bad parameter ; ; If people didn't use BLT etc instead of BLO etc then we could have ; strings up to 65535 bytes. But no, people have to use signed tests ; on unsigned values so much software will go berzerk when strings ; get longer than 32767 bytes... Too late now, of course. Maybe in ; another OS? ; * move.l a1,a4 save pointer to parameter * * Determine the length of the new area to allocate * move.l EnvLen,d1 get length of current area add.l d4,d1 add the parameter length addq.l #1,d1 add one for the \0 at end of string * * Attempt to allocate the new area * moveq #0,d2 super basic will own new area moveq #mt.alchp,d0 trap #1 tst.l d0 did it work ? bne exit.om no, must be out of memory * * Ok, so we have an area of heap, let's copy the new string into it. At the * same time, let's check that there is an '=' in the definition, and remember * where it is. If there is not, release the area and return err.bp * move.l d1,d6 keep copy of byte count for later (used WHEN?) subq.w #1,d4 set up loop counter move.l a0,a1 make a copy of the base address sub.l a5,a5 clear out a5 (used for '=' checks) copy_par move.b 2(a6,a4.l),d3 why bother adding 2 before? addq.l #1,a4 cmp.b #equals,d3 is it an equals sign ? bne.s next if not, continue cmp.l #0,a5 have we already got one ? bne.s next yes, ignore this one... move.l a1,a5 copy current pointer:- points to '=' next move.b d3,(a1)+ copy out char dbra d4,copy_par carry on until finished * clr.b (a1)+ terminate the string * * Now perform final verification of the parameter:- check that we had an '=', * and that it was not the first char in the string * cmp.l #0,a5 did we get an '=' ? beq.s junkit ditch the area if not cmp.l a0,a5 was it first char ? bne.s parm_ok if not, string was OK junkit moveq #mt.rechp,d0 otherwise, release area... trap #1 bra exit.bp and return err.bp * * Right, now we have a valid string, a0 points to the base of the heap area, * a1 to the next entry, a5 to the '='. Now we need to copy the old variables * across, checking to see if we already have a definition in place. * parm_ok move.l a5,d7 get address of '=' sub.l a0,d7 find length of var name + 1 (for '=') subq.w #1,d7 and make it real length move.l EnvBas,a2 get current base address cmp.l #0,a2 do we have an area to copy ? bne.s do_vars no, go straight to updating pointers move.l a0,a5 copy base pointer move.l a1,a4 copy pointer to next var bra.s update update pointers * ; ; 1) "move.l EnvLen,d1" sets flags by D1. So no need to cmp.l #0,d1 ; (which could be more efficiently done by tst.l d1 ANYWAY.) ; Same applies to "move.b d0,(a1)+"/"cmp.b #0,d0" ; 2) "subq.l #1,d1 ... dbra d1,get_char". OY! dbra works with low ; 16 bits ONLY!!! Is d1 going to be treated as 16 bit or 32 bit? ; Make your minds up!!! ; do_vars move.l EnvLen,d1 get size of area beq.s zero_len don't need to copy anything else subq.l #1,d1 use it as a loop counter new_str move.l a1,d2 copy pointer to next string get_char move.b (a2)+,d0 get char from string cmp.b #equals,d0 is it '=' beq.s compare if so, check against one supplied nomatch move.b d0,(a1)+ write out char beq.s next_str if last char, set up a new string dbra d1,get_char loop to get next char zero_len move.l a1,a4 copy current pointer bra.s end_vars * next_str dbra d1,new_str loop back to set up new string move.l a1,a4 copy current pointer bra.s end_vars * * Now we need to compare the two strings:- if the one that we are processing * has the same name as the specified variable then we must skip it and move * to the next var. * compare move.l a1,d3 sub.l d2,d3 length of string to match subq.l #1,d3 use it as a loop counter cmp.w d7,d3 are the two strings of equal length ? bne.s nomatch if not, cannot match! * move.l a0,a3 copy pointer to start of param move.l d2,a4 copy pointer of string to check chk_str cmpm.b (a3)+,(a4)+ check char by char bne.s nomatch if not equal, return to copying dbra d3,chk_str loop back to check rest of string * * OK, so we matched! Scan until past \0 or end of vars * ; ; You were comparing with zero when the flags are set again... ; scan_end move.b (a2)+,d0 get next char from env vars beq.s reset_str reset string pointers if so dbra d1,scan_end else loop back if not at end move.l d2,a4 reset pointer to give correct length bra.s end_vars otherwise, got to end of vars * reset_str move.l d2,a1 reset pointer to start of string bra.s get_char carry on with the copy * end_vars move.l a0,a5 save copy of pointer to base of area move.l EnvBas,a0 get pointer to old base cmp.l #0,a0 beq.s update don't pass A0=0 to mt.rechp moveq #mt.rechp,d0 trap #1 release old area * update lea EnvBas,a0 move.l a5,(a0)+ update environment base area sub.l a5,a4 get real length of area move.l a4,(a0) update length variable * bra exit.ok ******************************************************************************* * * * ENV_LIST - routine to dump environment vars to screen * * * ******************************************************************************* ENV_LIST move.w ca.gtint,a2 get integer chan no, if supplied jsr (a2) onto RI stack cmp.w #1,d3 check count of args blo.s use_deflt zero args means use #1 beq.s find_chan go get the channel if there is one... bra exit.bp bomb if wrong param count * find_chan move.w (a6,a1.l),d7 get integer from stack bra.s gt_idx go get channel index * use_deflt moveq #1,d7 use channel 1 * gt_idx mulu #ch.lench,d7 set up offset into SB channel table add.l bv.chbas(a6),d7 set up pointer to chan id cmp.l bv.chp(a6),d7 check in range bge exit.cn bad #chan if not move.l (a6,d7.l),a0 get chan id move.w a0,d7 bmi exit.cn is has it been closed ? * * Now we have a channel id in the long word in a0. Let's go do the listing! * This will terminate when the env of the variables is finished, or a double * \0 is encountered. Note that it is required to change a \0 to an LF on the * fly. * move.l EnvBas,a2 get environment variable base move.l EnvLen,d4 get length of the area beq exit.ok zero length => "nah, don't bother!" subq.l #1,d4 set up to use a loop counter moveq #0,d3 set up zero timeout for output out_loop move.b (a2)+,d1 get char from string beq.s lf_out check for end, or output an LF move.b d1,d5 save char for reference out_char moveq #io.sbyte,d0 output one byte... trap #3 tst.l d0 did it work ? bne exit no, return given error code to SB dbra d4,out_loop else carry on bra exit.ok back to superbasic... * lf_out tst.b d5 was the last char \0 too ? beq exit.ok if so, end of variables moveq #lf,d1 if not, substitute lf for \0 moveq #0,d5 stick a zero in d5 for later bra.s out_char and loop back ******************************************************************************* * * * GETENV$ - function to return the value of an environment variable * * * ******************************************************************************* GETENV bsr get_find get param and find in env vars tst.l d0 did we get it ? bne exit.bp no, return error.bp * * We have located the string! a1 -> RI stack, a2 -> start of var, a5-> end * d4 = length of SB string * cmp.l a2,a5 did we get a variable ? bne.s got_var ok, process it, otherwise return null moveq #2,d1 setup RI stack allocaton length sub.l a5,a5 and zero-length string bra.s even_ok go and return null string got_var add.l d4,a2 go past variable name addq.l #1,a2 and '=' sign move.l a2,a3 save this for later! sub.l a2,a5 get length of string move.l a5,d1 copy into d1 ; This is the CORRECT way of rounding something up to even and adding 2... ; Note that bit 1 has no effect on bit 0. addq.l #3,d1 add space for word length count bclr #0,d1 top word unaffected ; ; BV.CHRIX is something of a thorny issue. However, study of a JS ROM ; disassembly reveals the following points:- ; ; 1) It tends to allocate rather more space than is necessary ; sometimes: Qview correct this in Minerva. ; 2) If there isn't enough memory in the Ql (or, in the light of 1, ; if there is merely almost enough) then it doesn't return, but ; instead dumps the stack and drops out to the command line. ; 3) After a call, it has NOT modified bv.rip(a6) by subtracting ; d1 from it. This is the responsibility of the CALLING CODE. ; The most obvious proof of this is the simple fact that if ; bv.rip(a6) - bv.tgbas(a6) >= d1, then an immediate return is ; made. ; 4) D0 is not set to anything useful on return. ; ; Originally, the next few lines DID NOT subtract the old D1 from BV.RIP. ; So that the result got stored in the wrong place. ; ; Another interesting point to note, with relevance to a bug fix for ; this code: on exit from ca.gtstr et al, a1 = bv.rip(a6); so if you ; DON'T 'pop' parameters off the ri stack then you will loose a few ; bytes every time you all GETENV$ (procedures get tidied up automatically ; anyway, but functions have to work in the depths of the expression ; parser.) This info again extracted from JS ROM disassembly. ; even_ok move.l d1,a0 address registers not touched by bv.chrix move.w bv.chrix,a2 get return space on RI stack jsr (a2) do it move.l bv.rip(a6),a1 get new stack pointer sub.l a0,a1 find base of string move.l a1,bv.rip(a6) move.l a1,a4 and copy it * * Right then, we now have space to return the string * ; ; Why mess around subtracting 1 and testing a DBRA loop counter when ; you can just jump to the end of the loop? I thought that this was ; well known. ; (But note, if the loop counter is known to be non-zero, then no ; test is needed and either way is equally good. Most of DBRAs in ; this program do in fact fall into this category.) ; move.w a5,(a6,a4.l) first copy word count move.w a5,d1 and then use d1 length as loop counter addq.l #2,a4 and advance pointer to first char posn bra.s ps1 put_str move.b (a3)+,(a6,a4.l) write out one char addq.l #1,a4 advance dest pointer ps1 dbra d1,put_str carry on copying the string moveq #1,d4 set up for string return bra.s exit.ok all done! ******************************************************************************* * * * RM_ENV - procedure to delete a definition from the environment variables * * * ******************************************************************************* ENV_DEL bsr.s get_find get parm from SB and find var tst.l d0 did it work ? bne.s exit.bp no, tell user * cmp.l a2,a5 did we find a variable ? beq.s exit.ok no, just return * * We matched a variable - a2 -> start, a5 -> end. We must check to see it was * the last one:- if so, just truncate the area. * addq.l #1,a5 set a5 past \0 move.l EnvLen,d2 get environment length PB add.l EnvBas,d2 plus base = pointer to end PB sub.l a5,d2 work out how much to copy PB bmi.s end_list .. check positive value DJW bra.s cp_join join move loop DJW * cp_back move.b (a5)+,(a2)+ back copy environment vars cp_join dbra d2,cp_back carry on until end of area * end_list clr.b (a2) terminate list move.l EnvBas,d1 get pointer to start of area sub.l d1,a2 determine new length of area lea EnvLen,a0 move.l a2,(a0) and update length variable * bra.s exit.ok return to SB ******************************************************************************* * * * Exit routines * * * ******************************************************************************* exit.cn moveq #-6,d0 error - channel not found rts * exit.om moveq #-3,d0 error - out of memory rts * exit.bp moveq #-15,d0 error - bad parameter rts * exit.ok moveq #0,d0 exit - OK rts return * exit rts exit as is ******************************************************************************* * * * Subroutines * * * ******************************************************************************* * * get_find - routine to get basic string and then find it in the environment * variable list. * * Returns are a1 - pointer to RI stack * a2 - pointer to start of string in env variables * a5 - pointer to end of string in env variables (\0) * d0 - error return * d4 - length of SB string * get_find move.w ca.gtstr,a2 get string routine jsr (a2) do it cmp.w #1,d3 was there only one ? bne.s exit.bp nah, give bad parameter * moveq #0,d4 flush out d4 move.w (a6,a1.l),d4 get length beq.s exit.bp null string => "yep - can't be right then !" move.w d4,d5 d5 is spare just now addq.w #3,d5 add 2 and round up bclr #0,d5 lea (a1,d5.w),a2 find top of string move.l a2,bv.rip(a6) pop string off stack now * move.l EnvBas,a5 get pointer to environment vars move.l EnvLen,a0 get length of env list cmp.l #0,a0 do we have any variables to check ? beq.s nowt no, return null string add.l a5,a0 make pointer to end of list * find_loop move.w d4,d5 copy length count subq.w #1,d5 use it as a loop counter move.l a1,a4 take copy of TOS addq.l #2,a4 skip length count move.l a5,a2 save pointer to start of this one get_str move.b (a5)+,d0 check char by char cmp.b (a6,a4.l),d0 bne.s get_nul if no match, then skip this env var addq.l #1,a4 move a1 to point at next char dbra d5,get_str loop back for next char * * OK, so we got the string matched, but this may be a substr:- need to check * next char is an '=' sign * cmp.b #equals,(a5) bne.s get_nul if not, try the next variable * * So, we have the string, a2 -> start, a5 -> '=', let's find the end... * get_end tst.b (a5)+ is char \0 bne.s get_end no, keep on looking! subq.l #1,a5 correct to look at \0 bra.s exit.ok return OK to user... * get_nul tst.b (a5)+ beq.s find_loop OK, let's try the next one cmp.l a0,a5 have we reached the end of the vars ble.s get_nul no, carry on looking * * OK, so we couldn't find the variable:- let's return a null string * nowt move.l EnvBas,a2 point at start of env area move.l a2,a5 and again bra.s exit.ok return to caller - no error END