; Copyright 1996 Acorn Computers Ltd ; ; Licensed under the Apache License, Version 2.0 (the "License"); ; you may not use this file except in compliance with the License. ; You may obtain a copy of the License at ; ; http://www.apache.org/licenses/LICENSE-2.0 ; ; Unless required by applicable law or agreed to in writing, software ; distributed under the License is distributed on an "AS IS" BASIS, ; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. ; See the License for the specific language governing permissions and ; limitations under the License. ; TTL => Arthur2 ; GET $.Hdr.Variables - got at start MACRO $l GSVarGetWSpace $l LDR R12, =GSVarWSpace MEND ;mjs performance enhancements for Ursula (ChocolateSysVars) ; GBLL SysVars_QuickContext GBLL SysVars_StickyNodes SysVars_QuickContext SETL {TRUE} :LAND: ChocolateSysVars ;avoid abysmal O(n*n) enumeration of vars SysVars_StickyNodes SETL {TRUE} :LAND: ChocolateSysVars ;attempt to avoid lots of SysHeap operations, ;especially grows and shrinks SysVars_Vindex_NStart * 256 ;initial no. of vars supported by index SysVars_Vindex_NBump * 32 ;additional no. of vars each time index size is bumped up [ SysVars_QuickContext ; ;format of block anchored at VariableList ; ^ 0 SysVars_LastContext # 4 ;last var table index for last context ptr returned, or -1 if invalid SysVars_VTableOffset # 0 ; ;immediately followed by table data as in old code: ; 1 word = total number of variables (N) ; N words = ptrs to variable blocks (sorted table) ; ] [ SysVars_StickyNodes SysVars_StickyNode_UnitSize * 32 ;quantise node size to multiples of this many bytes ;(must be multiple of 8, and power of 2) SysVars_StickyNode_Log2US * 5 ;Log2 of unit size SysVars_StickyNode_MaxSize * 320 ;maximum size of node that may stick (be retained on removal as active node) ; ;There are currently 10 words allocated in kernel workspace for sticky pointers ASSERT SysVars_StickyNode_UnitSize*10 = SysVars_StickyNode_MaxSize ] GBLL DebugSysVars DebugSysVars SETL {FALSE} ;----------------------------------------------------------------------------------- ; ; This file covers: ; System variables: ; InitVariables ; OS_ReadVarVal ; OS_SetVarVal ; GSTrans: ; OS_GSInit ; OS_GSRead ; OS_GSTrans ; These have been grouped because GSTrans makes direct use of the system variables' ; structures. ; ; The system variables are stored as a one way sorted alphabetically linked list hanging ; off the zero-page location VariableList: ; ; VariableList---->sorted table of pointers to variable blocks (QuickIndex) - format as above ; ; The end is indicated by the link having the value 0. ; ; Each variable is stored in one block in the system heap (block will be word aligned). The ; format of each block is: ; ; No. Bytes Use ; N+1 Variable's name (length N, plus terminator). ; 1 Variable's type: ; 0 string ; 1 number ; 2 macro ; 3 expanded (not valid within sysvar structure) ; 16 code ; M data - depends on the variable's type ; ; The structure of the data is as follows: ; ; Type 0 - string ; Bytes Use ; 3 Length (N) ; N the bytes of the string - may contain any characters ; ; Type 1 - number ; Bytes Use ; 4 its value (not necessarily word aligned) ; ; Type 2 - macro ; Bytes Use ; 3 Length (N) ; N the bytes of the string - must be a valid GSTransable string ; including terminator ; ; Type 16 - code ; Bytes Use ; x Sufficient to word align... ; 4 Write entry ; 4 Read entry ; N The rest of the code InitVariables ROUT Push "lr" ; Blank the sysvar list MOV R0, #0 LDR R12, =ZeroPage+VariableList STR R0, [R12] ; Set up the preset system variables ADR R0, SystemVarList ; R0 pointer to name 01 MOV R1, R0 LDRB R2, [R1], #1 CMP R2, #0 Pull "PC", EQ 02 LDRB R3, [R1], #1 CMP R3, #0 BNE %BT02 LDRB R4, [R1], #1 ; get type ADD R1, R1, #3 BIC R1, R1, #3 LDR R2, [R1], #4 SWI XOS_SetVarVal ADD R0, R1, R2 B %BT01 LTORG ; System vars have Thunks : ; read thunk returns R0 ptr to string, R2 length. R1 corruptible ; set thunk takes R1 ptr to value, R2 length. Value is always a string. ; Can corrupt R1, R2, R4, R10-12 ; The list of nodes to copy into RAM : ; name, 0 , type, ALIGN, size of value, value SystemVarList ROUT = "Sys$$Time", 0, VarType_Code ALIGN & sv2-.-4 LDR PC, %FT01 LDR PC, %FT02 01 & SetTimeVar 02 & ReadTimeVar sv2 = "Sys$$Year", 0, VarType_Code ALIGN & sv3-.-4 LDR PC, %FT03 LDR PC, %FT04 03 & SetYear 04 & ReadYear sv3 = "Sys$$Date", 0, VarType_Code ALIGN & sv4-.-4 LDR PC, %FT05 LDR PC, %FT06 05 & SetDate 06 & ReadDate sv4 = "Sys$$ReturnCode", 0, VarType_Code ALIGN & sv5-.-4 LDR PC, %FT07 LDR PC, %FT08 07 & SetRC 08 & ReadRC sv5 = "Sys$$RCLimit", 0, VarType_Code ALIGN & sv6-.-4 LDR PC, %FT09 LDR PC, %FT10 09 & SetRCL 10 & ReadRCL sv6 = "Alias$.", 0, VarType_String ALIGN & sv7-.-4 = "Cat ", 10 sv7 = "Sys$$DateFormat", 0, VarType_String ALIGN & sv8-.-4 [ {TRUE} = "%24:%mi:%se %dy-%m3-%ce%yr", 10 | = "%w3,%dy %m3 %ce%yr.%24:%mi:%se", 10 ] sv8 = 0 SysTimeFormat = "%24:%mi:%se", 0 SysDateFormat = "%w3,%dy %m3", 0 SysYearFormat = "%ce%yr", 0 ALIGN ; Now the code for our system variables. ReadTimeVar ADR R0, SysTimeFormat B ReadTimeFormatted SetTimeVar ROUT CMP R2, #&FE BHI TimeVarTooLong Push "R0, lr" LDR R12, =SysVarWorkSpace MOV R11, #8 STRB R11, [R12], #1 MOV R10, #0 STRB R10, [R12, R2] MOV R10, R2 01 SUBS R10, R10, #1 LDRPLB R11, [R1, R10] STRPLB R11, [R12, R10] BPL %BT01 SUB R1, R12, #1 MOV R0, #15 SWI XOS_Word STRVS R0, [R13] Pull "R0, PC" TimeVarTooLong ADRL R0, ErrorBlock_VarTooLong [ International B TranslateError | RETURNVS ] ReadYear ADR R0, SysYearFormat B ReadTimeFormatted SetYear ROUT CMP R2, #4 BHI TimeVarTooLong Push "R0, lr" Push "R1,R2" ADR R0, SetYearPrefixFormat BL ReadTimeFormatted ADD R12, R0, R2 ; R12 -> position to copy year to Pull "R1,R2" BVS %FT02 MOV R10, #0 STRB R10, [R12, R2] MOV R10, R2 01 SUBS R10, R10, #1 LDRPLB R11, [R1, R10] STRPLB R11, [R12, R10] BPL %BT01 SUB R1, R0, #1 MOV R0, #15 STRB R0, [R1] SWI XOS_Word 02 STRVS R0, [R13] Pull "R0, PC" ReadDate ADR R0, SysDateFormat B ReadTimeFormatted SetDate ROUT CMP R2, #&F8 BHI TimeVarTooLong Push "R0, lr" LDR R12, =SysVarWorkSpace MOV R11, #15 STRB R11, [R12], #1 MOV R10, #0 STRB R10, [R12, R2] MOV R10, R2 01 SUBS R10, R10, #1 LDRPLB R11, [R1, R10] STRPLB R11, [R12, R10] BPL %BT01 ADD R1, R12, R2 ADR R0, SetDateSuffixFormat ; append year to supplied date Push "R12" BL ReadTimeFormattedAtR1 Pull "R12" SUB R1, R12, #1 MOV R0, #15 SWI XOS_Word STRVS R0, [R13] Pull "R0, PC" ; in: R0 = format string ; out: R0 -> time string (0 terminated) ; R2 = length of string (excluding terminator) ; R1 corrupt ReadTimeFormatted ROUT Push "R3,R4,LR" LDR R12, =SysVarWorkSpace ADD R2, R12, #1 01 MOV R4, R0 SUB R13, R13, #8 MOV R1, R13 MOV R0, #3 STRB R0, [R1] MOV R0, #14 SWI XOS_Word BVS %FT02 MOV R0, #-1 MOV R1, R13 MOV R3, #?SysVarWorkSpace-1 SWI XTerritory_ConvertDateAndTime 02 ADD R13, R13, #8 SUBVC R2, R1, R0 Pull "R3,R4,PC" ; in: R0 = format string ; R1 -> output buffer ; out: R0 -> time string (0 terminated) ; R1 corrupt ; R2 = length of string (excluding terminator) ReadTimeFormattedAtR1 Push "R3,R4,LR" MOV R2, R1 B %BT01 ReadRC ROUT LDR R0, =ZeroPage LDR R0, [R0, #ReturnCode] B ReadNumSysVar SetRC Push "lr" BL SetNumSysVar LDR R4, =ZeroPage+ReturnCode STR R2, [R4] LDR R4, =ZeroPage+RCLimit LDR R4, [R4] CMP R2, R4 BHI %FT03 CLRV Pull "PC" 03 ADRGT R0, ErrorBlock_RCExc ADRLT R0, ErrorBlock_RCNegative [ International BL TranslateError | SETV ] Pull "PC" SetYearPrefixFormat = "%w3,%dy %m3 ", 0 SetDateSuffixFormat = " %ce%yr", 0 ALIGN MakeErrorBlock RCExc MakeErrorBlock RCNegative ReadRCL LDR R0, =ZeroPage LDR R0, [R0, #RCLimit] ReadNumSysVar Push "lr" LDR R12, =SysVarWorkSpace MOV R1, R12 MOV R2, #256 SWI XOS_BinaryToDecimal MOV R0, R1 Pull "PC" SetRCL Push "lr" BL SetNumSysVar LDR R4, =ZeroPage+RCLimit CMP R2, #0 ; can't set -ve RCLimit RSBMIS R2, R2, #0 MOVMI R2, #0 ; BIC of MININT STR R2, [R4] Pull "PC" LTORG SetNumSysVar ROUT ; R1 ptr to string, R2 string length Push "lr" SUBS R2, R2, #1 ADDMI R2, R2, #1 ; give 0 in R2 for bad length. Pull "PC", MI LDR R12, =SysVarWorkSpace 03 LDRB R10, [R1], #1 ; copy into a buffer so we can terminate it. STRB R10, [R12], #1 SUBS R2, R2, #1 BPL %BT03 MOV R10, #13 STRB R10, [R12], #1 LDR R1, =SysVarWorkSpace LDRB R10, [R1] MOV R12, #0 CMP R10, #"-" MOVEQ R12, #-1 CMPNE R10, #"+" ADDEQ R1, R1, #1 MOV R0, #0 SWI XOS_ReadUnsigned CMP R12, #0 RSBMI R2, R2, #0 Pull "PC" ;***************************************************************************** ; GSINIT, GSREAD, GSTRANS ; To enable GSTrans nesting to stand a chance of working don't flatten the ; stack every FSINIT. Instead, pick up the stack pointer (any value is OK) ; and wrap at 255. Stack overflow occurs if you increment the pointer to ; where it started for this GSINIT, and stack underflow occurs if you ; decrement the pointer when it is currently equal to stack limit. ; The stack limit is held in the environment value, R2. ; The stack is empty ascending. GBLL GS_BufferNotStack GS_BufferNotStack SETL {TRUE} ; some semi-arbitrary flags GS_NoQuoteMess * 1 :SHL: 31 ; flags passed in from user GS_NoVBarStuff * 1 :SHL: 30 GS_Spc_term * 1 :SHL: 29 ; clear if user requested terminate on space GS_In_String * 1 :SHL: 28 ; set if waiting for closing " GS_ReadingString * 1 :SHL: 27 ; set if reading chars from a string var. GS_Macroing * 1 :SHL: 26 ; set if reading chars from a macro [ GS_BufferNotStack ASSERT GS_StackPtr_Lim = &80 GS_StackLimitBits * 7 GS_StackLimitPos * 19 ; The bit position of the LSB of the byte ; which holds the stack limit ; bits 0-18 hold the string length for string transfers | ; bits 24-25 are unused ; bits 0-23 hold the string length for string transfers ] ; After GSINIT, R2 has these flags, and if expanding a count in the low byte GSINIT ROUT ; In : R0 pointer to string to expand ; R2 has flags : ; Bit 29 set means space is a terminator ; Bit 30 set means | characters will not be molested ; Bit 31 set means don't mess with quotes ; Out : R0, R2 are values to pass back in to GSREAD ; R1 is the first non-blank character ; EQ means char is CR or LF, i.e. string is empty. ; Enable interupts as we've no right to have them disabled here WritePSRc SVC_mode, R1 [ GS_BufferNotStack AND R2, R2, #GS_NoQuoteMess :OR: GS_NoVBarStuff :OR: GS_Spc_term ; get caller's flags ] ; If no tokens to expand then don't reset evaluation stack ; This prevents conflict with modules opening messages files at lower levels Push "r0" 10 LDRB r1, [r0], #1 CMP r1, #13 CMPNE r1, #10 CMPNE r1, #0 Pull "r0",EQ BEQ %FT20 ; Jump if end of string, nothing to expand TEQ r1, #"<" ; Possibly something to expand? BNE %BT10 ; No then try next Pull "r0" ; Expansion may be necessary so flatten evaluation stack [ GS_BufferNotStack GSVarGetWSpace LDRB R1, [R12, #GS_StackPtr] AND R1, R1, #(GS_StackPtr_Lim-1) ; Ensure we remain in range STRB R1, [R12, #GS_StackPtr] ORR R2, R2, R1, LSL #GS_StackLimitPos | MOV R1, #0 GSVarGetWSpace STRB R1, [R12, #GS_StackPtr] ; no stacked R0s ] 20 [ GS_BufferNotStack | AND R2, R2, #GS_NoQuoteMess :OR: GS_NoVBarStuff :OR: GS_Spc_term ; get caller's flags ] EOR R2, R2, #GS_Spc_term ; and invert for convenience 01 LDRB R1, [R0], #1 CMP R1, #" " BEQ %BT01 TST R2, #GS_NoQuoteMess CMPEQ R1, #"""" SUBNE R0, R0, #1 ; dec if went too far ORREQ R2, R2, #GS_In_String ; set flag if in string CMP R1, #13 CMPNE R1, #10 CMPNE R1, #0 ORREQ lr, lr, #Z_bit ; and move EQ/NE to return pc BICNE lr, lr, #Z_bit ExitSWIHandler LTORG ; ----------------------------------------------------------------------------- GSREAD ROUT ; In : R0, R2 from last GSREAD/GSINIT ; Out : R1 character, R0, R2 updated. ; VS => "Bad String" error ; CS => string ended (in which case R1 = terminator) ; enable interupts as (a) they'll get enabled by a <thing> entry ; and (b) GSREAD may take some time WritePSRc SVC_mode, R10 BIC lr, lr, #C_bit MOV R10, #0 TST R2, #GS_ReadingString BNE GSREAD_RStringGetNextByte ; take byte from stringvar GSREAD_XPandGetNextByte LDRB R1, [R0], #1 CMP R1, #13 CMPNE R1, #10 CMPNE R1, #0 BEQ GSREAD_XPandGotToEnd CMP R1, #" " BEQ GSREAD_XPandGotSpace BLT GSREAD_BadStringError ; bad string : control code in string CMP R1, #"""" BEQ GSREAD_XPandGotQuote CMP R1, #"|" TSTEQ R2, #GS_NoVBarStuff BEQ GSREAD_WorkOutBarChar CMP R1, #"<" BNE GSREAD_ReturnWithChar ; OS_Exit with valid character ; got to try and get a variable value. Push "R0, R2, lr" LDRB R1, [R0] CMP R1, #">" CMPNE R1, #" " BEQ GSREAD_AngleBraDaftSoIsnt ; <> and < > are silly. ; Copy angle bracketed thing checking for correct termination ; OS_SetVarValue requires system variable names to be space or control ; terminated, so we shall discard anything which violates that rule GSVarGetWSpace ADD R12, R12, #GSNameBuff MOV R11, #0 20 LDRB R1, [R0], #1 STRB R1, [R12], #1 ADD R11, R11, #1 CMP R1, #">" BEQ %FT25 CMP R11, #?GSNameBuff CMPNE R1, #" " TSTNE R1, #&E0 ; i.e. EQ if <32 BNE %BT20 B GSREAD_AngleBraDaftSoIsnt 25 ; Check for number first MOV R1, #0 STRB R1, [R12, #-1] ; terminate it SUB R1, R12, R11 ; pointer to name or number Push "R0" MOV R0, #10 SWI XOS_ReadUnsigned ; check for number Pull "R0" BVS GSREAD_AngledThingAintNumber ; silly - has to be name LDRB R1, [R1] ; check terminated by the null CMP R1, #0 BNE GSREAD_AngledThingAintNumber MOV R1, R2 ; character value ADD stack, stack, #4 ; discard old R0 value. Pull "R2, lr" B GSREAD_ReturnWithChar ; exit-R1's the char value. GSREAD_AngledThingAintNumber ; R0, R2, lr on stack Push "R0, R3, R4, R10" ; corrupted by VarFindIt MOV R3, #0 ; context ptr SUB R0, R12, R11 ; name ptr BL VarFindIt Pull "R0, R3, R4, R10", EQ ; not found mate BEQ GSREAD_AngledThingNotThere ; return null expansion ; well, we've found it - better stack old R0 Pull "R0" GSVarGetWSpace [ GS_BufferNotStack LDRB r1, [r12, #GS_StackPtr] LDR r2, [sp, #4*4] ; r3,r4,r10,r0,r2,lr on stack, hence r2 retrieved MOV r2, r2, ASL #32-(GS_StackLimitPos+GS_StackLimitBits) SUB r2, r2, #1:SHL:(32-GS_StackLimitBits) TEQ r1, r2, LSR #32-GS_StackLimitBits BEQ GSREAD_CantNestMore | LDRB R1, [R12, #GS_StackPtr] CMP R1, #GS_StackPtr_Lim BHS GSREAD_CantNestMore ] ADD R12, R12, #GS_Stack STR R0, [R12, R1, LSL #2] ADD R1, R1, #1 [ GS_BufferNotStack AND R1, R1, #(GS_StackPtr_Lim-1) ] STRB R1, [R12, #GS_StackPtr-GS_Stack] MOV R0, R4 LDRB R1, [R0], #1 ; type CMP R1, #VarType_Code BEQ GSREAD_CallCodeVar CMP R1, #VarType_Number LDRB R1, [R0], #1 LDRB R3, [R0], #1 ORR R1, R1, R3, LSL #8 LDRB R3, [R0], #1 ORR R1, R1, R3, LSL #16 BLO GSREAD_GotVarAsString BHI GSREAD_GotMacroVar LDRB R3, [R0], #1 ORR R1, R1, R3, LSL #24 MOV R0, R1 ADD R1, R12, #GSNameBuff-GS_Stack MOV R2, #256 SWI XOS_BinaryToDecimal MOV R0, R1 MOV R1, R2 ; it's a string variable, by now. GSREAD_GotVarAsString Pull "R3, R4, R10" ADD stack, stack, #4 ; discard that R0 Pull "R2, lr" CMP R1, #0 BEQ ZeroLengthVar ORR R2, R2, R1 ; old flags+new count ORR R2, R2, #GS_ReadingString LDRB R1, [R0], #1 B GSREAD_ReturnWithChar GSREAD_GotMacroVar ; Macro - R0 is now the ptr to the macro value. Pull "R3, R4, R10" ADD stack, stack, #4 Pull "R2, lr" ORR R2, R2, #GS_Macroing B GSREAD_XPandGetNextByte ; loop, transforming chars. GSREAD_CantNestMore Pull "R3, R4, R10" ; no room to stack pointer, so don't expand GSREAD_AngledThingNotThere ADD stack, stack, #4 ; skip R0 - return null string Pull "R2, lr" B GSREAD_XPandGetNextByte ; get next char GSREAD_AngleBraDaftSoIsnt Pull "R0, R2, lr" MOV R1, #"<" B GSREAD_ReturnWithChar ; failed to get sensible variable GSREAD_XPandGotToEnd TST R2, #GS_In_String ; got CR or LF BNE GSREAD_BadStringError ; bad string TST R2, #GS_Macroing GSREAD_GotToAnEnd ORREQ lr, lr, #C_bit ; got terminator ExitSWIHandler EQ ; Nest out by one level GSVarGetWSpace LDRB R11, [R12, #GS_StackPtr] [ GS_BufferNotStack SUB R11, R11, #1 AND R11, R11, #(GS_StackPtr_Lim-1) MOV r2, r2, ROR #GS_StackLimitPos+GS_StackLimitBits TEQ r11, r2, LSR #32-GS_StackLimitBits MOV r2, r2, ROR #32-(GS_StackLimitPos+GS_StackLimitBits) | SUBS R11, R11, #1 ] BICEQ R2, R2, #GS_Macroing STRB R11, [R12, #GS_StackPtr] ADD R12, R12, #GS_Stack LDR R0, [R12, R11, LSL #2] B GSREAD_XPandGetNextByte ; return to prevstring GSREAD_XPandGotSpace TST R2, #(GS_In_String :OR: GS_Spc_term :OR: GS_Macroing) ; got space : check termination BEQ GSREAD_GotToAnEnd ; terminates GSREAD_ReturnWithChar ORR R1, R1, R10 ; valid character ExitSWIHandler GSREAD_XPandGotQuote TST R2, #GS_In_String BEQ GSREAD_ReturnWithChar ; if not in string, " is valid. LDRB R1, [R0], #1 CMP R1, #"""" ; "" in string? BEQ GSREAD_ReturnWithChar ; yup ; TMD 25-Sep-89: Fix termination here 10 CMP R1, #" " LDREQB R1, [R0], #1 BEQ %BT10 SUB R0, R0, #1 ORR lr, lr, #C_bit ; got terminator (second ") ExitSWIHandler ; and out GSREAD_WorkOutBarChar LDRB R1, [R0], #1 ; got |, do traditional escaping CMP R1, #"|" CMPNE R1, #"""" CMPNE R1, #"<" BEQ GSREAD_ReturnWithChar ; || gives |, |" gives ", |< gives < CMP R1, #"?" MOVEQ R1, #&7F ; delete BEQ GSREAD_ReturnWithChar ; valid ch CMP R1, #"!" MOVEQ R10, #&80 BEQ GSREAD_XPandGetNextByte ; tbs char CMP R1, #" " BLT GSREAD_BadStringError ; OS_Control character is naff CMP R1, #&7F ; CTRL-delete is delete EORGT R1, R1, #&20 ; softkey BGE GSREAD_ReturnWithChar ; now valid ch CMP R1, #"`" ; CTRL-` = CTRL-_ MOVEQ R1, #"_" CMP R1, #"@" ANDGE R1, R1, #&1F ; transform if @<=ch<delete B GSREAD_ReturnWithChar GSREAD_RStringGetNextByte SUB R2, R2, #1 ; we're reading a string [ GS_BufferNotStack MOVS R12, R2, ASL #32-GS_StackLimitPos | ANDS r12, r2, #&00ffffff ] LDRNEB R1, [R0], #1 ; and this is already expanded ExitSWIHandler NE ; so finished ZeroLengthVar GSVarGetWSpace LDRB R0, [R12, #GS_StackPtr] ; pull an R0 from our stack SUB R0, R0, #1 [ GS_BufferNotStack AND R0, R0, #(GS_StackPtr_Lim-1) ] STRB R0, [R12, #GS_StackPtr] ADD R12, R12, #GS_Stack LDR R0, [R12, R0, LSL #2] BIC R2, R2, #GS_ReadingString B GSREAD_XPandGetNextByte GSREAD_BadStringError ADR R0, BadStrErr [ International Push "lr" BL TranslateError Pull "lr" ] ORR lr, lr, #V_bit :OR: C_bit ExitSWIHandler BadStrErr MakeErrorBlock BadString GSREAD_CallCodeVar ADD R0, R0, #3 + 4 ; 3 to ALIGN, 4 to get to read entry MOV lr, PC ; get link BIC PC, R0, #3 ; call entrypoint to Read Thunk MOV R1, R2 B GSREAD_GotVarAsString ; --------------------------------------------------------------------------- GSTRANS ROUT ; enables interrupts ; In : R0 ptr to input string ; R1 ptr to Out buffer ; R2 max number of chars, with flags at top. ; Out : R0 points at terminator ; R1 unchanged ; R2 Number of chars got, ; C set if too many chars ; V set if bad string. BIC lr, lr, #C_bit Push "R1, R3-R5, lr" WritePSRc SVC_mode, R3 ; enable ints. MOV R3, R1 MOV R4, R1 ; two copies of start ptr BIC R5, R2, #&E0000000 ADD R5, R5, R1 ; 1st byte we can't write to. SWI XOS_GSInit 01 CMP R3, R5 BHS %FT03 ; no rheum for byte. SWI XOS_GSRead BVS %FT02 ; bad string STRB R1, [R3], #1 BCC %BT01 04 SUB R2, R3, R4 ; no chars got SUB R2, R2, #1 Pull "R1, R3-R5, lr" ExitSWIHandler 02 SUB R2, R3, R4 Pull "R1, R3-R5, lr" B SLVK_SetV ; bad string: error set by GSRead 03 SUB R2, R3, R4 Pull "R1, R3-R5, lr" ORR lr, lr, #C_bit ; buffer overflow ExitSWIHandler ;**************************************************************************** ; Read/Write variables ; Also the binary->decimal SWI. ; All the var SWIs enable interrupts - they all take quite a while. ; First the lookup SWI, ReadVarValue ; In: ; R0 -> name; maybe wildcarded (* and #) ; R1 -> buffer ; R2 = buffer max length ; R3 = 0 or pointer to name returned from previous ReadVarVal ; R4 = VarType_Expanded or something else ; Out: ; Not found: ; R0 -> VarCantFind error ; R1 unaltered ; R2 = 0 ; R3,r4 trashed ; VSet ; Found, r2 < 0 and r4 <> VarType_Expanded on entry: ; R0, R1 unaltered ; R2 = NOT length of value ; R3 -> name of variable (0-terminated) ; R4 = type of result ; Found, r2 < 0 and r4 = VarType_Expanded on entry: ; R0, R1 unaltered ; R2 = -ve ; R3 -> name of variable (0-terminated) ; R4 = type of result ; Found, r2 >= 0 on entry: ; R0, R1 unaltered ; R2 no chars got ; R3 -> name of variable. Can be passed to this SWI to continue enumeration ; of wildcard. ; R4 type of result (VarType_String, VarType_Number, VarType_Macro) ; VSet if buffer overflowed (R0->error block) [ Oscli_QuickAliases ; R0 in = -1 is special case: skip call to VarFindIt (r5,r6,r7 in supply r3,r4,r12) ] ReadVarValue ROUT WritePSRc SVC_mode, r11 ; enable interupts (mode remains unchanged) Entry "r0,r1" MOV r11, r4 [ Oscli_QuickAliases CMP r0, #-1 BNE rvv_noqaspecialentry MOV r3,r5 MOV r4,r6 MOV r12,r7 B rvv_qaspecialentry rvv_noqaspecialentry ] BL VarFindIt ; name=r0,context=r3 -> name found in node=r3,r4=after namein,r12=prev BEQ RVVNotFound [ Oscli_QuickAliases rvv_qaspecialentry ] ; Regardless of expanded or not - always call the code to get value LDRB lr, [r4], #1 TEQ lr, #VarType_Code BEQ ReadVarVal_CallCode ; Check whether expanded value wanted and pick up found variable's type TEQ r11, #VarType_Expanded MOV r11, r4 MOV r4, lr BEQ ReadVarVal_ExpandedWanted ; Unexpanded value wanted.... ; If number then want 4 bytes, else however many there are in the varval TEQ r4, #VarType_Number MOVEQ r10, #4 ReadVarVal_CopyStringVarToUserBuffer ; R1 -> user buffer ; R2 = user buffer size ; R3 -> name of sysvar found ; R4 = sysvar type to return ; R10 = length to transfer to user buffer (EQ only) ; R11 -> length byte(s) of sysvar (NE only) ; -> bytes string to transfer (EQ only) LDRNEB r10, [r11], #1 LDRNEB lr, [r11], #1 ORRNE r10, r10, lr, ASL #8 LDRNEB lr, [r11], #1 ORRNE r10, r10, lr, ASL #16 ReadVarVal_CopyR10BytesToUserBuffer ; R1 -> user buffer ; R2 = user buffer size ; R3 -> name of sysvar found ; R4 = type byte to be returned ; R10 = bytes to be copied ; R11 -> bytes to be copied CMP R10, R2 BGT ReadVarVal_BufWillOFlow VarNoOFlo ; Guaranteed the the buffer won't overflow now MOV R2, R10 ; bytes he's gonna get ; now copy R10 bytes into buffer 02 SUBS R10, R10, #1 LDRPLB R12, [R11, R10] STRPLB R12, [R1, R10] BPL %BT02 ReadVarVal_OKExit PullEnv ExitSWIHandler ReadVarVal_BufWillOFlow ; Have determined that the buffer will overflow, so generate an error ; and shorten down to the buffer's size ADR r0, BufferOFloError [ International BL TranslateError ] STR r0, [stack, #Proc_LocalStack + 0*4] LDR lr, [stack, #Proc_LocalStack + 2*4] ORR lr, lr, #V_bit ; set for return STR lr, [stack, #Proc_LocalStack + 2*4] ; ensure NOT length returned in r2 when returning with r2<0 on entry CMP r2, #0 MVNMI r10, r10 MOVPL r10, r2 B VarNoOFlo BufferOFloError MakeErrorBlock BuffOverflow ReadVarVal_CallCode Push "r0-r2" ; read sysvar : r4 points after type ADD r11, r4, #3 + 4 ; 3 to align and 4 to get to read entry MOV lr, pc ; construct link BIC pc, r11, #3 ; call read code in var MOV r11, r0 ; ptr to value MOV r10, r2 ; no of chars. Pull "r0-r2" ; error may be returned from reading the var val MOVVS r0, r11 BVS ReadVarVal_TestVExit MOV r4, #VarType_String B ReadVarVal_CopyR10BytesToUserBuffer ReadVarVal_ExpandedWanted ; Request for expanded value.... ; Check for number, string or macro CMP R4, #VarType_Number BLT ReadVarVal_CopyStringVarToUserBuffer BEQ ReadVarVal_FoundNumber ; macro - gstrans it. R1 buffer ptr, r2 max chars, R11+1 ptr to value. ; Macros have a terminator after their value, to allow GSTRANS. CMP r2, #0 ; if negative, then don't call GSTrans because bits 29..31 have MVNMI r10, r2 ; return r2 out by this method BMI ReadVarVal_BufWillOFlow ; a special meaning - just branch back to the normal overflow code ADD r0, r11, #3 ; skip length SWI XOS_GSTrans BVS ReadVarVal_TestVExit BCC ReadVarVal_OKExit ADR R0, BufferOFloError [ International BL TranslateError ] B ReadVarVal_SetVExit ReadVarVal_FoundNumber ; Found a number - extract its value and convert to string LDRB R0, [R11], #1 ; number - convert to string. LDRB R12, [R11], #1 ORR R0, R0, R12, LSL #8 LDRB R12, [R11], #1 ORR R0, R0, R12, LSL #16 LDRB R12, [R11] ORR R0, R0, R12, LSL #24 ; got number in R0, buffptr in R1, max chars in R2 SWI XOS_BinaryToDecimal MOV r4, #VarType_String ReadVarVal_TestVExit STRVS r0, [stack, #Proc_LocalStack + 0*4] PullEnv B SLVK_TestV RVVNotFound [ International MOV r4, r0 ADR r0, RVVNFError BL TranslateError_UseR4 | ADR R0, RVVNFError ] MOV r2, #0 ; indicate not found. ReadVarVal_SetVExit STR r0, [stack, #Proc_LocalStack + 0*4] PullEnv B SLVK_SetV ; general error return RVVNFError MakeErrorBlock VarCantFind ; ***************************************************************************** ; SWI OS_SetVarVal : create/update/destroy a variable. ; In: R0 pointer to name (can be wildcarded for update/delete) ; ctrl/char or space terminated ; R1 pointer to value. String values must be CR or LF terminated. ; R2 negative means destroy the variable. +ve is update/create ; R3 name pointer or 0 ; R4 type. ; ; Evaluation of value : this depends on the type. ; VarType_String : GSTRANS the given value ; VarType_Number : Value is a 4 byte (signed) integer ; VarType_Macro : Copy value (may be GSTRANSed on use) ; VarType_Expanded : the value is a string which should be evaluated as an ; expression. Variable is then numeric or string ; VarType_LiteralString : Copy the given value as a string ; ; VarType_Code : R2 is the length of the code to copy in, including ; padding to align the code. ; Can only delete sysvars if R4 = VarType_Code ; Out: R3 new name pointer (so can delete all occurrences of f*, etc. ; slightly more efficiently). ; R4 type created for expressions ; V set for : ; 1) bad name (creation of wildcarded names is banned) ; 2) Bad string from GSTRANS ; 3) Bad macro value (control codes not allowed) ; 4) Bad expression from ReadExpression ; 5) Can't find (for deletion) ; 6) Not enough room to create/update it (system heap full) ; 7) Value too long (variables are limited to 256 bytes in length) ; 8) Bad type (update/create) [ DebugSysVars SysVar_Write0 Entry "r0,r1" MOV r1, r0 10 LDRB r0, [r1], #1 CMP r0, #" " EXIT LO SWI XOS_WriteC B %BT10 ] SetVarValue ; enable IRQs WritePSRc SVC_mode, r10 Entry "r0,r1,r2,r4,r5,r6,r9" [ DebugSysVars SWI XOS_WriteS = "SetVarVal ",0 BL SysVar_Write0 SWI XOS_NewLine ] MOV r9, stack MOV r10, r4 CMP r2, #0 BMI SetVarVal_DeleteIt ; Range check type CMP r10, #VarType_Code CMPNE r10, #VarType_LiteralString ADRHIL r0, ErrorBlock_BadVarType BHI SetVarValBadExit_Translate ; Always expand a VarType_Expanded: TEQ r10, #VarType_Expanded BNE SetVarVal_AintExpanded ; Process VarType_Expanded MOV r0, stack, LSR #20 ; SVC stack base assumed on 1M boundary SUB r0, sp, r0, LSL #20 ; amount of stack left CMP r0, #LongCLISize + 2048 ; insist on 2k left after long buffer MOVHS r2, #LongCLISize ; ok, got a long buffer MOVLO r2, #256 ; stack full-ish, use a 256 buffer and hope it's big enough SUB stack, stack, r2 MOV r0, r1 ; ptr to expression MOV r1, stack SWI XOS_EvaluateExpression BVS SetVarVal_TestVExit TEQ r1, #0 ; integer? MOVNE r10, #VarType_LiteralString MOVEQ r10, #VarType_Number STREQ r2, [stack] MOVEQ r2, #4 STR r10, [r9, #3*4] ; r4 out MOV r1, stack LDR r0, [r9, #0*4] SetVarVal_AintExpanded ; Setting a variable BL VarFindIt BNE SetVarVal_NodeAlreadyExists ; Node missing.... ; Check variable name has no wildcards SUB r4, r0, #1 05 LDRB lr, [r4, #1]! CMP lr, #"#" CMPNE lr, #"*" CMPNE lr, #" " BHI %BT05 CMP lr, #"#" CMPNE lr, #"*" CMPNE r4, r0 ADREQL r0, ErrorBlock_BadVarNam BEQ SetVarValBadExit_Translate ; error no. 1) ; R12 index of 1st entry in QuickIndex >= the entry we're interested in MOV r3, #0 ; To indicate absence of current B SetVarVal_CreateNode SetVarVal_NodeAlreadyExists MOV r0, r3 ; If already there use that's name in case supplied name wildcarded LDRB lr, [r4] TEQ lr, #VarType_Code BNE SetVarVal_CreateNode TEQ r10, #VarType_Code BEQ SetVarVal_CreateNode ; Assign non code value to code node CMP r10, #VarType_Number BHI SetVarVal_AssignToCodeDoIt BLO SetVarVal_AssignStringToCode SUB stack, stack, #256 ; buffer MOV r2, #256 ; Assign a number to the code variable LDRB r0, [r1], #1 LDRB lr, [r1], #1 ORR r0, r0, lr, LSL #8 LDRB lr, [r1], #1 ORR r0, r0, lr, LSL #16 LDRB lr, [r1], #1 ORR r0, r0, lr, LSL #24 MOV r1, stack SWI XOS_BinaryToDecimal B SetVarVal_AssignToCodeDoIt SetVarVal_AssignStringToCode MOV r0, stack, LSR #20 ; SVC stack base assumed on 1M boundary SUB r0, sp, r0, LSL #20 ; amount of stack left CMP r0, #LongCLISize + 2048 ; insist on 2k left after long buffer MOVHS r2, #LongCLISize ; ok, got a long buffer MOVLO r2, #256 ; stack full-ish, use a 256 buffer and hope it's big enough SUB stack, stack, r2 ; Expand string to stack frame then do it MOV r0, r1 MOV r1, stack SWI XOS_GSTrans BVS SetVarVal_TestVExit ADRCSL r0, ErrorBlock_VarTooLong BCS SetVarValBadExit_Translate SetVarVal_AssignToCodeDoIt ADDS r4, r4, #3 + 1 ; skip type, add 3 for ALIGN , clear V MOV lr, PC BIC PC, R4, #3 ; complete align and call B SetVarVal_TestVExit SetVarVal_CreateNode ; Create a node ; ; r0 -> name (already confirmed non-wildcarded) ; r1 -> value ; r2 = length (where appropriate) ; r3 = this or 0 ; r10 = type ; r12 = insertion point MOV r5, r1 MOV r6, r3 ; first work out the length of those things we can work the length of ; Header and name... MOV r3, #0 ;accumulator for length of things we know MOV r1, r0 10 LDRB lr, [r1], #1 ADD r3, r3, #1 CMP lr, #" " BHI %BT10 ;r3 is now name length +1 for terminator ADD r3, r3, #1 ;add in 1 for the type byte ; Deal with number and string type CMP r10, #VarType_Number ADDLO r3, r3, #64 ; only an initial guess for the string type ADDEQ r3, r3, #4 MOVEQ r2, #4 BLS SetVarVal_GotInitialLength CMP r10, #VarType_Code ADDEQ r3, r3, #3 ; ALIGN BICEQ r3, r3, #3 ADDEQ r3, r3, r2 ; code BEQ SetVarVal_GotInitialLength TEQ r10, #VarType_LiteralString BEQ %FT20 ; Macro - strlen and check the value is vaguely OK MOV r2, r5 15 LDRB lr, [r2], #1 CMP lr, #" " BHS %BT15 TEQ lr, #0 ; must terminate with NUL, CR or LF TEQNE lr, #10 TEQNE lr, #13 ADRNE r0, ErrorBlock_BadMacVal BNE SetVarValBadExit_Translate SUB r2, r2, r5 20 ADD r3, r3, r2 ADD r3, r3, #3 ; for the length bytes SetVarVal_GotInitialLength ; r0 -> node's name ; r2 = value length (Number, Macro and Code) ; r3 = node length needed (maybe initial guess for Strings) ; r5 -> value (r1 in) ; r6 -> name of node to be replaced (0 if no node being replaced) ; r10 = value's type (String, Number, Macro or Code) ; r12 -> insertion point Push "r0-r2" [ SysVars_StickyNodes ADD r3,r3,#SysVars_StickyNode_UnitSize-1 BIC r3,r3,#SysVars_StickyNode_UnitSize-1 ;so we don't fight sticky routines over sizes BL SysVars_ClaimVNode | BL ClaimSysHeapNode ] Pull "r0-r2",VS BVS SetVarVal_VarNoRoom ; Got a heap block - fill it in ; Copy name MOV r4, r2 LDR r0,[sp] 25 LDRB lr, [r0], #1 CMP lr, #" " MOVLS lr, #0 STRB lr, [r4], #1 BHI %BT25 LDR r1,[sp,#8] ADD sp,sp,#12 ; balances push r0-r2 above - value length (entry r2) now in r1 ; Variable's type TEQ r10, #VarType_LiteralString MOVEQ lr, #VarType_String MOVNE lr, r10 STRB lr, [r4], #1 TEQ r10, #VarType_String BEQ SetVarVal_FillInString TEQ r10, #VarType_Code ADDEQ r4, r4, #3 BICEQ r4, r4, #3 Push "r4",EQ ; Remember start of code block for code variables TEQNE r10, #VarType_Number BEQ SetVarVal_CopyR1BytesToR4 ; For macro type fill in a length TEQ r10, #VarType_Macro SUBEQ r1, r1, #1 ; ghastly fudge to avoid display of terminator STRB r1, [r4], #1 MOV r1, r1, ROR #8 STRB r1, [r4], #1 MOV r1, r1, ROR #8 STRB r1, [r4], #1 MOV r1, r1, ROR #16 ADDEQ r1, r1, #1 ; undo ghastly fudge B %FT35 30 LDRB lr, [r5], #1 STRB lr, [r4], #1 35 SetVarVal_CopyR1BytesToR4 SUBS r1, r1, #1 BHS %BT30 TEQ r10, #VarType_Code BNE SetVarVal_NewNodeReady Pull "r1" ; Grab pointer to start of code block Push "r0,r2" MOV r0,#1 MOV r1,r4 SWI XOS_SynchroniseCodeAreas Pull "r0,r2" B SetVarVal_NewNodeReady SetVarVal_FillInString ; Here's the real smart bit of code ; The idea is this: ; Instead of GSTransing, we GSInit and GSRead ourselves. When the ; block gets full expand it and carry on. At the end the block is shrunk to fit. ADD r4, r4, #3 ; for the length bytes MOV r11, r4 ; preserve location of string start for when we've done MOV r0, r5 ; r1 in MOV r5, r2 MOV r2, #0 SWI XOS_GSInit BVS SetVarVal_DisasterExpandingString B %FT45 40 SWI XOS_GSRead BVS SetVarVal_DisasterExpandingBadString BCS SetVarVal_StringFinishedExpanding STRB r1, [r4], #1 CMP r4, r3 BLO %BT40 ; Run out of room in this block - stretch it Push "r0-r2" MOV r0, #HeapReason_ExtendBlock MOV r2, r5 MOV r3, #64 ;should be a multiple of StickyNode_UnitSize if SysVars_StickyNodes TRUE [ SysVars_StickyNodes BL SysVars_ExpandOrShrinkVNode | BL DoSysHeapOpWithExtension ] STRVS r0, [sp] SUBVC lr, r2, r5 ADDVC r4, r4, lr ADDVC r11, r11, lr MOVVC r5, r2 Pull "r0-r2" BVS SetVarVal_DisasterExpandingString 45 LDR r3, [r5, #-4] ; The heap block's size [ SysVars_StickyNodes SUB r3, r3, #8 ; the amount we're allowed to use | SUB r3, r3, #4 ; the amount we're allowed to use ] ADD r3, r3, r5 ; the block's end B %BT40 SetVarVal_StringFinishedExpanding ; Shorten block to required size MOV r0, #HeapReason_ExtendBlock [ SysVars_StickyNodes Push "r4" ADD r4, r4, #SysVars_StickyNode_UnitSize-1 BIC r4, r4, #SysVars_StickyNode_UnitSize-1 ;so we don't fight over sticky sizes SUB r3, r4, r3 Pull "r4" MOV r2, r5 BL SysVars_ExpandOrShrinkVNode | SUB r3, r4, r3 MOV r2, r5 BL DoSysHeapOpWithExtension ] BVS SetVarVal_DisasterExpandingString ; Relocate pointers SUB lr, r2, r5 ADD r4, r4, lr ADD r11, r11, lr ; Work out ultimate size and store it SUB lr, r4, r11 STRB lr, [r11, #-3] MOV lr, lr, LSR #8 STRB lr, [r11, #-2] MOV lr, lr, LSR #8 STRB lr, [r11, #-1] SetVarVal_NewNodeReady ; r2 -> new node ; r6 -> old node's name (or is 0 if no old node) ; r12 = insertion point [ DebugSysVars Push "r0,r1,r2" SUB sp, sp, #12 MOV r0, r2 MOV r1, sp MOV r2, #12 SWI XOS_ConvertHex8 SWI XOS_Write0 SWI XOS_WriteI+" " MOV r0, r6 MOV r1, sp MOV r2, #12 SWI XOS_ConvertHex8 SWI XOS_Write0 SWI XOS_WriteI+" " MOV r0, r12 MOV r1, sp MOV r2, #12 SWI XOS_ConvertHex8 SWI XOS_Write0 SWI XOS_WriteI+" " ADD sp, sp, #12 Pull "r0,r1,r2" ] LDR r11, =ZeroPage+VariableList LDR r10, [r11] [ SysVars_QuickContext TEQ r10,#0 ADDNE r10,r10,#SysVars_VTableOffset ] MOV r5, r2 TEQ r6, #0 BEQ SetVarVal_Insertion [ DebugSysVars SWI XOS_WriteS = "-straight replace-",0 ] MOV r2, r6 [ SysVars_StickyNodes BL SysVars_FreeVNode | BL FreeSysHeapNode ] B SetVarVal_Replace SetVarVal_Insertion [ DebugSysVars SWI XOS_WriteS = "-insert-",0 ] TEQ r10, #0 BNE SetVarVal_PossibleExtend [ DebugSysVars SWI XOS_WriteS = "-create index-",0 ] [ SysVars_QuickContext ; SysVars_Vindex_NStart nodes, 1 word for the count, plus data before table MOV r3, #SysVars_Vindex_NStart*4 ADD r3, r3, #4+SysVars_VTableOffset | MOV r3, #(10*4)+4 ; 10 nodes and 1 word for the count ] BL ClaimSysHeapNode ; this is not a variable node (its the index) BVS SetVarVal_NoRoomForIndex [ SysVars_QuickContext MOV r10,#-1 STR r10, [r2, #SysVars_LastContext] ; initialise last context as invalid ] MOV r10, r2 MOV r4, #0 B SetVarVal_DoInsertNewBlock SetVarVal_PossibleExtend [ DebugSysVars SWI XOS_WriteS = "-extend index-",0 ] LDR r4, [r10] [ SysVars_QuickContext LDR lr, [r10, #-(4+SysVars_VTableOffset)] ; Block length, from heap block SUB lr, lr, #4+4+SysVars_VTableOffset ; 4 for heap adjustment, 4 for entry count word, plus name buffer | LDR lr, [r10, #-4] ; Block length, from heap block SUB lr, lr, #4+4 ; 4 for heap adjustment and 4 for entry count word ] CMP lr, r4, ASL #2 BHI SetVarVal_DoInsert ; we've got room with this block [ DebugSysVars SWI XOS_WriteS = "-do extend-",0 ] MOV r0, #HeapReason_ExtendBlock [ SysVars_QuickContext SUB r2, r10, #SysVars_VTableOffset MOV r3, #SysVars_Vindex_NBump*4 ; room for SysVars_Vindex_NBump more nodes | MOV r2, r10 MOV r3, #40 ; room for 10 more nodes ] BL DoSysHeapOpWithExtension ;not a variable node (expanding index) BVS SetVarVal_NoRoomForIndex MOV r10, r2 SetVarVal_DoInsertNewBlock STR r10, [r11] [ SysVars_QuickContext ADD r10,r10,#SysVars_VTableOffset ] SetVarVal_DoInsert [ DebugSysVars SWI XOS_WriteS = "-doinsert-",0 ] ADD r0, r10, r12, ASL #2 ; insertion point ADD r1, r10, r4, ASL #2 ; rover B SetVarVal_DoInsertEnd SetVarVal_DoInsertStart LDR lr, [r1], #-4 STR lr, [r1, #8] SetVarVal_DoInsertEnd CMP r1, r0 BHS SetVarVal_DoInsertStart ADD r4, r4, #1 STR r4, [r10] SetVarVal_Replace [ DebugSysVars SWI XOS_WriteS = "-doreplace-",0 ] STR r5, [r10, r12, ASL #2] [ DebugSysVars SWI XOS_WriteS = "-done-",0 ] ; All done B SetVarVal_TestVExit SetVarVal_DeleteIt BL VarFindIt ; Error if not found ADREQL r0, ErrorBlock_VarCantFind ; V set no. 1) BEQ SetVarValBadExit_Translate ; Check if found vartype code that the supplied vartype was code too LDRB lr, [r4] TEQ lr, #VarType_Code BNE %FT80 TEQ r10, #VarType_Code BNE SetVarVal_TestVExit 80 LDR r11, =ZeroPage+VariableList LDR r10, [r11] [ SysVars_QuickContext ADD r10,r10,#SysVars_VTableOffset ] LDR r4, [r10] ADD r0, r10, r12, ASL #2 ; rover ADD r1, r10, r4, ASL #2 ; end B SetVarVal_DoRemoveEnd SetVarVal_DoRemoveStart LDR lr, [r0, #4]! STR lr, [r0, #-4] SetVarVal_DoRemoveEnd CMP r0, r1 BLO SetVarVal_DoRemoveStart MOV r2, r3 [ SysVars_StickyNodes BL SysVars_FreeVNode | BL FreeSysHeapNode ] ; Reduce number of nodes SUB r4, r4, #1 STR r4, [r10] ; Construct best guess context ptr to be prev node (if present) TEQ r12, #1 SUBHI r12, r12, #1 LDRHI r3, [r10, r12, ASL #2] MOVLS r3, #0 SetVarVal_TestVExit MOV stack, r9 STRVS r0, [stack] PullEnv B SLVK_TestV SetVarValBadExit_Translate [ International BL TranslateError ] SetVarValBadExit_NoTranslate SETV B SetVarVal_TestVExit SetVarVal_DisasterExpandingString SetVarVal_NoRoomForIndex MOV r2, r5 BL FreeSysHeapNode ;forget stickiness (return node to heap is best here) SetVarVal_VarNoRoom ADR r0, ErrorBlock_VarNoRoom B SetVarValBadExit_Translate SetVarVal_DisasterExpandingBadString Push "r0" ; Save bad string error MOV r2, r5 BL FreeSysHeapNode ;forget stickiness (return node to heap is best here) Pull "r0" SETV B SetVarVal_TestVExit MakeErrorBlock BadVarType MakeErrorBlock BadVarNam MakeErrorBlock VarTooLong MakeErrorBlock BadMacVal MakeErrorBlock VarNoRoom ; ***************************************************************************** ; Utility routines. ; ----------------------------------------------------------------------------- ; ; VarFindIt ; ; In ; r0 -> (wildcard) name of variable to find ; r3 = context pointer ; ; Out ; r3 = name pointer ; r4 = pointer after name terminator ; r12 = insertion point (1st node >= this node) ; NE if found, EQ if not found ; VarFindIt Entry "r0,r1,r2,r5,r6,r7,r8,r9,r10,r11" ; validate R3 by looking down the list to see if we find it. ; Crude, but effective! [ DebugSysVars SWI XOS_WriteS = "VarFindIt(",0 BL SysVar_Write0 ] LDR r9, =ZeroPage+VariableList LDR r9, [r9] TEQ r9, #0 [ SysVars_QuickContext LDRNE r12,[r9,#SysVars_LastContext] MOVEQ r12,#-1 ;r12 = var table index for last context, or -1 if notvalid/notthere ADDNE r9,r9,#SysVars_VTableOffset ] LDRNE r8, [r9] MOVEQ r8, #0 TEQ r3, #0 BEQ %FT20 [ DebugSysVars SWI XOS_WriteS = "-scan-",0 ] ; r3 non-zero - scan list for entry [ SysVars_QuickContext ;massive short cut - see if context is the last context we returned CMP r12, r8 ;if not valid, or higher than current number of vars, forget it BHI %FT04 LDR lr, [r9, r12, ASL #2] CMP lr, r3 BEQ %FT70 04 ;no such luck - scan list anyway ] ADD r12, r8, #1 B %FT10 05 LDR lr, [r9, r12, ASL #2] CMP lr, r3 BEQ %FT70 ; continue scan down list 10 SUBS r12, r12, #1 BHI %BT05 20 [ DebugSysVars SWI XOS_WriteS = "-wildcheck-",0 ] ; not found in scan - check for name being wildcarded MOV r10, r0 25 LDRB lr, [r10], #1 TEQ lr, #"*" TEQNE lr, #"#" BEQ %FT65 CMP lr, #" " BHI %BT25 [ DebugSysVars SWI XOS_WriteS = "-bchop-",0 ] ; Name not wildcarded - do binary chop search ORRS r7, r8, r8, LSR #1 ORR r7, r7, r7, LSR #2 ORR r7, r7, r7, LSR #4 ORR r7, r7, r7, LSR #8 ORR r7, r7, r7, LSR #16 BICS r7, r7, r7, LSR #1 ; least 2^n <= number of entries MOV r6, #0 B %FT60 40 ADD r5, r6, r7 CMP r5, r8 BHI %FT55 MOV r1, r0 LDR r4, [r9, r5, ASL #2] 45 LDRB r2, [r1], #1 CMP r2, #" " MOVLS r2, #0 LDRB r3, [r4], #1 CMP r3, #" " MOVLS r3, #0 UpperCase R2,LR UpperCase R3,LR CMP r3, r2 BNE %FT50 CMP r3, #0 BNE %BT45 50 MRSHS r10, CPSR ; preserve last HS result we got MOVHS r11, r4 MOVLO r6, r5 55 MOVS r7, r7, LSR #1 60 BNE %BT40 ; We always want the element above. ; If r6<r8 then we want the preserved result ; else we want the result HI ADD r6, r6, #1 CMP r6, r8 LDRLS r3, [r9, r6, ASL #2] [ SysVars_QuickContext ASSERT SysVars_LastContext = SysVars_VTableOffset - 4 STRLS r6, [r9, #-4] ;save var table index for context we're returning, in LastContext ] MOVLS r4, r11 MOVHI r3, #0 MSRLS CPSR_f, r10 [ DebugSysVars SWI XOS_WriteS = "-complete-",0 SWI XOS_NewLine ] MOV r12, r6 TOGPSR Z_bit, lr EXIT 65 [ DebugSysVars SWI XOS_WriteS = "-listscan-",0 SWI XOS_NewLine ] ; Scan down list looking for wildmatch MOV r12, #0 70 ADD r12, r12, #1 CMP r12, r8 BHI %FT90 ; end of list reached LDR r4, [r9, r12, ASL #2] BL WildMatch ; trashes r10,r11 BNE %BT70 80 [ DebugSysVars SWI XOS_WriteS = "-complete-",0 SWI XOS_NewLine ] ; Found ; r4->name end ; r12 = entry number LDR r3, [r9, r12, ASL #2] [ SysVars_QuickContext ASSERT SysVars_LastContext = SysVars_VTableOffset - 4 STR r12, [r9, #-4] ;save var table index for context we're returning, in LastContext ] MOVS r12, r12 ; set NE EXIT 90 ; Not found [ DebugSysVars SWI XOS_WriteS = "-not found-",0 SWI XOS_NewLine ] MOV r12, #1 MOVS r3, #0 EXIT WildMatch ROUT ; In : R0 is wildcard spec ptr, R4 is name ptr. ; Wild Terminators are any ch <=" ", name terminator 0 ; Wildcards are *, # ; Out : EQ/NE for match (EQ if matches) ; R4 points after name terminator for found ; R0 preserved, R10, 11 corrupted Push "R0-R3" MOV R11, #0 ; this is the wild backtrack pointer MOV R3, #0 ; and this is the name backtrack ptr. 01 LDRB R1, [R0], #1 ; nextwild CMP R1, #"*" BEQ %FT02 ; IF nextwild = "*" LDRB R2, [R4], #1 ; nextname CMP R2, #0 BEQ %FT03 UpperCase R1, R10 UpperCase R2, R10 CMP R1, R2 ; IF nextwild=nextname CMPNE R1, #"#" ; OR nextwild = # (terminator checked already) BEQ %BT01 ; THEN LOOP (stepped already) MOV R0, R11 ; try backtrack MOVS R4, R3 ; if * had at all BNE %FT02 CMP PC, #0 ; set NE 04 Pull "R0-R3" ; return NE (failed) MOV PC, lr 03 CMP R1, #" " ; name terminated : has wildcard? BHI %BA04 ; note HI has NE set. CMP R1, R1 ; set EQ Pull "R0-R3" MOV PC, lr 02 MOV R11, R0 ; wild backtrack ptr is char after * LDRB R1, [R0], #1 ; step wild CMP R1, #"*" BEQ %BT02 ; fujj ** UpperCase R1, R10 05 LDRB R2, [R4], #1 ; step name CMP R2, #0 ; terminator? BEQ %BT03 UpperCase R2, R10 CMP R1, R2 CMPNE R1, #"#" ; match if # BNE %BT05 MOV R3, R4 ; name backtrack ptr is char after match B %BT01 ; LOOP [ Oscli_QuickAliases ;routines to speed up alias checking for OS_CLI ;VarFindIt_QA - similar to VarFindIt ; ; In ; r3 -> non-wildcarded, already upper-cased name of var to find ; will be of form ALIAS$<whatever> ; ; Out ; r5 = name pointer (equivalent to r3 for VarFindIt ; r6 = pointer after name terminator (equivalent to r4 for VarFindIt) ; r7 = insertion point (equivalent to r12 for VarFindIt) ; NE if found, EQ if not found ; VarFindIt_QA ROUT Push "r0,r1,r2,r3,r4,r8,r9,r10,r11,LR" MOV r0, r3 LDR r9, =ZeroPage+VariableList LDR r9, [r9] TEQ r9,#0 BEQ %FT99 ;exit with EQ (not found) [ SysVars_QuickContext ADD r9,r9,#SysVars_VTableOffset ] LDR r8, [r9] ; do binary chop search ORRS r7, r8, r8, LSR #1 ORR r7, r7, r7, LSR #2 ORR r7, r7, r7, LSR #4 ORR r7, r7, r7, LSR #8 ORR r7, r7, r7, LSR #16 BICS r7, r7, r7, LSR #1 ; least 2^n <= number of entries MOV r6, #0 B %FT60 40 ADD r5, r6, r7 CMP r5, r8 BHI %FT55 MOV r1, r0 LDR r4, [r9, r5, ASL #2] 45 LDRB r2, [r1], #1 CMP r2, #" " MOVLS r2, #0 LDRB r3, [r4], #1 CMP r3, #" " MOVLS r3, #0 UpperCase R3,LR CMP r3, r2 BNE %FT50 CMP r3, #0 BNE %BT45 50 MRSHS r10, CPSR ; preserve last HS result we got MOVHS r11, r4 MOVLO r6, r5 55 MOVS r7, r7, LSR #1 60 BNE %BT40 ; We always want the element above. ; If r6<r8 then we want the preserved result ; else we want the result HI ADD r6, r6, #1 CMP r6, r8 LDRLS r5, [r9, r6, ASL #2] ; don't want to save context in this version of routine MOV r7, r6 MOVLS r6, r11 MOVHI r5, #0 MSRLS CPSR_f, r10 TOGPSR Z_bit, lr 99 Pull "r0,r1,r2,r3,r4,r8,r9,r10,r11,PC" ] ;Oscli_QuickAliases [ SysVars_StickyNodes ; ; SysVars_ClaimVNode ; ; entry: R3 = size required ; exit: R2 = address of allocated node, or V set for error ; ; if R3 > max sticky size, just delegates to ClaimSysHeapNode ; if R3 <= max sticky size, rounds up to next unit size, and attempts to pick ; up sticky node of that size - if not found, gets one from heap (now of size that can ; stick on free) ; SysVars_ClaimVNode ROUT Push "r0,r1,r3,LR" CMP r3,#SysVars_StickyNode_MaxSize BHI %FT80 ;too big for sticky node ADD r3,r3,#SysVars_StickyNode_UnitSize-1 BIC r3,r3,#SysVars_StickyNode_UnitSize-1 ;round up to unit size LDR r1,=ZeroPage+SysVars_StickyPointers LDR r2,[r1,r3,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size CMP r2,#0 ;also clears V BEQ %FT80 MOV LR,#0 STR LR,[r1,r3,LSR #(SysVars_StickyNode_Log2US-2)] ;used it [ mjsSysHeapNodesTrace Push "r0-r2" LDR r0,=ZeroPage LDR r1,[r0,#mjsSHNT_vcs_total] ADD r1,r1,#1 STR r1,[r0,#mjsSHNT_vcs_total] Pull "r0-r2" ] Pull "r0,r1,r3,PC" 80 BL ClaimSysHeapNode STRVS r0,[SP] [ mjsSysHeapNodesTrace Push "r0-r2" LDR r0,=ZeroPage LDR r1,[r0,#mjsSHNT_vch_total] ADD r1,r1,#1 STR r1,[r0,#mjsSHNT_vch_total] Pull "r0-r2" ] Pull "r0,r1,r3,PC" ; ; SysVars_FreeVNode ; ; entry: R2 = address of node to free (must be valid) ; exit: - ; OR V set, error ; ; - checks size of node (uses internal knowledge of Heap blocks - naughty!) ; - if size is a sticky size, and the corresponding sticky pointer is 0, retains it, ; else delegates to FreeSysHeapNode ; SysVars_FreeVNode Push "r0,r1,r3,LR" LDR r1,[r2,#-4] ;pick up OS_Heap's size word SUB r1,r1,#8 ;sticky sizes will be 8 less than heap sizes CMP r1,#SysVars_StickyNode_MaxSize ;is it too big? BHI %FT80 TST r1,#SysVars_StickyNode_UnitSize-1 ;is it a multiple of unit size BNE %FT80 LDR r3,=ZeroPage+SysVars_StickyPointers LDR LR,[r3,r1,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size CMP LR,#0 STREQ r2,[r3,r1,LSR #(SysVars_StickyNode_Log2US-2)] ;stick! 80 [ mjsSysHeapNodesTrace Push "r0-r2" LDR r0,=ZeroPage LDREQ r1,[r0,#mjsSHNT_vfs_total] LDRNE r1,[r0,#mjsSHNT_vfh_total] ADD r1,r1,#1 STREQ r1,[r0,#mjsSHNT_vfs_total] STRNE r1,[r0,#mjsSHNT_vfh_total] Pull "r0-r2" ] BLNE FreeSysHeapNode STRVS r0,[SP] Pull "r0,r1,r3,PC" ; ; SysVars_ExpandOrShrinkVNode ; ; entry: R2 = address of block ; R3 = change of size required in bytes (signed integer) ; exit: R2 = address of block, which may have changed (block moved/copied) ; OR V set, error returned ; ; - checks size of node (uses internal knowledge of Heap blocks - naughty!) ; - assumes all VNodes currently less than MaxSize and of sticky size *must* be stickily ; allocated nodes (so that maximum current size that could be presumed by client is heap ; size minus 8, rather than minus 4) ; - if new size is small enough to be a sticky node, attempts to return a sticky node, ; without doing an OS_Heap grow or shrink, else delegates to DoSysHeapOpWithExtension ; SysVars_ExpandOrShrinkVNode Push "r0,r1,r3-r6,LR" LDR r5,[r2,#-4] ;pick up OS_Heap's size word SUB r5,r5,#4 ;usable sizes are 4 less than heap sizes ADD r4,r5,r3 ;putative new size CMP r4,#SysVars_StickyNode_MaxSize ;is it too big? BHI %FT90 SUB r6,r5,#4 ;sticky sizes will be 8 less than heap sizes SUB r4,r4,#4 ADD r4,r4,#SysVars_StickyNode_UnitSize-1 BIC r4,r4,#SysVars_StickyNode_UnitSize-1 ;round up to unit size CMP r4,r6 ;same as current size? BEQ %FT55 LDR r1,=ZeroPage+SysVars_StickyPointers LDR LR,[r1,r4,LSR #(SysVars_StickyNode_Log2US-2)] ;sticky pointer for this size CMP LR,#0 BEQ %FT40 MOV r3,#0 STR r3,[r1,r4,LSR #(SysVars_StickyNode_Log2US-2)] ;used it MOV r5,r2 MOV r2,LR B %FT50 40 MOV r5,r2 MOV r3,r4 BL SysVars_ClaimVNode BVS %FT95 50 ;copy min(r6,r4) bytes (multiple of 8) from old node at r5 to new node at r2 CMP r4,r6 MOVLO r6,r4 MOV r3,r2 MOV LR,r5 52 LDMIA LR!,{r0,r1} STMIA r3!,{r0,r1} SUBS r6,r6,#8 BGT %BT52 MOV r6,r2 MOV r2,r5 BL SysVars_FreeVNode MOV r2,r6 BVS %FT95 55 [ mjsSysHeapNodesTrace Push "r0-r2" LDR r0,=ZeroPage LDR r1,[r0,#mjsSHNT_vxs_total] ADD r1,r1,#1 STR r1,[r0,#mjsSHNT_vxs_total] Pull "r0-r2" ] CLRV Pull "r0,r1,r3-r6,PC" 90 [ mjsSysHeapNodesTrace Push "r0-r2" LDR r0,=ZeroPage LDR r1,[r0,#mjsSHNT_vxh_total] ADD r1,r1,#1 STR r1,[r0,#mjsSHNT_vxh_total] Pull "r0-r2" ] MOV r0,#HeapReason_ExtendBlock BL DoSysHeapOpWithExtension 95 STRVS r0,[SP] Pull "r0,r1,r3-r6,PC" ] ;SysVars_StickyNodes LTORG END