        tabs    8,8                     ;first tab is 8, then each tab is 8 ahead
        width   132                     ;prevent folding of long lines
        noproces                        ;
;
        title   "Phunsy 2650 Micro Computer"
        stitle  "PHUNSY MONITOR FP-2010-11-11"
        name    phunsy_monitor          ;the module name
;
;       monitor program by Frank Philipse (www.philipse.info)
;       this software was written in hex in 1982
;       it was disassembled and commented in 2010
;       it can be assembled with the VACS 2650 assembler
;
        INCLUDE "2650.inc"              ; 2650 definitions
        INCLUDE "ascii.inc"             ; ascii definitions
        INCLUDE "phunsy.inc"            ; phunsy hardware definitions
;
        section rom                     ;declare a section
        org     0                       ; this is where th 2650 starts after reset
;
reset   bcta,un minit
;
wrtsp   lodi,r0 20h
wrtzv   bcta,un *ioad
;
redzv   bcta,un *iiad
;
wrtcr   lodi,r0 0dh
        zbsr    wrtzv
        lodi,r0 0ah
        zbsr    wrtzv
        retc,un
;
chizv   bcta,un *icad
;
wrtdx   lodz    r1
        zbsr    wrtzv
        bdrr,r2 wrtdx
        retc,un
;
zb1vr   bcta,un *zb1a
;
        db      acon,zbvecse-zbvecs
zbvecs  equ     $
cmtbsv  dw      cmtbs
ictbsv  dw      ictbs
dctbsv  dw      dctbs
pstbsv  dw      pstbs
pltbsv  dw      pltbs
adtbsv  dw      adtbs
sbtbsv  dw      sbtbs
tinprv  dw      tinpr
tehexv  dw      tehex
gthexv  dw      gthex
wrtbsv  dw      wrtbs
wchexv  dw      wchex
chescv  dw      chesc
zbvecse equ     $
;
zb2vr   eorz    r0
zb2vra  bcta,un *zb2a
;
;                                       == compare two byte value with tbsr
cmtbs   ppsl    rs
        strz    r3
        loda,r0 tbsr
        coma,r0 mram,r3
        bcfr,eq cmtbsa
        loda,r0 tbsr+1
        coma,r0 mram+1,r3
cmtbsa  cpsl    rs
        retc,un
;
;                                       == increment two byte value
ictbs   ppsl    rs+wc+c
        strz    r3
        loda,r0 mram,r3+
        addi,r0 0
        stra,r0 mram,r3
        loda,r0 mram,r3-
        addi,r0 0
        stra,r0 mram,r3
        cpsl    rs+wc
        retc,un
;
;                                       == decrement two byte value
dctbs   ppsl    rs+wc+c
        strz    r3
        loda,r0 mram,r3+
        subi,r0 1
        stra,r0 mram,r3
        loda,r0 mram,r3-
        subi,r0 0
        stra,r0 mram,r3
        cpsl    rs+wc
        retc,un
;
;                                       == push two byte value
pstbs   ppsl    rs
        strz    r3
        loda,r0 tbsr+1
        stra,r0 mram,r3+
        loda,r0 tbsr
        stra,r0 mram,r3-
        bctr,un pltbsb
;
;                                       == pull two byte value
pltbs   ppsl    RS
        strz    r3
        loda,r0 mram,r3+
        stra,r0 tbsr+1
        loda,r0 mram,r3-
pltbsa  stra,r0 tbsr
pltbsb  cpsl    RS+WC
        retc,un
;
;                                       == add two byte value
adtbs   ppsl    rs+wc
        cpsl    c
        strz    r3
        loda,r0 tbsr+1
        adda,r0 mram,r3+
        stra,r0 tbsr+1
        loda,r0 tbsr
        adda,r0 mram,r3-
        bctr,un pltbsa
;
;                                       == subtract two byte value
sbtbs   ppsl    rs+wc+c
        strz    r3
        loda,r0 tbsr+1
        suba,r0 mram,r3+
        stra,r0 tbsr+1
        loda,r0 tbsr
        suba,r0 mram,r3-
        bctr,un pltbsa
;
;                                       == test input routine (get char from input buffer)
tinpr   loda,r3 inpram
        loda,r0 inpram,r3+
        stra,r3 inpram
        subi,r3 1                       ; if not used, restore R3
        comi,r0 " "
        retc,un
;
;                                       == test if hex
;                                       returns cc = 0 if space
;                                       returns cc = p if hex
;                                       returns cc = n if other
tehex   comi,r0 " "
        retc,eq
        comi,r0 "0"
        retc,lt
        comi,r0 "9"+1
        bctr,lt tehexb
        comi,r0 "F"
        bctr,gt tehexa
        comi,r0 "A"-1
        retc,gt
tehexa  comz    r0
        ppsl    cc1                    ; set cc to neg
        retc,un
