;> 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
 & 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
 & 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
 & FACERR-AJ6 ;MANDEL
DIMFN STMFD SP!,{R14}
 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 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 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 BYTE
 MOV IACC,R2
 B SINSTK
BEAT MOV R0,#0
 SWI SOUNDEVENTQBEAT
 B SINSTK
RBEATS MVN R0,#0
 SWI SOUNDEVENTQBEAT
 B SINSTK
RTEMPO MOV R0,#0
 SWI SOUNDEVENTTEMPO
 B SINSTK
UNMINS STMFD SP!,{R14}
; BL UNPLUS
 BL FACTOR
 BEQ ERTYPEINT
VALCMP RSBPL IACC,IACC,#0 ;negate integer
 LDMPLFD SP!,{PC}
 [ FP=0
 TEQ FACC,#0
 EORNE FSIGN,FSIGN,#&80000000 ;negate floating point
 TEQ TYPE,#0
 |
 RSFD FACC,FACC,#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
 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 STMFD SP!,{R14}
 BL LVNOTCACHE
 LDMFD SP!,{R14}
 BNE VARIND
TSTVB1 LDRB R0,[ARGP,#BYTESM]
 TST R0,#2
 BNE FACERR
 LDR R0,[ARGP,#ASSPC]
 B SINSTK
TSTVBCACHEARRAY BIC AELINE,AELINE,#TFP
 STMFD SP!,{R14}
 BL ARLOOKCACHE
 LDMFD SP!,{R14}
 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
 ADDS AELINE,AELINE,R1
 BMI TSTVBCACHEARRAY
VARIND CMP TYPE,#4
 BCC VARBYT
 BEQ VARINT
 CMP TYPE,#128
 BCS VARNOTNUM
VARFP
 [ FP=0
 BIC FSIGN,IACC,#3
; AND FGRD,FACC,#3
 MOVS FGRD,IACC,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
 |
 LDFD FACC,[IACC]
 ]
 MOVS TYPE,#TFP
 MOV PC,R14
VARBYT LDRB IACC,[IACC]
 MOVS TYPE,#TINTEGER
 MOV PC,R14
VARINT ANDS R2,IACC,#3
 BNE VARINT1
 LDR IACC,[IACC]
 MOVS TYPE,#TINTEGER
 MOV PC,R14
VARINT1 BIC IACC,IACC,#3
 LDMFD IACC,{IACC,R1}
 MOV R2,R2,LSL #3
 MOV IACC,IACC,LSR R2
 RSB R2,R2,#32
 ORR IACC,IACC,R1,LSL 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
 LOAD 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
 ADDS AELINE,AELINE,R1
 MOVPL PC,R14
 BIC AELINE,AELINE,#TFP
 [ FP=0
 AND FACCX,TYPE,#255
 AND FSIGN,TYPE,#TFP
 |
 STMFD SP!,{IACC,TYPE}
 LDFD FACC,[SP],#8
 ]
 MOVS TYPE,#TFP
 MOV PC,R14
TSTNNOTCACHE STMFD SP!,{AELINE,R14}
 BL FREAD
 BCC FACERR
 LDMFD SP!,{R6,R14}
 TEQ TYPE,#0
 [ FP=0
 ORRMI TYPE,FACCX,FSIGN
 |
 STFMID FACC,[SP,#-8]!
 LDMMIFD SP!,{IACC,TYPE}
 ]
 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 STMFD SP!,{R14}
 BL EXPR
 CMP R10,#")"
 BNE ERBRA
 TEQ TYPE,#0
 LDMFD SP!,{PC}
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 STMFD SP!,{R14}
 BL CHAN
 MOV R0,#0
RPTRA SWI 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,#1
 SWI WORD
 LDR IACC,[R1]
 [ 1=0
 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
 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 STMFD SP!,{R14}
 BL FACTOR
 BEQ ERTYPEINT
 [ FP=0
 MOVMI FSIGN,#0
 |
 ABSMID FACC,FACC
 ]
 LDMMIFD SP!,{PC} ;do fp abs (easy)
 TEQ IACC,#0
 RSBMI IACC,IACC,#0 ;if negative, negate
 TEQ TYPE,#0
 LDMFD SP!,{PC}
ADC STMFD SP!,{R14}
 BL FACTOR
 BL INTEGZ
 MOV R1,R0
 MOV R2,R0,LSR #8
 MOV R0,#&80
 SWI BYTE
 AND IACC,R1,#255
; AND R2,R2,#255 ;removed since GStark claims its OK
 ORR IACC,IACC,R2,LSL #8
 B PSINSTK
ASC STMFD SP!,{R14}
 BL FACTOR
 BNE ERTYPESTR
 LDMFD SP!,{R14}
 ADD IACC,ARGP,#STRACC
 CMP CLEN,IACC
 BNE VARBYT
 ;null string gives -1
TRUE MVN IACC,#0
 B SINSTK
ACS STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
 MOV R10,#1
 B ASN1
 |
 ACSD FACC,FACC
 MOVS TYPE,#TFP
 LDMFD SP!,{PC}
 ]
BBGET STMFD SP!,{R14}
 BL CHAN
 SWI 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 STMFD SP!,{R14}
 BL FACTOR
 BL OSSTRI
 STMFD SP!,{AELINE}
 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 STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
 BL FEXP
 |
 EXPD FACC,FACC
 ]
FSINSTK MOVS TYPE,#TFP
 LDMFD SP!,{PC}
EXT STMFD SP!,{R14}
 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 READC
 B SINSTK
INKEY STMFD SP!,{R14}
 BL FACTOR
 BL INTEGZ
 MOV R1,IACC
 MOV R2,IACC,LSR #8
 MOV R0,#&81
 SWI BYTE
 LDMFD SP!,{R14}
 ANDS R2,R2,#255
 BNE TRUE
 AND IACC,R1,#255
 B SINSTK
INSTR STMFD SP!,{R14}
 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 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 IACC,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}
 [ FP=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
 |
 FIXDM IACC,FACC
 MOVS TYPE,#TINTEGER
 LDMFD SP!,{PC}
 ]
LEN STMFD SP!,{R14}
 BL FACTOR
 BNE ERTYPESTR
 ADD IACC,ARGP,#STRACC
 SUB IACC,CLEN,IACC
PSINSTK MOVS TYPE,#TINTEGER
 LDMFD SP!,{PC}
LN STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
 BL FLOG
 |
 LGND FACC,FACC
 ]
 B FSINSTK
LOG STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
 BL FLOG
 ADR TYPE,RPLN10
 B FMULFSINSTK
 |
 LOGD FACC,FACC
 MOVS TYPE,#TFP
 LDMFD SP!,{PC}
 ]
