; Copyright 2001 Pace Micro Technology plc ; ; 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. ; ;> Factor ;UNMIN1 BEQ UNMINS ; CMP R10,#"""" ; BEQ QSTR ; CMP R10,#"+" ;UNPLUS LDREQB R10,[AELINE],#1 ;eq state maintained through jump table! ; B DOPLUS ;Factors must return valid condition codes! FACTOR LDRB R10,[AELINE],#1 ; CMP R10,#" " ; BEQ FACTOR ; CMP R10,#"-" ; BLE UNMIN1 DOPLUS LDR R4,[PC,R10,LSL #2] ;get table offset ADD PC,PC,R4 ;and go there AJ4 * .+4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACTOR-AJ4 & TSTVBNOTCACHE-AJ4 & QSTR-AJ4 & FACERR-AJ4 & TSTVBNOTCACHE-AJ4 & BININ-AJ4 & HEXIN-AJ4 & FACERR-AJ4 & BRA-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACTOR-AJ4 & FACERR-AJ4 & UNMINS-AJ4 & TSTN-AJ4 & FACERR-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & TSTN-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & TSTVB-AJ4 & FACERR-AJ4 & TSTVBNOTCACHE-AJ4 ; | & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & MODULUS-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & FACERR-AJ4 & OPENU-AJ4 & RPTR-AJ4 & RPAGE-AJ4 & RTIME-AJ4 & RLOMEM-AJ4 & RHIMEM-AJ4 & ABS-AJ4 & ACS-AJ4 & ADC-AJ4 & ASC-AJ4 & ASN-AJ4 & ATN-AJ4 & BBGET-AJ4 & COS-AJ4 & COUNT-AJ4 & DEG-AJ4 & ERL-AJ4 & ERR-AJ4 & EVAL-AJ4 & EXP-AJ4 & EXT-AJ4 & FALSE-AJ4 & FN-AJ4 & GET-AJ4 & INKEY-AJ4 & INSTR-AJ4 & INT-AJ4 & LEN-AJ4 & LN-AJ4 & LOG-AJ4 & NOT-AJ4 & OPENI-AJ4 & OPENO-AJ4 & PI-AJ4 & POINTB-AJ4 & POS-AJ4 & RAD-AJ4 & RND-AJ4 & SGN-AJ4 & SIN-AJ4 & SQR-AJ4 & TAN-AJ4 & TO-AJ4 & TRUE-AJ4 & USR-AJ4 & VAL-AJ4 & VPOS-AJ4 & CHRD-AJ4 & GETD-AJ4 & INKED-AJ4 & LEFTD-AJ4 & MIDD-AJ4 & RIGHTD-AJ4 & STRD-AJ4 & STRND-AJ4 & EOF-AJ4 & TWOFUNC-AJ4 ; Escape: functions & FACERR-AJ4 ; Escape: commands & TWOFUNCA-AJ4 ; Escape: statements (but may be functions) & FACERR-AJ4 ; WHEN & FACERR-AJ4 ; OTHER & FACERR-AJ4 ; ENDCA & FACERR-AJ4 ; ELSE2 & FACERR-AJ4 ; ENDIF & FACERR-AJ4 ; ENDWH & FACERR-AJ4 ; LPTR & FACERR-AJ4 ; LPAGE & FACERR-AJ4 ; LTIME & FACERR-AJ4 ; LLOMEM & FACERR-AJ4 ; LHIMEM & FACERR-AJ4 ; SOUND & FACERR-AJ4 ; BBPUT & FACERR-AJ4 ; CALL & FACERR-AJ4 ; CHAIN & FACERR-AJ4 ; CLEAR & FACERR-AJ4 ; CLOSE & FACERR-AJ4 ; CLG & FACERR-AJ4 ; CLS & FACERR-AJ4 ; DATA & FACERR-AJ4 ; DEF & DIMFN-AJ4 & FACERR-AJ4 ; DRAW & GIVEEND-AJ4 ; END & FACERR-AJ4 ; ENDPR & FACERR-AJ4 ; ENVEL & FACERR-AJ4 ; FOR & FACERR-AJ4 ; GOSUB & FACERR-AJ4 ; GOTO & FACERR-AJ4 ; GCOL & FACERR-AJ4 ; IF & FACERR-AJ4 ; INPUT & FACERR-AJ4 ; LET & FACERR-AJ4 ; LOCAL & MODEFN-AJ4 ; MODES & FACERR-AJ4 ; MOVE & FACERR-AJ4 ; NEXT & FACERR-AJ4 ; ON & VDUFN-AJ4 & FACERR-AJ4 ; PLOT & FACERR-AJ4 ; PRINT & FACERR-AJ4 ; PROC & FACERR-AJ4 ; READ & FACERR-AJ4 ; REM & FACERR-AJ4 ; REPEAT & REPFN-AJ4 & FACERR-AJ4 ; RESTORE & FACERR-AJ4 ; RETURN & FACERR-AJ4 ; RUN & FACERR-AJ4 ; STOP & FACERR-AJ4 ; COLOUR & TRACEFN-AJ4 & FACERR-AJ4 ; UNTIL & WIDTHFN-AJ4 & FACERR-AJ4 ; OSCL TWOFUNC LDRB R10,[AELINE],#1 CMP R10,#TTWOFUNCLIMIT BCS FACERR SUBS R4,R10,#&8E BCC FACERR LDR R4,[PC,R4,LSL #2] ADD PC,PC,R4 AJ5 * .+4 & SUM-AJ5 & BEAT-AJ5 TWOFUNCA LDRB R10,[AELINE],#1 CMP R10,#TTWOSTMTLIMIT BCS FACERR SUBS R4,R10,#TQUIT BCC FACERR LDR R4,[PC,R4,LSL #2] ADD PC,PC,R4 AJ6 * .+4 & RQUIT-AJ6 & FACERR-AJ6 ;SYS & FACERR-AJ6 ;INSTALL & FACERR-AJ6 ;LIBRARY & RTINT-AJ6 & FACERR-AJ6 ;ELLIPSE & RBEATS-AJ6 & RTEMPO-AJ6 ;TEMPO & FACERR-AJ6 ;VOICES & FACERR-AJ6 ;VOICE & FACERR-AJ6 ;STEREO & FACERR-AJ6 ;OVERLAY DIMFN STR R14,[SP,#-4]! LDRB R10,[AELINE],#1 CMP R10,#"(" BNE ERARRW BL LVBLNK BEQ ERARRYDIM CMP TYPE,#256 BCC ERDIMFN LDR R2,[IACC] CMP R2,#16 BCC ERARRZ BL AESPAC CMP R10,#"," BEQ DIMFN1 CMP R10,#")" BNE ERBRA MVN IACC,#0 DIMFN0 ADD IACC,IACC,#1 LDR R1,[R2],#4 TEQ R1,#0 BNE DIMFN0 B PSINSTK DIMFN1 STR R2,[SP,#-4]! BL EXPR CMP R10,#")" BNE ERBRA BL INTEGY LDR R2,[SP],#4 DIMFN2 LDR R1,[R2],#4 TEQ R1,#0 BEQ ERRSB2 SUBS IACC,IACC,#1 BNE DIMFN2 SUB IACC,R1,#1 B PSINSTK REPFN LDRB R10,[AELINE],#1 TEQ R10,#"$" BNE FACERR ADD CLEN,ARGP,#STRACC ADD R1,ARGP,#ERRORS REPTFN LDRB R0,[R1],#1 STRB R0,[CLEN],#1 TEQ R0,#0 BNE REPTFN SUB CLEN,CLEN,#1 B RNULX WIDTHFN LDR IACC,[ARGP,#WIDTHLOC] ADD IACC,IACC,#1 B SINSTK TRACEFN LDR IACC,[ARGP,#TRACEFILE] B SINSTK MODEFN MOV R0,#&87 SWI OS_Byte MOV IACC,R2 B SINSTK VDUFN STR R14,[SP,#-4]! BL FACTOR BL INTEGZ LDR R14,[SP],#4 MOV R1,#-1 MOV R2,#0 STMFD SP!,{R0-R2} MOV R0,SP ADD R1,SP,#8 SWI OS_ReadVduVariables LDR IACC,[R1] ADD SP,SP,#12 B SINSTK BEAT MOV R0,#0 SWI Sound_QBeat B SINSTK RBEATS MVN R0,#0 SWI Sound_QBeat B SINSTK RTEMPO MOV R0,#0 SWI Sound_QTempo B SINSTK UNMINS STR R14,[SP,#-4]! ; BL UNPLUS BL FACTOR BEQ ERTYPEINT VALCMP RSBPL IACC,IACC,#0 ;negate integer LDRPL PC,[SP],#4 [ FPOINT=0 TEQ FACC,#0 EORNE FSIGN,FSIGN,#&80000000 ;negate floating point TEQ TYPE,#0 ELIF FPOINT=1 RSFD FACC,FACC,#0 ELIF FPOINT=2 FNEGD FACC,FACC | ! 1, "Unknown FPOINT setting" ] LDR PC,[SP],#4 DATAST LDRB R10,[AELINE],#1 CMP R10,#" " BEQ DATAST CMP R10,#"""" BEQ QSTR ADD CLEN,ARGP,#STRACC SUB AELINE,AELINE,#1 DATASL LDRB R10,[AELINE],#1 STRB R10,[CLEN],#1 CMP R10,#"," CMPNE R10,#13 BNE DATASL SUB CLEN,CLEN,#1 SUB AELINE,AELINE,#1 B RNULX QSTR ADD CLEN,ARGP,#STRACC QSTRLOP LDRB R10,[AELINE],#1 CMP R10,#13 BEQ ERMISQ CMP R10,#"""" STRNEB R10,[CLEN],#1 BNE QSTRLOP LDRB R10,[AELINE],#1 CMP R10,#"""" STREQB R10,[CLEN],#1 BEQ QSTRLOP SUB AELINE,AELINE,#1 B RNULX TSTVBNOTCACHE STR R14,[SP,#-4]! BL LVNOTCACHE LDR R14,[SP],#4 BNE VARIND TSTVB1 LDRB R0,[ARGP,#BYTESM] TST R0,#OPT_errors BNE FACERR LDR R0,[ARGP,#ASSPC] B SINSTK TSTVBCACHEARRAY SUB AELINE,AELINE,#TFP STR R14,[SP,#-4]! BL ARLOOKCACHE LDR R14,[SP],#4 BNE VARIND B TSTVB1 TSTVB AND R1,AELINE,#CACHEMASK ADD R1,ARGP,R1,LSL #CACHESHIFT LDMIA R1,{IACC,R1,R4,TYPE} CMP R4,AELINE BNE TSTVBNOTCACHE CMN R1,#1 ADD AELINE,AELINE,R1 BMI TSTVBCACHEARRAY VARIND CMP TYPE,#4 BCC VARBYT BEQ VARINT CMP TYPE,#128 BCS VARNOTNUM VARFP [ FPOINT=0 LOAD5 FACC,FACCX,IACC,FGRD,FSIGN AND FSIGN,FACC,#&80000000 ORRNE FACC,FACC,#&80000000 ELIF FPOINT=1 LDFD FACC,[IACC] ELIF FPOINT=2 FLDD FACC,[IACC] | ! 1, "Unknown FPOINT setting" ] MOVS TYPE,#TFP MOV PC,R14 VARBYT LDRB IACC,[IACC] MOVS TYPE,#TINTEGER MOV PC,R14 VARINT LDW IACC,IACC,R1,R2 MOVS TYPE,#TINTEGER MOV PC,R14 VARNOTNUM BEQ VARSTR CMP TYPE,#256 BCS ERVARAR ADD CLEN,ARGP,#STRACC ADD R3,CLEN,#256 ADD R3,R3,#1 VARRPA LDRB R1,[IACC],#1 STRB R1,[CLEN],#1 TEQ CLEN,R3 TEQNE R1,#13 BNE VARRPA TEQ CLEN,R3 SUBEQ CLEN,CLEN,#256 SUB CLEN,CLEN,#1 MOVS TYPE,#0 MOV PC,R14 VARSTR LDRB CLEN,[IACC,#4] ;current length TEQ CLEN,#0 BEQ RNUL LDW IACC,IACC,R3,R1 ;load pointer to string area ADD R3,ARGP,#STRACC ADD CLEN,CLEN,R3 VARST2 LDR R1,[IACC],#4 STR R1,[R3],#4 CMP R3,CLEN BCC VARST2 MOVS TYPE,#0 MOV PC,R14 TSTN AND R1,AELINE,#CACHEMASK ADD R1,ARGP,R1,LSL #CACHESHIFT LDMIA R1,{IACC,R1,R4,TYPE} CMP R4,AELINE BNE TSTNNOTCACHE CMN R1,#1 ADD AELINE,AELINE,R1 MOVPL PC,R14 SUB AELINE,AELINE,#TFP [ FPOINT=0 AND FACCX,TYPE,#255 AND FSIGN,TYPE,#TFP ELIF FPOINT=1 STMFD SP!,{IACC,TYPE} LDFD FACC,[SP],#8 ELIF FPOINT=2 FMDRR FACC,IACC,TYPE | ! 1, "Unknown FPOINT setting" ] MOVS TYPE,#TFP MOV PC,R14 TSTNNOTCACHE STMFD SP!,{AELINE,R14} BL FREAD BCC FACERR LDMFD SP!,{R6,R14} TEQ TYPE,#0 [ FPOINT=0 ORRMI TYPE,FACCX,FSIGN ELIF FPOINT=1 STFMID FACC,[SP,#-8]! LDMMIFD SP!,{IACC,TYPE} ELIF FPOINT=2 FMRRDMI IACC,TYPE,FACC | ! 1, "Unknown FPOINT setting" ] AND R5,R6,#CACHEMASK ADD R5,ARGP,R5,LSL #CACHESHIFT SUB R4,AELINE,R6 ADDMI R4,R4,#TFP STMIA R5,{IACC,R4,R6,TYPE} MOVMI TYPE,#TFP MOV PC,R14 BRA STR R14,[SP,#-4]! BL EXPR CMP R10,#")" BNE ERBRA TEQ TYPE,#0 LDR PC,[SP],#4 HEXIN MOV IACC,#0 MOV TYPE,#0 ;invalid hex HEXIP LDRB R10,[AELINE],#1 CMP R10,#"0" BCC HEXEND CMP R10,#"9" BLS HEXOK SUB R10,R10,#"A"-10 CMP R10,#10 BCC HEXEND CMP R10,#16 BCC HEXOK SUB R10,R10,#"a"-"A" CMP R10,#10 BCC HEXEND CMP R10,#16 BCS HEXEND HEXOK AND R10,R10,#&F TST IACC,#&F0000000 BNE ERHEX2 ORR IACC,R10,IACC,LSL #4 MOV TYPE,#TINTEGER ;thus making sure of final cc state B HEXIP HEXEND SUB AELINE,AELINE,#1 TEQ TYPE,#0 ;test TYPE for validity MOVNE PC,R14 B ERHEX BININ MOV IACC,#0 MOV TYPE,#0 ;invalid BIN BINIP LDRB R10,[AELINE],#1 CMP R10,#"1" TEQNE R10,#"0" MOVEQ TYPE,#TINTEGER ;thus making sure of final cc state ADCEQ IACC,IACC,IACC BEQ BINIP SUB AELINE,AELINE,#1 TEQ TYPE,#0 ;test TYPE for validity MOVNE PC,R14 B ERBIN RPTR STR R14,[SP,#-4]! BL CHAN MOV R0,#0 RPTRA SWI OS_Args MOV IACC,R2 B PSINSTK RPAGE LDR IACC,[ARGP,#PAGE] B SINSTK RTIME ADD R1,ARGP,#STRACC LDRB R10,[AELINE] CMP R10,#"$" BEQ RTIMED MOV R0,#OsWord_ReadSystemClock SWI OS_Word LDR IACC,[R1] [ {FALSE} LDR R1,[ARGP,#TIMEOF] SUB FACC,FACC,R1 ;subtract the offset ] B SINSTK RTIMED ADD AELINE,AELINE,#1 MOV R0,#0 STR R0,[R1] ;long time MOV R0,#OsWord_ReadRealTimeClock SWI OS_Word SUB CLEN,R1,#1 ; measure length RTIMED1 LDRB R0,[CLEN,#1]! CMP R0,#32 BHS RTIMED1 B RNULX RLOMEM LDR IACC,[ARGP,#LOMEM] B SINSTK RHIMEM LDR IACC,[ARGP,#HIMEM] B SINSTK ABS STR R14,[SP,#-4]! BL FACTOR BEQ ERTYPEINT [ FPOINT=0 MOVMI FSIGN,#0 ELIF FPOINT=1 ABSMID FACC,FACC ELIF FPOINT=2 FABSDMI FACC,FACC | ! 1, "Unknown FPOINT setting" ] LDRMI PC,[SP],#4 ;do fp abs (easy) TEQ IACC,#0 RSBMI IACC,IACC,#0 ;if negative, negate TEQ TYPE,#0 LDR PC,[SP],#4 ADC STR R14,[SP,#-4]! BL FACTOR BL INTEGZ MOV R1,R0 MOV R2,R0,LSR #8 MOV R0,#&80 SWI OS_Byte AND IACC,R1,#255 ; AND R2,R2,#255 ;removed since GStark claims its OK ORR IACC,IACC,R2,LSL #8 B PSINSTK ASC STR R14,[SP,#-4]! BL FACTOR BNE ERTYPESTR LDR R14,[SP],#4 ADD IACC,ARGP,#STRACC CMP CLEN,IACC BNE VARBYT ;null string gives -1 TRUE MVN IACC,#0 B SINSTK ACS STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ [ FPOINT=0 MOV R10,#1 B ASN1 ELIF FPOINT=1 ACSD FACC,FACC MOVS TYPE,#TFP LDR PC,[SP],#4 ELIF FPOINT=2 VFPElementary acos FPSCRCheck R14 MOVS TYPE,#TFP LDR PC,[SP],#4 | ! 1, "Unknown FPOINT setting" ] BBGET STR R14,[SP,#-4]! BL CHAN SWI OS_BGet B PSINSTK COUNT LDR IACC,[ARGP,#TALLY] B SINSTK GIVEEND LDR IACC,[ARGP,#FSA] B SINSTK ERL LDR IACC,[ARGP,#ERRLIN] B SINSTK ERR LDR IACC,[ARGP,#ERRNUM] B SINSTK EVAL STR R14,[SP,#-4]! BL FACTOR BL OSSTRI STR AELINE,[SP,#-4]! SUB SP,SP,#256 LDR R4,[ARGP,#FSA] ADD R4,R4,#1024 CMP R4,SP BCS ERDEEPNEST BL EVMATCH MOV AELINE,SP BL EXPR MOV R4,SP BL PURGECACHE TEQ TYPE,#0 ADD SP,SP,#256 LDMFD SP!,{AELINE,PC} EXP STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ [ FPOINT=0 BL FEXP ELIF FPOINT=1 EXPD FACC,FACC ELIF FPOINT=2 VFPElementary exp FPSCRCheck R14 | ! 1, "Unknown FPOINT setting" ] FSINSTK MOVS TYPE,#TFP LDR PC,[SP],#4 EXT STR R14,[SP,#-4]! BL CHAN MOV R0,#2 B RPTRA RQUIT LDRB R0,[ARGP,#CALLEDNAME] CMP R0,#0 BEQ TRUE FALSE MOV IACC,#0 SINSTK MOVS TYPE,#TINTEGER MOV PC,R14 GET SWI OS_ReadC B SINSTK INKEY STR R14,[SP,#-4]! BL FACTOR BL INTEGZ MOV R1,IACC MOV R2,IACC,LSR #8 MOV R0,#&81 SWI OS_Byte LDR R14,[SP],#4 ANDS R2,R2,#255 BNE TRUE AND IACC,R1,#255 B SINSTK INSTR STR R14,[SP,#-4]! BL EXPR TEQ TYPE,#0 BNE ERTYPESTR CMP R10,#"," BNE ERCOMM BL SPUSH BL EXPR TEQ TYPE,#0 BNE ERTYPESTR MOV R4,#0 CMP R10,#")" BEQ INSTRG CMP R10,#"," BNE ERCOMM BL SPUSH BL BRA BL INTEGZ SUBS R4,IACC,#1 MOVMI R4,#0 CMP R4,#255 MOVCS R4,#0 BL SPULL ;start in r4, search for string in stracc, look in string on stack INSTRG LDR R5,[SP],#4 ADD R7,ARGP,#STRACC SUB R5,R5,R7 ;length of initial string SUB R1,CLEN,R7 ;length of search string MOV R0,#0 ;answer :not found SUBS R6,R5,R1 BCC INSTRY ;substring longer than string SUBS R6,R6,R4 BCC INSTRY ;start+len substring longer than string TEQ R1,#0 BEQ INSTRDONE ;zero sized substring MOV R0,#0 INSTR1 ADD R3,SP,R4 ;R3 is 1st char on stack ADD R7,ARGP,#STRACC ;first char of substring INSTR2 LDRB R10,[R3],#1 LDRB R9,[R7],#1 CMP R9,R10 BNE INSTRA TEQ R7,CLEN BNE INSTR2 INSTRDONE ADD IACC,R4,#1 ;answer is start position+1 INSTRY ADD SP,SP,R5 ADD SP,SP,#3 BIC SP,SP,#3 MOVS TYPE,#TINTEGER LDR PC,[SP],#4 INSTRA ADD R4,R4,#1 SUBS R6,R6,#1 BPL INSTR1 B INSTRY INT STR R14,[SP,#-4]! BL FACTOR BEQ ERTYPEINT LDRPL PC,[SP],#4 [ FPOINT=0 TEQ FSIGN,#0 BPL INTF MOVS FWACC,FACC BEQ PSINSTK SUBS FWACCX,FACCX,#&80 ;subtract bias BLS INTS ;branch if too small RSBS FWGRD,FWACCX,#32 ;decide whether possible BLS FOVR ;too large MOV FACC,FACC,LSR FWGRD ;shift by 32-exponent RSB FACC,FACC,#0 ;negate MOVS FWACC,FWACC,LSL FWACCX BEQ PSINSTK SUB FACC,FACC,#1 B PSINSTK INTF BL SFIX B PSINSTK INTS MVN IACC,#0 B PSINSTK ELIF FPOINT=1 FIXM IACC,FACC MOVS TYPE,#TINTEGER LDR PC,[SP],#4 ELIF FPOINT=2 MOV R14,#FPSCR_RMODE_DOWN FMXR FPSCR,R14 ASSERT FACC = 0 FTOSID S0,FACC ; Double -> int, rounding to minus infinity FPSCRCheck R14 FMRS IACC,S0 MOV R14,#0 FMXR FPSCR,R14 ; Restore default rounding mode MOVS TYPE,#TINTEGER LDR PC,[SP],#4 | ! 1, "Unknown FPOINT setting" ] LEN STR R14,[SP,#-4]! BL FACTOR BNE ERTYPESTR ADD IACC,ARGP,#STRACC SUB IACC,CLEN,IACC PSINSTK MOVS TYPE,#TINTEGER LDR PC,[SP],#4 LN STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ [ FPOINT=0 BL FLOG ELIF FPOINT=1 LGND FACC,FACC ELIF FPOINT=2 VFPElementary log FPSCRCheck R14 | ! 1, "Unknown FPOINT setting" ] B FSINSTK LOG STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ [ FPOINT=0 BL FLOG ADR TYPE,RPLN10 B FMULFSINSTK ELIF FPOINT=1 LOGD FACC,FACC MOVS TYPE,#TFP LDR PC,[SP],#4 ELIF FPOINT=2 VFPElementary log10 FPSCRCheck R14 MOVS TYPE,#TFP LDR PC,[SP],#4 | ! 1, "Unknown FPOINT setting" ] DEG STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ ADR TYPE,F180DP B FMULFSINSTK RAD STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ ADR TYPE,FPID180 [ FPOINT=0 FMULFSINSTK BL FMUL MOVS TYPE,#TFP LDR PC,[SP],#4 RPLN10 = &A9,&D8,&5B,&DE = &7F,0,0,0 ;4.342944820E-1 F180DP = &D3,&E0,&2E,&E5 = &86,0,0,0 ;5.729577951E1 FPID180 = &12,&35,&FA,&8E = &7B,0,0,0 ;1.745329252E-2 ELIF FPOINT=1 FMULFSINSTK LDFD F1,[TYPE] MUFD FACC,FACC,F1 MOVS TYPE,#TFP LDR PC,[SP],#4 F180DP DCFD 57.2957795130823208767981548141 FPID180 DCFD 0.0174532925199432957692369076849 ELIF FPOINT=2 FMULFSINSTK FLDD D1,[TYPE] FMULD FACC,FACC,D1 FPSCRCheck R14 MOVS TYPE,#TFP LDR PC,[SP],#4 F180DP DCFD 57.2957795130823208767981548141 FPID180 DCFD 0.0174532925199432957692369076849 | ! 1, "Unknown FPOINT setting" ] NOT STR R14,[SP,#-4]! BL FACTOR BL INTEGZ MVN IACC,IACC B PSINSTK OPENU MOV R0,#&40 B F OPENI MOV R0,#&C0 B F OPENO MOV R0,#&80 F STMFD SP!,{R0,R14} BL FACTOR BL OSSTRI LDMFD SP!,{R0,R14} SWI OS_Find B SINSTK POINTB STR R14,[SP,#-4]! BL EXPR BL INTEGY CMP R10,#"," BNE ERCOMM STR IACC,[SP,#-4]! BL BRA BL INTEGZ MOV R1,R0 LDMFD SP!,{R0,R14} SWI OS_ReadPoint MOV R0,R2 B SINSTK RTINT LDRB R10,[AELINE],#1 CMP R10,#"(" BNE ERBRA1 STR R14,[SP,#-4]! BL EXPR BL INTEGY CMP R10,#"," BNE ERCOMM STR IACC,[SP,#-4]! BL BRA BL INTEGZ MOV R1,R0 LDMFD SP!,{R0,R14} SWI OS_ReadPoint MOV R0,R3 B SINSTK POS MOV R0,#&86 SWI OS_Byte AND IACC,R1,#255 B SINSTK RND STR R14,[SP,#-4]! LDRB R10,[AELINE] CMP R10,#"(" BNE SIMPLE ADD AELINE,AELINE,#1 BL BRA BL INTEGZ TEQ IACC,#0 BMI RNDSET LDREQ IACC,[ARGP,#SEED] BEQ FRND TEQ IACC,#1 BEQ FRND1 [ FPOINT=0 BL IFLT FPUSH BL DORANDOM BL FRNDAA MOV TYPE,SP BL IFMUL BL SFIX ADD IACC,IACC,#1 PULLJ 2 ELIF FPOINT=1 FLTD F7,IACC BL DORANDOM BL FRNDAA MUFDZ FACC,FACC,F7 FIXZ IACC,FACC ADD IACC,IACC,#1 ELIF FPOINT=2 FMSR S14,IACC FSITOD D7,S14 BL DORANDOM BL FRNDAA FMULD FACC,FACC,D7 ASSERT FACC = 0 FTOSIZD S0,FACC FPSCRCheck IACC FMRS IACC,S0 ADD IACC,IACC,#1 | ! 1, "Unknown FPOINT setting" ] B PSINSTK FRND1 BL DORANDOM FRND BL FRNDAA B FSINSTK RNDSET STR IACC,[ARGP,#SEED] MOV R4,#&40 STRB R4,[ARGP,#SEED+4] B PSINSTK SIMPLE BL DORANDOM B PSINSTK ;convert IACC to FACC FRNDAA [ FPOINT=0 MOV FSIGN,#0 MOV FACCX,#&80 ;exponent in range 1/2-1 MOV FGRD,#0 EOR FACC,FACC,#&80 EOR FACC,FACC,FACC,LSL #8 EORS FACC,FACC,FACC,LSL #16 B FNRM2 | MOV R1,#0 ;second part of fraction (if rqd) MOV R2,#&40000000 SUB R2,R2,#2:SHL:20 ;exponent 1/2-1, + sign EOR IACC,IACC,#&80 EOR IACC,IACC,IACC,LSL #8 EORS IACC,IACC,IACC,LSL #16 ;convert to double precision floating ;IACC is high mantissa, R1 rest of it ;R2 is exponent and sign FCONVERT BMI FCONVERT2 BEQ FCONVERTB FCONVERTA SUB R2,R2,#1 :SHL: 20 ;decrement exponent by one ADDS R1,R1,R1 ADCS IACC,IACC,IACC ;double mantissa BVC FCONVERTA FCONVERT2 ADDS R1,R1,R1 ADC IACC,IACC,IACC ORR R2,R2,IACC,LSR #12 ;build 1st word MOV R3,IACC,LSL #20 ORR R3,R3,R1,LSR #12 ;build second word [ FPOINT=1 STMFD SP!,{R2,R3} ;save... LDFD FACC,[SP],#8 ;...and restore in FACC | FMDRR FACC,R3,R2 ] MOV PC,R14 FCONVERTB MOVS IACC,R1 ;if msword of mantissa zero then 32 bit move SUB R2,R2,#32:SHL:20 ;exponent dec by word BNE FCONVERT ;worth doing MOV R2,#0 ;otherwise answer is zero B FCONVERT2 ] ;iterate random number generator and return in IACC DORANDOM LDR R2,[ARGP,#SEED] LDRB R3,[ARGP,#SEED+4] TST R3,R3,LSR #1 ;get old top bit for 33 bit shift MOVS IACC,R2,RRX ;33 bit rotate right ADC R1,R1,R1 ;rotate left with carry to salvage top bit EOR IACC,IACC,R2,LSL #12 ;david assures me the number is right EOR IACC,IACC,IACC,LSR #20 ;ditto STR IACC,[ARGP,#SEED] STRB R1,[ARGP,#SEED+4] MOV PC,R14 SGN STR R14,[SP,#-4]! BL FACTOR LDR R14,[SP],#4 BEQ ERTYPEINT BPL SGNINT [ FPOINT=0 TEQ FACC,#0 BEQ SINSTK TEQ FSIGN,#0 BMI TRUE ELIF FPOINT=1 CMF FACC,#0 BEQ FALSE BMI TRUE ELIF FPOINT=2 FCMPZD FACC FMRX PC, FPSCR BEQ FALSE BMI TRUE | ! 1, "Unknown FPOINT setting" ] INTONE MOV IACC,#1 B SINSTK SGNINT TEQ IACC,#0 BEQ SINSTK BMI TRUE B INTONE TAN STR R14,[SP,#-4]! BL FACTOR [ FPOINT=0 BLPL FLOATQ CMP FACCX,#&98 BCS FRNGQQ FPUSH ;stack X ; Here follows DJS's disgusting code to multiply FACC by 2/pi ; = 0.6366197723 ; = 0.A2F9836E hex ; = (2^-1) + (2^-3) + (2^-6) - (2^-8) - (2^-13) + (2^-15) - (2^-17) ; + (2^-22) - (2^-25) - (2^-28) - (2^-31) MOV FWGRD,FACC,LSL #30 MOV FWACC,FACC,LSR #2 ADDS FWGRD,FWGRD,FACC,LSL #27 ADC FWACC,FWACC,FACC,LSR #5 SUBS FWGRD,FWGRD,FACC,LSL #25 SBC FWACC,FWACC,FACC,LSR #7 SUBS FWGRD,FWGRD,FACC,LSL #20 SBC FWACC,FWACC,FACC,LSR #12 ADDS FWGRD,FWGRD,FACC,LSL #18 ADC FWACC,FWACC,FACC,LSR #14 SUBS FWGRD,FWGRD,FACC,LSL #16 SBC FWACC,FWACC,FACC,LSR #16 ADDS FWGRD,FWGRD,FACC,LSL #11 ADC FWACC,FWACC,FACC,LSR #21 SUBS FWGRD,FWGRD,FACC,LSL #8 SBC FWACC,FWACC,FACC,LSR #24 SUBS FWGRD,FWGRD,FACC,LSL #5 SBC FWACC,FWACC,FACC,LSR #27 SUBS FWGRD,FWGRD,FACC,LSL #2 SBC FWACC,FWACC,FACC,LSR #30 ADDS FACC,FACC,FWACC SUBCC FACCX,FACCX,#1 ;Adjust exponent or re-normalise MOVCS FWGRD,FWGRD,LSR #1 ORRCS FWGRD,FWGRD,FACC,LSL #31 MOVCS FACC,FACC,RRX CMP FWGRD,#&80000000 ;Round correctly BICEQ FACC,FACC,#1 ADDCSS FACC,FACC,#1 MOVCS FACC,FACC,RRX ADDCS FACCX,FACCX,#1 TEQ FACCX,#0 ;Handle underflow (overflow is impossible) BLMI FCLR BL INTRND MOVS R10,FACC ;quadrant value BEQ TAN1 BL IFLT ; Here follows DJS's disgusting code to multiply FACC by pi/2 ; = 1.921FB54442CF8 hex ; = (2^0) + (2^-1) + (2^-4) + (2^-7) + (2^-11) - (2^-18) - (2^-20) ; + (2^-22) + (2^-24) + (2^-26) + (2^-30) + (2^-34) + (2^-38) ; - (2^-40) - (2^-42) + (2^-44) - (2^-49) MOV FGRD,FACC,LSR #2 ADD FGRD,FGRD,FACC,LSR #6 SUB FGRD,FGRD,FACC,LSR #8 SUB FGRD,FGRD,FACC,LSR #10 ADD FGRD,FGRD,FACC,LSR #12 SUB FGRD,FGRD,FACC,LSR #17 MOV FWACC,#0 ADDS FGRD,FGRD,FACC,LSL #31 ADC FWACC,FWACC,FACC,LSR #1 ADDS FGRD,FGRD,FACC,LSL #28 ADC FWACC,FWACC,FACC,LSR #4 ADDS FGRD,FGRD,FACC,LSL #25 ADC FWACC,FWACC,FACC,LSR #7 ADDS FGRD,FGRD,FACC,LSL #21 ADC FWACC,FWACC,FACC,LSR #11 SUBS FGRD,FGRD,FACC,LSL #14 SBC FWACC,FWACC,FACC,LSR #18 SUBS FGRD,FGRD,FACC,LSL #12 SBC FWACC,FWACC,FACC,LSR #20 ADDS FGRD,FGRD,FACC,LSL #10 ADC FWACC,FWACC,FACC,LSR #22 ADDS FGRD,FGRD,FACC,LSL #8 ADC FWACC,FWACC,FACC,LSR #24 ADDS FGRD,FGRD,FACC,LSL #6 ADC FWACC,FWACC,FACC,LSR #26 ADDS FGRD,FGRD,FACC,LSL #2 ADC FWACC,FWACC,FACC,LSR #30 ADDS FACC,FACC,FWACC ADDCS FACCX,FACCX,#1 ;Re-normalise MOVCS FGRD,FGRD,LSR #1 ORRCS FGRD,FGRD,FACC,LSL #31 MOVCS FACC,FACC,RRX ; No overflow/underflow possible. Rounding not wanted because both ; parts of result are going to be subtracted from value on stack EOR FSIGN,FSIGN,#&80000000 ;Negate to do subtraction (non-zero number) STMFD SP!,{FGRD,FSIGN,FACCX} ADD TYPE,SP,#3*4 ;input value BL FADD FSTA TYPE LDMFD SP!,{FGRD,FSIGN,FACCX} ;Recover guard word SUB FACCX,FACCX,#32 MOVS FACC,FGRD BEQ TAN1 TANA1 SUBPL FACCX,FACCX,#1 ;Re-normalise - NB expected to be faster than MOVPLS FACC,FACC,LSL #1 ;binary chop method in this environment BPL TANA1 TEQ FACCX,#0 BMI TAN1 MOV TYPE,SP BL FADD ;result of first addition FSTA TYPE B TAN2 TAN1 FLDA SP ;input value TAN2 CMP FACCX,#&71 BCC TAN2A BL FSQR FPUSH ;stack g, f ADR TYPE,TANP2 BL FMUL ADR TYPE,TANP1 BL FADD MOV TYPE,SP BL FMUL ADD TYPE,SP,#8 BL FMUL BL FADD FSTA TYPE ;stack g, f*P(g) FLDA SP ADR TYPE,TANQ2 BL FMUL ADR TYPE,TANQ1 BL FADD MOV TYPE,SP BL FMUL MOV FWACC,#&80000000 MOV FWACCX,#&81 MOV FWSIGN,#0 BL FADDW ADD TYPE,SP,#8 ;f*P(g) TST R10,#1 BNE TAN3 BL FXDIV ADD SP,SP,#16 B FSINSTK TANP2 DCD &8CEC34E1 ;.1057154738488E-2 = &77,0,0,0 TANP1 DCD &E4117783 ;-.1113614403566E0 = &7D,0,0,&80 TANQ2 DCD &82DAA19A ;.1597339213300E-1 = &7B,0,0,0 TANQ1 DCD &E3AF087D ;-.4446947720281E0 = &7F,0,0,&80 TAN3 MOV FWACC,FACC MOV FWACCX,FACCX EOR FWSIGN,FSIGN,#&80000000 FLDA TYPE BL FDIVA ADD SP,SP,#16 B FSINSTK TAN2A TST R10,#1 EORNE FSIGN,FSIGN,#&80000000 BLNE FRECIP ADD SP,SP,#8 ELIF FPOINT=1 BLPL FLOATQ TAND FACC,FACC ELIF FPOINT=2 BLPL FLOATQ VFPElementary tan FPSCRCheck R14 | ! 1, "Unknown FPOINT setting" ] B FSINSTK SQR STR R14,[SP,#-4]! BL FACTOR BLPL FLOATQ [ FPOINT=0 BL FSQRT ELIF FPOINT=1 SQTD FACC,FACC ELIF FPOINT=2 FSQRTD FACC,FACC FPSCRCheck R14,_SQRT | ! 1, "Unknown FPOINT setting" ] B FSINSTK TO LDRB R10,[AELINE],#1 CMP R10,#"P" BNE FACERR LDR IACC,[ARGP,#TOP] B SINSTK USR STR R14,[SP,#-4]! BL FACTOR BL INTEGY MOV TYPE,IACC [ FPOINT=0 BL EMUMOS LDRNE PC,[SP],#4 ] MOV R4,TYPE MOV R5,#0 BL CALLARMROUT B PSINSTK VALSTR STR R14,[SP,#-4]! B VAL0 ;, or cr stop already present VAL STR R14,[SP,#-4]! BL FACTOR BL OSSTRI ;Get stop mark (cr) VAL0 STR AELINE,[SP,#-4]! ADD AELINE,ARGP,#STRACC VALA LDRB R10,[AELINE],#1 CMP R10,#" " BEQ VALA CMP R10,#"-" BEQ VALMIN CMP R10,#"+" BNE VALPLU LDRB R10,[AELINE],#1 VALPLU BL FREAD LDMFD SP!,{AELINE,PC} VALMIN LDRB R10,[AELINE],#1 BL FREAD LDR AELINE,[SP],#4 B VALCMP VPOS MOV R0,#&86 SWI OS_Byte AND IACC,R2,#255 B SINSTK CHRD STR R14,[SP,#-4]! BL FACTOR BL INTEGY LDR R14,[SP],#4 B SINSTR GETDH STR R14,[SP,#-4]! BL CHAN ADD CLEN,ARGP,#STRACC GETDH1 ADD R0,ARGP,#STRACC SUB R0,CLEN,R0 CMP R0,#255 BCS LEFTX SWI OS_BGet MOVCS R0,#10 TEQ R0,#10 TEQNE R0,#13 MOVEQ R0,#10 STRNEB R0,[CLEN],#1 BNE GETDH1 B LEFTX GETD LDRB R0,[AELINE] TEQ R0,#"#" BEQ GETDH SWI OS_ReadC SINSTR ADD CLEN,ARGP,#STRACC STRB IACC,[CLEN],#1 MOVS TYPE,#0 MOV PC,R14 INKED STR R14,[SP,#-4]! BL FACTOR BL INTEGY MOV R1,IACC MOV R2,IACC,LSR #8 MOV R0,#&81 SWI OS_Byte LDR R14,[SP],#4 AND IACC,R1,#255 ANDS R2,R2,#255 BEQ SINSTR RNUL ADD CLEN,ARGP,#STRACC RNULX MOVS TYPE,#0 MOV PC,R14 LEFTD STR R14,[SP,#-4]! BL EXPR TEQ TYPE,#0 BNE ERTYPESTR CMP R10,#"," BNE LEFTDB BL SPUSH BL BRA BL INTEGZ MOV R7,IACC ;save new length BL SPULL ADD R0,ARGP,#STRACC SUB CLEN,CLEN,R0 CMP R7,CLEN ;test if new length less than total length MOVCC CLEN,R7 ;unsigned to reject -ve numbers ADD CLEN,CLEN,R0 LEFTX MOVS TYPE,#0 LDR PC,[SP],#4 LEFTDB CMP R10,#")" BNE ERCOMM ADD R0,ARGP,#STRACC CMP CLEN,R0 SUBNE CLEN,CLEN,#1 B LEFTX MIDD STR R14,[SP,#-4]! BL EXPR TEQ TYPE,#0 BNE ERTYPESTR BL SPUSH CMP R10,#"," BNE ERCOMM BL EXPR BL INTEGY STR IACC,[SP,#-4]! MOV IACC,#255 CMP R10,#"," BNE MIDDA BL EXPR BL INTEGY MIDDA CMP R10,#")" BNE ERBRA MOV R7,IACC LDR R6,[SP],#4 BL SPULL ;r6, r7 are 1st and 2nd numbers maintained across spull ADD R4,ARGP,#STRACC SUBS R4,CLEN,R4 BEQ LEFTX ;null i/p gives null o/p ADD CLEN,ARGP,#STRACC TEQ R6,#0 SUBNE R6,R6,#1 ;adjust start position SUBS R5,R4,R6 BCC LEFTX ;start outside string CMP R7,R5 ;test if can fit enough things in MOVCS R7,R5 ;fit as many as possible TEQ R7,#0 BEQ LEFTX ;another null string ADD R6,R6,CLEN MIDLP LDRB R0,[R6],#1 STRB R0,[CLEN],#1 SUBS R7,R7,#1 BNE MIDLP B LEFTX RIGHTD STR R14,[SP,#-4]! BL EXPR TEQ TYPE,#0 BNE ERTYPESTR CMP R10,#"," BNE RIGHTDB BL SPUSH BL BRA BL INTEGZ ADD R6,ARGP,#STRACC ADD R7,IACC,R6 ;save new length BL SPULL SUBS R6,CLEN,R7 ;calc offset BLS LEFTX ;if too many or all elements of source string req ADD CLEN,ARGP,#STRACC ;end position ADD R0,R6,CLEN ;start position CMP R7,CLEN BLS LEFTX ;null string returned RGHLOP LDRB R1,[R0],#1 STRB R1,[CLEN],#1 TEQ R7,CLEN BNE RGHLOP B LEFTX RIGHTDB CMP R10,#")" BNE ERCOMM ADD R0,ARGP,#STRACC CMP CLEN,R0 BLS LEFTX LDRB R0,[CLEN,#-1] ADD CLEN,ARGP,#STRACC STRB R0,[CLEN],#1 B LEFTX STRD LDRB R10,[AELINE],#1 CMP R10,#" " BEQ STRD CMP R10,#"~" MOVEQ R5,#1 MOVNE R5,#0 SUBNE AELINE,AELINE,#1 STMFD SP!,{R5,R14} BL FACTOR LDR R4,[ARGP,#INTVAR] CMP R4,#&1000000 MOVCC R4,#0 LDR R5,[SP],#4 BL FCONFP MOV CLEN,TYPE MOVS TYPE,#0 LDR PC,[SP],#4 STRND STR R14,[SP,#-4]! BL EXPR BL INTEGY CMP R10,#"," BNE ERCOMM STR IACC,[SP,#-4]! BL BRA BNE ERTYPESTR LDMFD SP!,{IACC,R14} SUBS IACC,IACC,#1 BLT RNUL ADD R1,ARGP,#STRACC TEQNE CLEN,R1 BEQ RNULX ;if null string or just 1 MOV R1,CLEN STRNL ADD R4,ARGP,#STRACC ADD R5,R1,CLEN SUB R5,R5,R4,LSL #1 ;subtract two STRACCs CMP R5,#256 BCS ERLONG STRNLP LDRB R5,[R4],#1 STRB R5,[CLEN],#1 TEQ R1,R4 BNE STRNLP SUBS IACC,IACC,#1 BNE STRNL MOV PC,R14 ;type already correct and subtract set the right status EOF STR R14,[SP,#-4]! BL CHAN MOV R0,#&7F SWI OS_Byte ANDS IACC,R1,#255 MVNNE IACC,#0 B PSINSTK LNK Funct.s