;
tehexb  comz    r0
        ppsl    cc0                    ; set cc to pos
        retc,un
;
;                                       == get hex value from input buffer
;                                       returns cc = 0 if no hex found
;                                       updates the input buffer pointer
gthex   eorz    r0
        strz    r1
        strz    r2
gthexa  bstr,un tinpr                   ; get char from input buffer
        bctr,eq gthexa                  ; skip spaces
        bstr,un tehex                   ; check if hex character
        bctr,gt gthexd                  ; it is hex
        eorz    r0                      ; clear R0
gthexb  stra,r3 inpram                  ; restore input buffer pointer so the last character not yet processed
        stra,r2 tbsr+1                  ; store value, 0 if no hex value found
        stra,r1 tbsr                    ; 
        iorz    r0                      ; set cc to character from buffer (goes wrong if character was nul)
        retc,un                         ;
;
gthexc  bstr,un tinpr                   ; get another character
        bstr,un tehex                   ; is it hex?
        bcfr,gt gthexb                  ; no
gthexd  tmi,r0  040h                    ; A-F?
        bcfr,z  gthexe                  ; no
        addi,r0 9                       ; add 9, will result in 4A-4F
gthexe  andi,r0 00fh
        ppsl    wc
        rrl,r2
        rrl,r1
        rrl,r2
        rrl,r1
        rrl,r2
        rrl,r1
        rrl,r2
        rrl,r1
        cpsl    wc
        andi,r2 0f0h
        iorz    r2
        strz    r2
        bctr,un gthexc
;
;                                       == output hex word
wrtbs   loda,r0 mram,r3
        bstr,un wchex
        loda,r0 mram+1,r3
;                                       == output hex byte
wchex   strz    r1
        rrr,r0
        rrr,r0
        rrr,r0
        rrr,r0
        bstr,un wchexa
        zbsr    wrtzv
        lodz    r1
        bstr,un wchexa
        zbrr    wrtzv
;
wchexa  andi,r0 00fh
        iori,r0 030h
        comi,r0 03ah
        retc,lt
        addi,r0 7
        retc,un
;
;                                       == input routine, one chracter to buffer
;                                          R2 indicates max characters
;                                          R3 is input buffer pointer
inprt   zbsr    redzv                   ; get char from user
        comi,r0 '~'
        bctr,gt inprt                   ; ignore del
        comi,r0 bs                      ; back space ?
        bcfr,eq inprtc                  ; no
        brnr,r3 inprtb                  ; decrement R3 and if zero, return escape character
inprta  lodi,r0 esc
        retc,un
;
inprtb  subi,r3 1                       ; decrement input buffer pointer
        zbsr    wrtzv
        bctr,un inprt                   ; go get next character
;
inprtc  comi,r0 nak                     ; nak ?
        bctr,eq inprtd                  ; yes
        comi,r0 ' '                     ; any other control character ?
        retc,lt                         ; yes, return with cc = neg
inprtd  strz    r1                      ; save character
        lodz    r2                      ; get max characters input buffer
        comz    r3                      ; compare with number of characters entered
        bcfr,gt inprta                  ; return with esc if buffer full
        subz    r3
        comi,r0 4                       ; 4 bytes left?
        bctr,gt inprte                  ; no, more then 4
        lodi,r0 bel                     ; issue warning that buffer is almost full
        zbsr    wrtzv
inprte  lodz    r1                      ; get entered character
        zbsr    wrtzv                   ; echo to screen
        comi,r1 nak                     ; forward cursor
        bctr,eq inprtf                  ; yes, keep character returned from screen
        lodz    r1                      ; get entered character
inprtf  comi,r0 " "                     ; control character (nak)?
        bctr,lt inprta                  ; return with esc
        comi,r0 "~"                     ; del or something with b7 set?
        bctr,gt inprta                  ; yes, return with esc
        stra,r0 inpram,r3+              ; accept character and store it in input buffer.
        bctr,un inprt                   ; get next character
;
;                                       == check if escape kew was pressed
chesc   zbsr    chizv
        comi,r0 del
        retc,eq
        zbsr    redzv
        comi,r0 esc
        bctr,eq errorb
        retc,un
;
;                                       == write error to screen and quit current action
error   lodi,r3 errdend-errdat
errora  loda,r0 errdat,r3-
        zbsr    wrtzv
        brnr,r3 errora
errorb  zbsr    wrtcr
        bcta,un *eret
;
        db      text, errdend-errdat
errdat  db      "RORRE"
        db      bel,lf,cr
errdend equ     $
;
;                                       == 'type wtiter', echo everything until escape pressed
typwr   zbsr    redzv
        comi,r0 esc
        retc,eq
        zbsr    wrtzv
        bctr,un typwr
