;> 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
 & UNPLUS-AJ4
 & TSTVB-AJ4
 & FACERR-AJ4
 & FACERR-AJ4
 & TSTVB-AJ4
 & BININ-AJ4
 & HEXIN-AJ4
 & FACERR-AJ4
 & BRA-AJ4
 & FACERR-AJ4
 & FACERR-AJ4
 & FACERR-AJ4
 & FACERR-AJ4
 & FACERR-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
 & TSTVB-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

 & 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
 & FACERR-AJ4; Escape: statements

 & 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
 & FACERR-AJ4; MODES
 & FACERR-AJ4; MOVE
 & FACERR-AJ4; NEXT
 & FACERR-AJ4; ON
 & FACERR-AJ4; VDU
 & 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
 & FACERR-AJ4; TRACE
 & FACERR-AJ4; UNTIL
 & WIDTHFN-AJ4
 & FACERR-AJ4; OSCL
TWOFUNC LDRB R10,[AELINE],#1
 SUB R4,R10,#&8E
 LDR R4,[PC,R4,LSL #2]
 ADD PC,PC,R4
AJ5 * .+4
 & SUM-AJ5
DIMFN STMFD SP!,{R14}
 LDRB R10,[AELINE],#1
 CMP R10,#"("
 BNE ERARRW
 BL LVBLNK
 BEQ ERARRYDIM
 CMP TYPE,#256
 BCC ERDIMFN
 LDR R2,[FACC]
 CMP R2,#16
 BCC ERARRZ
 BL AESPAC
 CMP R10,#","
 BEQ DIMFN1
 CMP R10,#")"
 BNE ERBRA
 MVN FACC,#0
DIMFN0 ADD FACC,FACC,#1
 LDR R1,[R2],#4
 TEQ R1,#0
 BNE DIMFN0
 B PSINSTK
DIMFN1 STMFD SP!,{R2}
 BL EXPR
 CMP R10,#")"
 BNE ERBRA
 BL INTEGY
 LDMFD SP!,{R2}
DIMFN2 LDR R1,[R2],#4
 TEQ R1,#0
 BEQ ERRSB2
 SUBS FACC,FACC,#1
 BNE DIMFN2
 SUB FACC,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 FACC,[ARGP,#WIDTHLOC]
 ADD FACC,FACC,#1
 B SINSTK
UNMINS STMFD SP!,{R14}
 BL UNPLUS
 BEQ ERTYPEINT
VALCMP RSBPL FACC,FACC,#0 ;negate integer
 LDMPLFD SP!,{PC}
 TEQ FACC,#0
 EORNE FSIGN,FSIGN,#&80000000 ;negate floating point
 TEQ TYPE,#0
 LDMFD SP!,{PC}
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
 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
TSTVB1 LDRB R0,[ARGP,#BYTESM]
 TST R0,#2
 BNE FACERR
 LDR R0,[ARGP,#ASSPC]
 B PSINSTK
TSTVB STMFD SP!,{R14}
 BL LVCONT
 BEQ TSTVB1
 LDMFD SP!,{R14}
VARIND CMP TYPE,#4
 BCC VARBYT
 BEQ VARINT
 CMP TYPE,#128
 BCS VARNOTNUM
VARFP BIC FSIGN,FACC,#3
; AND FGRD,FACC,#3
 MOVS FGRD,FACC,LSL #31
 LDMFD FSIGN,{FACC,FACCX}
 MOVCS FACC,FACC,LSR #16
 ORRCS FACC,FACC,FACCX,LSL #16
 MOVCS FACCX,FACCX,LSR #16
 MOVMI FACC,FACC,LSR #8
 ORRMI FACC,FACC,FACCX,LSL #24
 MOVMI FACCX,FACCX,LSR #8
; MOVS FGRD,FGRD,LSL #3
; MOVNE FACC,FACC,LSR FGRD                                                      ; RSBNE FSIGN,FGRD,#32
; ORRNE FACC,FACC,FACCX,LSL FSIGN
; MOVNE FACCX,FACCX,LSR FGRD
 AND FSIGN,FACC,#&80000000
 ANDS FACCX,FACCX,#255
 TEQEQ FACC,#0
 ORRNE FACC,FACC,#&80000000
 MOVS TYPE,#TFP
 MOV PC,R14
VARBYT LDRB FACC,[FACC]
 B SINSTK
VARINT ANDS R2,FACC,#3
 LDREQ FACC,[FACC]
 BEQ SINSTK
 BIC FACC,FACC,#3
 LDMFD FACC,{FACC,R1}
 MOV R2,R2,LSL #3
 MOV FACC,FACC,LSR R2
 RSB R2,R2,#32
 ORR FACC,FACC,R1,LSL R2
 B SINSTK
VARNOTNUM BEQ VARSTR
 CMP TYPE,#256
 BCS ERVARAR
 ADD CLEN,ARGP,#STRACC
 ADD R3,CLEN,#256
 ADD R3,R3,#1
VARRPA LDRB R1,[FACC],#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,[FACC,#4] ;current length
 TEQ CLEN,#0
 BEQ RNUL
 LOAD FACC,FACC,R3,R1 ;load pointer to string area
 ADD R3,ARGP,#STRACC
 ADD CLEN,CLEN,R3
VARST2 LDR R1,[FACC],#4
 STR R1,[R3],#4
 CMP R3,CLEN
 BCC VARST2
 MOVS TYPE,#0
 MOV PC,R14
TSTN STMFD SP!,{R14}
 BL FREAD
 LDMCSFD SP!,{PC}
 B FACERR
BRA STMFD SP!,{R14}
 BL EXPR
 CMP R10,#")"
 BNE ERBRA
 TEQ TYPE,#0
 LDMFD SP!,{PC}
HEXIN MOV FACC,#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 FACC,#&F0000000
 BNE ERHEX2
 ORR FACC,R10,FACC,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 FACC,#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 FACC,FACC,FACC
 BEQ BINIP
 SUB AELINE,AELINE,#1
 TEQ TYPE,#0 ;test TYPE for validity
 MOVNE PC,R14
 B ERBIN
RPTR STMFD SP!,{R14}
 BL CHAN
 MOV R0,#0
RPTRA SWI ARGS
 MOV FACC,R2
 B PSINSTK
RPAGE LDR FACC,[ARGP,#PAGE]
 B SINSTK
RTIME ADD R1,ARGP,#STRACC
 LDRB R10,[AELINE]
 CMP R10,#"$"
 BEQ RTIMED
 MOV R0,#1
 SWI WORD
 LDR FACC,[R1]
 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,#14
 SWI WORD
 ADD CLEN,R1,#24 ;length
 B RNULX
RLOMEM LDR FACC,[ARGP,#LOMEM]
 B SINSTK
RHIMEM LDR FACC,[ARGP,#HIMEM]
 B SINSTK
ABS STMFD SP!,{R14}
 BL FACTOR
 BEQ ERTYPEINT
 MOVMI FSIGN,#0
 LDMMIFD SP!,{PC} ;do fp abs (easy)
 TEQ FACC,#0
 RSBMI FACC,FACC,#0 ;if negative, negate
 TEQ TYPE,#0
 LDMFD SP!,{PC}
ADC STMFD SP!,{R14}
 BL FACTOR
 BL INTEGZ
 MOV R1,R0
 MOV R2,R0,LSL #8
 MOV R0,#&80
 SWI BYTE
 AND FACC,R1,#255
 AND R2,R2,#255
 ORR FACC,FACC,R2,LSL #8
 B PSINSTK
ASC STMFD SP!,{R14}
 BL FACTOR
 BNE ERTYPESTR
 LDMFD SP!,{R14}
 ADD FACC,ARGP,#STRACC
 CMP CLEN,FACC
 BEQ TRUE ;null string gives -1
 LDRB FACC,[FACC]
 B SINSTK
ACS STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 MOV R10,#1
 B ASN1
BBGET STMFD SP!,{R14}
 BL CHAN
 SWI BGET
 B PSINSTK
COUNT LDR FACC,[ARGP,#TALLY]
 B SINSTK
GIVEEND LDR FACC,[ARGP,#FSA]
 B SINSTK
ERL LDR FACC,[ARGP,#ERRLIN]
 B SINSTK
ERR LDR FACC,[ARGP,#ERRNUM]
 B SINSTK
EVAL STMFD SP!,{R14}
 BL FACTOR
 BL OSSTRI
 STMFD SP!,{AELINE}
 SUB SP,SP,#256
 BL EVMATCH
 MOV AELINE,SP
 BL EXPR
 TEQ TYPE,#0
 ADD SP,SP,#256
 LDMFD SP!,{AELINE,PC}
EXP STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 BL FEXP
 B FSINSTK
EXT STMFD SP!,{R14}
 BL CHAN
 MOV R0,#2
 B RPTRA
FALSE MOV FACC,#0
SINSTK MOVS TYPE,#TINTEGER
 MOV PC,R14
GET SWI READC
 B SINSTK
INKEY STMFD SP!,{R14}
 BL FACTOR
 BL INTEGY
 MOV R1,FACC
 MOV R2,FACC,LSR #8
 MOV R0,#&81
 SWI BYTE
 LDMFD SP!,{R14}
 ANDS R2,R2,#255
 BNE TRUE
 AND FACC,R1,#255
 B SINSTK
INSTR STMFD SP!,{R14}
 BL EXPR
 BNE ERTYPESTR
 CMP R10,#","
 BNE ERCOMM
 BL SPUSH
 BL EXPR
 BNE ERTYPESTR
 MOV R4,#0
 CMP R10,#")"
 BEQ INSTRG
 CMP R10,#","
 BNE ERCOMM
 BL SPUSH
 BL BRA
 BL INTEGZ
 SUBS R4,FACC,#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 LDMFD SP!,{R5}
 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 FACC,R4,#1 ;answer is start position+1
INSTRY ADD SP,SP,R5
 ADD SP,SP,#3
 BIC SP,SP,#3
 MOVS TYPE,#TINTEGER
 LDMFD SP!,{PC}
INSTRA ADD R4,R4,#1
 SUBS R6,R6,#1
 BPL INSTR1
 B INSTRY
INT STMFD SP!,{R14}
 BL FACTOR
 BEQ ERTYPEINT
 LDMPLFD SP!,{PC}
 TEQ FSIGN,#0
 BPL INTF
 MOVS FWACC,FACC
 BEQ PSINSTK
 SUBS FWACCX,FACCX,#&80 ;subtract bias
 BCC INTS ;branch if too small
 RSBS FWGRD,FWACCX,#32 ;decide whether possible
 BCC 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 FACC,#0
 B PSINSTK
LEN STMFD SP!,{R14}
 BL FACTOR
 BNE ERTYPESTR
 ADD FACC,ARGP,#STRACC
 SUB FACC,CLEN,FACC
PSINSTK MOVS TYPE,#TINTEGER
 LDMFD SP!,{PC}
LN STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 BL FLOG
 B FSINSTK
LOG STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 BL FLOG
 ADR TYPE,RPLN10
 BL FMUL
 B FSINSTK
DEG STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 ADR TYPE,F180DP
 BL FMUL
 B FSINSTK
RAD STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 ADR TYPE,FPID180
 BL FMUL
 B FSINSTK
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
NOT STMFD SP!,{R14}
 BL FACTOR
 BL INTEGZ
 MVN FACC,FACC
 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 OPEN
 B SINSTK
PI STMFD SP!,{R14}
 BL FLDAPI
 ADD FACCX,FACCX,#1 ;double it
FSINSTK MOVS TYPE,#TFP
 LDMFD SP!,{PC}
POINTB STMFD SP!,{R14}
 BL EXPR
 BL INTEGZ
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{FACC}
 BL BRA
 BL INTEGZ
 ADD R1,ARGP,#STRACC
 LDMFD SP!,{R2,R14}
 STR R2,[R1]
 STRB FACC,[R1,#2]
 MOV FACC,FACC,LSR #8
 STRB FACC,[R1,#3]
 MOV FACC,#9
 SWI WORD
 LDRB FACC,[R1,#4]
 CMP FACC,#&80
 BCS TRUE
 B SINSTK 
POS MOV R0,#&86
 SWI BYTE
 AND FACC,R1,#255
 B SINSTK
RND STMFD SP!,{R14}
 LDRB R10,[AELINE]
 CMP R10,#"("
 BNE SIMPLE
 ADD AELINE,AELINE,#1
 BL BRA
 BL INTEGZ
 TEQ FACC,#0
 BMI RNDSET
 LDREQ FACC,[ARGP,#SEED]
 BEQ FRND
 TEQ FACC,#1
 BEQ FRND1
 BL IFLT
 BL FPUSH
 BL FRNDAB
 BL FRNDAA
 MOV TYPE,SP
 BL IFMUL
 BL SFIX
 ADD FACC,FACC,#1
 PULLJ 2
 B PSINSTK
FRND1 BL FRNDAB
FRND BL FRNDAA
 B FSINSTK
RNDSET STR FACC,[ARGP,#SEED]
 MOV R4,#&40
 STRB R4,[ARGP,#SEED+4]
 B PSINSTK
SIMPLE BL FRNDAB
 B PSINSTK
FRNDAA MOV FSIGN,#0
 MOV FACCX,#&80
 MOV FGRD,#0
 EOR FACC,FACC,#&80
 EOR FACC,FACC,FACC,LSL #8
 EORS FACC,FACC,FACC,LSL #16
 B FNRM2
FRNDAB LDR R2,[ARGP,#SEED]
 LDRB R3,[ARGP,#SEED+4]
 TST R3,R3,LSR #1 ;get old top bit for 33 bit shift
 MOVS R0,R2,RRX ;33 bit rotate right
 [ RRX=0
 TST R2,R2,LSR #1 ;fix only involves regenerating C
 ]
 ADC R1,R1,R1 ;rotate left with carry to salvage top bit
 EOR R0,R0,R2,LSL #12 ;david assures me the number is right
 EOR R0,R0,R0,LSR #20 ;ditto
 STR R0,[ARGP,#SEED]
 STRB R1,[ARGP,#SEED+4]
 MOV PC,R14
SGN STMFD SP!,{R14}
 BL FACTOR
 LDMFD SP!,{R14}
 BEQ ERTYPEINT
 BPL SGNINT
 TEQ FACC,#0
 BEQ SINSTK
 TEQ FSIGN,#0
 BMI TRUE
INTONE MOV FACC,#1
 B SINSTK
SGNINT TEQ FACC,#0
 BEQ SINSTK
 BMI TRUE
 B INTONE
TAN STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 CMP FACCX,#&98
 BCS FRNGQQ
 BL 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
 STMFD SP!,{FGRD,FSIGN,FACCX}
 ADD TYPE,SP,#3*4 ;input value
 BL FADD
 BL FSTA
 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
 BL FSTA
 B TAN2
TAN1 MOV TYPE,SP
 BL FLDA ;input value
TAN2 CMP FACCX,#&71
 BCC TAN2A
 BL FSQR
 BL 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
 BL FSTA ;stack g, f*P(g)
 MOV TYPE,SP
 BL FLDA
 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
 BL FLDA
 BL FDIVA
 ADD SP,SP,#16
 B FSINSTK
TAN2A EOR FSIGN,FSIGN,#&80000000
 TST R10,#1
 BLNE FRECIP
 ADD SP,SP,#8
 B FSINSTK
SQR STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 BL FSQRT
 B FSINSTK
TO LDRB R10,[AELINE],#1
 CMP R10,#"P"
 BNE FACERR
 LDR FACC,[ARGP,#TOP]
 B SINSTK
TRUE MVN FACC,#0
 B SINSTK
USR STMFD SP!,{R14}
 BL FACTOR
 BL INTEGY
 MOV TYPE,FACC
 BL EMUMOS
 LDMNEFD SP!,{PC}
 MOV R4,TYPE
 MOV R5,#0
 BL CALLARMROUT
 B PSINSTK
VALSTR STMFD SP!,{R14}
 B VAL0 ;, or cr stop already present
VAL STMFD SP!,{R14}
 BL FACTOR
 BL OSSTRI ;Get stop mark (cr)
VAL0 STMFD SP!,{AELINE}
 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
 LDMFD SP!,{AELINE}
 B VALCMP
VPOS MOV R0,#&86
 SWI BYTE
 AND FACC,R2,#255
 B SINSTK
CHRD STMFD SP!,{R14}
 BL FACTOR
 BL INTEGY
 LDMFD SP!,{R14}
 B SINSTR
GETDH STMFD SP!,{R14}
 BL CHAN
 ADD CLEN,ARGP,#STRACC
GETDH1 ADD R0,ARGP,#STRACC
 SUB R0,CLEN,R0
 CMP R0,#255
 BCS LEFTX
 SWI 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 READC
SINSTR ADD CLEN,ARGP,#STRACC
 STRB FACC,[CLEN],#1
 MOV TYPE,#0
 MOV PC,R14
INKED STMFD SP!,{R14}
 BL FACTOR
 BL INTEGY
 MOV R1,FACC
 MOV R2,FACC,LSR #8
 MOV R0,#&81
 SWI BYTE
 LDMFD SP!,{R14}
 AND FACC,R1,#255
 ANDS R2,R2,#255
 BEQ SINSTR
RNUL ADD CLEN,ARGP,#STRACC
RNULX MOVS TYPE,#0
 MOV PC,R14
LEFTD STMFD SP!,{R14}
 BL EXPR
 BNE ERTYPESTR
 CMP R10,#","
 BNE LEFTDB
 BL SPUSH
 BL BRA
 BL INTEGZ
 MOV R7,FACC ;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
 LDMFD SP!,{PC}
LEFTDB CMP R10,#")"
 BNE ERCOMM
 ADD R0,ARGP,#STRACC
 CMP CLEN,R0
 SUBNE CLEN,CLEN,#1
 B LEFTX
MIDD STMFD SP!,{R14}
 BL EXPR
 BNE ERTYPESTR
 BL SPUSH
 CMP R10,#","
 BNE ERCOMM
 BL EXPR
 BL INTEGZ
 STMFD SP!,{FACC}
 MOV FACC,#255
 CMP R10,#","
 BNE MIDDA
 BL EXPR
 BL INTEGZ
MIDDA CMP R10,#")"
 BNE ERBRA
 MOV R7,FACC
 LDMFD SP!,{R6}
 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 STMFD SP!,{R14}
 BL EXPR
 BNE ERTYPESTR
 CMP R10,#","
 BNE RIGHTDB
 BL SPUSH
 BL BRA
 BL INTEGZ
 ADD R6,ARGP,#STRACC
 ADD R7,FACC,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 FWACC,[ARGP,#INTVAR]
 CMP FWACC,#&1000000
 MOVCC FWACC,#0
 LDMFD SP!,{R5}
 BL FCONFP
 MOV CLEN,TYPE
 MOVS TYPE,#0
 LDMFD SP!,{PC}
STRND STMFD SP!,{R14}
 BL EXPR
 BL INTEGZ
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{FACC}
 BL BRA
 BNE ERTYPESTR
 LDMFD SP!,{FACC,R14}
 SUBS FACC,FACC,#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 FACC,FACC,#1
 BNE STRNL
 MOV PC,R14 ;type already correct and subtract set the right status
EOF STMFD SP!,{R14}
 BL CHAN
 MOV R0,#&7F
 SWI BYTE
 ANDS FACC,R1,#255
 MVNNE FACC,#0
 B PSINSTK
 LNK Funct
