;> Stmt2 poly, graphics, file io, mos emulator
;statements (of the poly variety)
LERROR BL SPACES
 CMP R10,#TEXT
 BEQ LERROREXT
 SUB LINE,LINE,#1
 BL INTEXA
 STMFD SP!,{IACC}
 BL EXPR
 TEQ TYPE,#0
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R7}
 MOV R0,#0
 STRB R0,[CLEN],#1 ;0 at end of string
 BL SPUSH
 STR R7,[SP]
 MOV R14,SP
 B MSGERR
LERROREXT BL INTEXA
 STMFD SP!,{IACC}
 BL EXPR
 TEQ TYPE,#0
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R7}
 MOV R0,#0
 STRB R0,[CLEN],#1 ;0 at end of string
 BL SPUSH
 STR R7,[SP]
 ADD R12,ARGP,#OLDERR
 BL PUTBACKHAND
 MOV R2,#42
 STRB R2,[ARGP,#CALLEDNAME]
 MOV R0,SP
 SWI GENERATEERROR
 SWI EXIT
LPAGE BL EQAEEX
 ADD IACC,IACC,#3
 BIC IACC,IACC,#3
 ADD R1,ARGP,#FREE
 CMP IACC,R1
 BCC LPAGEOUT
;;;;; CMP IACC,#&3400000
 CMP IACC,#&1800000 ;warning changed
 BCS LPAGEROM
 LDR R1,[ARGP,#MEMLIMIT]
 CMP IACC,R1
 STRCC IACC,[ARGP,#PAGE]
 BCC NXT
LPAGEOUT MOV R0,#4
 SWI BASICTrans_Message
 BVC NXT
 SWI WRITES
 = "Out of range value assigned to PAGE",10,13,0
 B NXT
LPAGEROM STR IACC,[ARGP,#PAGE]
 ADD IACC,ARGP,#FREE
 B LLOMEMROM
LTIME LDRB R10,[LINE]
 CMP R10,#"$"
 BEQ LTIMED
 BL EQAEEX
 ADD R1,ARGP,#STRACC
 STR IACC,[R1]
 MOV R0,#0
 STR R0,[R1,#4]
 MOV R0,#2
 SWI WORD ;set time
 [ 1=0
 SWI WORD ;time now
 LDR FACC,[R1]
 SUB FACC,FACC,R4 ;what the offset has to be
 STR FACC,[ARGP,#TIMEOF]
 ]
 B NXT
LTIMED ADD LINE,LINE,#1
 BL SPACES
 CMP R10,#"="
 BNE MISSEQ
 BL AEEXPR
 TEQ TYPE,#0
 BNE ERTYPESTR
 BL AEDONE
 STRB TYPE,[CLEN]       ; terminate the string
 ADD R1,ARGP,#STRACC
 SUB R0,CLEN,R1
 ; no! can't just use length - must be reason code. let's deduce what reason code
 ; by looking at length: length<=8 => time (reason 8),
 ;                  else length<=maximum date length => date (reason 15),
 ;                  else => date+time (reason 24).
 CMP R0,#8
 MOVLS R0,#8
 BLS LTIMED1
 STMFD SP!,{R0-R2}
 LDR R2,[ARGP,#FSA]
 MOV R1,R2              ; dummy
 MOV R0,#-1
 SWI Territory_ReadCalendarInformation
 ; date format is "%w3,%dy %m3 %ce%yr": max length is 7+max length of %w3,%dy and %m3
 MOV R7,#7
 LDR R0,[R2,#24]
 ADD R7,R7,R0
 LDR R0,[R2,#28]
 ADD R7,R7,R0
 LDR R0,[R2,#40]
 ADD R7,R7,R0
 LDMFD SP!,{R0-R2}
 CMP R0,R7
 MOVLS R0,#15
 MOVHI R0,#24
LTIMED1
 STRB R0,[R1,#-1]!
 MOV R0,#15
 SWI WORD
 B NXT
LLOMEM BL EQAEEX
LLOMEMROM ADD IACC,IACC,#3
 BIC IACC,IACC,#3
 ADD R1,ARGP,#FREE
 CMP IACC,R1
 BCC LLOMEMOUT
 LDR R1,[ARGP,#MEMLIMIT]
 CMP IACC,R1
 BCS LLOMEMOUT
 STR IACC,[ARGP,#LOMEM]
 STR IACC,[ARGP,#FSA]
 MOV R0,#0
 STR R0,[ARGP,#FREELIST]
 BL SETVAL
 B NXT
LLOMEMOUT MOV R0,#5
 SWI BASICTrans_Message
 BVC NXT
 SWI WRITES
 = "Out of range value assigned to LOMEM",10,13,0
 B NXT
LHIMEM BL EQAEEX
 BIC IACC,IACC,#3
 ADD R1,ARGP,#FREE
 CMP IACC,R1
 BCC LHIMEMOUT
 LDR R1,[ARGP,#MEMLIMIT]
 CMP IACC,R1
 BHI LHIMEMOUT
 STR IACC,[ARGP,#HIMEM]
 BL POPLOCALAR
 LDR SP,[ARGP,#HIMEM]
 MOV R0,#0
 STMFD SP!,{R0-R9} ;stack stop
 STR SP,[ARGP,#ERRSTK]
 B NXT
LHIMEMOUT MOV R0,#6
 SWI BASICTrans_Message
 BVC NXT
 SWI WRITES
 = "Out of range value assigned to HIMEM",10,13,0
 B NXT
LLEFTD BL AELV
 BEQ FACERR
 CMP TYPE,#128
 BNE ERTYPESTRING
 STMFD SP!,{IACC}
 MOV IACC,#1
 STMFD SP!,{IACC}
 BL AESPAC
 MOV IACC,#255
 CMP R10,#","
 BNE LMIDD1
 BL EXPR
 BL INTEGY
 B LMIDD1
LMIDD BL AELV
 BEQ FACERR
 CMP TYPE,#128
 BNE ERTYPESTRING
 BL AESPAC
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 STMFD SP!,{IACC}
 MOV R0,#255
 CMP R10,#","
 BNE LMIDD1
 BL EXPR
 BL INTEGY
LMIDD1 STMFD SP!,{IACC}
 CMP R10,#")"
 BNE ERBRA
 BL AESPAC
 CMP R10,#"="
 BNE MISSEQ
 BL EXPR
 TEQ TYPE,#0
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R4,R5,R6}
 ADD R1,ARGP,#STRACC
 CMP CLEN,R1
 BEQ NXT ;no right string
;R4 is max length, R5 is start position, R6 is pointer to string block
LRIGHTD2 LOAD IACC,R6,R1,R7
 SUB R1,R5,#1
 CMP R1,#255
 MOVCS R5,#1
 LDRB R1,[R6,#4] ;get length
 CMP R5,R1
 BHI NXT
 ADD R1,IACC,R1
 ADD R7,IACC,R5
 SUB R7,R7,#1 ;start address
 ADD R3,ARGP,#STRACC
LMIDD2 LDRB R5,[R3],#1
 STRB R5,[R7],#1
 TEQ R3,CLEN
 BEQ NXT ;exhausted right string
 CMP R7,R1
 BCS NXT ;exhausted left string
 SUBS R4,R4,#1
 BHI LMIDD2
 B NXT
LRIGHTD BL AELV
 BEQ FACERR
 CMP TYPE,#128
 BNE ERTYPESTRING
 STMFD SP!,{IACC}
 BL AESPAC
 MOV IACC,#255
 CMP R10,#","
 BNE LRIGHTD1
 BL EXPR
 BL INTEGY
LRIGHTD1 STMFD SP!,{IACC}
 CMP R10,#")"
 BNE ERBRA
 BL AESPAC
 CMP R10,#"="
 BNE MISSEQ
 BL EXPR
 TEQ TYPE,#0
 BNE ERTYPESTR
 BL AEDONE
 LDMFD SP!,{R4,R6}
 ADD R1,ARGP,#STRACC
 SUBS R0,CLEN,R1 ;length of rightside
 BEQ NXT ;no right string
 CMP R4,R0
 MOVCS R4,R0
 LDRB R5,[R6,#4]
 SUBS R5,R5,R4
 ADD R5,R5,#1
 BCS LRIGHTD2
 B NXT
ASSIGNAT LDRB R10,[LINE],#1
 CMP R10,#"%"
 BNE ERSYNT
 LDRB R10,[LINE],#1
 CMP R10,#"("
 BEQ ERSYNT
 CMP R10,#" "
 BLEQ SPACES
 CMP R10,#"-"
 TEQCC R10,#"+"
 MOVEQ R5,#4
 ADDEQ R4,ARGP,#INTVAR
 STMEQFD SP!,{R4,R5}
 MOVEQ AELINE,LINE
 BEQ ATGOTLT2
 CMP R10,#"="
 BNE MISSEQ
 BL AEEXPR
 BL AEDONE
 TEQ TYPE,#0
 BEQ ASSIGNATSTRING
 BLMI INTEGB
 STR IACC,[ARGP,#INTVAR]
 B NXT
ASSIGNATSTRING STRB TYPE,[CLEN],#1 ;write trailing null
 ADD R4,ARGP,#STRACC
 LDRB R5,[R4],#1
 CMP R5,#"+"
 MOVEQ R0,#1
 MOVNE R0,#0
 STRB R0,[ARGP,#INTVAR+3] ;set/clear STR$ flag
 LDREQB R5,[R4],#1
 BIC R6,R5,#&20 ;clear case bit
 LDRB R0,[ARGP,#INTVAR+2] ;format and "," bit
 ORR R0,R0,#3 ;set to max+1
 CMP R6,#"G"
 SUBEQ R0,R0,#1
 CMPNE R6,#"E"
 SUBEQ R0,R0,#1
 CMPNE R6,#"F"
 SUBEQ R0,R0,#1
 STREQB R0,[ARGP,#INTVAR+2] ;format ("," bit unchanged)
 LDREQB R5,[R4],#1
 CMP R5,#"."
 CMPNE R5,#","
 BEQ ASSIGNATDOT
 BL READNUM
 BCC NXT ;read garbage!
 STRB R0,[ARGP,#INTVAR] ;field width
 CMP R5,#"."
 CMPNE R5,#","
 BNE NXT
ASSIGNATDOT LDRB R0,[ARGP,#INTVAR+2]
 BIC R0,R0,#&80 ;clear "," bit
 CMP R5,#","
 ORREQ R0,R0,#&80 ;set "," bit
 STRB R0,[ARGP,#INTVAR+2]
 LDRB R5,[R4],#1
 BL READNUM
 STRCSB R0,[ARGP,#INTVAR+1]
 B NXT
;read unsigned number, carry set if OK
READNUM CMP R5,#"0"
 MOVCC PC,R14
 CMP R5,#"9"+1
 BICHIS PC,R14,#CFLAG
 AND R0,R5,#&F
READNUMDIG LDRB R5,[R4],#1
 SUBS R6,R5,#"0"
 ORRCCS PC,R14,#CFLAG
 CMP R5,#"9"+1
 ADDCC R0,R0,R0,LSL #2
 ADDCC R0,R6,R0,LSL #1;smode*2+r0
 BCC READNUMDIG
 MOV PC,R14 ;carry set
; graphics
CLG MOV R0,#16
 B CLSA
CLS MOV R0,#12
CLSA BL DONES
 BL CTALLY
 SWI WRITEC
 B NXT
CIRCLE MOV R0,#&95
 MOV R1,#&9D
 BL CHECKFILL
 STMFD SP!,{IACC}
 BL INTEXA
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R3,R4,TYPE}
 ADD R5,R4,IACC
 MOV R0,#4
 MOV R1,R4
 MOV R2,R3
 BL DOPLOT ;move x,y
 MOV R0,TYPE
 MOV R1,R5
 BL DOPLOT ;plot q,x+w,y
 B NXT
CHECKFILL STMFD SP!,{R14}
 BL SPACES
 CMP R10,#TESCSTMT
 BNE CHECKFILL1
 LDRB R10,[LINE],#1
 TEQ R10,#TFILL
 MOVEQ R0,R1
 LDMEQFD SP!,{PC}
 SUB LINE,LINE,#1
CHECKFILL1 SUB LINE,LINE,#1
 LDMFD SP!,{PC}
COLOUR BL AEEXPR
 BL INTEGY
 CMP R10,#TESCSTMT
 BEQ COLOURTINT
 TEQ R10,#","
 BEQ PALETTE
 BL AEDONE
 SWI WRITEI+17
 SWI WRITEC
 B NXT
COLOURTINT LDRB R10,[AELINE],#1
 CMP R10,#TTINT
 BNE ERSYNT
 STMFD SP!,{IACC}
 BL EXPRDN
 MOV R1,IACC
 LDMFD SP!,{IACC}
 SWI WRITEI+17
 SWI WRITEC
 MOV IACC,IACC,LSR #7
 AND IACC,IACC,#1
 B TINTEND
PALETTE STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 TEQ R10,#","
 BEQ PALETTE4
 BL AEDONE
 MOV R1,IACC
 LDMFD SP!,{IACC}
 SWI WRITEI+19
 SWI WRITEC
 MOV IACC,R1
 BL WRITEG
 MOV IACC,R1,LSR #16
 BL WRITEG
 B NXT
PALETTE4 STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 TEQ R10,#","
 BNE COLOUR3
 STMFD SP!,{IACC}
 BL EXPRDN
 MOV R6,#16
PROGPAL MOV R5,IACC
 SWI WRITEI+19
 LDMFD SP!,{R1,R2,R3}
 MOV IACC,R3
 SWI WRITEC
 MOV IACC,R6
 SWI WRITEC
 MOV IACC,R2
 SWI WRITEC
 MOV IACC,R1
 SWI WRITEC
 MOV IACC,R5
 SWI WRITEC
 B NXT
COLOUR3 BL AEDONE
 LDMFD SP!,{R1,R2}
 AND R0,R0,#255 ;blue
 AND R1,R1,#255 ;green
 AND R2,R2,#255 ;red
 ORR R1,R2,R1,LSL #8
 ORR R0,R1,R0,LSL #16
 MOV R0,R0,LSL #8
 MOV R3,#0
 SWI COLOURTRANSSETTEXTCOLOUR
 B NXT
CURSON SWI WRITES
 = 23,1,1,0
 MOV R1,#7
 BL ZEROX
 B NXT
CURSOFF BL DONES
 SWI WRITES
 = 23,1,0,0
 MOV R1,#8
 BL ZEROX
 B NXT
DRAW MOV IACC,#5
 B PLOTER
ELLIPSE MOV R0,#&C5
 MOV R1,#&CD
 BL CHECKFILL
 STMFD SP!,{IACC}
 BL INTEXA
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 CMP R10,#","
 BEQ ELLIPSEANGLE
 BL AEDONE
 LDMFD SP!,{R5,R6,R7,TYPE}
 MOV R3,R0
 MOV R4,#0
 B ELLIPSEDO
ELLIPSEANGLE BL IFLT
 BL FPUSH ;min
;min, maj%, y org%, x org%, FILL%
 BL EXPR
 BL FLOATY
 BL AEDONE
 BL FPUSH ;ang
 [ FP=0
;ang, min, maj%, y org%, x org%, FILL%
 STMFD SP!,{R10}
 BL SINOP
 LDMFD SP!,{R10}
 BL FPUSH
;sinang, ang, min, maj%, y org%, x org%, FILL%
 ADD TYPE,SP,#8
 FLDA TYPE
 STMFD SP!,{R10}
 BL COSOP
 LDMFD SP!,{R10}
 ADD TYPE,SP,#8
 FSTA TYPE
;sinang, cosang, min, maj%, y org%, x org%, FILL%
 LDR FACC,[SP,#24] ;maj%
 BL IFLT
 BL FPUSH ;maj
;maj, sin, cos, min, maj%, y org%, x org%, FILL%
 ADD TYPE,SP,#24 ;min
 BL FMUL
 BL FPUSH
;slicet, maj, sin, cos, min, maj%, y org%, x org%, FILL%
 ADD TYPE,SP,#32 ;min
 FLDA TYPE
 ADD TYPE,SP,#24 ;cos
 BL FMUL
 BL FSQR ;(min*cos)^2
 BL FPUSH
;temp, slicet, maj, sin, cos, min, maj%, y org%, x org%, FILL%
 ADD TYPE,SP,#16 ;maj
 FLDA TYPE
 ADD TYPE,SP,#24 ;sin
 BL FMUL
 BL FSQR ;(maj*sin)^2
 MOV TYPE,SP ;(min*cos)^2
 BL FADD
 BL FSQRT
 FSTA TYPE ;maxy
;maxy, slicet, maj, sin, cos, min, maj%, y org%, x org%, FILL%
 ADD TYPE,SP,#8 ;slicet
 BL FXDIV
 BL SFIX
 STR IACC,[SP,#48] ;slicew%
;maxy, slicet, maj, sin, cos, min, slicew%, y org%, x org%, FILL%
 ADD TYPE,SP,#16 ;maj
 FLDA TYPE
 BL FSQR
 FSTA TYPE
 ADD TYPE,SP,#40 ;min
 FLDA TYPE
 BL FSQR
 ADD TYPE,SP,#16 ;maj^2
 BL FXSUB
 ADD TYPE,SP,#24 ;sin
 BL FMUL
 ADD TYPE,SP,#32 ;cos
 BL FMUL
 ADD TYPE,SP,#8
 FSTA TYPE
;maxy, sheart, maj^2, sin, cos, min, slicew%, y org%, x org%, FILL%
 FLDA SP ;maxy
 ADD TYPE,SP,#8 ;sheart
 BL FXDIV
 BL SFIX
 STR FACC,[SP,#44] ;shearx%
 BL FPULL
;sheart, maj^2, sin, cos, junk%, shearx%, slicew%, y org%, x org%, FILL%
 BL SFIX
 |
;ang, min, maj%, y org%, x org%, FILL%
 SIND F1,FACC
 STFD F1,[SP,#-8]!
;sinang, ang, min, maj%, y org%, x org%, FILL%
 COSD F1,FACC
 STFD F1,[SP,#8]
;sinang, cosang, min, maj%, y org%, x org%, FILL%
 LDR IACC,[SP,#24] ;maj%
 BL IFLT
 FPUSH ;maj
;maj, sin, cos, min, maj%, y org%, x org%, FILL%
 LDFD F1,[SP,#24] ;min
 MUFD FACC,F1,FACC
 FPUSH
;slicet, maj, sin, cos, min, maj%, y org%, x org%, FILL%
 LDFD F2,[SP,#24] ;cos
 MUFD F2,F2,F1 ;min*cos
 MUFD F2,F2,F2 ;(min*cos)^2
 STFD F2,[SP,#-8]!
;temp, slicet, maj, sin, cos, min, maj%, y org%, x org%, FILL%
 LDFD F1,[SP,#16] ;maj
 LDFD FACC,[SP,#24] ;sin
 MUFD FACC,F1,FACC ;maj*sin
 MUFD FACC,FACC,FACC ;(maj*sin)^2
 ADFD FACC,FACC,F2 ;(min*cos)^2+(maj*sin)^2
 SQTD FACC,FACC
 STFD FACC,[SP] ;maxy
;maxy, slicet, maj, sin, cos, min, maj%, y org%, x org%, FILL%
 LDFD F2,[SP,#8] ;slicet
 DVFD F2,F2,FACC ;slicet/maxy
 FIXDZ IACC,F2
 STR IACC,[SP,#48] ;slicew%
;maxy, slicet, maj, sin, cos, min, slicew%, y org%, x org%, FILL%
 MUFD F1,F1,F1 ;maj^2
 LDFD F2,[SP,#40] ;min
 MUFD F2,F2,F2 ;min^2
 SUFD F2,F1,F2 ;maj^2-min^2
 LDFD F1,[SP,#24] ;sin
 MUFD F2,F1,F2
 LDFD F1,[SP,#32] ;cos
 MUFD F2,F1,F2
 STFD F2,[SP,#8]
;maxy, sheart, maj^2, sin, cos, min, slicew%, y org%, x org%, FILL%
 DVFD FACC,FACC,F2 ;maxy/sheart
 BL SFIX
 STR IACC,[SP,#44] ;shearx%
 BL FPULL
;sheart, maj^2, sin, cos, junk%, shearx%, slicew%, y org%, x org%, FILL%
 BL SFIX
 ]
 STR IACC,[SP,#32]!
;maxy%, shearx%, slicew%, y org%, x org%, FILL%
 LDMFD SP!,{R3,R4,R5,R6,R7,TYPE}
ELLIPSEDO MOV R0,#4
 MOV R1,R7
 MOV R2,R6
 BL DOPLOT ;move x,y
 MOV R0,#4
 ADD R1,R5,R7
 BL DOPLOT ;move x+slicew,y
 MOV R0,TYPE
 ADD R1,R4,R7
 ADD R2,R3,R6
 BL DOPLOT ;plot type,x+shearx,y+maxy
 B NXT
FILL MOV IACC,#&85
 B PLOTER
GCOL BL AEEXPR
 BL INTEGY
 CMP R10,#","
 BEQ GCOL2
 MOV R1,IACC
 MOV R0,#0 ;pretend we read two
 CMP R10,#TESCSTMT
 BNE DOGCOL
GCOLTINT LDRB R10,[AELINE],#1
 CMP R10,#TTINT
 BNE ERSYNT
 STMFD SP!,{R0,R1}
 BL EXPRDN
 MOV R1,IACC
 LDMFD SP!,{R0,R2}
 SWI WRITEI+18
 SWI WRITEC
 MOV R0,R2
 SWI WRITEC
 TST R0,#128
 MOVEQ R0,#2
 MOVNE R0,#3
 B TINTEND
GCOL2 STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 CMP R10,#","
 BEQ GCOL3
 MOV R1,IACC
 LDMFD SP!,{IACC}
 CMP R10,#TESCSTMT
 BEQ GCOLTINT
DOGCOL BL AEDONE
 SWI WRITEI+18
 SWI WRITEC
 MOV IACC,R1
 SWI WRITEC
 B NXT
GCOL3 STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 CMP R10,#","
 BEQ GCOL4
 BL AEDONE
;GCOL r,g,b: b in IACC, g, r on stack
 LDMFD SP!,{R1,R2}
 MOV R3,#256 ;dither
 MOV R4,#0 ;store action
 B GCOLCTRANS
GCOL4 STMFD SP!,{IACC}
 BL EXPRDN
;GCOL a,r,g,b: b in IACC, g, r, a on stack
 LDMFD SP!,{R1,R2,R3}
 AND R4,R3,#255 ;GCOL action
 ORR R3,R3,#256 ;dither
GCOLCTRANS AND R2,R2,#255
 AND R1,R1,#255
 AND R0,R0,#255
 ORR R0,R2,R0,LSL #16
 ORR R0,R0,R1,LSL #8
 MOV R0,R0,LSL #8
 SWI COLOURTRANSSETGCOL
 B NXT
LINEST BL SPACES
 TEQ R10,#TINPUT
 MOVEQ R5,#0
 MOVEQ R4,#&40
 BEQ INPLP
 SUB LINE,LINE,#1
 BL INTEXA
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R4,R5,R6}
 MOV R3,IACC ;r3: y2, r4: x2, r5: y, r6: x
 MOV R0,#4
 MOV R1,R6
 MOV R2,R5
 BL DOPLOT ;move x,y
 MOV R0,#5
 MOV R1,R4
 MOV R2,R3
 BL DOPLOT ;draw x2,y2
 B NXT
MODES MOV AELINE,LINE
 BL EXPR
 MOV LINE,AELINE
 BL DONE
 TEQ TYPE,#0
 BEQ MODESTRING
 BLMI INTEGB
 BL CTALLY
 CMP R0,#256
 BCS MODESS
 SWI WRITEI+22
 SWI WRITEC
 B NXT
MODESS MOV R1,R0
 MOV R0,#0
 SWI SCREENMODE
 B NXT
MODESTRING MOV R0,#10
 STRB R0,[CLEN]
 ADD R0,ARGP,#STRACC
 MOV R1,#9
 ADR R2,WIMPMODETEXT
MODESTRINGLOOP
 LDRB R3,[R2,#-1]!
 STRB R3,[R0,#-1]!
 SUBS R1,R1,#1
 BNE MODESTRINGLOOP
 SWI CLI
 B NXT
 = "WimpMode "
WIMPMODETEXT
 ALIGN
DOMOUSE BL SPACES
 CMP R10,#TTEXT
 BEQ DOMOUSECOLOUR
 CMP R10,#TON
 BEQ DOMOUSEON
 CMP R10,#TOFF
 BEQ DOMOUSEOFF
 CMP R10,#TTO
 BEQ DOMOUSETO
 CMP R10,#TSTEP
 BEQ DOMOUSESTEP
 CMP R10,#TESCSTMT
 BEQ DOMOUSERECT
 SUB LINE,LINE,#1
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 STMFD SP!,{IACC,TYPE}
 MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BNE ERCOMM
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 STMFD SP!,{IACC,TYPE}
 MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BNE ERCOMM
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BEQ MOUSEFOUR
 BL DONE
 STMFD SP!,{IACC,TYPE}
 SWI MOUSE
 MOV R6,R0
 MOV R7,R1
 MOV IACC,R2
DOMOUSESTORE MOV TYPE,#TINTEGER
 BL STORE ;store switches in last one
 MOV IACC,R7
 MOV TYPE,#TINTEGER
 BL STORE ;store y
 MOV IACC,R6
 MOV TYPE,#TINTEGER
 BL STORE ;store x
 B NXT
MOUSEFOUR STMFD SP!,{IACC,TYPE}
 BL CRAELV
 BEQ ERMOUS
 CMP TYPE,#128
 BCS ERMOUS
 MOV LINE,AELINE
 BL DONES
 STMFD SP!,{IACC,TYPE}
 SWI MOUSE
 MOV R6,R0
 MOV R7,R1
 MOV AELINE,R2
 MOV R0,R3
 MOV TYPE,#TINTEGER
 BL STORE
 MOV IACC,AELINE
 B DOMOUSESTORE
DOMOUSERECT LDRB R10,[LINE],#1
 CMP R10,#TRECT
 BNE ERSYNT
 BL INTEXA
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R1,R2,R3}
 ADD R4,R2,R0
 ADD R5,R1,R3
;R3 XLO,R2 YLO,R5 XHI,R4 YHI
 MOV R0,#&FF
 ORR R0,R0,#&FF00
 AND R3,R3,R0
 ORR R2,R3,R2,LSL #16
 AND R5,R5,R0
 ORR R3,R5,R4,LSL #16
 ADD R1,ARGP,#STRACC
 ADD R1,R1,#3
 MOV R0,#1
 STRB R0,[R1]
 STR R2,[R1,#1]
 STR R3,[R1,#5]
 MOV R0,#&15
 SWI WORD
 B NXT
DOMOUSESTEP BL AEEXPR
 BL INTEGY
 AND R1,IACC,#&FF
 CMP R10,#","
 BNE DOMOUSESTEP1
 STMFD SP!,{IACC}
 BL EXPR
 BL INTEGY
 AND R1,IACC,#&FF
 LDMFD SP!,{IACC}
DOMOUSESTEP1 BL AEDONE
 MOV IACC,IACC,LSL #8
 AND IACC,IACC,#&FF00
 ORR IACC,IACC,#2
 ORR IACC,IACC,R1,LSL #16
 ADD R1,ARGP,#STRACC
 STR IACC,[R1]
 MOV R0,#&15
 SWI WORD
 B NXT
DOMOUSETO BL INTEXA
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R1}
 STMFD SP!,{IACC}
 MOV R1,R1,LSL #16
 ORR R1,R1,#&300
 STMFD SP!,{R1}
 ADD R1,SP,#1
 MOV R0,#&15
 SWI WORD
 ADD SP,SP,#8
 B NXT
DOMOUSEOFF MOV IACC,#0
 BL DONES
 B DOMOUSEON1
DOMOUSEON MOV IACC,#1
 BL SPACES
 CMP R10,#":"
 CMPNE R10,#13
 CMPNE R10,#TELSE
 BEQ DOMOUSEON1
 SUB LINE,LINE,#1
 BL AEEXDN
DOMOUSEON1 MOV R1,IACC
 MOV R0,#106
 SWI BYTE
 B NXT
DOMOUSECOLOUR BL INTEXA
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL INTEXC
 STMFD SP!,{IACC}
 BL EXPRDN
 MOV R6,#25
 B PROGPAL
MOVE MOV IACC,#4
PLOTER BL SPACES
PLOTER1 CMP R10,#"B"
 SUBNE LINE,LINE,#1
 BNE PLOTER2
 LDRB R10,[LINE],#1
 CMP R10,#"Y"
 SUBEQ IACC,IACC,#4
 SUBNE LINE,LINE,#2
 B PLOTER2
ORGIN BL INTEXA
 STMFD SP!,{IACC}
 BL EXPRDN
 SWI WRITEI+29
 MOV R3,IACC
 LDMFD SP!,{R0} ;X
 BL WRITEG
 MOV R0,R3
 BL WRITEG
 B NXT
PLOT BL INTEXA
 MOV LINE,AELINE
PLOTER2 STMFD SP!,{IACC}
 BL INTEXA
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R3,R4} ;X,TYPE
 MOV R2,IACC
 MOV R0,R4
PLOTACT MOV R1,R3 ;action in R0, Y in R2, X in R3
 BL DOPLOT
 B NXT
PSET BL SPACES
 MOV IACC,#&45
 CMP R10,#TTO
 BNE PLOTER1
 BL INTEXA ;point to
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R1}
 STMFD SP!,{IACC}
 MOV R1,R1,LSL #16
 ORR R1,R1,#&500
 STMFD SP!,{R1}
 ADD R1,SP,#1
 MOV R0,#&15
 SWI WORD
 ADD SP,SP,#8
 B NXT
RECT MOV R0,#0
 MOV R1,#&65
 BL CHECKFILL
 STMFD SP!,{IACC}
 BL INTEXA
 STMFD SP!,{IACC} ;X
 BL INTEXC
 STMFD SP!,{IACC} ;Y
 BL EXPR
 BL INTEGY
 STMFD SP!,{IACC} ;W
 CMP R10,#","
 BNE RECTSIMPLE
 BL EXPR
 BL INTEGY
RECTSIMPLE LDMFD SP!,{R3,R4,R5}
 ADD R3,R5,R3 ;X+W
 ADD R6,R4,IACC ;Y+H
 CMP R10,#TTO
 BEQ RECTMOVE
 BL AEDONE
 MOV R0,#4
 MOV R1,R5
 MOV R2,R4
 BL DOPLOT ;move x,y
 LDMFD SP!,{R0}
 TEQ R0,#0
 MOVNE R2,R6
 BNE PLOTACT ;plot &65,x+w,y+h
 MOV R0,#13
 MOV R1,R3
 BL DOPLOT ;'draw' x+w,y
 MOV R0,#13
 MOV R2,R6
 BL DOPLOT ;'draw' x+w,y+h
 MOV R0,#13
 MOV R1,R5
 BL DOPLOT ;'draw' x,y+h
 MOV R0,#13
 MOV R2,R4
 BL DOPLOT ;'draw' x,y
 B NXT
RECTMOVE STMFD SP!,{R3,R4,R5,R6} ;x2, y, x, y2
 BL INTEXC
 STMFD SP!,{IACC}
 BL EXPRDN
 LDMFD SP!,{R3,R4,R5,R6,R7,TYPE}
 MOV AELINE,IACC
; r3: x3, r4: x2, r5: y, r6: x, r7: y2, TYPE: type, AELINE: y3
 MOV R0,#4
 MOV R1,R6
 MOV R2,R5
 BL DOPLOT ;move x,y
 MOV R0,#4
 MOV R1,R4
 MOV R2,R7
 BL DOPLOT ;move x2,y2
 TEQ TYPE,#0
 MOVEQ R0,#&BE
 MOVNE R0,#&BD
 MOV R1,R3
 MOV R2,AELINE
 BL DOPLOT ;plot q,x3,y3
 B NXT
DOTINT BL INTEXA
 STMFD SP!,{IACC}
 BL EXPRDN
 MOV R1,IACC
 LDMFD SP!,{IACC}
;TINT R0,R1
TINTEND SWI WRITEI+23
 SWI WRITEI+17
 SWI WRITEC
 MOV IACC,R1
 SWI WRITEC
 MOV R1,#6
 BL ZEROX
 B NXT
VDUP MOV IACC,IACC,LSR #8
 SWI WRITEC
VDU BL SPACES
VDUL CMP R10,#":"
 BEQ NXT
 CMP R10,#13
 BEQ NXT
 CMP R10,#TELSE
 BEQ NXT
 SUB AELINE,LINE,#1
 BL EXPR
 MOV LINE,AELINE
 BL INTEGY
 SWI WRITEC
 CMP R10,#","
 BEQ VDU
 CMP R10,#";"
 BEQ VDUP
 CMP R10,#"|"
 BNE VDUL
 MOV R1,#9
 BL ZEROX
 B VDU
WAIT BL DONES
 MOV R0,#19
 SWI BYTE
 B NXT
;plot r0,r1,r2: destroys R0
DOPLOT SWI XOSPLOT
 MOVVC PC,R14
 SWI GENERATEERROR
;write lo byte, high byte
WRITEG SWI WRITEC
 MOV R0,R0,LSR #8
 SWI WRITEC
 MOV PC,R14
;write R1 zeroes
ZEROX MOV R0,#0
ZEROX1 SWI WRITEC
 SUBS R1,R1,#1
 BGT ZEROX1
 MOV PC,R14
;overlay
OVERLAY BL AELV
 BEQ ERARRY
 CMP TYPE,#256+128
 BNE ERTYPESTRINGARRAY
 LDR TYPE,[IACC]
 CMP TYPE,#16
 BCC ERARRZ
 BL AEDONES
 BL GETARRAYSIZE1
 MOV AELINE,TYPE
 MOV R6,TYPE
 MOV R7,#0 ;maximum size used
OVERLAYSIZES MOV IACC,R6
 BL VARSTR
 SUB R4,CLEN,ARGP
 SUBS R4,R4,#STRACC
 BEQ OVERLAYSIZES1
 MOV R0,#13
 STRB R0,[CLEN]
 BL OSFILEINFOSTRACC
 CMP R0,#1
 BNE OVERLAYSIZES1
 CMP R4,R7
 MOVCS R7,R4
OVERLAYSIZES1 ADD R6,R6,#5
 SUBS R10,R10,#1
 BNE OVERLAYSIZES
 ADD R7,R7,#3
 BIC R7,R7,#3
 LDR R4,[ARGP,#FSA]
 ADD R6,R4,#12 ;3 words of data: Array Base, current overlay and size
 ADD R6,R6,R7
 ADD R5,R6,#1024
 CMP R5,SP
 BCS BADDIMSIZE
 LDR R0,[ARGP,#OVERPTR]
 TEQ R0,#0
 MOV R0,#0
 STRNE R0,[ARGP,#PROCPTR] ;forget all procedures or functions in case they are
 STRNE R0,[ARGP,#FNPTR] ;overlays already (if overlays existed!).
 STR R6,[ARGP,#FSA]
 STR R4,[ARGP,#OVERPTR] ;overlay pointer
 STR AELINE,[R4] ;Base of array: [,#-4] has size of array
 MVN R0,#0
 STR R0,[R4,#4] ;current overlay (-1=none)
 STR R7,[R4,#8] ;total size allowed for overlayed program
 LDRB R10,[LINE,#-1]
 B NXT
;file io
LEXT MOV R0,#3
 B LPTRA
LPTR MOV R0,#1
LPTRA STMFD SP!,{R0}
 BL AECHAN
 STMFD SP!,{IACC}
 MOV LINE,AELINE
 BL EQAEEX
 MOV R2,IACC
 LDMFD SP!,{R1}
 LDMFD SP!,{R0}
 SWI ARGS
 B NXT
BBPUT BL AECHAN
 BL AESPAC
 CMP R10,#","
 BNE ERCOMM
 STMFD SP!,{R1}
 BL EXPR
 TEQ TYPE,#0
 BEQ BBPUT1
 BLMI INTEGB
 BL AEDONE
 LDMFD SP!,{R1}
 SWI BPUT
 B NXT
BBPUT1 TEQ R10,#";"
 MOVNE R0,#10
 STRNEB R0,[CLEN],#1
 BLEQ AESPAC
 BL AEDONE
 MOV R5,CLEN
 MOV R0,#2
 LDMFD SP!,{R1}
 ADD R2,ARGP,#STRACC
 SUBS R3,R5,R2
 SWINE MULTIPLE
 B NXT
CLOSE BL AECHAN
 BL AESPAC
 BL AEDONE
 MOV R0,#0
 SWI OPEN
 B NXT
INPUTH MOV AELINE,LINE
 BL CHANNL
 STMFD SP!,{IACC} ;save channel as TOS
INPHLP MOV LINE,AELINE
 BL SPACES
 CMP R10,#","
 BNE INPHEX
 BL CRAELV
 BEQ ERSYNT
 MOV R4,IACC
 MOV R5,TYPE
 LDR R1,[SP] ;channel
ENDOFFILE SWI BGET
 BCS ENDOFFILE
 CMP R5,#128
 BCC INPHNO ;branch if input to number
 MOVS TYPE,R0,LSL #24
 BNE ERTYPESTR ;wanted string
 SWI BGET
 TEQ R0,#0
 ADD CLEN,ARGP,#STRACC
 ADD CLEN,CLEN,R0
 BEQ INPHSS
 MOV R3,R0
 MOV R6,CLEN
INPHSL SWI BGET
 STRB R0,[R6,#-1]!
 SUBS R3,R3,#1
 BNE INPHSL
 B INPHSS
INPHNO MOVS TYPE,R0,LSL #24
 BEQ ERTYPEINT ;wanted number
 BMI INPHNF ;read floating
 SWI BGET
 MOV R2,R0,LSL #24
 SWI BGET
 ORR R2,R2,R0,LSL #16
 SWI BGET
 ORR R2,R2,R0,LSL #8
 SWI BGET
 ORR R0,R2,R0
INPHSS BL STOREA
 B INPHLP
INPHNF CMP R0,#&88 ;new FP?
 MOVEQ R3,#8 ;yes
 MOVNE R3,#5 ;no
 ADD TYPE,ARGP,#STRACC
 MOV R2,#0
INPHFP SWI BGET
 STRB R0,[TYPE,R2]
 ADD R2,R2,#1
 CMP R2,R3
 BNE INPHFP
 CMP R3,#8
 BEQ INPHFP8
 [ FP=0
 LDMIA TYPE,{FACC,FACCX}
 AND FSIGN,FACC,#&80000000
 ANDS FACCX,FACCX,#255
 TEQEQ FACC,#0
 ORRNE FACC,FACC,#&80000000
 |
 LDMIA TYPE,{IACC,R1}
 ANDS R1,R1,#255
 AND R2,IACC,#TFP
 TEQEQ IACC,#0
 ORRNE IACC,IACC,#TFP
 SUB R1,R1,#&82 ;remove 5 byte bias
 ADD R1,R1,#&400 ;add D format bias
 ORR R2,R2,R1,LSL #20
 MOV R1,#0
 BL FCONVERT2 ;either MI or EQ, so quicker
 ]
 MOV TYPE,#TFP
 B INPHSS
INPHFP8
 [ FP=0
 LDMIA TYPE,{FGRD,TYPE}
 AND FSIGN,FGRD,#TFP
 MOV FACCX,FGRD,LSR #20
 BIC FACCX,FACCX,#&800
 SUB FACCX,FACCX,#&400
 ADD FACCX,FACCX,#&82
 MOVS FACC,FGRD,LSL #11
 ORRS FACC,FACC,TYPE,LSR #21
 TEQEQ FACCX,#0
 ORRNE FACC,FACC,#TFP
 TEQ FACCX,#0
 MOVMI FACCX,#0
 MOVMI FACC,#0
 CMP FACCX,#256
 MOVCS FACCX,#255
 MVNCS FACC,#0
 |
 LDFD FACC,[TYPE]
 ]
 MOV TYPE,#TFP
 B INPHSS
PRTHEX MOV LINE,AELINE
INPHEX ADD SP,SP,#4 ;remove thing
 B DONEXT
PRINTH MOV AELINE,LINE
 BL CHANNL
 STMFD SP!,{IACC} ;save handle
 BL AESPAC
PRTHLP CMP R10,#","
 BNE PRTHEX
 BL EXPR
 [ FP=0
 BL FTOW ;move r0,r1,r3 to r4,r5,r7
 MOV R0,TYPE,LSR #24
 LDR R1,[SP]
 SWI BPUT
 TEQ TYPE,#0
 BEQ PRTHS
 BMI PRTHF
 |
 MOV R4,IACC
 TEQ TYPE,#0
 BMI PRTHF
 MOV R0,TYPE,LSR #24
 LDR R1,[SP]
 SWI BPUT
 TEQ TYPE,#0
 BEQ PRTHS
 ]
 MOV R0,R4,LSR #24
 SWI BPUT
 MOV R0,R4,LSR #16
 SWI BPUT
 MOV R0,R4,LSR #8
 SWI BPUT
 MOV R0,R4
 SWI BPUT
 B PRTHLP
PRTHS ADD R3,ARGP,#STRACC
 SUB R0,CLEN,R3
 SWI BPUT
 TEQ R0,#0
 BEQ PRTHLP
PRTHSL LDRB R0,[CLEN,#-1]!
 SWI BPUT
 TEQ CLEN,R3
 BNE PRTHSL
 B PRTHLP
 [ FP=0
PRTHF ADD TYPE,ARGP,#STRACC
 BL FWTOA
 BL F1STA
 ADD CLEN,TYPE,#5
 |
PRTHF MOV R0,#&88
 LDR R1,[SP]
 SWI BPUT
 ADD TYPE,ARGP,#STRACC
 STFD FACC,[TYPE]
 ADD CLEN,TYPE,#8
 ]
 LDR R1,[SP]
PRTHFL LDRB R0,[TYPE],#1
 SWI BPUT
 TEQ TYPE,CLEN
 BNE PRTHFL
 B PRTHLP
LIBRARY BL LIBSUB
 LDR R3,[ARGP,#LIBRARYLIST]
 STR R2,[ARGP,#LIBRARYLIST] ;link in at list head
 STR R3,[R2],#4
 [ CHECKCRUNCH=1
 BL CRUNCHCHK
 BEQ NOLIBCRUNCH
 ]
 MOV R0,#SAFECRUNCH
 MOV R1,R2
 STMFD SP!,{R10}
 BL CRUNCHROUTINE
 ADD R2,R2,#3
 BIC R2,R2,#3
 STR R2,[ARGP,#FSA]
 LDMFD SP!,{R10}
 B NXT
 [ CHECKCRUNCH=1
NOLIBCRUNCH ADD R2,R2,R4
 STR R2,[ARGP,#FSA]
 B NXT
 ]
;load library to heap top: return length in R4
LIBSUB STMFD SP!,{R14}
 BL AEEXPR
 BL OSSTRI
 BL AEDONE
 BL OSFILEINFO
 CMP R0,#1
 BNE LIBSUB1
 ADD R4,R4,#3
 BIC R4,R4,#3
 LDR R2,[ARGP,#FSA]
 ADD R0,R2,#4
 ADD R3,R0,R4
 ADD R3,R3,#1024
 CMP R3,SP
 BCS NOLIBROOM
LIBSUB1 STMFD SP!,{R0,R2,R4}
 ADD R2,R2,#4
 BL OSFILELOAD
 LDMFD SP!,{R0,R2,R4}
LIBTOP LDRB R1,[R0]
 CMP R1,#13
 BNE BADPRO1
 LDRB R1,[R0,#1]
 CMP R1,#&FF
 LDMEQFD SP!,{PC}
 LDRB R1,[R0,#3]
 CMP R1,#4
 ADDCS R0,R0,R1
 BCS LIBTOP
 B BADPRO1
OSCL BL AEEXPR
 BL OSSTRI
 BL AEDONE
 ADD R0,ARGP,#STRACC
 BL OSCLIREGS
 SWI CLI
 B NXT
SYSNAME ADD R1,ARGP,#STRACC
 MOV R0,#0
 STRB R0,[CLEN]
 SWI SWINUMBERFROMSTRING
 B SYSGOTSWINUMB
SYS0STRING MOV R0,#0
 STRB R0,[CLEN],#1
 LDR R7,[ARGP,#FSA]
 LDMFD SP!,{R0,R4,R5,R6}
 STMIA R7!,{R0,R4,R5,R6}
 LDMFD SP!,{R0,R4,R5,R6}
 STMIA R7!,{R0,R4,R5,R6}
 LDMFD SP!,{R0,R4,R5,R6}
 STMIA R7!,{R0,R4,R5,R6} ;move 12 words from stack to free memory
 BL SPUSH
 LDMDB R7!,{R0,R4,R5,R6} ;move 12 words back from free memory
 STMFD SP!,{R0,R4,R5,R6}
 LDMDB R7!,{R0,R4,R5,R6}
 STMFD SP!,{R0,R4,R5,R6}
 LDMDB R7!,{R0,R4,R5,R6}
 STMFD SP!,{R0,R4,R5,R6}
 ADD IACC,SP,#11*4+4+4 ;11 words on stack plus string length plus R4
 B SYS0PUSH
SYS BL AEEXPR
 TEQ TYPE,#0
 BEQ SYSNAME
 BLMI SFIX
SYSGOTSWINUMB MOV TYPE,SP ;initial SP in R9/TYPE
 STMFD SP!,{IACC} ;save action
 MOV R4,#0
 MOV R5,#0
 MOV R6,#0
 MOV R7,#0
 STMFD SP!,{R4-R7,R9} ;R9=TYPE
 STMFD SP!,{R4-R7}
 STMFD SP!,{R4,R5} ;save 10 register holes and old sp
 CMP R10,#","
 BNE SYSCALL
;note R4 (SYS register index) already 0
SYS0 CMP R4,#10
 BCS ERSYSINPUTS
SYS0SPACES LDRB R10,[AELINE],#1
 CMP R10,#" "
 BEQ SYS0SPACES
 CMP R10,#","
 BEQ SYS0END
 STMFD SP!,{R4}
 SUB AELINE,AELINE,#1
 BL EXPR
 TEQ TYPE,#0
 BEQ SYS0STRING
 BLMI SFIX
SYS0PUSH LDMFD SP!,{R4}
 STR IACC,[SP,R4,LSL #2]
SYS0END ADD R4,R4,#1
 CMP R10,#","
 BEQ SYS0
SYSCALL MOV LINE,AELINE
 [ STRONGARM = 1
 ADD AELINE,ARGP,#SWICODE
 LDR R4,[SP,#10*4] ;old sp
 LDR R5,[R4,#-4] ;SWI call value
 BIC R5,R5,#&FF000000
 ORR R5,R5,#&EF000000	;SWI like what's already there :-)
 STR R5,[ARGP,#SWICODE]
 |
 ADD AELINE,ARGP,#STRACC
 LDR R4,[SP,#10*4] ;old sp
 LDR R5,[R4,#-4] ;SWI call value
 BIC R5,R5,#&FF000000
 LDR R6,SYSDATA
 ORR R6,R6,R5
 STR R6,[AELINE]
 LDR R6,SYSDATA+4
 STR R6,[AELINE,#4]
 ]
 CMP R10,#TTO
 BEQ SYSCALLTO
 BL DONE
 LDMFD SP!,{R0-R9} ;get parameters from stack
 MOV R14,PC
 MOV PC,AELINE
 MOV ARGP,#VARS
 LDR SP,[SP] ;pop stack and continue
 B NXT
SYSCALLTO LDMFD SP!,{R0-R9} ;get parameters from stack
 MOV R14,PC
 MOV PC,AELINE
 STMFD SP!,{R0-R9,PC} ;write parameters back to stack
 MOV ARGP,#VARS
 MOV R7,#0
SYS1 CMP R7,#10
 BCS ERSYSOUTPUTS
 STMFD SP!,{R7}
 BL CRAELV
 LDMFD SP!,{R7}
 BEQ SYS1COMMA
 MOV R4,IACC
 MOV R5,TYPE
 LDR IACC,[SP,R7,LSL #2]
 MOV TYPE,#TINTEGER
 CMP R5,#128
 BCC SYS1END
 MOV TYPE,#0
 ADD CLEN,ARGP,#STRACC
 ADD R3,CLEN,#256
SYS1STRING LDRB R1,[IACC],#1
 STRB R1,[CLEN],#1
 TEQ CLEN,R3
 TEQNE R1,#13
 TEQNE R1,#0
 TEQNE R1,#10
 BNE SYS1STRING
 TEQ CLEN,R3
 SUBEQ CLEN,CLEN,#255
 SUB CLEN,CLEN,#1
SYS1END STMFD SP!,{R7}
 BL STOREA
 LDMFD SP!,{R7}
SYS1ENDA ADD R7,R7,#1
 MOV LINE,AELINE
SYS1SPACES LDRB R10,[LINE],#1
 CMP R10,#" "
 BEQ SYS1SPACES
 CMP R10,#","
 BEQ SYS1
 CMP R10,#";"
 BNE SYSEXIT
 BL CRAELV
 BEQ ERSYNT
 MOV R4,IACC
 MOV R5,TYPE
 LDR IACC,[SP,#10*4]
 MOV IACC,IACC,LSR #28
 MOV TYPE,#TINTEGER
 BL STOREA
 MOV LINE,AELINE
 BL SPACES
SYSEXIT LDR SP,[SP,#11*4] ;recover old SP
 B DONEXT
SYS1COMMA BL SPACES
 CMP R10,#","
 CMPNE R10,#";"
 SUBEQ AELINE,LINE,#1
 BEQ SYS1ENDA
 B ERSYNT
 [ STRONGARM = 0
SYSDATA SWI 0
 MOV PC,R14
 ]
CALL BL AEEXPR
 BL INTEGY
 CMP R10,#","
 BEQ CALLARM
 BL AEDONE
 MOV TYPE,IACC
 [ FP=0
 BL EMUMOS
 BNE NXT
 ]
 MOV R4,TYPE
 MOV R5,#0
 B CALLARMGO
CALLARM MOV R4,IACC
 MOV R5,#0
CALLARMPARM STMFD SP!,{R4,R5}
 MOV LINE,AELINE
 BL CRAELV
 BEQ ERSYNT
 LDMFD SP!,{R4,R5}
 ADD R5,R5,#1
 STMFD SP!,{IACC,TYPE}
 BL AESPAC
 CMP R10,#","
 BEQ CALLARMPARM
 BL AEDONE
;Go to ARM code
CALLARMGO BL CALLARMROUT
 B NXT
CALLARMROUT MOV TYPE,SP ;pointer to list of lvs
 STMFD SP!,{R4,R5,ARGP,AELINE,LINE,R10,R14}
 MOV R10,R5 ;number
 ADD R11,ARGP,#STRACC
 ADDS R0,ARGP,#INTVAR+4
 LDMIA R0,{R0-R7} ;A%-H%
 ADR R14,CALL2
 LDMFD SP!,{PC} ;go there!
OSCLIREGS ADR R5,CALL2
 MOV R4,SP
 MOV R3,LINE
 MOV R2,ARGP
 LDR R1,[R5,#-4]
 MOV PC,R14
;enter user with:
;r8  points to basic's ARGP workspace
;r9  pointer to list of lvs
;r10 number of lvs
;r11 STRACC
;r12 LINE
;r13 points to FD stack
;r14 link back to ab
CALL2REAL LDMFD SP!,{R5,ARGP,AELINE,LINE,R10,R14}
 ADD SP,SP,R5,LSL #3 ;pop stack by two words per parameter
 MOVVC PC,R14
 BIC R14,R0,#&FC000003
 B MSGERR
 DCD &BA51C005
CALL2 B CALL2REAL ;0th entry in table is return address
;words offset from ARGP
 & STRACC
 & PAGE
 & TOP
 & LOMEM
 & HIMEM
 & MEMLIMIT
 & FSA
 & TALLY
 & TRACEFILE
 & ESCWORD
 & WIDTHLOC
;internal basic routines
 B VARIND
 B STOREA
 B STSTORE
 B EXTLVBLNK
 B CREATE
 B EXTEXPR
 B CLIENTMATCH
 B TOKENADDR
 & 0
 [ FP=0
 & 9
 B F1STA
 B F1LDA
 B F1ADD
 B F1XSUB
 B F1MUL
 B F1XDIV
 B FLOATB
 B INTEGB
 B FSQRT
 ]
;special EXPR routine to deal with cache
EXTEXPR STMFD SP!,{AELINE,R14}
 BL EXPR
 LDMFD SP!,{R4}
 BL PURGECACHE
 TEQ TYPE,#0
 LDMFD SP!,{PC}
;special LVBLNK routine to deal with cache
EXTLVBLNK STMFD SP!,{AELINE,R14}
 BL LVBLNK
 ADDEQ SP,SP,#4
 LDMNEFD SP!,{R4}
 BLNE PURGECACHE
 LDMFD SP!,{PC}
 [ FP=0
;MOS emulation of r9 call
EMUMOS MOV R7,R9,LSR #8
 TEQ R7,#&FF
 BNE NOTMOS
 AND R7,R9,#&FF
 TEQ R7,#&E0
 BEQ MOSRDCH
 LDR R0,[ARGP,#INTVAR+4]
;'A' only
 TEQ R7,#&EE
 BEQ MOSWRCH
 TEQ R7,#&E7
 BEQ MOSNEWL
 TEQ R7,#&E3
 BEQ MOSASCI
 LDR R1,[ARGP,#INTVAR+("X"-"@")*4]
 LDR R2,[ARGP,#INTVAR+("Y"-"@")*4]
;'A X Y' only
 TEQ R7,#&F4
 BEQ MOSBYTE
 TEQ R7,#&D7
 BEQ MOSBGET
 TEQ R7,#&D4
 BEQ MOSBPUT
;'A address'
 CMP R1,#256
 ORRCC R1,R1,R2,LSL #8
 TEQ R7,#&F1
 BEQ MOSWORD
 TEQ R7,#&F7
 BEQ MOSCLI
 TEQ R7,#&DD
 BEQ MOSFILE
 TEQ R7,#&DA
 BEQ MOSARGS
 TEQ R7,#&D1
 BEQ MOSGBPB
 TEQ R7,#&CE
 BNE NOTMOS
 SWI OPEN ;osfind
 B RETMOS
MOSGBPB MOV R7,R1
 MOV R5,#12
MOSGP1 LDRB R4,[R7,R5]
 STRB R4,[SP,#-1]!
 SUBS R5,R5,#1
 BNE MOSGP1
 LDRB R1,[R7]
 LDMFD SP!,{R2,R3,R4}
 SWI MULTIPLE
 STMFD SP!,{R2,R3,R4}
 MOV R5,#1
MOSGP2 LDRB R4,[SP],#1
 STRB R4,[R7,R5]
 ADD R5,R5,#1
 TEQ R5,#13
 BNE MOSGP2
 B RETMOS
MOSBPUT MOV R1,R2
 SWI BPUT
 B RETMOS
MOSBGET MOV R1,R2
 SWI BGET
 B RETMOS
MOSARGS MOV R1,R2
 SWI ARGS
 B RETMOS
MOSFILE MOV R7,R1
 MOV R5,#17
MOSFL1 LDRB R4,[R7,R5]
 STRB R4,[SP,#-1]!
 SUB R5,R5,#1
 CMP R5,#1
 BNE MOSFL1
 LDRB R2,[R7,#1]
 LDRB R1,[R7]
 ORR R1,R1,R2,LSL #8
 LDMFD SP!,{R2,R3,R4,R5}
 SWI FILE
 STMFD SP!,{R2,R3,R4,R5}
 MOV R5,#2
MOSFL2 LDRB R4,[SP],#1
 STRB R4,[R7,R5]
 ADD R5,R5,#1
 TEQ R5,#18
 BNE MOSFL2
 B RETMOS
MOSRDCH SWI READC
 B RETMOS
MOSNEWL SWI NEWLINE
 B RETMOS
MOSASCI TEQ R0,#13
 SWIEQ WRITEI+10
MOSWRCH SWI WRITEC
 B RETMOS
MOSWORD SWI WORD
 B RETMOS
MOSBYTE SWI BYTE
 B RETMOS
MOSCLI MOV R0,R1
 SWI CLI
RETMOS AND R0,R0,#&FF
 AND R1,R1,#&FF
 AND R2,R2,#&FF
 ORR R0,R0,R1,LSL #8
 ORR R0,R0,R2,LSL #16
 ORRCS R0,R0,#&1000000
 MOVS TYPE,#TINTEGER
 MOV PC,R14
NOTMOS MOVS R0,#0
 MOV PC,R14
 ]
QUIT BL DONES
 SWI EXIT
MUNGIG LDRB R10,[LINE],#1
 CMP R10,#13
 BNE MUNGIG
MUNGNL LDRB R10,[LINE],#1
 ADD LINE,LINE,#2
 CMP R10,#&FF
 BNE MUNGLE1
 SUB LINE,LINE,#4
 MOV PC,R14 ;exit with pointer to the cr
MUNGLE LDR R10,[ARGP,#ESCWORD]
 TST R10,#&8000
 BNE MUNGLESLOW
MUNGLE1 LDRB R10,[LINE],#1
 CMP R10,#" "
 CMPNE R10,#":"
 BEQ MUNGLE1
 CMP R10,#13
 BEQ MUNGNL
 CMP R10,#TELSE
 CMPNE R10,#TREM
 CMPNE R10,#TDEF
 CMPNE R10,#TDATA
 BEQ MUNGIG
 SUB LINE,LINE,#1
MUNGLESLOW LDR R10,[ARGP,#FSA]
 ADD R10,R10,#1024
 CMP R10,SP
 MOVCC PC,R14
 B ERDEEPNEST
;process exceptional condition
;entry with r4 as the controller
;must not destroy r0 or UNTIL will not work
DOEXCEPTION TST R4,#&80 ;check for escape itself
 BNE ESCAPE
 TST R4,#&8000
 BNE DOTRACE
 MOV R4,#0
 STR R4,[ARGP,#ESCWORD]
 B EREXCEPT
DOTRACE LDRB R4,[LINE,#-4]
 CMP R4,#13
 MOVNE PC,R14 ;not at a place where number can be shown
 LDR R5,[ARGP,#TRCNUM] ;check for trace type
 BICS R4,R5,#&FF000000 ;quick check for 0...
 MOVEQ PC,R14 ;if trcnum 0 then no line number trace
 LDRB R4,[LINE,#-3]
 LDRB R6,[LINE,#-2]
 ADD R4,R6,R4,LSL #8
 BIC R6,R5,#&FF000000 ;clear extra bits
 CMP R4,R6
 MOVGT PC,R14 ;tracing numbers but not in range
 STMFD SP!,{R0,R7,R14}
 MOV R0,R4
 LDR TYPE,[ARGP,#TRACEFILE]
 CMP TYPE,#0
 MOVNE TYPE,#&8000 ;sets TYPE for chout in posite
 MOV R7,#128 ;sets R7 for chout in posite
 BLEQ TRCSTART
 BL POSITE ;output number
 BL TRCEND
 LDMFD SP!,{R0,R7,PC}
;store system
STORE LDMFD SP!,{R4,R5}
STOREA CMP R5,#TFPLV
 BHI STSTOR
 BEQ FPSTOR
 TEQ TYPE,#0
 BEQ ERTYPEINT
 [ FP=0
 BMI STOREINT1
STOREANINT CMP R5,#4
 BNE BYTSTO
 TST R4,#3
 STREQ IACC,[R4]
 MOVEQ PC,R14
STORER0MISAL MOV R1,IACC,LSR #8
 STRB R1,[R4,#1]
 MOV R1,IACC,LSR #16
 STRB R1,[R4,#2]
 MOV R1,IACC,LSR #24
 STRB R1,[R4,#3]
BYTSTO STRB IACC,[R4]
 MOV PC,R14
STOREINT1 SUBS FACCX,FACCX,#&80 ;subtract bias
 MOVLS FACC,#0
 BLS STOREINT0 ;branch if too small
 RSBS FACCX,FACCX,#32 ;decide whether possible
 BLS STOREINT2 ;too large (but check carefully for maximum negative integer)
 MOV FACC,FACC,LSR FACCX ;shift by exponent
 TEQ FSIGN,#0 ;check sign
 RSBMI FACC,FACC,#0 ;negate
STOREINT0 CMP R5,#4
 BNE BYTSTO
 TST R4,#3
 STREQ IACC,[R4]
 MOVEQ PC,R14
 STRB IACC,[R4]
 MOV R2,IACC,LSR #8
 STRB R2,[R4,#1]
 MOV R2,IACC,LSR #16
 STRB R2,[R4,#2]
 MOV R2,IACC,LSR #24
 STRB R2,[R4,#3]
 MOV PC,R14
STOREINT2 BNE FOVR ;modulus greater than 2^32
 TEQ FSIGN,#0
 BPL FOVR ;positive
 CMP FACC,#TFP
 BEQ STOREINT0 ;-2^31
 B FOVR
 |
 FIXMIDZ IACC,FACC
STOREANINT CMP R5,#4
 BNE BYTSTO
 TST R4,#3
 STREQ IACC,[R4]
 MOVEQ PC,R14
STORER0MISAL MOV R1,IACC,LSR #8
 STRB R1,[R4,#1]
 MOV R1,IACC,LSR #16
 STRB R1,[R4,#2]
 MOV R1,IACC,LSR #24
 STRB R1,[R4,#3]
BYTSTO STRB IACC,[R4]
 MOV PC,R14
 ]
FPSTOR TEQ TYPE,#0
 BPL FPSTOR1
 [ FP=0
F1STABYR4 BIC FGRD,FACC,#&80000000
 ORR FGRD,FGRD,FSIGN ;fsign only 0 or &80000000!
 TST R4,#2
 BNE FPSTORA2
 STRB FACCX,[R4,#4]
 TST R4,#1
 STREQ FGRD,[R4]
 MOVEQ PC,R14
 LDRB FSIGN,[R4,#-1]
 ORR FSIGN,FSIGN,FGRD,LSL #8
 STR FSIGN,[R4,#-1]
 MOV FSIGN,FGRD,LSR #24
 STRB FSIGN,[R4,#3]
 |
 STFD FACC,[R4]
 ]
 MOV PC,R14
 [ FP=0
FPSTORA21 MOV R14,TYPE
FPSTORA2 STRB FGRD,[R4]
 MOV FGRD,FGRD,LSR #8
 ORR FGRD,FGRD,FACCX,LSL #24
 TST R4,#1
 STRNE FGRD,[R4,#1]
 MOVNE PC,R14
 STRB FGRD,[R4,#1]
 MOV FGRD,FGRD,LSR #8
 LDRB FSIGN,[R4,#5]
 ORR FSIGN,FGRD,FSIGN,LSL #24
 STR FSIGN,[R4,#2]
 MOV PC,R14
 ]
FPSTOR1 BEQ ERTYPEINT
 [ FP=0
 MOV TYPE,R14
 BL IFLT
 BIC FGRD,FACC,#&80000000
 ORR FGRD,FGRD,FSIGN ;fsign only 0 or &80000000!
 TST R4,#2
 BNE FPSTORA21
 STRB FACCX,[R4,#4]
 TST R4,#1
 STREQ FGRD,[R4]
 MOVEQ PC,TYPE
 LDRB FSIGN,[R4,#-1]
 ORR FSIGN,FSIGN,FGRD,LSL #8
 STR FSIGN,[R4,#-1]
 MOV FSIGN,FGRD,LSR #24
 STRB FSIGN,[R4,#3]
 MOV PC,TYPE
 |
 FLTD FACC,IACC
 STFD FACC,[R4]
 MOV PC,R14
 ]
STSTOR CMP R5,#256
 BCS ERVARAR
 TEQ TYPE,#0
 BNE ERTYPESTR
 CMP R5,#128
 BNE ROPSTOR
 ADD R3,ARGP,#STRACC
;store string, doing reallocate
;r4: address of string information block (preserved)
;r2/clen: length of string (address of end) (preserved)
;r3: address of start of string (preserved)
;uses r0,r1,r5,r6,r7
STSTORE LOAD IACC,R4,R5,R1 ;entry from function return and local
 LDRB R1,[R4,#4] ;get current length
 ADD R1,R1,#3
 BIC R1,R1,#3 ;round current length to words
 SUB R5,CLEN,R3
 ADD R5,R5,#3
 BIC R5,R5,#3 ;r5=length required (OR 0)
 CMP R5,R1
 BEQ ALLOCY ;no need to fiddle with allocation
CONTIGUITY * 2
;0 BASIC 1.02 contiguity check
;1 entirely omitted check
;2 contiguity check but no extending allocation
 [ CONTIGUITY=0
 LDR R6,[ARGP,#FSA] ;get free space pointer
 ADD R7,R1,IACC ;compute end of current string area
 TEQ R7,R6 ;does end of current string match free space?
 BEQ ALLOCEXTEND ;yes, so just add/subtract a few words
 ADD R6,ARGP,#FREELIST-4
 ]
 [ CONTIGUITY=2
 LDR R6,[ARGP,#FSA] ;get free space pointer
 ADD R7,R1,IACC ;compute end of current string area
 TEQ R7,R6 ;does end of current string match free space?
 ADD R6,ARGP,#FREELIST-4
 STREQ IACC,[ARGP,#FSA] ;yes, so reduce free space pointer
 BEQ REALLOCATE2
 ]
 [ CONTIGUITY=1
 ADD R6,ARGP,#FREELIST-4
 ]
 CMP R1,#0
 BEQ REALLOCATE ;no size to deallocate
;Deallocate the old chunk to the right free list: all possible chunk sizes
;live on their own free list, i.e. one list for sizes 4..256 so that
;reallocation does not involve searching. Also the minimum allocation size is
;one word since entries in the free lists do not need to have the sizes.
COAL * 0 ;coalesce deallocates if 1
FOAL * 0 ;fragment allocates if 1
 [ COAL=1
;Try a small amount of coalescing by checking the top of each list in the
;range 4 to 256-i.

;R0 block addr; R1 block len (words); R2 byte len of new string; R3 addr of new
;R4 sib addr; R5 new len (words); R6 freelists; r7 null
 RSBS R5,R1,#256
 BEQ COALESCEZ ;largest block won't coalesce with anything
 ADD R1,R1,FACC ;block end address
COALESCE LDR R7,[R6,R5]
 CMP R1,R7 ;end of block = start of entry?
 BEQ COALESCES
 ADD R7,R7,R5 ;end of entry
 CMP FACC,R7 ;= start of block?
 BEQ COALESCEE
 SUBS R5,R5,#4
 BEQ COALESCEX
 LDR R7,[R6,R5]
 CMP R1,R7 ;end of block = start of entry?
 BEQ COALESCES
 ADD R7,R7,R5 ;end of entry
 CMP FACC,R7 ;= start of block?
 BEQ COALESCEE
 SUBS R5,R5,#4
 BNE COALESCE
COALESCEX SUB R1,R1,FACC ;failed to coalesce: recompute dull freelist entry
 ]
COALESCEZ LDR R7,[R6,R1] ;deallocate old block by inserting at head of list
;free list has pointer to next or 0
 STR IACC,[R6,R1] ;point list to me
 STR R7,[IACC] ;point me to rest of list
 [ COAL=1
 SUB R5,CLEN,R3
 ADD R5,R5,#3
REALLOCATE2 BICS R5,R5,#3 ;recomputed r5
 |
REALLOCATE2 TEQ R5,#0
 ]
 BEQ STSTEX ;no size to reallocate for
;reallocate by looking at free list sizes >= R5
REALLOCATE LDR IACC,[R6,R5]
 TEQ IACC,#0
 LDRNE R1,[IACC]
 STRNE R1,[R6,R5] ;unlink the found block
 BNE ALLOCOLDQ ;something on the right list!!!
 [ FOAL=1
 MOV R7,R5
 MOV R1,R5
 CMP R1,#8
 MOVCC R1,#8
 ADD R7,R7,R1
 CMP R7,#256
 BCS REALLOCATE2
REALLOCATE1 LDR FACC,[R6,R7]
 TEQ FACC,#0
 BNE ALLOCOLD ;something on a list!!!
 ADD R7,R7,#4
 CMP R7,#256
 BCC REALLOCATE1
REALLOCATE2 MOV R7,#256
 LDR FACC,[R6,R7]
 TEQ FACC,#0
 BNE ALLOCOLD ;something on biggest list!!!
 ]
 LDR IACC,[ARGP,#FSA] ;allocate brand new space
 ADD R1,IACC,R5
 ADD R5,R1,#512
 CMP R5,SP
 STRCC R1,[ARGP,#FSA] ;update free space used
 BCC ALLOCOLDQ
 MOV R1,#0 ;won't fit - but have deallocated old string!
 STRB R1,[R4,#4] ;mark length as zero....
 B ALLOCR
 [ COAL=1
COALESCES SUB R1,R1,FACC ;block length
 LDR R7,[R7]
 ADD R1,R1,R5 ;total length to deallocate
 STR R7,[R6,R5] ;unlink coalesce-ee
 B COALESCEZ
COALESCEE SUB FACC,R7,R5 ;replace start of block by start of entry
 LDR R7,[FACC]
 SUB R1,R1,FACC ;total length to deallocate
 STR R7,[R6,R5] ;unlink coalesce-ee
 B COALESCEZ
 ]
 [ CONTIGUITY=0
ALLOCEXTEND ADD R1,FACC,R5
 ADD R5,R1,#512
 CMP R5,SP
 STRCC R1,[ARGP,#FSA] ;update free space used
 BCC ALLOCX ;ok
 B ALLOCR
 ]
 [ FOAL=1
ALLOCOLD LDR R1,[FACC]
 STR R1,[R6,R7] ;unlink the found block
 SUBS R7,R7,R5 ;calculate remainder left unused
 LDRNE R1,[R6,R7] ;if any remainder, access correct list
 STRNE R1,[R5,FACC]! ;attach to tail of block
 STRNE R5,[R6,R7] ;insert tail of block address into correct list
 ]
ALLOCOLDQ STRB IACC,[R4]
 MOV R1,IACC,LSR #8
 STRB R1,[R4,#1]
 MOV R1,IACC,LSR #16
 STRB R1,[R4,#2]
 MOV R1,IACC,LSR #24
 STRB R1,[R4,#3] ;new address
ALLOCX MOV R1,R3
 SUB R5,CLEN,R3
 STRB R5,[R4,#4] ;write new length
STSTMV LDR R5,[R1],#4
 STR R5,[IACC],#4
 CMP R1,CLEN
 MOVCS PC,R14
 LDR R5,[R1],#4
 STR R5,[IACC],#4
 CMP R1,CLEN
 BCC STSTMV
 MOV PC,R14
STSTEX SUB R0,CLEN,R3
 STRB R0,[R4,#4] ;write new length
 MOV PC,R14
ALLOCY CMP R5,#0
 BNE ALLOCX
; STRB R5,[R4,#4] if R5 zero, R1 must have been 0 already!
 MOV PC,R14
ROPSTOR CMP R4,#&8000
 BCC ERDOLL
 ADD R0,ARGP,#STRACC
 TEQ R0,CLEN
 BEQ ROPSTX
ROPMOV LDRB R1,[R0],#1
 STRB R1,[R4],#1
 TEQ R0,CLEN
 BNE ROPMOV
ROPSTX MOV R1,#13
 STRB R1,[R4],#1
 MOV PC,R14
 LNK Array