;
;                                       == monitor main loop
monml   lodi,r0 com
        lpsl
        eorz    r0
        lpsu                            ; stack pointer now is 0 !
        strz    r3                      ; clear input buffer pointer
        stra,r0 comres                  ;
        stra,r0 inpram                  ; 
        zbsr    wrtcr                   ; new line
        lodi,r2 0ffh                    ; ??
        lodi,r0 '*'                     ; prompt
monmla  zbsr    wrtzv                   ;
        bsta,un inprt                   ; get user command line
        comi,r0 1                       ; 
        bstr,eq typwr                   ; echo characters until escape is entered
        comi,r0 esc                     ; abort ?
        bctr,eq monml                   ; restart
        comi,r0 cr                      ; end of command
        bcfr,eq monmla                  ; no
        stra,r0 inpram,r3+              ; store cr at end of line
        zbsr    wrtcr                   ; newline
monmlb  eorz    r0                      ; contunue here for next command in command line, if any
        lpsu                            ;
        lodi,r0 com                     ;
        lpsl                            ;
        lodi,r0 HI monml                ; store error return addres
        stra,r0 eret                    ; can be used to return to program that was called from here or elsewhere
        lodi,r0 LO monml                ; and if escape pressed a jump is made to eret
        stra,r0 eret+1                  ;
        zbsr    *gthexv                 ; get hex value from input buffer
        bctr,eq monmlc                  ; 
        lodi,r2 080h                    ; set bit 7 
monmlc  zbsr    *tinprv                 ; get character from input buffer
        bctr,eq monmlc                  ; skip spaces
        comi,r0 cr                      ; end of command line?
        bcta,eq monml                   ; yes
        lodi,r1 numcmd                  ; number of command characters
monmld  coma,r0 mncmda,r1-              ; find command
        bctr,eq monmle                  ; found
        brnr,r1 monmld                  ; try next
        bcta,un error                   ; invalid command character
;
monmle  loda,r0   mncmdb,r1             ; get required hex values indicator for command
        iorz      r2                    ; 
        bctr,lt   monmlf                ; bit 7 was set
        andi,r0   0f1h                  ; save all bits except the ones indicating which value must be stored.
monmlf  strz      r2                    ; store in R2 for processing
        iora,r0   comres                ; or with previous
        strz      r3                    ; R3 can be used in the user selected function
        rrr,r2                          ; bit 0 is 1 ? command letter?
        bcfr,n    monmlg                ; no
        eorz      r0                    ; clear comres if command. Then it is free for next command
monmlg  stra,r0   comres                ; now determine the where the hex value has te be stored.
        lodi,r0   LO stad               ; start address
        rrr,r2                          ; bit 1 is 1 ?
        bctr,n    monmlh                ; yes
        lodi,r0   LO enad               ; end address
        rrr,r2                          ; bit 2 is 1 ?
        bctr,n    monmlh                ; yes
        lodi,r0   LO toad               ; target address
        rrr,r2                          ; bit 3 is 1 ?
        bcfr,n    monmli                ; no
monmlh  zbsr      *pstbsv               ; store hex value
monmli  rrl,r1                          ; index x2
        loda,r0   mncmdc,r1+            ; get address constant for 
        stra,r0   cmad+1
        loda,r0   mncmdc,r1-
        stra,r0   cmad
        bsta,un   *cmad
        zbsr      *chescv               ; check if escape pressed and quit if so
        bcta,un   monmlb
;
        db      text,numcmd
MNCMDA  db      "-:=>GIMPQRSTUVWX"
numcmd  equ     $-MNCMDA
;
;                                       ; bits indicating command properties
;                                       ; bit 0 indicates command, causes comres to be cleared
;                                       ; bit 1 indicates start address required
;                                       ; bit 2 indicates end address required
;                                       ; bit 3 indicates target address required
        db      data,numcmd
MNCMDB  db      002h                    ; - start address is entered
        db      003h                    ; : start address and command
        db      001h                    ; = command only, no data required
        db      004h                    ; > end address is entered
        db      003h                    ; G start address and command
        db      005h                    ; I end address and command
        db      009h                    ; M target address and command
        db      009h                    ; P target address and command
        db      003h                    ; Q start address and command
        db      003h                    ; R start address and command
        db      001h                    ; S command only
        db      001h                    ; T command only
        db      003h                    ; U start address and command
        db      009h                    ; V target address and command
        db      005h                    ; W end address and command
        db      001h                    ; X command only
;
        db      acon,numcmd*2
mncmdc  dw      monmlb                  ; set start address
        dw      cgmem                   ; change memory
        dw      dpbnk                   ; display bank
        dw      monmlb                  ; set end address
        dw      gomem                   ; go execute
        dw      inmem                   ; inspect memory
        dw      momem                   ; move memory
        dw      prmem                   ; preset memory
        dw      setqp                   ; set / execute at Q bank
        dw      rdcas                   ; read cassette
        dw      error                   ; error message
        dw      mdcrp                   ; go to mdcr software
        dw      setup                   ; set / execute at U bank
        dw      vymem                   ; verify memory
        dw      wrcas                   ; write cassette
        dw      ident                   ; indntify, prints monitor id