DEG STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 ADR TYPE,F180DP
 B FMULFSINSTK
RAD STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 ADR TYPE,FPID180
 [ FP=0
FMULFSINSTK BL FMUL
 MOVS TYPE,#TFP
 LDMFD SP!,{PC}
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
 |
FMULFSINSTK LDFD F1,[TYPE]
 MUFD FACC,FACC,F1
 MOVS TYPE,#TFP
 LDMFD SP!,{PC}
F180DP DCFD 57.2957795130823208767981548141
FPID180 DCFD 0.0174532925199432957692369076849
 ]
NOT STMFD SP!,{R14}
 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 OPEN
 B SINSTK
POINTB STMFD SP!,{R14}
 BL EXPR
 BL INTEGY
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{IACC}
 BL BRA
 BL INTEGZ
 MOV R1,R0
 LDMFD SP!,{R0,R14}
 SWI READPOINT
 MOV R0,R2
 B SINSTK 
RTINT LDRB R10,[AELINE],#1
 CMP R10,#"("
 BNE ERBRA1
 STMFD SP!,{R14}
 BL EXPR
 BL INTEGY
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{IACC}
 BL BRA
 BL INTEGZ
 MOV R1,R0
 LDMFD SP!,{R0,R14}
 SWI READPOINT
 MOV R0,R3
 B SINSTK 
POS MOV R0,#&86
 SWI BYTE
 AND IACC,R1,#255
 B SINSTK
RND STMFD SP!,{R14}
 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
 [ FP=0
 BL IFLT
 FPUSH
 BL DORANDOM
 BL FRNDAA
 MOV TYPE,SP
 BL IFMUL
 BL SFIX
 ADD IACC,IACC,#1
 PULLJ 2
 |
 FLTD F7,IACC
 BL DORANDOM
 BL FRNDAA
 MUFDZ FACC,FACC,F7
 FIXDZ IACC,FACC
 ADD IACC,IACC,#1
 ]
 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
 [ FP=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
 STMFD SP!,{R2,R3} ;save...
 LDFD FACC,[SP],#8 ;...and restore in FACC
 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 STMFD SP!,{R14}
 BL FACTOR
 LDMFD SP!,{R14}
 BEQ ERTYPEINT
 BPL SGNINT
 [ FP=0
 TEQ FACC,#0
 BEQ SINSTK
 TEQ FSIGN,#0
 BMI TRUE
 |
 CMF FACC,#0
 BEQ FALSE
 BMI TRUE
 ]
INTONE MOV IACC,#1
 B SINSTK
SGNINT TEQ IACC,#0
 BEQ SINSTK
 BMI TRUE
 B INTONE
TAN STMFD SP!,{R14}
 BL FACTOR
 [ FP=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
 |
 BLPL FLOATQ
 TAND FACC,FACC
 ]
 B FSINSTK
SQR STMFD SP!,{R14}
 BL FACTOR
 BLPL FLOATQ
 [ FP=0
 BL FSQRT
 |
 SQTD FACC,FACC
 ]
 B FSINSTK
TO LDRB R10,[AELINE],#1
 CMP R10,#"P"
 BNE FACERR
 LDR IACC,[ARGP,#TOP]
 B SINSTK
USR STMFD SP!,{R14}
 BL FACTOR
 BL INTEGY
 MOV TYPE,IACC
 [ FP=0
 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 IACC,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 IACC,[CLEN],#1
 MOVS TYPE,#0
 MOV PC,R14
INKED STMFD SP!,{R14}
 BL FACTOR
 BL INTEGY
 MOV R1,IACC
 MOV R2,IACC,LSR #8
 MOV R0,#&81
 SWI BYTE
 LDMFD SP!,{R14}
 AND IACC,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
 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
 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
 TEQ TYPE,#0
 BNE ERTYPESTR
 BL SPUSH
 CMP R10,#","
 BNE ERCOMM
 BL EXPR
 BL INTEGY
 STMFD SP!,{IACC}
 MOV IACC,#255
 CMP R10,#","
 BNE MIDDA
 BL EXPR
 BL INTEGY
MIDDA CMP R10,#")"
 BNE ERBRA
 MOV R7,IACC
 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
 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
 LDMFD SP!,{R5}
 BL FCONFP
 MOV CLEN,TYPE
 MOVS TYPE,#0
 LDMFD SP!,{PC}
STRND STMFD SP!,{R14}
 BL EXPR
 BL INTEGY
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{IACC}
 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 STMFD SP!,{R14}
 BL CHAN
 MOV R0,#&7F
 SWI BYTE
 ANDS IACC,R1,#255
 MVNNE IACC,#0
 B PSINSTK
 LNK Funct
