Simple coroutines example in m68k (on AmigaOS)

amigaos-coroutines.asm

   incdir  "include:"
   include "exec/exec.i"
   include "exec/exec_lib.i"
   include "dos/dos_lib.i"

        opt p=68020


_start
        movem.l d2-d7/a2-a6,-(sp)

        movea.l (4).w,a6
        lea     (dosname,pc),a1
        moveq   #39,d0
        jsr     (_LVOOpenLibrary,a6)
        move.l  d0,a6           ; no check, no fail

        lea     (buf,pc),a2
        move.l  a2,a3

        lea     (getc,pc),a4
        bsr     parse

        move.l  a6,a1
        movea.l (4).w,a6
        jsr     (_LVOCloseLibrary,a6)
end0
        movem.l (sp)+,d2-d7/a2-a6
        moveq   #0,d0
        rts


dosname
        dc.b "dos.library",0
        even
templ
        dc.b "%s: %s",10,0
        even
word_t
        dc.b "WORD",0
        even
punct_t
        dc.b "PUNCT",0
        even
wp
        dc.l word_t,punct_t
buf
        ds.b 256
        ;; a static buffer in the code section...
        


getchar
        jsr    (_LVOInput,a6)
        move.l d0,d1
        jsr    (_LVOFGetC,a6)
        rts

add_to_token
        move.b  d4,(a2)+
        rts

   
got_token
        clr.b   (a2)+
        move.l  a3,-(sp)
        lea     (wp,pc),a0
        move.l  (a0,d2.l*4),-(sp)
        move.l  sp,d2
        lea     (templ,pc),a0
        move.l  a0,d1
        jsr     (_LVOVPrintf,a6)
        addq.l  #8,sp
        move.l  a3,a2    ; start over
        rts


;; cmp2?
isalpha
        cmp.b   #"A",d0
        blt.s   noal
        cmp.b   #"Z",d0
        ble.s   sial
        cmp.b   #"z",d0
        bhi.s   noal
        cmp.b   #"a",d0
        blt.s   noal
sial
        moveq   #1,d0
        rts
noal
        moveq   #0,d0
        rts



;; correct entry point would load a4 first
loop
getc
     bsr     getchar
     tst.l   d0
     bmi.s   end
     cmp.b   #$FF,d0
     bne     nocompr
     bsr     getchar
     move.l  d0,d2
     subq.w  #1,d2
     bsr     getchar
     move.l  d0,d3
emitloop
     move.l  d3,d0
     move.l  a4,-(sp)
     dc.w  $49FA, $0004
     ;lea     (4.w,pc),a4  ; genam won't allow this
     rts
     dbf     d2,emitloop
     bra.s   loop
nocompr:
     move.l  a4,-(sp)
     dc.w  $49FA, $0004
     rts
     bra.s   loop
end:
     moveq   #-1,d0
     move.l  a4,-(sp)
     dc.w  $49FA, $0004
     rts
     rts



TWORD    equ 0
TPUNCT   equ 1

;; correct entry point would load a4 first
parse
     move.l  a4,-(sp)
     dc.w  $49FA, $0004  
     rts
     move.l  d0,d4
     tst.l   d0
     bmi.s   end2
     bsr     isalpha
     tst.l   d0
     beq.s   noalfa
while
     move.l  d4,d0
     bsr     add_to_token

     move.l  a4,-(sp)
     dc.w  $49FA, $0004  
     rts
     move.l  d0,d4
     tst.l   d0
     bmi.s   wend
     bsr     isalpha
     tst.l   d0
     bne.s   while
wend
     moveq   #TWORD,d2
     bsr     got_token
     tst.l   d4
     bmi.s   end2
noalfa
     move.l  d4,d0
     bsr     add_to_token
     moveq   #TPUNCT,d2
     bsr     got_token
     bra.s   parse
end2
     rts