;
;                                       == check if the correct hex values were entered
;                                          R3 has the info that indicates required address values (see MNCMDB table)
;                                       ==  check if end address is not less then start address
chhxd   lodi,r0 LO enad                 ; end address
        zbsr    *pltbsv                 ;
        lodi,r0 LO stad                 ; start address
        zbsr    *cmtbsv                 ; compare
        bctr,un chhxdc
;
;                                       == check if target address does not cause an address larger then 32767
chhxda  lodi,r0 LO enad                 ; end address
        zbsr    *pltbsv                 ;
        lodi,r0 LO stad                 ; start address
        zbsr    *sbtbsv                 ;
        lodi,r0 LO toad                 ; target address
        zbsr    *adtbsv                 ; add
        loda,r0 tbsr                    ; get ms byte result
        retc,n                          ; no good if negatige (>7fff)
chhxdb  tmi,r3  008h                    ; target address entered?
        retc,n                          ; no
        loda,r0 toad                    ; target address > 32767 ?
chhxdc  retc,n                          ; yes
        tmi,r3  004h                    ; end address entered?
        retc,n                          ; no
        loda,r0 enad                    ; end address larger then 32767 ?
        retc,n                          ; yes
chhxdd  tmi,r3  002h                    ; start address entered ?
        retc,n                          ; no
        loda,r0 stad                    ; start address larger then 32767 ?
        retc,un                         ; it shows in cc
;
;                                       == inspect memory
inmem   tmi,r3  004h                    ; end address entered ?
        bctr,z  inmema                  ; yes
        lodi,r0 LO enad                 ;
        zbsr    *ictbsv                 ; increment end address if none entered
inmema  lodi,r0 LO enad                 ;
        zbsr    *pltbsv                 ; end adrress to two bytes register
        tmi,r3  002h                    ; start address entered ?
        bctr,z  inmemb                  ; yes
        lodi,r0 LO stad                 ; if not, make start address equal to end address
        zbsr    *pstbsv                 ;
inmemb  lodi,r3 006h                    ; fake that start and end address are entered
        bsta,un chhxd                   ; check address value
        bcta,n  error                   ; error if incorrect
inmemc  zbsr    *chescv                 ; escape?
        zbsr    wrtcr                   ; etc etc
        lodi,r3 LO stad
        zbsr    *wrtbsv
        lodi,r0 ':'
        zbsr    wrtzv
inmemd  zbsr    wrtsp
inmeme  loda,r0 *stad
        zbsr    *wchexv
        zbsr    wrtsp
        lodi,r0 LO stad
        zbsr    *cmtbsv
        bcfa,gt wrtcr
        lodi,r0 LO stad
        zbsr    *ictbsv
        loda,r0 stad+1
        andi,r0 00fh
        bctr,z  inmemc
        andi,r0 003h
        bctr,z  inmemd
        bctr,un inmeme
;
;                                       == change memory
cgmem   zbsr    *gthexv
        bctr,z  cgmema
        loda,r0 stad
        bctr,n  cgmemb
        stra,r2 *stad
        lodi,r0 LO stad
        zbsr    *ictbsv
        bctr,un cgmem
;
cgmema  zbsr    *tinprv
        comi,r0 '.'
        retc,eq
        comi,r0 cr
        bcta,eq *eret
cgmemb  bcta,un error
;
;                                       == move memory
momem   bsta,un chhxd
        bctr,n  cgmemb
        bsta,un chhxda
        bctr,n  cgmemb
        lodi,r0 LO enad
        zbsr    *cmtbsv
        retc,eq
        bctr,gt momemb
momema  loda,r0 *stad
        stra,r0 *toad
        lodi,r0 LO toad
        zbsr    *cmtbsv
        retc,z
        retc,n
        lodi,r0 LO stad
        zbsr    *ictbsv
        lodi,r0 LO toad
        zbsr    *ictbsv
        bctr,un momema
;
momemb  loda,r0 *enad
        stra,r0 *tbsr
        lodi,r0 LO toad
        zbsr    *cmtbsv
        retc,z
        retc,n
        lodi,r0 LO enad
        zbsr    *dctbsv
        lodi,r0 LO tbsr
        zbsr    *dctbsv
        bctr,un momemb
;
;                                       == verify memory
vymem   bsta,un chhxd
        bctr,n  vymema
        bsta,un chhxda
vymema  bcta,n  error
        lodi,r3 0
vymemb  loda,r0 *stad
        coma,r0 *toad
        bctr,eq vymemc
        zbsr    wrtcr
        lodi,r3 LO stad
        bstr,un vymeme
        lodi,r3 LO toad
        bstr,un vymeme
        zbsr    *chescv
