; ; bas.s ; ; Base code for BAS ; ; © 1994-1998 Straylight ; ;----- Licensing note ------------------------------------------------------- ; ; This file is part of Straylight's BASIC Assembler Supplement. ; ; BAS is free software; you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation; either version 2, or (at your option) ; any later version. ; ; BAS is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; ; You should have received a copy of the GNU General Public License ; along with BAS. If not, write to the Free Software Foundation, ; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. ;----- Standard Header ------------------------------------------------------ GET libs:header GET libs:swis GET libs:stream ;----- External dependencies ------------------------------------------------ GET sh.aofGen GET sh.basicEnv GET sh.basTalk GET sh.fastMove GET sh.flex GET sh.get GET sh.insert GET sh.lit GET sh.messages GET sh.string GET sh.vars GET sh.workspace ;----- Branch table header -------------------------------------------------- AREA |!BAS$$Header|,CODE,READONLY B bas__workSize ;Find workspace requirements B bas__init ;Initialise workspace B aof_init ;Initialise AOF generation B aof_pass ;Signal start of new pass B aof_iImport ;Import a symbol B aof_export ;Export a symbol B get ;Read in a header file B aof_area ;Define start of new area B aof_reloc ;Mark start of reloc area B aof_noReloc ;Mark start of non-reloc area B aof_entry ;Define entry point of image B aof_save ;Save AOF file B insert_align ;Align and add zeroes B insert_reserve ;Reserve lots of zeroes B lit_add ;Add data to literal pool B lit_ltorg ;Insert a literal pool B bas__saveOpt ;Read the current OPT value B bas__restoreOpt ;Restore the OPT value ;----- Main code ------------------------------------------------------------ AREA |BAS$$Code|,CODE,READONLY ; --- bas__workSize --- ; ; On entry: -- ; ; On exit: R0 == size of workspace required (picked up by USR()) ; ; Use: Allows the BASIC component to allocate a workspace block of ; the right size. This will then be passed to us in R7 when ; we get called later. bas__workSize ROUT LDR R0,=bas_wSize ;Get the workspace size MOVS PC,R14 ;And return to caller LTORG ; --- bas__init --- ; ; On entry: R7 == address of workspace ; R8-R14 from BASIC's CALL ; ; On exit: -- ; ; Use: Initialises the code component of BAS. bas__init ROUT STMFD R13!,{R12,R14} ;Save some registers STR R12,[R7,#:INDEX:be__line] ;Store line value MOV R12,R7 ;Point to my workspace ; --- Fill in the BASIC environment things --- STR R8,be__argp ;Save BASIC's workspace addr STR R14,be__interface ;And save the interface ptr ; --- Set up some special bits --- MOV R14,#0 ;Set up string's buffer STR R14,str__buffNum ;Tell it to use the first one STR R14,aof__objHead ;We're not generating AOF ; --- Work out address of A% --- ADR R0,bas__aPercent ;Find the variable name BL bTalk_lvblnk ;Find the address of it STR R0,be__percents ;Save this address ; --- Start up our memory manager --- BL flex_init ;Initialise flex BL vars_set ;Set up register names etc. LDMFD R13!,{R12,PC}^ ;And return to caller bas__aPercent DCB "A%",0 LTORG ; --- bas__saveOpt --- ; ; On entry: R8 == BASIC's ARGP pointer ; ; On exit: R0 == current value of OPT ; ; Use: Returns the current value of BASIC's assembler options. This ; is handy, because BASIC doesn't seem terribly good at ; handling this by itself. The value -38 used here is stolen ; from BAX. bas__saveOpt ROUT LDRB R0,[R8,#-38] ;Load the OPT value MOVS PC,R14 ;And return to caller LTORG ; --- bas__restoreOpt --- ; ; On entry: R0 == OPT value to restore ; R8 == BASIC's ARGP pointer ; ; On exit: -- ; ; Use: Sets the value of BASIC's assembler options to the given ; value. This is necessary because BASIC isn't terribly good ; at nesting the option values. bas__restoreOpt ROUT STRB R0,[R8,#-38] ;Store the OPT value MOVS PC,R14 ;And return to caller LTORG ; --- bas_argString --- ; ; On entry: R1 == address of destination buffer ; R9 == pointer to argument entry ; R10 == number of arguments left ; ; On exit: R9 increased by 8 ; R10 decreased by 1 ; ; Use: Reads a string argument into a buffer and null terminates ; it sensibly so we can use it. EXPORT bas_argString bas_argString ROUT STMFD R13!,{R0-R3,R14} ;Save some registers SUBS R10,R10,#1 ;Decrement R10 as promised BCC bas_badCall ;If there wasn't one, die LDR R14,[R9,#4] ;Load the argument type CMP R14,#&81 ;Is this a $(addr) string? BEQ %50bas_argString ;Yes -- handle that then CMP R14,#&80 ;Is it a normal string? BNE bas_badCall ;No -- the make an error ; --- Handle a normal string variable --- MOV R0,R1 ;Point to caller's buffer LDR R3,[R9],#8 ;Load the string pointer ANDS R14,R3,#3 ;Get non-word-alignedness BIC R1,R3,#3 ;Word align anyway LDMIA R1,{R1,R2} ;Load the possible bytes MOV R14,R14,LSL #3 ;Convert bytes to bits MOVNE R1,R1,LSR R14 ;Shove the bytes down RSB R14,R14,#32 ;Get the other shift size ORRNE R1,R1,R2,LSL R14 ;And work that out LDRB R2,[R3,#4] ;Load the string length BL fastMove ;(This is overkill) MOV R14,#0 ;Terminate the string STRB R14,[R0,R2] ;Do this nicely B %90bas_argString ;And return to caller ; --- Handle a $(addr) type string --- 50bas_argString MOV R2,R1 ;Keep the buffer pointer MOV R0,R1 ;And point to it for str_cpy LDR R1,[R9],#8 ;Point to caller's string BL str_cpy ;Copy it over (and null term) 90bas_argString LDMFD R13!,{R0-R3,PC}^ ;Return to caller LTORG ; --- bas_badCall --- ; ; On entry: -- ; ; On exit: Generates an error ; ; Use: Generates an error about bad arguments. It saves space to ; just have this here. EXPORT bas_badCall bas_badCall ROUT ADRL R0,msg_errBadArg SWI OS_GenerateError LTORG ; --- bas_noMem --- ; ; On entry: -- ; ; On exit: Generates an error ; ; Use: Generates an error about not having any memory left. EXPORT bas_noMem bas_noMem ROUT ADRL R0,msg_errNoMoreMem SWI OS_GenerateError LTORG ;----- That's all, folks ---------------------------------------------------- END