          Globsize = 0

          Start = 1 << 2

          HostProc = 2 << 2

          StartInit = 3 << 2

          Stacksize = 4 << 2

          BrkEsc = 5 << 2

          Instring = 8 << 2

          Outstring= 9 <<2

          Result2 = 13 << 2

          LineBuff = 17 << 2

          Input = 27 <<2

          Cis = 31 << 2

          Cos = 32 << 2

          ReturnCode = 39 << 2

          Stackbase = 40 << 2

          HeapDescriptor = 57 << 2

          Abort = 63 << 2

          Backtrace = 64 << 2

          Fault = 95 << 2

          Loadpoint = 142 << 2

          Libterminateio = 143 << 2

          TopStore = 148 << 2



          .entry    enter

          .AREA     Code

          .include  "regnames"

          .include  "swinames"

          .include  "adr"

          rbcpl     = r4

          rmg       = r5

          rsect     = r6

          rbase     = r8

enter:    b         firstoff

St:       .ascii    "BCPL"

          .long     globinits - St

          .ascii    "bcplroot"

          .ascii    "14 Mar 90 00-00-00  "

          .long     0

          .long     -1

          .ascic    "Initial"

initial:  .LONG     0

firstoff: ldr       r8, [pc,#initial-$-8]

          ADR       r1, St

          mov       rmg, #100

          ldr       rbcpl, [r1]

sectlp1:  mov       rsect, a1

          ldmfd     a1, {a2, a3}        ;?"BCPL", glob

          cmp       a2, rbcpl           ; unless a1!1 = "BCPL" break

          bne       notsect

          add       a1, a3, a1          ; a1 := globinits

gl1:      ldmfd     a1!, {a2, a3}

          cmp       a3, #0              ; until a1!1 = 0 do a1 +:= 2

          bne       gl1

          cmp       a2, rmg

          movge     rmg, a2

          ldr       a3, [a1]

          ldr       a2, [pc,#onetwo-$-8]

          cmp       a2, a3

          bne       sectlp1             ; no relocations

          ldr       a2, [pc,#eightsev-$-8]

          add       a1, a1, #4

          cmp       rb, #0

          bne       norel

reloc:    ldmfd     a1!, {a3}

          cmp       a2, a3              ;until !a1 = eightsev

          ldrne     r0, [rsect, a3]

          addne     r0, r0, rsect

          strne     r0, [rsect, a3]     ;rsect!(!a1) +:= rsect

          bne       reloc

          b         sectlp1

onetwo:   .long     0x12345678

eightsev: .long     0x87654321

norel:    ldmfd     a1!, {a3}

          cmp       a2, a3

          bne       norel

          b         sectlp1

;

;         Relocations done and "BCPL", maxglob, sectbase set in r4, r5, r8;

;         a1 set to point after last section.

;

notsect:  add       rg, a1, #64         ;leave 16 words between code and globals

          add       rfp, rg, rmg,lsl #2 ;then the heap after rmg

          str       rmg, [rg]           ;g0 := #globals

illglob:  mov       r6, #0xAE000000

          add       r6, r6, #0x950000   ; illegal value for g0

          add       r6, r6, rmg, lsl #2

          str       r6, [rg,rmg,lsl #2] ; g!rmg :=#Xae950000 +4*rmg

          subs      rmg, rmg, #1        ; rmg -:= 1 repeatwhile rmg

          bne       illglob

          ADR       a1, St

glini:    ldmfd     a1, {a2,a3}

          cmp       a2, rbcpl           ; unless a1!0 = "BCPL" break

          bne       glinibr

          add       a1, a1, a3

glini1:   ldmfd     a1!, {a2,a3}

          cmp       a3, #0              ; a1 -> glob, offset or maxglob,0

          strne     a3, [rg, a2,lsl #2] ; g!a3 := 4*a2 (already relocated)

          bne       glini1

          ldr       a3, [a1]

          ldr       a2, [pc, #onetwo-$-8]

          cmp       a2, a3

          bne       glini               ; No relocations; next section

          ldr       a2, [pc, #eightsev-$-8]

glini2:   ldmfd     a1!, {a3}

          cmp       a2, a3

          bne       glini2              ; walk to end of sect

          b         glini

;

;         globals initialised; rg, rfp points to g0, g0 + rmg (+4) above.

;

glinibr:  add       rfp, rfp, #4        ;frame pointer, empty frame, bos

          mov       r5, #0x100          ;C&S-brk resets, brk exits, esc ignored

          str       r5, [rg, #BrkEsc]

          mov       r5, #0x1000         ; default stackwords

          str       r5, [rg, #Stacksize]

          mov       r5, #0xae00

          add       r5, r5, #0x95

          ldr       rb, [rg, #StartInit]

          cmp       r5, rb, lsr #16

          blne      Call                ; Call if StartInit present

          strne     a1, [rg, #Stacksize]

          swi       OS_GetEnv

          str       r0, [pc, #saveregs-$-8]       ;*command

          sub       a1, a1, #1

          str       a1, [r9, #TopStore]

          mov       a3, a1              ; Top of addressable store

          mov       a1, rfp             ; Base   ""          ""

          str       a1, [rg, #HeapDescriptor]

          sub       a3, a3, a1          ; length available

          mov       a3, a3, lsr #2

          mov       a3, a3, lsl #2      ; must be wordsized

          mov       r0, #0              ; initialise heap

          swi       OS_Heap

          mov       r0, #2

          ldr       a3, [rg, #Stacksize]

          add       a3, a3, #1

          mov       a3, a3, lsl #2      ; Stackbytes + 4

          swi       OS_Heap

          mov       r5, a2, lsr #2

          add       r5, r5, #1

          str       r5, [rg, #Stackbase]; of Stacksize words

          mov       rfp, a2             ; with rfp as base


          mov       a3, #264

          mov       r0, #2

          swi       OS_Heap             ; get space for Linebuff

          mov       r0, a2, lsr #2

          str       r0, [rg, #Instring] ; set Instring

          add       r0, r0, #2

          str       r0, [rg, #LineBuff] ; set Linebuf

          add       a2, a2, #4

          str       r0, [a2], #5       ; Instring!1 := Instring+2

          sub       a3, a2, #1         ; a3 = linebufB

          ldr       r0, [pc, #saveregs-$-8]

Walk:     ldrb      a1, [r0], #1

          cmp       a1, #32

          bgt       Walk

          subne     r0, r0, #1

          mov       a1, a2             ; Command tail to Linebuf!2

          mov       a2, #256

          swi       OS_GSTrans

          bvc       cmdl

          mov       a1, #12

          str       a1, [rg, #ReturnCode]

          ADR       a1, errcl

          mov       a1, a1, lsr #2

          ldr       rb, [rg, #Fault]

          bl        Call

          b         Finish              ; ? needed

errcl:    .asciz    "Bad CLine"

          .align


cmdl:     strb      a2, [a3], #-8       ; Instring!0 := Linebuf%0

          str       a2, [a3]

          mov       r0, #0

          str       r0, [rg, #Outstring];Outstring := 0


          ldr       a2, [rg,#Stacksize]

          rsb       a2, a2, #0          ; -StacksizeW

          str       a2, [rfp]

          sub       a3, rfp, a2, lsl #2 ; TOSB

          add       rfp, rfp, #4        ; Now Stackbase agrees with global

          mov       r0, #0

          mvn       a2, #0

          mov       a4, a3, lsr #2

          sub       a4, a4, #1

          stmea     rfp!, {r0, a2, a4}  ; sb!0, 1, 2, 3 := 0, -Sbw, TOSW, -Sbw

          mov       a1, #1              ; sb!5 only needed

          stmea     rfp!, {r0, a1, a2}    ; wrong!!!!!!!

          mov       rts, rfp            ; Empty frame

;

;stack shd be ffff0000, 0, ffff0000, tos,......,wordaddress at top

; 148-174 ommitted

;

          mov       r0, #65

          str       r0, [rg, #HostProc]

          mov       r0, #0

          str       r0, [pc, #Envflag - 8 - $]

          mov       a1, #0

          mov       a2, #0

          mvn       a3, #1

          ldr       a4, [rg, #Abort]

          mov       r5, #0xae00

          add       r5, r5, #0x95

          cmp       r5, a4, lsr #16

          streq     r0, [pc, #UInstr - 8 - $]



          blnv        NewEnv                  ; Remove nv

          ADR       r0, St

          mov       r0, r0, lsr #2

          str       r0, [rg, #Loadpoint]

          ldr       rgb, [pc, #Rgbval-8-$]

          add       rgb, rgb, #0x40000000

          mov       r0, #0

          str       r0, [rg, #ReturnCode]

          mov       r0, #1 << 24        ; Newline() not fast

          str       r0, [rg, #Cis]

          str       r0, [rg, #Cos]

          ldr       rb, [rg, #Start]

          bl        Call

Finish:   mov       rts, rfp

;          ldr       rb, [rg, Libterminateio]      ;not needed

;          bl        Call

Depart:   ldr       a1, [pc, #abex-8-$]

          ldr       a2, [rg, #ReturnCode]

          swi       OS_Exit

abex:     .ascii    "ABEX"


saveregs: .blkl     16

Rgbval:   .long     Rgbs-4              ; Relocate these two


          .long     -1

          .ascic    "ErrHand"

ErrHand:  movs      pc, lr

EscHand:  stmfd     rl!, {lr}

          mov       r0, #126

          swi       OS_Byte+XOS         ; Acknowledge Escape

          ldrb      r0, [rg, #BrkEsc]

          teq       r0, #0

          swine     OS_WriteS+XOS

          .asciz    "\c\nEscape\c\n"

          .align

          swine     OS_Exit

          ldmfd     rl!, {lr}

          movs      pc, lr


BrkHand:  mov       pc, lr


          .long     -1

          .ascic    "EvHandl"

EvHandl:  ADR       rts, EveRtnes       ; Call EveRtns!r0

          ldr       pc, [rts, r0, lsl #2]


EvFlag:   ADR       rts, EveParams

          ldr       rts, [rts, r0, lsl #2]

          str       a1, [rts], #4

          str       a2, [rts], #4

          str       a3, [rts], #4

          str       a4, [rts], #4

          movs      pc, rl


ErrBuff:  .blkl     16


          .long     -1

          .ascic    "CBHandl"

CBHandl:  ADR       r0, CBBuff

          ldr       lr, [r0, #60]      ; Exit?

;          tsts      lr, #3

;          beq       CB3

;          mov       a1, lr              ; keep safe svc_lr

;          swi       OS_SetCallBack      ; another Callback

;          mov       lr, a1

          ldmfd     r0, {r0-lr}

          movs      pc, lr

CBBuff:   .blkl     16


EvBuff:   ADR       rts, EveParams

          ldr       rts, [rts, r0, lsl #2]

          mov       r0, r0, lsl #16

          orr       r0, r0, a1, lsl #8

          orr       r0, r0, a2

          ldmfd     rts!, {a1, a2, rl}

          add       a1, a1, #1

          moveq     a1, #0

          cmp       a1, a2

          strne     a1, [rts, #-12]

          mov       rl, #0

EvReturn: movs      pc, lr


EveRtnes: .blkl     18                  ; 0-11 Events in Arthur

EveParams:.blkl     18                  ; 0-17   ""    Riscos

          .long     -1

          .ascic    "Seteven"

Seteven:  cmp       a3, #0

          ADR       a2, EvReturn

          beq       Evenex              ; ignore

          cmp       a3, #2

          ADRNE     a4, EveParams

          movne     a2, a2, lsl #2      ; flag(1) or buffer(3) BCPL

          strne     a2, [a4, a1, lsl #2]

          ADRNE     a2, EvFlag;

          cmpne     a3, #1

          ADRNE     a2, EvBuff

Evenex:   ADR       a4, EveRtnes       ; ARM Routine(2)

          strne     a2, [a4, a1, lsl #2]

          movs      pc, lr


Uinhand:  str       lr, [pc, #Xcpbuf0-$-8]

          mov       lr, #1

          b         Hardhand

Pfahand:  str       lr, [pc, #Xcpbuf0-$-8]

          mov       lr, #2

          b         Hardhand

Dtahand:  str       lr, [pc, #Xcpbuf0-$-8]

          mov       lr, #3

          b         Hardhand

Adxhand:  str       lr, [pc, #Xcpbuf0-$-8]

          mov       lr, #4

Hardhand: str       lr, [pc, #Xcpbuf1-$-8]

          ADR       lr, XcpRegs

          stmea     lr, {r0 - lr}^

          tstp      pc, #0              ; leave svc mode

          swi       OS_WriteI+14

          add       rts, rfp, #160

          ldr       rb, [rg, #Abort]

          ldr       a1, [pc, #Xcpbuf1-$-8]

          ldr       lr, [pc, #Xcpbuf0-$-8]

          mov       pc, rb


          .long     -1

          .ascic    "TKRErr "

TKRErr:   mov       a3, a1, lsl #2

          ADR       a4, ErrBuff+4

          mov       r5, #0

TKRlp:    ldrb      rb, [a4], #1

          cmp       rb, #0

          beq       TKRex

          add       r5, r5, #1

          strb      rb, [a3, r5]

          cmp       r5, a2

          blt       TKRlp

TKRex:    strb      r5, [a3]

          movs      pc, lr


          .long     -1

          .ascic     "Stop   "

Stop:     str       a1, [rg, #ReturnCode]    ;? #ReturnCode

          ldr       a3, [rg, #Stackbase]

          mov       a3, a3, lsl #2

          ldr       a2, [a3, #4]

          ldr       rfp, [a3, #24]

          cmn       a2, #1

          beq       Finish

          b         ResCflt

          .long     -1

          .ascic    "Chenv  "

NewEnv:   ADR       a4, UInstr

          ADR       r5, OUInstr

          b         ChEnv

OldEnv:   ADR       a4, OUInstr

          ADR       r5, UInstr

          b         ChEnv


XcpRegs:  .blkl     16

Xcpbuf0:  .blkl     1

Xcpbuf1:  .blkl     1

OUInstr:  .blkl     1

OPrefab:  .blkl     1

ODatab:   .blkl     1

OAddexp:  .blkl     1

OOtherx:  .blkl     1

OErrorH:  .blkl     3

OCallBH:  .blkl     3

OBreakPtH:.blkl     3

OEscapeH: .blkl     2

OEventH:  .blkl     2

OExitH:   .blkl     2

OUnusSWI: .blkl     2

OExcepReg:.blkl     1

OAplSp:   .blkl     1

OCao:     .blkl     1

OUpCall:  .blkl     2


Envflag:  .address  0

UInstr:   .address  Uinhand

Prefab:   .address  Pfahand

Datab:    .address  Dtahand

Addexp:   .address  Adxhand

Otherx:   .address  0

ErrorH:   .address  ErrHand

          .address  0                   ; dont care

          .address  ErrBuff

CallBH:   .address  CBHandl

          .address  0

          .address  CBBuff

BreakPtH: .address  0

          .address  0

          .address  0

EscapeH:  .address  0

          .address  0

EventH:   .address  EvHandl

          .address  0

ExitH:    .address  Exithan

          .address  0

UnkSWI:   .address  0

          .address  0

ExcepReg: .address  0;XcpRegs

AplSp:    .address  0

Cao:      .address  0

UpCall:   .address  0

          .address  0


;Changenv Called with r0 case for OS_Changenv, a4 address of new value, r5

;address to put old value; ends with a4, r5 incremented.


ChEnv:    ldr       r0, [pc, #UInstr-$-8]

          cmp       r0, #0

          moveq     pc, lr

          mov       r0, #0              ; NB 0(Memlim not serviced)

Envlp:    mov       a2, #0

          mov       a3, #0

          add       r0, r0, #1

          ldr       a1, [a4], #4

          teq       r0, #0

          teqne     r0, #1

          teqne     r0, #2

          teqne     r0, #3

          teqne     r0, #4

          teqne     r0, #5

          teqne     r0, #13

          teqne     r0, #14

          teqne     r0, #15

          beq       Env1

          ldr       a2, [a4], #4

          teq       r0, #9

          teqne     r0, #10

          teqne     r0, #11

          teqne     r0, #12

          teqne     r0, #13

          teqne     r0, #16

          beq       Env1

          ldr       a3, [a4], #4

Env1:     swi       OS_ChangeEnvironment

          str       a1, [r5], #4

          teq       r0, #0

          teqne     r0, #1

          teqne     r0, #2

          teqne     r0, #3

          teqne     r0, #4

          teqne     r0, #5

          teqne     r0, #13

          teqne     r0, #14

          teqne     r0, #15

          beq       Envlp

          str       a2, [r5], #4

          teq       r0, #9

          teqne     r0, #10

          teqne     r0, #11

          teqne     r0, #12

          teqne     r0, #13

          beq       Envlp

          teq       r0, #16

          moveq     pc, lr

          str       a3, [r5], #4

Env2:     b         Envlp


UPCHand:  stmia     r12, {r0-r5, lr}

          tst       r0, #256            ; R12 points to 7 word block

          ldreq     r0, [pc, #Envflag-$-pc]

          teqeq     r0, #1

          bne       UpEx

          bl        OldEnv

          mov       r0, #0

          str       r0, [pc, #Envflag-$-pc]

UpEx:     ldmia     r12, {r0-r5, lr}

          movs      pc, lr


Exithan:  bl        OldEnv

          swi       OS_Exit


          .long     -1

          .ascic    "OSCLI  "

OSCLI:    mov       r0, a1, lsl #2

          ldrb      a1, [r0], #1        ; string byte base, length

          add       a2, a1, r0          ; string byte terminator position

          ldrb      r3, [a2]

          mov       a4, #0

          strb      a4, [a2]

          ldr       a1, [pc, #Envflag-$-pc]

          cmp       a1, #0

          bne       SavEnv

          swi       OS_CLI+XOS

          strb      a3, [a2]

          mov       a1, #0

          mvnvs     a1, #0

          mov       pc, lr

SavEnv:   stmea     rts!, {lr}

          stmea     rts!, {a2, a3}

          bl        OldEnv

          swi       OS_CLI+XOS

          mov       a1, #0

          mvnvs     a1, #0

StEnv:    bl        NewEnv

          ldmea     rts!, {a2, a3}

          strb      a3, [a2]

          ldmea     rts!, {pc}


          .long     -1                  ; needs a global

          .ascic    "RestEnv"

ResetEnv: ldr       a1, [pc, #Envflag-$-pc]

          cmp       a1, #1

          moveq     pc, lr

          mov       r6, lr

          b         StEnv


          .long     -1

          .ascic    "Call   "

Call:     mov       pc, rb

Rgbs:     b         Depart

Mpy:      stmfd     rg, {a4, lr}        ; mpy

          mov       a4, #0

          movs      lr, a2

          rsbmi     lr, lr, #0

Mpylp:    movs      lr, lr, lsr #1

          addcs     a4, a4, a1

          mov       a1, a1, lsl #1

          bne       Mpylp

          mov       a1, a4

          teqs      a2, #0

          rsbmi     a1, a1, #0

          ldmea     rg, {a4,pc}^


Div:      stmfd     rg, {a3-r5,lr}      ; a1/a2, a1 rem a2

          movs      lr, a1

          rsbmi     lr, lr, #0

          movs      a3, a2

          beq       DivZero             ; Divide by zero fault

          rsbmi     a3, a3, #0

          mov       a4, #0

          mov       r5, #1

Divl1:    cmp       a3, #0x80000000

          cmpcc     a3, lr

          movcc     a3, a3, lsl #1

          movcc     r5, r5, lsl #1

          bcc       Divl1

Divl2:    cmp       a3, lr

          addls     a4, a4, r5

          subls     lr, lr, a3

          movs      r5, r5, lsr #1

          movne     a3, a3, lsr #1

          bne       Divl2

          teqs      a1, a2

          rsbmi     a4, a4, #0

          cmp       a1, #0

          mov       a2, lr

          rsblt     a2, a2, #0

          mov       a1, a4

          ldmea     rg, {a3-r5, pc}^   ; a1, a2 = a1/a2, a1 rem a2


          movnv     r0,r0

          stmea     rts!, {rb, fp, sp, lr}

          sub       fp, rts, #16

          ldr       rl, [rb, #-4]

          ldr       r0, [rb, #4]

          add       r0, r0, #1

          str       r0, [rb, #4]

          ldr       pc, [rb, #8]        ; ????????????


          add       lr, lr, #4

          stmfd     rg, {r0, lr}

          bic       lr, lr, #0xfc000000

          ldr       r0, [r5]

          ldmea     rg, {r0, pc}^

DivZero:  mov       a1, #12

          str       a1, [rg, #ReturnCode]

          ADR       a1, Divz

          b         Faults       ; in ResumeC

Divz:     .ascic    "Division by zero\0"

          .align


          .long     -1

          .ascic    "Muldiv "

Muldiv:   stmea     rts!, {rb, rfp, rl, lr }

          sub       rfp, rts, #16

          stmea     rts!, {a1, a2, a3}

          cmp       a2, #0

          beq       Divz

          cmp       a1, #0

          rsblt     a1, a1, #0

          cmp       a2, #0

          rsblt     a2, a2, #0          ; a1, a2 := mod a1, mod a2

          mov       r0, a1, lsr #16     ; a1 hi

          mov       a4, a2, lsr #16     ; a2 hi

          bic       a1, a1, r0, lsl #16 ; a1 lo

          bic       a2, a2, a4, lsl #16 ; a2 lo

          mul       a3, a1, a2          ; bits 0-15+part 16-31

          mul       a2, r0, a2          ; part bits 16-47

          mul       a1, a4, a1          ;  ""        ""

          mul       a4, r0, a4          ; part bits 32-47 + bits 48-63

          adds      a1, a2, a1

          addcs     a4, a4, #0x10000     ; carry from middle

          adds      a3, a3, a1, lsl #16

          adc       a4, a4, a1, lsr #16 ; result in a3(lo)-a4(hi)


          ldmea     rts, {r5}           ; divisor

          mov       a1, #0              ; dividend

          mov       a2, #0              ; remainder

          mov       r0, #64             ; count

divlp1:   subs      r0, r0, #1

          beq       DivDone

          adds      a3, a3, a3

          adcs      a4, a4, a4

          bpl       divlp1              ; a4 bit 31 now set

divlp2:   adds      a3, a3, a3

          adcs      a4, a4, a4

          adc       a2, a2, a2          ; rem := Rem*2+Carry

          cmp       a2, r5

          subcs     a2, a2, r5          ; rem -:= divisor

          adcs       a1, a1, a1         ; div := div*2+Carry

          bcs       Toobig

divsm:    subs      r0, r0, #1

          bne       divlp2


DivDone:  str       a2, [rg, #Result2]

          ldmea     rts!, {a3-r5}

          eors      a3, a3, a4

          rsblt     a1, a1, #0

          eors      a3, a4, r5

;          rsblt     a2, a2, #0

          ldmea     rts!, {rb, rfp, rl, pc}^

Toobig:   mov       a1, #15

          str       a1, [rg, #ReturnCode]

          ADR       a1, oflo

          b         Faults

oflo:     .ascic    "Muldiv result oflo\0"


          .align

          .long     -1

          .ascic    "OSByte "

OSByte:   mov       r0, a1

          mov       a1, a2

          mov       a2, a3

          swi       OS_Byte

          str       a2, [rg, #Result2]

          movs      pc, lr


          .long     -1

          .ascic    "OSWord "

OSWord:   and       r0, a1, #0xff

          mov       a1, a2, lsl #2

          swi       OS_Word

          movs      pc, lr              ; nb if p0 = 0 OS_Readline ISNT Called.


          .long     -1

          .ascic    "OSArgs "

OSArgs:   mov       r0, a1

          mov       a1, a2

          mov       a2, a3

          swi       OS_Args

          mov       a1, a2

          str       r0, [rg, #Result2]

          movs      pc, lr


          .long     -1

          .ascic    "OSFile "

OSFile:   stmea     rts!, {nil}

          mov       r0, a1

          cmp       a2, #0

          movlt     nil, #0

          movlt     a1, #0

          sublt     a1, a1, a2

          mvnge     nil, #0

          movge     a1, a2, lsl #2

          ldrgeb    a2, [a1], #1        ; string byte base, length

          addge     a4, a2, a1          ; string byte terminator position

          ldrgeb    r5, [a4]

          movge     rb, #0

          strgeb    rb, [a4]

          stmea     rts!, {a4, r5}

          mov       rb, a3, lsl #2

          ldr       a2, [a1]

          cmp       a2, #0

          addeq     a1, a1, #1

          ldmia     rb, {a2-r5}

          swi       OS_File + XOS

          stmia     rb, {a2-r5}

          mov       a2, #0

          mvnvs     a2, #0

          str       a2, [rg, #Result2]

          mov       a1, r0

          ldmea     rts!, {a4, r5}

          cmp       nil, #0

          strneb    r5, [a4]            ; restore

          ldmea     rts!, {nil}

          movs      pc, lr


          .long     -1

          .ascic    "OSWrCh "

OSWrCh:   mov       r0, a1

          swi       OS_WriteC

          movs      pc, lr


          .long     -1

          .ascic    "OSRdCh "

OSRdCh:   swi       OS_ReadC

          mov       a1, r0

          mov       r0, #0

          mvncs     r0, #0

          str       r0, [rg, #Result2]

          movs      pc, lr


          .long     -1

          .ascic    "OSBPut "

OSBPut:   mov       r0, a1

          mov       a1, a2

          swi       OS_BPut

          movs      pc, lr


          .long     -1

          .ascic    "OSBGet "

OSBGet:   swi       OS_BGet+XOS

          mov       a1, r0

          movcs     a1, #0xff

          movcs     a1, a1, lsl #1

          movs      pc, lr


          .long     -1

          .ascic    "Level  "

Level:    mov       a1, rfp

          movs      pc, lr


          .long     -1

          .ascic    "LongJum"

LongJump: cmp       rfp, a1

          moveq     pc, a2              ; Same level

          mov       a4, rfp

LJ1:      ldr       r5, [a4, #4]        ; rfp enclosing frame rfp!1

          cmp       r5, a4

          beq       LJ2                 ; base of stack?

          cmp       r5, a1              ; enclosing frame correct?

          movne     a4, r5

          bne       LJ1

          ldr       rl, [a4, #8]        ; rl of found frame  rfp!2

          mov       rts, a4

          mov       rfp, a1

          mov       pc, a2              ; successful

LJ2:      mov       a3, a1

          mov       a1, #14

          str       a1, [rg, #ReturnCode]

          str       r2, [ rg, #Result2 ]

          ADR       a1, LJRep

          b         Faults

LJRep:    .ascic    "Destination frame %n for LongJump in the stack\0"

          .align


          .long     -1

          .ascic    "GBytes "

GBytes:   mov       r0, a1

          mov       a1, #0              ; returns last 4 bytes ( max a2 )

GBloop:   ldrb      a3, [r0], #1        ; from a1 (not wrd aligned) in one word

          add       a1, a3, a1, lsl #8  ; Byteword := GBytes( Byteaddr, Number )

          subs      a2, a2, #1

          bgt       GBloop

          movs      pc, lr


          .long     -1

          .ascic    "PBytes "

PBytes:   add       a1, a1, a2          ; PBytes( Byteword, Number, Byteaddr )

PBloop:   strb      a3, [a1, #-1]

          subs      a2, a2, #1

          bgt       PBloop

          movs      pc, lr


          .long     -1

          .ascic    "Move   "

Move:     mov       a4, a2, lsl #2      ; to b

          mov       a2, a3

          mov       a3, a1, lsl #2      ; from b

          mov       a1, #1

          b         MWLoop


          .long     -1

          .ascic    "Backmov"

BackMov:  add       a4, a2, a3          ; to w

          mov       a2, a3

          add       a3, a1, a3          ; from w

          mvn       a1, #0

          b         MoveWo


          .long     -1

          .ascic    "MoveWor"

MoveWo:   mov       a4, a4, lsl #2

          mov       a3, a3, lsl #2

MWLoop:   ldr       r0, [a3], a1,lsl #2 ; a3 postindex icr/decr by a1

          str       r0, [a4], a1,lsl #2

          subs      a2, a2, #1

          bgt       MWLoop

          mov       pc, lr


          .long     -1

          .ascic    "FillWor"

FillWo:   mov       a1, a1, lsl #2

Filloop:  str       a3, [a1], #4

          subs      a2, a2, #1

          bgt       Filloop

          movs      pc, lr


          .LONG     -1

          .ascic    "Movebyt"

Movebyte: cmp       a3, #0

          moveq     pc, lr

mb:       ldrb      r0, [a1], #1

          strb      r0, [a2], #1

          subs      a3, a3, #1

          bgt       mb

          mov       pc, lr


          .long     -1

          .ascic    "Backmvb"

Backmvby: cmp       a3, #0

          moveq     pc, lr

bmb:      subs      a3, a3, #1

          ldrb      r0, [ a1, a3 ]

          strb      r0, [ a2, a3 ]

          bgt       bmb

          mov       pc, lr


          .long     -1

          .ascic    "CoWait "           ; CoWait( Coptr )

CoWait:   stmea     rts!, {rb, rfp, rl, lr} ; fp!0, 1, 2, 3 :=

                                        ;      Called, Calling fp, statics, link

          sub       rfp, rts, #16       ; frame pointer

          stmea     rts!, {a1}          ; fp!4 := coptr

          ldr       a2, [rg, #Stackbase]; Current Stackbase

          mov       a2, a2, lsl #2

          ldr       a3, [a2, #4]        ; sb := sb!1

          cmns      a3, #1

          beq       ResCflt             ; sb!1=-1 -> Mainstack

          str       a3, [rg, #Stackbase];      otherwise Calling stack

          mov       a4, #0

          str       a4, [a2, #4]        ;     := 0 -> waiting

          str       rfp, [a2, #16]      ; sb!4 := frameptr for resume

          mov       a3, a3, lsl #2

          ldr       rfp, [a3, #16]      ; frptr = Oldsb!4

          ldmed     rfp, {rfp, rl, pc}^ ; frameptr, statics, resumepc :=

                                        ;         frameptr!4, 3, 2

          .long     -1

          .ascic    "CreateC"          ; (function, stack#)

CreateC:  stmea     rts!, {rb, rfp, rl, lr}

          sub       rfp, rts, #16

          stmea     rts!, {a1, a2}

          mov       a1, a2

          bl        GetVec

          cmps      a1, #0              ; if v = 0 goto ResCflt

          beq       ResCflt

          ldmea     rts!, {a4, lr}

          add       lr, a1, lr          ; lr := v+Stack#, i.e Stacktopword(Stw)

          mov       a2, a1, lsl #2      ; a2 := Stackbotbyte(Sbb)

          ldr       rb, [rg, #Stackbase]

          mov       a3, rb, lsl #2

          ldr       r5, [a3]

          str       a1, [a3]            ; oldsb!0 := Stack#

          stmea     a2, {r5, rb, lr}    ; sb!0, 1, 2 := Oldsb!0, owning sbW, Stw

          str       a4, [a2, #20]       ; sb!5 := function

          str       a3, [a2, #16]       ; sb!4 := OwningsbB

          str       a1, [rg, #Stackbase]; Stackbase := StackbaseW

          add       rfp, a2, #24

ccret:    mov       rts, rfp

          bl        CoWait

          ldr       rb, [rfp, #-4]      ; function

          bl        Call

          b         ccret               ; loop


          .long     -1

          .ascic    "DeleteC"

DeleteC:  stmea     rts!, {rb, rfp, rl, lr}

          sub       rfp, rts,  #16

          stmea     rts!, {a1}          ;(coptr) returns successcode

          mov       a2, a1, lsl #2

          ldr       a3, [a2, #4]        ; sb!1

          cmp       a3, #0

          bne       ResCflt              ; not a stack

          ldr       a3, [rg, #Stackbase]

dlc1:     mov       a4, a4, lsl #2

          ldr       a4, [a4, #4]

          cmn       a4, #1              ; if owningsb!1 \= -1,ie nain, loop

          bne       dlc1

          mov       r0, #0

dlcl2:    mov       a4, a3

          ldr       a3, [r0, a3, lsl #2]

          cmp       a3, 0

          beq       ResCflt

          cmp       a1, a3              ; Coptr

          bne       dlcl2

          ldr       a2, [r0, a1, lsl #2]

          str       a2, [r0, a4, lsl #2]

          bl        FreeVec

          mov       rts, rfp

          ldmed     rts, {rfp, rl, pc}^


          .long     -1

          .ascic    "CallCo "

CallCo:   stmea     rts!, {rb, rfp, rl, lr}

          sub       rfp, rts, #16

          stmea     rts!, {a1, a2}       ; CallCo( Coptr, arg )

          mov       a3, a1, lsl #2

          ldr       a4, [a3, #4]        ; if coptr!1 = 0 goto ResCflt

          cmp       a4, #0

          bne       ResCflt              ; Not waiting

          ldr       rb, [rg, #Stackbase]

          str       rb, [a3, #4]        ; Coptr!1 := Calling Stackbase

          mov       rb, rb, lsl #2

CallCo1:  str       a1, [rg, #Stackbase]; Stackbase := Coptr

          str       rfp, [rb, #16]      ; OldStackbase!4 := rfp

          ldr       rts, [a3, #16]      ; rts := Coptr!4

          mov       a1, a2              ; arg

          ldmed     rts, {rfp, rl, pc}^


          .long     -1

          .asciC    "ResumeC"

ResumeC:  stmea     rts!, { rb,rfp, rl, lr}

          sub       rfp, rts, #16

          stmea     rts!, {a1, a2}      ; ResumeCo( coptr, Arg )

          ldr       rb, [rg, #Stackbase]

          cmp       rb, a1              ; Resume oneself == Call

          beq       resco2

          mov       a3, a1, lsl #2

          ldr       a4, [a3, #4]        ; a4 := owner

          bne       ResCflt              ; Exists, error return

          mov       rb, rb, lsl #2

resco3:   ldr       a4, [rb, #4]

          cmns      a4, #1

          beq       ResCflt

          str       a4, [a3, #4]        ; owner of new := Owner of old

          mov       a4, #0

          str       a4, [rb, #4]        ; CoWait old

          b         CallCo1

resco2:   mov       a1, a2

          mov       rts, rfp

          ldmed     rts, {rfp, rl, lr}^

ResCflt:  ADR       a1, ResCerr

          mov       a1, #13

          str       a1, [rg, #ReturnCode]

Faults:   mov       a1, a1, lsr #2

          ldr       rb, [rg, #Fault]

          swi       OS_NewLine

          bl        Call

          b         Finish

ResCerr:  .ascic    "Coroutine error\n"

          .align

ResC78:   .ascii    "VERN"

          .long     -1

          .ascic    "GetVect"

GetVec:   mov       r0, #2

          add       a1, a1, #1

          mov       a3, a1, lsl #2

Comvec:   ldr       a1, [rg, #HeapDescriptor]

          swi       OS_Heap + XOS

          mov       a1, a2, lsr #2

          movvc     r0, #0

          mvnvs     r0, #0

          str       r0, [ rg, #Result2 ]

          movvc     pc, lr               ; error return now if Result2

          ADR       a1, Gv

          b         Faults

Gv:       .ascic    "Heap fault"

          .align

          .long     -1

          .ascic     "MaxVect"

MaxVec:   mov       r0, #1

          b         Comvec

          .long     -1

          .ascic    "FreeVec"

FreeVec:  cmp       a1, #0

          moveq     pc, lr              ; return if 0

          mov       r0, #3

          mov       a2, a1, lsl #2

          b         Comvec

hexbuf:   .blkb     9

          .align


          .long     -1

          .ascic    "OSFind "

OSFind:   movs      r0, a1

          bne       OSFOpen

          mov       a1, a2              ; handle

          swi       OS_Find

          mov       a1, r0

          mov       pc, lr


OSFOpen:  cmp       a2, #0

          mvnle     a4, #0

          movlt     a1, #0

          sublt     a1, a1, a2

          movge     a1, a2, lsl #2

          ldrgeb    a2, [a1], #1        ; string byte base, length

          addge     a3, a2, a1          ; string byte terminator position

          ldrgeb   a4, [a3]

          movge     r5, #0

          strgeb    r5, [a3]

          swi       OS_Find+XOS

          movvc     a1, #0

          mvnvs     a1, #0

          str       a1, [rg, #Result2]

          cmp       a4, #0

          strgeb    a4, [a3]            ; restore

          mov       a1, r0

          mov       pc, lr

globinits:

          .long     16

          .long     Muldiv - St

          .long     35

          .long     Stop - St

          .long     37

          .long     GBytes - St

          .long     38

          .long     PBytes - St

          .long     41

          .long     Level  - St

          .long     42

          .long     LongJump - St

          .long     48

          .long     CreateC - St

          .long     49

          .long     DeleteC - St

          .long     50

          .long     CallCo - St

          .long     51

          .long     ResumeC - St

          .long     52

          .long     CoWait - St

          .long     54

          .long     GetVec - St

          .long     55

          .long     FreeVec - St

          .long     56

          .long     MaxVec - St

          .long     96

          .long     OSArgs - St

          .long     97

          .long     OSBGet - St

          .long     98

          .long     OSBPut - St

          .long     99

          .long     OSFind - St

          .long     100

          .long     OSFile - St

          .long     101

          .long     OSCLI - St

          .long     102

          .long     OSWrCh - St

          .long     103

          .long     OSRdCh - St

          .long     104

          .long     OSByte - St

          .long     105

          .long     OSWord - St

          .long     106

          .long     TKRErr - St

          .long     135

          .long     ResetEnv - St

          .long     136

          .long     Move - St

          .long     137

          .long     BackMov - St

          .long     138

          .long     Movebyte - St

          .long     139

          .long     Backmvby - St

          .long     140

          .long     MoveWo - St

          .long     141

          .long     FillWo - St

          .long     Stackbase

          .long     FillWo - St

          .long     150

          .long     0

          .long     0x12345678

          .long     globinits           ; not +4 because b instr at head

          .long     globinits+8

          .long     globinits+16

          .long     globinits+24

          .long     globinits+32

          .long     globinits+40

          .long     globinits+48

          .long     globinits+56

          .long     globinits+64

          .long     globinits+72

          .long     globinits+80

          .long     globinits+88

          .long     globinits+96

          .long     globinits+104

          .long     globinits+112

          .long     globinits+120

          .long     globinits+128

          .long     globinits+136

          .long     globinits+144

          .long     globinits+152

          .long     globinits+160

          .long     globinits+168

          .long     globinits+176

          .long     globinits+184

          .long     globinits+192

          .long     globinits+200

          .long     globinits+208

          .long     globinits+216

          .long     globinits+224

          .long     globinits+232

          .long     globinits+240

          .long     globinits+248

          .long     Rgbval-4

          .long     UInstr-4

          .long     Prefab-4

          .long     Datab-4

          .long     Addexp-4

          .long     ErrorH-4

          .long     ErrorH+4

          .long     CallBH-4

          .long     CallBH+4

          .long     EventH-4

          .long     ExitH-4

          .long     ExcepReg-4

          .long     0x87654321