vymemc  lodi,r0 LO enad
        zbsr    *pltbsv
        lodi,r0 LO stad
        zbsr    *cmtbsv
        bcfr,p  vymemd
        lodi,r0 LO stad
        zbsr    *ictbsv
        lodi,r0 LO toad
        zbsr    *ictbsv
        bctr,un vymemb
;
vymemd  lodz    r3
        retc,z
        zbrr    wrtcr
;
vymeme  lodz    r3
        zbsr    *pltbsv
        zbsr    *wrtbsv
        lodi,r0 ':'
        zbsr    wrtzv
        loda,r0 *tbsr
        zbsr    *wchexv
        zbsr    wrtsp
        zbrr    wrtsp
;
;                                       == write cassette
;                                       this should be compatible with Apple II tape format
wrcas   bsta,un chhxd
        bcta,n  error
        lodi,r0 LO tbsr
        zbsr    *ictbsv
        lodi,r0 LO stad
        zbsr    *sbtbsv
        lodi,r0 LO enad
        zbsr    *pstbsv
        lodi,r0 HI mram
        stra,r0 tbsr
        eorz    r0
        strz    r1
        stra,r0 tbsr+1
        lodi,r2 3
        lodi,r3 247
        bstr,un headr
        lodi,r0 64
        lodi,r2 2
        bstr,un headr
        lodi,r0 LO stad
        zbsr    *pltbsv
        lodi,r0 64
        loda,r1 enad
        loda,r2 enad+1
        lodi,r3 0
headr   ppsl    rs
headra  lodi,r1 26
        lodi,r2 78
        bctr,un headrc
;
headrb  lodi,r2 80
        iorz    r0
headrc  bdrr,r2 headrc
        ppsu    F+II
        lodi,r2 81
        iorz    r0
headrd  bdrr,r2 headrd
        cpsu    F
        bdrr,r1 headrb
        bdrr,r0 headra
        nop
        lodi,r1 20
        bstr,un wcbyta
        lodi,r3 0ffh
        lodi,r1 12
        cpsl    RS
wrclp   loda,r0 *tbsr,r3
        ppsl    RS
        bstr,un wcbyt
        lodi,r1 2
        bstr,un idcrt
        iorz    r0
        bcfr,z  wrclp
        ppsl    RS
        lodz    r3
        lodi,r3 25
        lodi,r1 2
wrclpa  bstr,un wcbyt
        eorz    r0
        lodi,r1 18
        iorz    r0
        bdrr,r3 wrclpa
        cpsl    RS
        rete,un
;
wcbyt   lodi,r2 7                       ; for 8 bits...
wcbyta  bdrr,r1 wcbyta
        iorz    r0
        bcfr,n  wcbytc
        lodi,r1 27
wcbytb  bdrr,r1 wcbytb
wcbytc  ppsu    F
        iorz    r0
        bctr,n  wcbytd
        lodi,r1 23
        bctr,un wcbyte
;
wcbytd  lodi,r1 52
wcbyte  bdrr,r1 wcbyte
        nop
        cpsu    F
        rrl,r0
        subi,r2 1
        retc,n
        lodi,r1 21
        bctr,un wcbyta
;
;                                       == increment address for casette routines
idcrt   eorz    r3
        strz    r3
        lodi,r0 WC+COM
        lpsl
        addi,r3 1
        loda,r0 tbsr
        addi,r0 0
        stra,r0 tbsr
        cpsl    C
        subi,r2 0
        subi,r1 0
        cpsl    WC
        lodz    r1
        iorz    r2
        retc,un
;
;                                       == read data from cassette
;                                       this should be compatible with Apple II tape format
rdcas   lodi,r0 HI mram
        stra,r0 tbsr
        eorz    r0
        stra,r0 tbsr+1
        strz    r1
        tmi,r3  002h
        bctr,z  rdcasa
        lodi,r2 3
        lodi,r3 247
        bsta,un rdhdr
        loda,r0 cpores                  ; control port out storage
        wrtc,r0
rdcasa  lodi,r2 2
        lodi,r3 250
        bstr,un rdhdr
        lodi,r0 LO enad
        zbsr    *pltbsv                 ; tbsr = enad
        lodi,r0 LO toad
        zbsr    *pstbsv                 ; toad = tbsr
        lodi,r0 LO tbsr
        zbsr    *dctbsv                 ; tbsr -= 1
        lodi,r0 LO stad
        zbsr    *adtbsv                 ; tbsr += stad
        lodi,r0 LO enad
        zbsr    *pstbsv                 ; enad = tbsr
        lodi,r3 6
        bsta,un chhxd
        bcta,n  error
        zbsr    wrtcr
        lodi,r3 5
rdcasb  loda,r0 stad-2,r2+
        zbsr    *wchexv
        bdrr,r3 rdcasb
        zbsr    wrtcr
        zbsr    chizv
        comi,r0 esc
        bcta,eq *eret
        lodi,r0 LO stad
        zbsr    *pltbsv
        loda,r1 toad
        loda,r2 toad+1
rdhdr   ppsl    RS
        lodi,r3 255
        lodi,r1 32
rdhdra  tpsu    S
        bcfr,z  rdhdrb
        bdrr,r1 rdhdra
rdhdrb  bstr,un rdbit
        bcfr,n  rdhdrb
rdclp   bstr,un rdbyt
        cpsl    RS
        stra,r0 *tbsr,r3
        ppsl    RS
        bsta,un idcrt
        ppsl    RS
        bcfr,z  rdclp
        bstr,un rdbyt
        eorz    r3
        bcfr,z  rdbitd
        cpsl    RS
rdclpa  bdrr,r1 rdclpa
        bdrr,r0 rdclpa
        retc,un
;
rdbyt   lodi,r2 7
        eorz    r0
rdbyta  rrl,r0
        bstr,un rdbit
        bctr,n  rdbytb
        iori,r0 1
rdbytb  subi,r2 1
        retc,n
        bctr,un rdbyta
;
rdbit   lodi,r1 224
rdbita  tpsu    S
        bctr,z  rdbitb
        birr,r1 rdbita
        bctr,un rdbitd

rdbitb  lodi,r1 224
rdbitc  tpsu    S
        bcfr,z  rdbite
        birr,r1 rdbitc
rdbitd  cpsl    RS+WC
        bcta,un error
;
rdbite  addi,r1 20
        retc,un
;
;                                       == set U-bank 1 and continue at mdcr software
mdcrp   lodi,r2 010h
        bstr,un setupa
mdcrpa  bcta,un ustrt
;
;                                       == select U-bank
setup   tmi,r3  002h
        bcfr,z  mdcrpa
        loda,r2 tbsr+1
        rrl,r2
        rrl,r2
        rrl,r2
        rrl,r2
        andi,r2 0f0h
setupa  loda,r0 cpores
        andi,r0 00fh
setupb  iorz    r2
        stra,r0 cpores
        wrtc,r0
        retc,un
;
;                                       == select Q-bank
setqp   tmi,r3  002h
        bcfa,z  qstrt
        loda,r2 tbsr+1
        andi,r2 00fh
        loda,r0 cpores
        andi,r0 0f0h
        bctr,un setupb
;
;                                       == go execute stuff at entered address
gomem   bsta,un chhxdd
        bcta,n  error
        bcta,un *tbsr
;
;                                       == display banks
dpbnk   zbsr    wrtcr
        loda,r0 cpores
        zbsr    *wchexv
        zbrr    wrtcr
;
;                                       == preset memory area
prmem   bsta,un chhxd
        bctr,n  prmema
        bsta,un chhxdb
prmema  bcta,n  error
        loda,r3 toad+1
prmemb  stra,r3 *stad
        lodi,r0 LO stad
        zbsr    *cmtbsv
        retc,eq
        retc,lt
        lodi,r0 LO stad
        zbsr    *ictbsv
        bctr,un prmemb
;
;                                       == print monitor version etc...
ident   lodi,r1 0ffh
        lodi,r2 idtdate-idtdat
identa  loda,r0 idtdat,r1+
        zbsr    wrtzv
        bdrr,r2 identa
        retc,un
;
        db      titl, idtdate-idtdat
idtdat  db      cr,lf
        db      "*** PHUNSY MONITOR 04-00 *** '82 "
        db      cr,lf
idtdate equ     $
;
;                                       == initial address constants for ram
        db      acon, ioptrse-ioptrs
ioptrs  equ     $
        dw      wchar
        dw      keyin
        dw      chinp
        dw      srout
        dw      serin
        dw      dchin
ioptrse equ     $
;
;                                       == monitor initialisation after reset
minit   eorz    r0
        wrtd,r0
        wrtc,r0
        stra,r0 cpores
        lpsu
        lodi,r0 com
        lpsl
        redc,r0
        lodi,r1 05ah
        tmi,r0  004h
        bctr,z  minita
        lodi,r1 0feh
minita  stra,r1 brtres
        lodi,r2 6
        lodi,r1 6
        tmi,r0  002h
        bctr,z  minitb
        lodi,r1 12
minitb  loda,r0 ioptrs,r1-
        stra,r0 ioad,r2-
        brnr,r2 minitb
        eorz    r0
        zbsr    wrtzv
        lodi,r0 bel
        zbsr    wrtzv
        bcta,un monml
;
;                                       == check for key input
chinp   redd,r0
        bcfr,n  keyina                  ; branch if msb is 0
        lodi,r0 del                     ; indicate no key pressed
        retc,un
;
;                                       == wait for keyboard entry and get it
keyin   redd,r0
        bctr,n  keyin                   ; wait until key pressed, until msb (=keyboard flip-flop is 0
keyina  ppsl    RS
        lodi,r1 KEYBACK                 ; keyboard ack bit, preset keyboard flip-flop to '1'
        wrtd,r1
        redd,r0                         ; read key data byte
        lodi,r1 0                       ; stop clearing keyboard flip-flop
        wrtd,r1
keyinb  redd,r1
        bcfr,n  keyinb                  ; wait until keyboard flip-flop is set to 1
        cpsl    RS
        andi,r0 07fh
        retc,un
;
;                                       == screen routines
;                                          the screen memory is located from 1000-17FF
;                                          it is output as a video signal to a monotor in black & white
;                                          there are 32 lines of 64 characters
;                                          R1-R3 are left unchanged
;                                          R0 returns the character that appears from under the cursor
wchar   ppsl    RS
        iorz    r0
        bctr,z  wchara
        loda,r3 curres
        stra,r3 *curs
wchara  comi,r0 del
        bctr,lt wcharb
        bctr,z  wcharg
        lodi,r3 13
        tmi,r0  040h
        bctr,z  wcharf
        lodi,r3 54
        tmi,r0  020h
        bctr,z  wcharf
wcharb  comi,r0 ' '
        bctr,lt wcharc
        andi,r0 07fh
        stra,r0 *curs
        lodi,r3 0
        loda,r0 curs+1
        andi,r0 03fh
        coma,r0 rienre
        bctr,lt wcharf
        lodi,r3 09ah
        bctr,un wcharf
;
wcharc  lodi,r3 16
wchard  coma,r0 wcdata,r3-
        bctr,eq wchare
        brnr,r3 wchard
        bctr,un wcharg
;
wchare  loda,r0 wcdatb,r3
        strz    r3
wcharf  bsxa    ricur,r3
wcharg  loda,r0 curres
        loda,r3 *curs
        stra,r3 curres
        lodi,r3 del
        stra,r3 *curs
        cpsl    RS
        retc,un
;
;                                       == control characters
        db      data, 16
WCDATA  db      rscrn                   ; reset screen
        db      cleol                   ; clear cursor to end of line
        db      cleos                   ; clear cursor to end of screen
        db      bel                     ; bell
        db      bs                      ; move cursor left 1 position
        db      cscrn                   ; clear screen
        db      cr                      ; carriage return
        db      culem                   ; move cursor to left most position
        db      curim                   ; move cursor to right most position
        db      cuupm                   ; move cursor to top of screen
        db      cudom                   ; move cursor to bottom of screen
        db      nak                     ; move cursor one position right
        db      curi1                   ; move cursor one position right
        db      cule1                   ; move cursor one position left
        db      cudo1                   ; move cursor one position lower
        db      cuup1                   ; move cursor one position higher
;
;                                       == index to control routines
        db      data, 16
WCDATB  db      rstsc-ricur
        db      clcel-ricur
        db      clcep-ricur
        db      bellr-ricur
        db      lecur-ricur
        db      clscr-ricur
        db      cretn-ricur
        db      sclep-ricur
        db      scrip-ricur
        db      scupp-ricur
        db      sclop-ricur
        db      ricur-ricur
        db      ricur-ricur
        db      lecur-ricur
        db      docur-ricur
        db      upcur-ricur
;
chvrl   loda,r3 curs+1
        loda,r0 curs
        ppsl    WC
        rrl,r3
        rrl,r0
        rrl,r3
        rrl,r0
        cpsl    WC
        andi,r0 01fh
        coma,r0 loenre
        bctr,lt chvrlb
chvrla  ppsl    CC0
        retc,un
;
chvrlb  coma,r0 upstre
        bctr,gt chhrla
chvrlc  ppsl    CC1
        retc,un
;
chhrl   loda,r0 curs+1
        andi,r0 03fh
        coma,r0 rienre
        bcfr,lt chvrla
        coma,r0 lestre
        bcfr,gt chvrlc
chhrla  comz    r0
        retc,un
;
ricur   bstr,un chhrl
        bctr,p  ricura
        lodi,r0 1
        bctr,un docurb
;
ricura  bstr,un docur
sclep   loda,r0 lestre
stcrh   andi,r0 03fh
        loda,r3 curs+1
        andi,r3 0c0h
        iorz    r3
        stra,r0 curs+1
        retc,un
;
docur   bsta,un chvrl
        bctr,p  scupp
docura  lodi,r0 64
docurb  adda,r0 curs+1
        stra,r0 curs+1
        loda,r0 curs
        ppsl    WC
        addi,r0 0
        cpsl    WC
        stra,r0 curs
        retc,un
;
scupp   loda,r0 upstre
stcrv   rrr,r0
        rrr,r0
        strz    r3
        andi,r3 007h
        iori,r3 010h
        stra,r3 curs
        loda,r3 curs+1
        andi,r0 0c0h
        andi,r3 03fh
        iorz    r3
        stra,r0 curs+1
        retc,un
;
lecur   bsta,un chhrl
        bctr,n  lecura
        lodi,r3 1
        bctr,un upcura
;
lecura  bstr,un upcur
scrip   loda,r0 rienre
        bcta,un stcrh
;
upcur   bsta,un chvrl
        bctr,n  sclop
        lodi,r3 64
upcura  loda,r0 curs+1
        subz    r3
        stra,r0 curs+1
        loda,r0 curs
        ppsl    WC
        subi,r0 0
        cpsl    WC
        stra,r0 curs
        retc,un
;
sclop   loda,r0 loenre
        bcta,un stcrv
;
rstsc   eorz    r0                      ; min left and upper margin
        stra,r0 upstre
        stra,r0 lestre
        lodi,r0 31                      ; max lower margin
        stra,r0 loenre
        lodi,r0 63                      ; max right margin
        stra,r0 rienre
clscr   bsta,un sclep
        bsta,un scupp
        bcta,un clcep
;
cretn   bstr,un clcel
        bsta,un sclep
        bsta,un docur
        bsta,un chvrl
        retc,z
        retc,p
        loda,r3 loenre
        suba,r3 upstre
        bcfr,gt clcel
cretna  loda,r0 rienre
        suba,r0 lestre
        addi,r0 1
        strz    r1
        addi,r0 64
        strz    r2
cretnb  loda,r0 *curs,r2-
        stra,r0 *curs,r1-
        brnr,r1 cretnb
        bsta,un docura
        bdrr,r3 cretna
clcel   loda,r0 rienre
        loda,r3 curs+1
        andi,r3 03fh
        subz    r3
        strz    r3
        addi,r3 1
        lodi,r0 ' '
clcela  stra,r0 *curs,r3-
        brnr,r3 clcela
        retc,un
;
clcep   loda,r1 curs
        loda,r2 curs+1
clcepa  bstr,un clcel
        bsta,un chvrl
        bctr,p  clcepb
        bsta,un sclep
        bsta,un docura
        bctr,un clcepa
;
clcepb  stra,r1 curs
        stra,r2 curs+1
        retc,un
;
bellr   eorz    r0
        lodi,r1 64
bellra  lodi,r2 64
        eori,r0 SPEAKER
        wrtd,r0
bellrb  bdrr,r2 bellrb
        bdrr,r1 bellra
        retc,un
;
;                                       == serial user output
srout   PPSL    RS
        lodi,r1 9
        strz    r2
        eori,r2 0ffh
        lodi,r0 ttyout                  ; bit 0
srouta  wrtd,r0
        bstr,un delay
        lodz    r2
        rrr,r2
        andi,r0 ttyout
        bdrr,r1 srouta
        wrtd,r1
        bstr,un delay
        bstr,un delay
        cpsl    RS
dchin   lodi,r0 del
        retc,un
;
delay   loda,r0 brtres
        strz    r3
delaya  bdrr,r3 $
delayb  bdrr,r0 $
delayc  loda,r0 brtres
        strz    r3
delayd  bdrr,r3 $
delaye  bdrr,r0 $
        retc,un
;
;                                      == serial user input
serin   bstr,un serina
        andi,r0 07fh
        retc,un
;
serina  ppsl    RS
        lodi,r2 0
        lodi,r1 8
serinb  redc,r0
        andi,r0 ttyin
        bcfr,z  serinb
        bstr,un delayc
serinc  bstr,un delay
        redc,r0
        andi,r0 ttyin
        iorz    r2
        strz    r2
        rrr,r2
        bdrr,r1 serinc
        bstr,un delay
        lodz    r2
        cpsl    RS
        retc,un
;
        section ram
        org     mram
;
        ds      0e0h                    ; 224 bytes not used by the monitor
zb1a    ds      2                       ;
zb2a    ds      2                       ;
cmad    ds      2                       ; command address
eret    ds      2                       ; indirect escape return address
ioad    ds      2                       ; indirect output address - pointer to character output routine
iiad    ds      2                       ; indirect input address - pointer to character input routine
icad    ds      2                       ; indirect check input address - key pressed?
brtres  ds      1                       ; baudrate
curres  ds      1                       ; cursor position
upstre  ds      1                       ; screen border upper
lestre  ds      1                       ; screen border left
loenre  ds      1                       ; screen border lower
rienre  ds      1                       ; screen border rigth
curs    ds      2                       ; cursor position
comres  ds      1                       ; command information reserved byte
cpores  ds      1                       ; control port out storage
stad    ds      2                       ; start address
enad    ds      2                       ; end address
toad    ds      2                       ; target address
tbsr    ds      2                       ; two bytes register
;
        org     inpram
        ds      256                     ; input ram, 1st byte is index
;
        end
