        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  "mdcr program FP-2010-11-12"
        name    phunsy_pdcr_006         ;the module name
;
;       mdcr 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 i/o definitions
        INCLUDE "monitor.inc"           ; monitor definitions
;
;
;                                       casette definitions
finfo   equ     128                     ;2nd 128 bytes in catalog is file info
fadr    equ     0                       ;file address (lsb first !)
flen    equ     2                       ;file length  (lsb first !)
fbix    equ     4                       ;first block of file on cassette
lang    equ     5                       ;language info byte
bank    equ     6                       ;bank info (control port)
part    equ     7                       ;part, program files may consist of more then one part
;
        section rom
        org     01800h
;
MDCRT   EORZ    R0                      ;1800 20
        WRTD,R0                         ;1801 F0
        STRZ    R2                      ;1802 C2
        CPSU    II                      ;1803 7420
        LODI,R0 COM                     ;1805 0402
        LPSL                            ;1807 93
        BSTR,UN GENAM                   ;1808 3B34      get command to filename buffer
        LODI,R1 10                      ;180A 050A      there are 10 commands
MDCRTA  LODI,R3 0FFh                    ;180C 07FF
MDCRTB  LODA,R0 FNAME,R3+               ;180E 0F2E08
        COMA,R0 MDCRCT,R2               ;1811 EE786B
        BCTR,EQ MDCRTE                  ;1814 180E
MDCRTC  LODA,R0 MDCRCT,R2               ;1816 0E786B
        ADDI,R2 1                       ;1819 8601
        COMI,R0 " "                     ;181B E420
        BCFR,EQ MDCRTC                  ;181D 9877
        BDRR,R1 MDCRTA                  ;181F F96B
MDCRTD  BCTA,UN INPER                   ;1821 1F18C2    command not found, input error
;
MDCRTE  LODA,R0 MDCRCT,R2+              ;1824 0E386B
        COMI,R0 " "                     ;1827 E420
        BCFR,EQ MDCRTB                  ;1829 9863
        COMA,R0 FNAME,R3+               ;182B EF2E08
        BCFR,EQ MDCRTD                  ;182E 9871
        LODI,R2 2                       ;1830 0602
        RRL,R1                          ;1832 D1        command number x2
MDCRTF  LODA,R0 CMDADR,R1-              ;1833 0D58A2
        STRA,R0 cmad,R2-                ;1836 CE4EE4
        BRNR,R2 MDCRTF                  ;1839 5A78
        BCTA,UN *cmad                   ;183B 1F8EE4
;
;                                       == Get command or filename
GENAM   LODI,R1 0FFh                    ;183E 05FF
GENAMA  ZBSR    *tinprv                 ;1840 BBB0      get char from input buffer and compare with space
        BCTR,EQ GENAMA                  ;1842 187C      skip spaces
GENAMB  BCFR,GT GENAMC                  ;1844 9913      branch if not printable (>20)
        COMI,R0 ","                     ;1846 E42C
        BCTR,EQ GENAMC                  ;1848 180F
        COMI,R0 ";"                     ;184A E43B
        BCTR,EQ GENAMC                  ;184C 180B
        COMI,R1 7                       ;184E E507
        BCTR,EQ MDCRTD                  ;1850 184F      input error
        STRA,R0 FNAME,R1+               ;1852 CD2E08
        ZBSR    *tinprv                 ;1855 BBB0
        BCTR,UN GENAMB                  ;1857 1B6B
;
GENAMC  LODZ    R1                      ;1859 01        length is 0?
        BCTR,LT MDCRTD                  ;185A 1A45      yes, input error
        STRA,R3 inpram                  ;185C CF0F00    input buffer pointer
GENAMD  COMI,R1 006h                    ;185F E506      8 chars copied?
        RETC,GT                         ;1861 15        yes
        LODI,R0 " "                     ;1862 0420      fill with spaces
        STRA,R0 FNAME,R1+               ;1864 CD2E08
        BCTR,UN GENAMD                  ;1867 1B76
;
        BYTE    text,MDCRCTE-MDCRCT     ;1869 (35h)
MDCRCT  BYTE    "CAT "
        BYTE    "DELETE "
        BYTE    "INIT "
        BYTE    "LOAD "
        BYTE    "LOCK "
        BYTE    "RENAME "
        BYTE    "REW "
        BYTE    "RUN "
        BYTE    "SAVE "
        BYTE    "UNLOCK "
MDCRCTE equ     $
;
        BYTE    acon,CMDADRE-CMDADR     ;18A0
CMDADR  EQU     $
        WORD    UNLOR                   ;18A2 1D8A
        WORD    SAVRT                   ;18A4 1E4E
        WORD    RUNRT                   ;18A6 1EFF
        WORD    REWRT                   ;18A8 1FBE
        WORD    RENAM                   ;18AA 1DBA
        WORD    LOCKR                   ;18AC 1DA2
        WORD    LOADR                   ;18AE 1D6D
        WORD    INITC                   ;18B0 19B6
        WORD    DELET                   ;18B2 1E0B
        WORD    CATAL                   ;18B4 1C63
CMDADRE EQU     $
;
;                                       == error entries
;                                       R0: bit0-3 number of first word.
;                                           bit4-6 number of words
;                                           bit7   if 0, also print word 0, ERROR
;                                                  if 1, do not print ERROR, just message
REDER   LODI,R0 014h                    ;18B6 0414      READ ERROR
        BCTR,UN MDCER                   ;18B8 1B22
CASER   LODI,R0 011h                    ;18BA 0411      CASSETTE ERROR
        BCTR,UN MDCER                   ;18BC 1B1E
WRPER   LODI,R0 0B1h                    ;18BE 04B1      CASSETTE WRITE PROTECTED
        BCTR,UN MDCER                   ;18C0 1B1A
INPER   LODI,R0 015h                    ;18C2 0415      INPUT ERROR
        BCTR,UN MDCER                   ;18C4 1B16
NICER   LODI,R0 0B6h                    ;18C6 04B6      NOT IN CATALOG
        BCTR,UN MDCER                   ;18C8 1B12
CFLER   LODI,R0 0A8h                    ;18CA 04A8      CATALOG FULL
        BCTR,UN MDCER                   ;18CC 1B0E
RUNER   LODI,R0 01Ah                    ;18CE 041A      RUN ERROR
        BCTR,UN MDCER                   ;18D0 1B0A
TLGER   LODI,R0 0ABh                    ;18D2 04AB      TOO LONG
        BCTR,UN MDCER                   ;18D4 1B06
LKDER   LODI,R0 09Dh                    ;18D6 049D      LOCKED
        BCTR,UN MDCER                   ;18D8 1B02
JSTER   LODI,R0 000h                    ;18DA 0400      ERROR
;
MDCER   CPSL    RS+WC                   ;18DC 7518
        STRZ    R1                      ;18DE C1
        STRZ    R2                      ;18DF C2
        EORZ    R0                      ;18E0 20
        WRTD,R0                         ;18E1 F0
        ZBSR    wrtcr                   ;18E2 BB0B
        LODI,R3 0FFh                    ;18E4 07FF
MDCERA  LODA,R0 FNAME,R3+               ;18E6 0F2E08
        COMI,R0 " "                     ;18E9 E420
        BCTR,EQ MDCERB                  ;18EB 1806
        ZBSR    wrtzv                   ;18ED BB05
        COMI,R3 6                       ;18EF E706
        BCFR,GT MDCERA                  ;18F1 9973
MDCERB  ZBSR    wrtsp                   ;18F3 BB03
;
        LODZ    R1                      ;18F5 01
        BCTR,EQ MDCERE                  ;18F6 1823      branch of only error is printed
        LODI,R3 0FFh                    ;18F8 07FF
        ANDI,R2 00Fh                    ;18FA 460F
MDCERC  LODA,R0 ERRTBL,R3+              ;18FC 0F392E
        COMI,R0 020h                    ;18FF E420
        BCFR,EQ MDCERC                  ;1901 9879
        BDRR,R2 MDCERC                  ;1903 FA77
        ANDI,R1 0F0h                    ;1905 45F0
MDCERD  LODA,R0 ERRTBL,R3+              ;1907 0F392E
        STRZ    R2                      ;190A C2
        ZBSR    wrtzv                   ;190B BB05
        COMI,R2 " "                     ;190D E620
        BCFR,EQ MDCERD                  ;190F 9876
        SUBI,R1 010h                    ;1911 A510
        LODZ    R1                      ;1913 01
        ANDI,R0 07Fh                    ;1914 447F
        BCFR,EQ MDCERD                  ;1916 986F
        LODZ    R1                      ;1918 01
        BCFR,EQ MDCERG                  ;1919 980C      skip print 'error' if msb was set
MDCERE  LODI,R3 0FFh                    ;191B 07FF
MDCERF  LODA,R0 ERRTBL,R3+              ;191D 0F392E
        STRZ    R2                      ;1920 C2
        ZBSR    wrtzv                   ;1921 BB05
        COMI,R2 020h                    ;1923 E620
        BCFR,EQ MDCERF                  ;1925 9876
MDCERG  CPSU    II                      ;1927 7420
        BCTA,UN ERRORB                  ;1929 1F019F    cr,lf and return to error return address (ERET)
;
        BYTE    text,ERRTBLE-ERRTBL
ERRTBL  BYTE    "ERROR "                ;  0
        BYTE    "CASSETTE "             ;  1
        BYTE    "WRITE "                ;  2
        BYTE    "PROTECTED "            ;  3
        BYTE    "READ "                 ;  4
        BYTE    "INPUT "                ;  5
        BYTE    "NOT "                  ;  6
        BYTE    "IN "                   ;  7
        BYTE    "CATALOG "              ;  8
        BYTE    "FULL "                 ;  9
        BYTE    "RUN "                  ; 10
        BYTE    "TOO "                  ; 11
        BYTE    "LONG "                 ; 12
        BYTE    "LOCKED "               ; 13
ERRTBLE equ     $
;
CAREW   PPSU    II                      ;1980 7620
        BSTR,UN D150MS                  ;1982 3B16
CAREWA  REDC,R0                         ;1984 30
        TMI,R0  mdcrcip                 ;1985 F410      cassette present
        BCFA,EQ CASER                   ;1987 9C18BA
        TMI,R0  mdcrbet                 ;198A F420      cassette begin or end
        BCTR,EQ CAREWB                  ;198C 1805
        LODI,R0 mdcrrev                 ;198E 0410      cassette reverse
        WRTD,R0                         ;1990 F0
        BCTR,UN CAREWA                  ;1991 1B71
;
CAREWB  EORZ    R0                      ;1993 20
        WRTD,R0                         ;1994 F0        stop cassette
        STRA,R0 BLKNUM                  ;1995 CC0E01
        CPSU    II                      ;1998 7420
D150MS  LODI,R0 6                       ;199A 0406
D25MS   BSTR,UN D25MSA                  ;199C 3B09
;                                       == check if cassette still present
CHECA   REDC,R0                         ;199E 30
        ANDI,R0 mdcrcip+mdcrbet         ;199F 4430
        COMI,R0 mdcrcip                 ;19A1 E410
        BCFA,EQ CASER                   ;19A3 9C18BA
        RETC,UN                         ;19A6 17
;
D25MSA  PPSL    RS                      ;19A7 7710
D25MSB  LODI,R2 18                      ;19A9 0612
D25MSC  LODI,R3 152                     ;19AB 0798
D25MSD  BDRR,R3 D25MSD                  ;19AD FB7E
        BDRR,R2 D25MSC                  ;19AF FA7A
        BDRR,R0 D25MSB                  ;19B1 F876
        CPSL    RS                      ;19B3 7510
        RETC,UN                         ;19B5 17
;
INITC   LODI,R0 mdcrtst                 ;19B6 0408      set mdcr cassette present test flip flop
        WRTD,R0                         ;19B8 F0
        EORZ    R0                      ;19B9 20
        WRTD,R0                         ;19BA F0
        BSTR,UN CAREW                   ;19BB 3B43      rewind cassette
        REDC,R0                         ;19BD 30
        TMI,R0  mdcrwen                 ;19BE F408      writing allowed?
        BCFA,EQ WRPER                   ;19C0 9C18BE    no, cassette write protected
        PPSU    II                      ;19C3 7620
        EORZ    R0                      ;19C5 20
        STRZ    R1                      ;19C6 C1
INITCA  STRA,R0 TMPBLK,R1               ;19C7 CD6D00    clear the temp cassette buffer
        BIRR,R1 INITCA                  ;19CA D97B
        STRA,R0 CHECKS                  ;19CC CC0E00    and the checksum
        LODI,R0 mdcrfwd+mdcrwcd         ;19CF 0460      cassette forward with write enabled
        WRTD,R0                         ;19D1 F0
        LODI,R0 40                      ;19D2 0428      1 second delay
        BSTR,UN D25MS                   ;19D4 3B46
        LODI,R1 0FFh                    ;19D6 05FF      set block number to -1
INITCB  ADDI,R1 1                       ;19D8 8501      increment block number
        STRA,R1 BLKNUM                  ;19DA CD0E01    store block number
        LODI,R0 0AAh                    ;19DD 04AA      preamble
        BSTA,UN CCOUT                   ;19DF 3F1A3C    cassette character out
        DAR,R0                          ;19E2 94
        DAR,R0                          ;19E3 94
        LODZ    R1                      ;19E4 01        block number
        BSTA,UN CCOUT                   ;19E5 3F1A3C
        DAR,R0                          ;19E8 94
        DAR,R0                          ;19E9 94
        LODI,R0 0AAh                    ;19EA 04AA      
        BSTA,UN CCOUT                   ;19EC 3F1A3C
        LODZ    R1                      ;19EF 01        get block counter
        BCTR,LT INITCC                  ;19F0 1A11      branch if 128 blocks done
        LODI,R0 1                       ;19F2 0401
        BSTA,UN D25MS                   ;19F4 3F199C    25 ms delay
        BSTR,UN TBKTC                   ;19F7 3B1C      temporary block to cassette (takes 425 ms)
        LODI,R0 10                      ;19F9 040A      250ms delay
        BSTA,UN D25MS                   ;19FB 3F199C
        LODA,R1 BLKNUM                  ;19FE 0D0E01    get number of blocks
        BCTR,UN INITCB                  ;1A01 1B55
;
INITCC  LODI,R0 28                      ;1A03 041C
        BSTA,UN D25MSA                  ;1A05 3F19A7    700 ms delay
        REDC,R0                         ;1A08 30
        TMI,R0  mdcrcip                 ;1A09 F410
        BCFA,EQ CASER                   ;1A0B 9C18BA
        TMI,R0  mdcrbet                 ;1A0E F420      end of tape?
        BCFR,EQ INITCB                  ;1A10 9846      no, write another block number
        EORZ    R0                      ;1A12 20
        WRTD,R0                         ;1A13 F0        negate mdcr control
        RETE,UN                         ;1A14 37        done
;
;                                       == temporary block to cassette
TBKTC   LODI,R0 mdcrfwd+mdcrwcd         ;               initially data out bit is 0
        WRTD,R0                         ;               set the mdcr to write
        LODI,R0 2                       ;1A18 0402
        BSTA,UN D25MS                   ;1A1A 3F199C    50 ms delay
        LODI,R0 0AAh                    ;1A1D 04AA      preamble
        BSTR,UN CCOUT                   ;1A1F 3B1B
        IORZ    R0                      ;1A21 60
        IORZ    R0                      ;1A22 60
        LODA,R0 CHECKS                  ;1A23 0C0E00    get checksum
        BSTR,UN CCOUT                   ;1A26 3B14
        LODI,R1 0                       ;for 256 bytes
TBKTCA  LODA,R0 TMPBLK,R1               ;1A2A 0D6D00
        IORZ    R0                      ;1A2D 60
        BSTR,UN CCOUT                   ;1A2E 3B0C
        BIRR,R1 TBKTCA                  ;1A30 D978
        DAR,R0                          ;1A32 94
        LODI,R0 0AAh                    ;1A33 04AA
        BSTR,UN CCOUT                   ;1A35 3B05
        LODI,R0 1                       ;1A37 0401       25 ms delay
        BCTA,UN D25MS                   ;1A39 1F199C
;
;                                       == write byte to cassette
CCOUT   LODI,R2 16                      ;               16 times something to the contol port
CCOUTA  RRR,R0                          ;               rotate byte (bit 0 first)
CCOUTB  STRZ    R3                      ;               to r3 for output
        ANDI,R3 mdcrwda                 ;               strip anything else
        IORI,R3 mdcrfwd+mdcrwcd         ;               add bits to maintain write to cassette signals
        WRTD,R3                         ;               out
        SUBI,R2 1                       ;               decrement counter
        RETC,EQ                         ;               quit when done
        EORI,R0 0FFh                    ;               complement all data bits
        IORZ    R0                      ;               delay
        TMI,R2  1                       ;
        BCTR,EQ CCOUTC                  ;               no rotate but maintain correct number of cpu cycles
        BCTR,UN CCOUTA                  ;               next bit
;
CCOUTC  IORZ    R0                      ;               delay
        BCTR,UN CCOUTB                  ;               next bit
;
;                                       == read byte from cassette
CCHIN   LODI,R2 8                       ;1A54 0608
        EORZ    R0                      ;1A56 20
CCHINA  RRR,R0                          ;1A57 50        rotate byte being received
CCHINB  REDC,R3                         ;1A58 33        get mdcr read clock
        BCFR,N  CCHINB                  ;1A59 9A7D      wait if '0'
CCHINC  REDC,R3                         ;1A5B 33        read clock and data bit
        BCTR,N  CCHINC                  ;1A5C 1A7D      wait for falling egde clock
        RRL,R3                          ;1A5E D3        data bit to b7
        EORI,R3 080h                    ;1A5F 2780      invert bit
        ANDI,R3 080h                    ;1A61 4780      add it to the byte being received
        IORZ    R3                      ;1A63 63        restore
        BDRR,R2 CCHINA                  ;1A64 FA71      next until all 8 bits read
        RETC,UN                         ;1A66 17
;
;                                       == cassette read cycle
CRCYC   PPSU    II                      ;1A67 7620
        BSTR,UN RBKNR                   ;1A69 3B32
;                                       == read one block of cassette to temporary block
CTTBK   LODI,R0 mdcrfwd                 ;1A6B 0420
        WRTD,R0                         ;1A6D F0
        LODI,R0 1                       ;1A6E 0401
        BSTA,UN D25MS                   ;1A70 3F199C
        BSTR,UN CCHIN                   ;1A73 3B5F
        COMI,R0 0AAh                    ;1A75 E4AA
        BCFA,EQ REDER                   ;1A77 9C18B6
        BSTR,UN CCHIN                   ;1A7A 3B58
        STRA,R0 CHECKS                  ;1A7C CC0E00
        LODI,R1 0                       ;1A7F 0500
CTTBKA  BSTR,UN CCHIN                   ;1A81 3B51
        STRA,R0 TMPBLK,R1               ;1A83 CD6D00
        BIRR,R1 CTTBKA                  ;1A86 D979
        LODI,R0 2                       ;1A88 0402
CTTBKB  BSTA,UN D25MS                   ;1A8A 3F199C
        EORZ    R0                      ;1A8D 20
        WRTD,R0                         ;1A8E F0
        RETE,UN                         ;1A8F 37
;
;                                       == read first block number
RFBNR   BSTA,UN CAREW                   ;1A90 3F1980
        PPSU    II                      ;1A93 7620
        LODI,R0 mdcrfwd                 ;1A95 0420
        WRTD,R0                         ;1A97 F0
        LODI,R0 28                      ;1A98 041C
        BSTA,UN D25MS                   ;1A9A 3F199C    700 ms
;                                       == read block number
RBKNR   LODI,R0 mdcrfwd                 ;1A9D 0420
        WRTD,R0                         ;1A9F F0
        LODI,R0    4                    ;1AA0 0404
        BSTA,UN D25MS                   ;1AA2 3F199C    100 ms
RFBNRA  EORZ    R0                      ;1AA5 20
        WRTD,R0                         ;1AA6 F0        stop cassette
        LODI,R0 mdcrfwd                 ;1AA7 0420
        WRTD,R0                         ;1AA9 F0        cassette forward
        LODI,R0 1                       ;1AAA 0401
        BSTA,UN D25MS                   ;1AAC 3F199C    25 ms delay
        BSTA,UN CCHIN                   ;1AAF 3F1A54
        COMI,R0 0AAh                    ;1AB2 E4AA
        BCFA,EQ REDER                   ;1AB4 9C18B6
        BSTA,UN CCHIN                   ;1AB7 3F1A54    get block number from cassette
        BCTA,LT REDER                   ;1ABA 1E18B6
        ADDI,R0 1                       ;1ABD 8401      add one
        STRA,R0 BLKNUM                  ;1ABF CC0E01    store
        LODI,R0 1                       ;1AC2 0401
        BSTA,UN D25MS                   ;1AC4 3F199C    25 ms delay
        EORZ    R0                      ;1AC7 20
        WRTD,R0                         ;1AC8 F0        stop cassette
        RETC,UN                         ;1AC9 17
;
;                                       == read first block, = catalog
RFSTB   LODI,R0 mdcrtst                 ;1ACA 0408
        WRTD,R0                         ;1ACC F0
        EORZ    R0                      ;1ACD 20
        WRTD,R0                         ;1ACE F0
        BSTA,UN RFBNR                   ;1ACF 3F1A90
        BSTA,UN CTTBK                   ;1AD2 3F1A6B
        EORZ    R0                      ;1AD5 20
        STRZ    R1                      ;1AD6 C1
RFSTBA  STRZ    R2                      ;1AD7 C2
        LODA,R0 TMPBLK,R1               ;1AD8 0D6D00
        STRA,R0 FSTBLK,R1               ;1ADB CD6C00
        ADDZ    R2                      ;1ADE 82
        BIRR,R1 RFSTBA                  ;1ADF D976
        COMA,R0 CHECKS                  ;1AE1 EC0E00
        BCFA,EQ REDER                   ;1AE4 9C18B6
        RETC,UN                         ;1AE7 17
;
;                                       == write first block, = catalog
WFSTB   EORZ    R0                      ;1AE8 20
        STRZ    R1                      ;1AE9 C1
WFSTBA  STRZ    R2                      ;1AEA C2
        LODA,R0 FSTBLK,R1               ;1AEB 0D6C00
        STRA,R0 TMPBLK,R1               ;1AEE CD6D00
        ADDZ    R2                      ;1AF1 82
        BIRR,R1 WFSTBA                  ;1AF2 D976
        STRA,R0 CHECKS                  ;1AF4 CC0E00
        BSTA,UN RFBNR                   ;1AF7 3F1A90
        BCTR,UN CWCYCA                  ;1AFA 1B05
;
;                                       == cassette write cycle
CWCYC   PPSU    II                      ;1AFC 7620
        BSTA,UN RBKNR                   ;1AFE 3F1A9D    read block number
CWCYCA  REDC,R0                         ;1B01 30
        TMI,R0  mdcrwen                 ;1B02 F408      iw swriting allowd?
        BCFR,EQ CWCYCB                  ;1B04 980A      no
        BSTA,UN TBKTC                   ;1B06 3F1A15    temporary block to cassette
        LODI,R0 mdcrfwd                 ;1B09 0420
        WRTD,R0                         ;1B0B F0
        LODI,R0 1                       ;1B0C 0401
        BCTR,UN OBFWDB                  ;1B0E 1B0F
;
CWCYCB  BSTR,UN OBFWDA                  ;1B10 3B08
        BCTA,UN WRPER                   ;1B12 1F18BE    write protect error
;
;                                       == one block forward
OBFWD   PPSU    II                      ;1B15 7620
        BSTA,UN RBKNR                   ;1B17 3F1A9D
OBFWDA  LODI,R0 mdcrfwd                 ;1B1A 0420
        WRTD,R0                         ;1B1C F0
        LODI,R0 18                      ;1B1D 0412      18 x 25 ms
OBFWDB  BCTA,UN CTTBKB                  ;1B1F 1F1A8A    stop after 450 ms
;
;                                       == Find block
FNDBK   LODA,R0 BLKNUM                  ;1B22 0C0E01    get current block number
        BCFR,EQ FNDBKB                  ;1B25 9805      branch if not 0
FNDBKA  BSTA,UN RFBNR                   ;1B27 3F1A90    read first block number
        BSTR,UN OBFWDA                  ;1B2A 3B6E      one block forward
FNDBKB  LODA,R1 FBLKOF                  ;1B2C 0D0E13    get first block of file
        ANDI,R1 07Fh                    ;1B2F 457F
        BCTA,EQ JSTER                   ;1B31 1C18DA    error if block is 0
        COMA,R1 BLKNUM                  ;1B34 ED0E01    have we reached our destiny?
        RETC,EQ                         ;1B37 14        yes
        BCTR,LT FNDBKC                  ;1B38 1A04      branch if we are too far
        BSTR,UN OBFWD                   ;1B3A 3B59      one block forward
        BCTR,UN FNDBKB                  ;1B3C 1B6E      test again
;
FNDBKC  COMI,R1 2                       ;1B3E E502      block needed is at beginning of tape?
        BCTR,LT FNDBKA                  ;1B40 1A65      yes
        BSTA,UN D150MS                  ;1B42 3F199A
        PPSU    II                      ;1B45 7620
        LODI,R0 mdcrrev                 ;1B47 0410      cassette in reverse
        WRTD,R0                         ;1B49 F0
        BSTA,UN D150MS                  ;1B4A 3F199A
FNDBKD  BSTR,UN FNDGP                   ;1B4D 3B28
        LODA,R0 BLKNUM                  ;1B4F 0C0E01
        SUBI,R0 1                       ;1B52 A401
        STRA,R0 BLKNUM                  ;1B54 CC0E01
        ADDI,R0 2                       ;1B57 8402
        COMZ    R1                      ;1B59 E1
        BCTR,GT FNDBKD                  ;1B5A 1971
        LODI,R0 86                      ;1B5C 0456      ?
        STRA,R0 BLKNUM                  ;1B5E CC0E01
        EORZ    R0                      ;1B61 20
        WRTD,R0                         ;1B62 F0        stop cassette
        BSTA,UN D150MS                  ;1B63 3F199A    150 ms delay
        LODI,R0 mdcrfwd                 ;1B66 0420      forward cassette
        WRTD,R0                         ;1B68 F0
        BSTA,UN D150MS                  ;1B69 3F199A
        BSTR,UN FNDGP                   ;1B6C 3B09
        BSTA,UN RFBNRA                  ;1B6E 3F1AA5
        BSTA,UN OBFWDA                  ;1B71 3F1B1A
        BCTA,UN FNDBK                   ;1B74 1F1B22
;
;                                       == find gap
FNDGP   LODI,R2 0                       ;1B77 0600
        LODI,R3 32                      ;1B79 0720
FNDGPA  BSTA,UN CHECA                   ;1B7B 3F199E    check if cassette present and not at end
        REDC,R0                         ;1B7E 30        get mdcr read clock
        BCFR,N  FNDGPB                  ;1B7F 9A04      branch if '0'
        BDRR,R2 FNDGPA                  ;1B81 FA78      
        BCTR,UN FNDGP                   ;1B83 1B72
;
FNDGPB  BDRR,R3 FNDGPA                  ;1B85 FB74
FNDGPC  LODA,R3 BLKNUM                  ;1B87 0F0E01
        ADDI,R3 74                      ;1B8A 874A
FNDGPD  LODI,R2 15                      ;1B8C 060F
FNDGPE  BSTA,UN CHECA                   ;1B8E 3F199E    check if cassette present and not at end
        REDC,R0                         ;1B91 30        get mdcr read clock
        BCFR,N  FNDGPC                  ;1B92 9A73      branch if '0'
        BDRR,R2 FNDGPE                  ;1B94 FA78
        BDRR,R3 FNDGPD                  ;1B96 FB74
        RETC,UN                         ;1B98 17
;
;                                       == external program. This is executed in ram to read or store to other banks.
        BYTE    data,0                  ;1B99 (0)
        BYTE    data,EXTP1E-EXTP1       ;1B9B (027H)
EXTP1   PPSU    II                      ;1B9D 7620
        LODA,R0 EADRES                  ;1B9F 0C0E11
        WRTC,R0                         ;1BA2 B0
EXTP1A  LODA,R0 *FILA,R2-               ;1BA3 0ECE16
        STRA,R0 TMPBLK,R2               ;1BA6 CE6D00
        ADDZ    R1                      ;1BA9 81
        STRZ    R1                      ;1BAA C1
        BRNR,R2 EXTP1A                  ;1BAB 5A76
        BCTR,UN EXTP1D                  ;1BAD 1B10
;
EXTP1B  PPSU    II                      ;1BAF 7620
        LODA,R0 EADRES                  ;1BB1 0C0E11
        WRTC,R0                         ;1BB4 B0
EXTP1C  LODA,R0 TMPBLK,R2-              ;1BB5 0E4D00
        STRA,R0 *FILA,R2                ;1BB8 CEEE16
        ADDZ    R1                      ;1BBB 81
        STRZ    R1                      ;1BBC C1
        BRNR,R2 EXTP1C                  ;1BBD 5A76
EXTP1D  LODA,R0 cpores                  ;1BBF 0C0EF7
        WRTC,R0                         ;1BC2 B0
        RETE,UN                         ;1BC3 37
EXTP1E  equ     $
;
;                                       == pull file data from catalog block
PLFDT   LODA,R2 CATINX                  ;1BC4 0E0E07
        LODI,R1 16                      ;1BC7 0510
PLFDTA  LODA,R0 FSTBLK+FINFO-1,R2+      ;1BC9 0E2C7F
        STRA,R0 FNAME,R1-               ;1BCC CD4E08
        COMI,R1 8                       ;1BCF E508
        BCTR,GT PLFDTA                  ;1BD1 1976
PLFDTB  LODA,R0 FSTBLK,R2-              ;1BD3 0E4C00
        ANDI,R0 07Fh                    ;1BD6 447F      strip block usage indication
        STRA,R0 FNAME,R1-               ;1BD8 CD4E08
        BRNR,R1 PLFDTB                  ;1BDB 5976
        RETC,UN                         ;1BDD 17
;
;                                       == push file data to catalog block
PSFDT   LODA,R2 CATINX                  ;1BDE 0E0E07
        LODI,R1 16                      ;1BE1 0510
PSFDTA  LODA,R0 FNAME,R1-               ;1BE3 0D4E08
        STRA,R0 FSTBLK+FINFO-1,R2+      ;1BE6 CE2C7F
        COMI,R1 008h                    ;1BE9 E508
        BCTR,GT PSFDTA                  ;1BEB 1976
PSFDTD  LODA,R0 FSTBLK,R2-              ;1BED 0E4C00
        ANDI,R0 080h                    ;1BF0 4480
        IORA,R0 FNAME,R1-               ;1BF2 6D4E08
        STRA,R0 FSTBLK,R2               ;1BF5 CE6C00
        BRNR,R1 PSFDTD                  ;1BF8 5973
        RETC,UN                         ;1BFA 17
;
;                                       == memory to cassette
MTCAS   BSTR,UN PSFDT                   ;1BFB 3B61
        BSTA,UN WFSTB                   ;1BFD 3F1AE8
MTCASA  BSTA,UN FNDBK                   ;1C00 3F1B22
        BSTR,UN MVEP1                   ;1C03 3B10
MTCASB  BSTR,UN CINXN                   ;1C05 3B19
        RETC,EQ                         ;1C07 14
        BSTA,UN MYTTB                   ;1C08 3F0E18
        STRA,R1 CHECKS                  ;1C0B CD0E00
        BSTA,UN CWCYC                   ;1C0E 3F1AFC
        BSTR,UN IFILA                   ;1C11 3B26
        BCTR,UN MTCASB                  ;1C13 1B70
;
MVEP1   LODI,R1 EXTP1E-EXTP1            ;1C15 0527
MVEP1A  LODA,R0 EXTP1,R1-               ;1C17 0D5B9D
        STRA,R0 MYTTB,R1                ;1C1A CD6E18
        BRNR,R1 MVEP1A                  ;1C1D 5978
        RETC,UN                         ;1C1F 17
;
CINXN   EORZ    R0                      ;1C20 20
        STRZ    R1                      ;1C21 C1
        STRZ    R2                      ;1C22 C2
        LODA,R0 FILS                    ;1C23 0C0E14
        BCTR,EQ CINXNA                  ;1C26 1807
        SUBI,R0 1                       ;1C28 A401
        STRA,R0 FILS                    ;1C2A CC0E14
        BCTR,UN CINXNB                  ;1C2D 1B07
;
CINXNA  LODA,R2 FILS+1                  ;1C2F 0E0E15
        RETC,EQ                         ;1C32 14
        STRA,R1 FILS+1                  ;1C33 CD0E15
CINXNB  LODI,R0 1                       ;1C36 0401
        RETC,UN                         ;1C38 17
;
IFILA   LODA,R0 FILA                    ;1C39 0C0E16
        ADDI,R0 1                       ;1C3C 8401
        STRA,R0 FILA                    ;1C3E CC0E16
        RETC,UN                         ;1C41 17
;
;                                       == cassette to memory
CASTM   BSTA,UN PLFDT                   ;1C42 3F1BC4
        BSTA,UN FNDBK                   ;1C45 3F1B22
        BSTR,UN MVEP1                   ;1C48 3B4B
CASTMA  LODA,R0 FILS                    ;1C4A 0C0E14
        IORA,R0 FILS+1                  ;1C4D 6C0E15
        RETC,EQ                         ;1C50 14
        BSTA,UN CRCYC                   ;1C51 3F1A67
        BSTR,UN CINXN                   ;1C54 3B4A
        BSTA,UN TBTMY                   ;1C56 3F0E2A
        COMA,R1 CHECKS                  ;1C59 ED0E00
        BCFA,EQ REDER                   ;1C5C 9C18B6
        BSTR,UN IFILA                   ;1C5F 3B58
        BCTR,UN CASTMA                  ;1C61 1B67
;
;                                       == catalog
CATAL   BSTA,UN RFSTB                   ;1C63 3F1ACA
        BYTE  0BBH,080H-(02000h-CAREWZ) ;1C66 BB6A      ZBSR CAREWZ
        BSTA,UN PRCAT                   ;1C68 3F1F50
        LODI,R3 0                       ;1C6B 0700      start with file 0.
CATALA  STRA,R3 CATINX                  ;1C6D CF0E07
        BSTA,UN PLFDT                   ;1C70 3F1BC4    pull file data from catalog
        LODA,R0 FBLKOF                  ;1C73 0C0E13    is there a file here?
        BCTA,EQ CATALG                  ;1C76 1C1CD1    no
        LODZ    R3                      ;1C79 03
        RRR,R0                          ;1C7A 50
        RRR,R0                          ;1C7B 50
        RRR,R0                          ;1C7C 50        catinx / 8
        ANDI,R0 00Fh                    ;1C7D 440F      
        ADDI,R0 1                       ;1C7F 8401      start at 1 with number
        COMI,R0 10                      ;1C81 E40A
        BCTR,LT CATALB                  ;1C83 1A02
        ADDI,R0 6                       ;1C85 8406      make number bcd
CATALB  ZBSR    *wchexv                 ;1C87 BBB8      print to screen
        ZBSR    wrtsp                   ;1C89 BB03
        LODI,R1 0FFh                    ;1C8B 05FF
        LODI,R2 8                       ;1C8D 0608
CATALC  LODA,R0 FNAME,R1+               ;1C8F 0D2E08    get filename
        ZBSR    wrtzv                   ;1C92 BB05      print to screen
        BDRR,R2 CATALC                  ;1C94 FA79
        ZBSR    wrtsp                   ;1C96 BB03
        LODI,R3 fila-mram               ;1C98 0716      file address
        ZBSR    *wrtbsv                 ;1C9A BBB6      hex word to screen
        LODI,R0 "-"                     ;1C9C 042D
        ZBSR    wrtzv                   ;1C9E BB05
        LODZ    R3                      ;1CA0 03
        ZBSR    *pltbsv                 ;1CA1 BBAA      file address in tbsr
        LODI,R3 tbsr-mram               ;1CA3 07FE
        LODZ    R3                      ;1CA5 03
        ZBSR    *dctbsv                 ;1CA6 BBA6      tbsr = tbsr-1
        LODI,R0 fils-mram               ;1CA8 0414      file size
        ZBSR    *adtbsv                 ;1CAA BBAC      tbsr += file size
        ZBSR    *wrtbsv                 ;1CAC BBB6      end address to screen
        ZBSR    wrtsp                   ;1CAE BB03
        LODI,R0 "L"                     ;1CB0 044C      'L' for locked
        LODA,R3 FBLKOF                  ;1CB2 0F0E13    get first block of file byte, bit7 indicates locked
        BCTR,N  CATALD                  ;1CB5 1A02      branch ocked
        LODI,R0 " "                     ;1CB7 0420      ' ' for not locked
CATALD  ZBSR    wrtzv                   ;1CB9 BB05
        ZBSR    wrtsp                   ;1CBB BB03
        LODZ    R3                      ;1CBD 03        1st block of file on cassette
        ANDI,R0 07Fh                    ;1CBE 447F      strip lock bit
        LODI,R3 3                       ;1CC0 0703
        BCTR,UN CATALF                  ;1CC2 1B05
;
CATALE  ZBSR    wrtsp                   ;1CC4 BB03
        LODA,R0 XOFXRS,R3-              ;1CC6 0F4E10
CATALF  ZBSR    *wchexv                 ;1CC9 BBB8      hex byte to sscreen
        BRNR,R3 CATALE                  ;1CCB 5B77      print 1st block number, language, extra address, part info
        ZBSR    wrtcr                   ;1CCD BB0B
        ZBSR    *chescv                 ;1CCF BBBA
CATALG  LODA,R3 CATINX                  ;1CD1 0F0E07
        ADDI,R3 8                       ;1CD4 8708      proceed to next file info
        BCFA,LT CATALA                  ;1CD6 9E1C6D    branch if less the 128. (max 16x file info)
        RETC,UN                         ;1CD9 17
;
;                                       == compare file name with catalog and return first block index number
LOFNR   LODI,R3 0                       ;1CDA 0700
        LODI,R2 16*8                    ;1CDC 0680      start at end of filenames
LOFNRA  LODI,R1 8                       ;1CDE 0508
LOFNRB  LODA,R0 FSTBLK,R2-              ;1CE0 0E4C00
        ANDI,R0 07Fh                    ;1CE3 447F      strip msb from file name characters
        COMA,R0 FNAME,R1-               ;1CE5 ED4E08
        BCTR,EQ LOFNRD                  ;1CE8 1806      byte equal
LOFNRC  ANDI,R2 078h                    ;1CEA 4678      set pointer to next filename
        BCFR,EQ LOFNRA                  ;1CEC 9870      compare next filename
        BCTR,UN LOFNRG                  ;1CEE 1B21      no filename match
;
LOFNRD  BRNR,R1 LOFNRB                  ;1CF0 596E      decrement pointer and compare next byte of not ready.
        LODA,R0 FSTBLK+finfo+fbix,R2    ;1CF2 0E6C84    get first block index
        BCTR,EQ LOFNRC                  ;1CF5 1873      find next if 0, this file is no longer valid
        LODA,R0 XOFXRS                  ;1CF7 0C0E10    get part indication
        BCTR,EQ LOFNRE                  ;1CFA 1805      0 if not used
        COMA,R0 FSTBLK+finfo+part,R2    ;1CFC EE6C87    does it match?
        BCFR,EQ LOFNRC                  ;1CFF 9869      no, continue search for the file
LOFNRE  LODA,R0 LANRES                  ;1D01 0C0E12    get language
        BCTR,EQ LOFNRF                  ;1D04 1805      branch if don't care
        COMA,R0 FSTBLK+finfo+lang,R2    ;1D06 EE6C85    compare
        BCFR,EQ LOFNRC                  ;1D09 985F      not this one, continue search for file
LOFNRF  LODZ    R2                      ;1D0B 02        get poiter
        STRA,R0 CIMATF-1,R3+            ;1D0C CF2E3F    store pointer in maching file array
        BCFR,EQ LOFNRA                  ;1D0F 984D      chech of more file entries match
LOFNRG  STRA,R3 MATNF                   ;1D11 CF0E3F    store number of matching files
        LODZ    R3                      ;1D14 03        set cc to number of matching files found
        RETC,UN                         ;1D15 17
;
;                                       == get file parameters from input buffer
GTPRM   BSTA,UN CLPRM                   ;1D16 3F1E45    clear file parameters, 4 bytes
GTPRMA  BYTE   0BBH,080H-(02000h-SKPKM) ;1D19 BB6D      ZBSR SKPKM skip space and ind comma
        RETC,GT                         ;1D1B 15        no comma
        RETC,LT                         ;1D1C 16        no comma
        ZBSR    *gthexv                 ;1D1D BBB4      get hex byte from input buffer
        BCTR,EQ GTPRMD                  ;1D1F 180D      error if not found
GTPRMB  ZBSR    *tinprv                 ;1D21 BBB0      get next none space char from input buffer
        BCTR,EQ GTPRMB                  ;1D23 187C
GTPRMC  COMI,R0 "L"                     ;1D25 E44C      is it L for language?
        BCFR,EQ GTPRME                  ;1D27 9808      no
        STRA,R2 LANRES                  ;1D29 CE0E12    store it
        BCTR,UN GTPRMA                  ;1D2C 1B6B      check for more parameters
;
GTPRMD  BCTA,UN INPER                   ;1D2E 1F18C2
;
GTPRME  COMI,R0 "O"                     ;1D31 E44F      is it O of xOFx ?
        BCFR,EQ GTPRMF                  ;1D33 9813      no
        ZBSR    *tinprv                 ;1D35 BBB0
        COMI,R0 "F"                     ;1D37 E446      is next char an F?
        BCFR,EQ GTPRMD                  ;1D39 9873      no, then error
        ANDI,R2 00Fh                    ;1D3B 460F      leave bit 0-3
        STRA,R2 XOFXRS                  ;1D3D CE0E10    store
        ZBSR    *gthexv                 ;1D40 BBB4      get next hex value
        BCTR,EQ GTPRMD                  ;1D42 186A      error if not present
        LODI,R1 0                       ;1D44 0500      offset to XOFXRS
        BCTR,UN GTPRMH                  ;1D46 1B13      continue
;
GTPRMF  LODI,R1 1                       ;1D48 0501      index to EADRES
        COMI,R0 "Q"                     ;1D4A E451      Q for Q-bank parameter ?
        BCFR,EQ GTPRMG                  ;1D4C 9809      no
        ANDI,R2 00Fh                    ;1D4E 460F      add Q bank parameter
        LODI,R0 0F0h                    ;1D50 04F0
        ANDA,R0 EADRES                  ;1D52 4C0E11
        BCTR,UN GTPRMI                  ;1D55 1B0F
;
GTPRMG  COMI,R0 "U"                     ;1D57 E455       U for U-bank parameter ?
        BCFR,EQ GTPRMD                  ;1D59 9853       no, then it is not recognized -> error
GTPRMH  RRL,R2                          ;1D5B D2         add hex value to R1 indexed byte
        RRL,R2                          ;1D5C D2
        RRL,R2                          ;1D5D D2
        RRL,R2                          ;1D5E D2
        LODA,R0 XOFXRS,R1               ;1D5F 0D6E10
        ANDI,R2 0F0h                    ;1D62 46F0
        ANDI,R0 00Fh                    ;1D64 440F
GTPRMI  IORZ    R2                      ;1D66 62
        STRA,R0 XOFXRS,R1               ;1D67 CD6E10
        BCTA,UN GTPRMA                  ;1D6A 1F1D19
;
;                                       == Load file from cassette
LOADR   BYTE   0BBH,080H-(02000h-CHCEX) ;1D6D BB42      ZBSR CHCEX check if cassette present
LOADRA  BSTR,UN LOADRB                  ;1D6F 3B05      loaf file
        BYTE   0BBH,080H-(02000h-SKPPK) ;1D71 BB75      ZBSR SKPPK semicolon?
        BCTR,EQ LOADRA                  ;1D73 187A      yes, next file
        RETC,UN                         ;1D75 17
;
LOADRB  BYTE   0BBH,080H-(02000h-PRPAR) ;1D76 BB54      ZBSR PRPAR prepare parameters
LOADRC  LODA,R3 MATNF                   ;1D78 0F0E3F    get matching number of files
        RETC,EQ                         ;1D7B 14        quit if none
        LODA,R0 CIMATF,R3-              ;1D7C 0F4E40    get index in catalog
        STRA,R3 MATNF                   ;1D7F CF0E3F    decrement number of matching files
        STRA,R0 CATINX                  ;1D82 CC0E07    store catalog index
        BSTA,UN CASTM                   ;1D85 3F1C42    cassette to memory
        BCTR,UN LOADRC                  ;1D88 1B6E      next file part?
;
;                                       == unlock file
UNLOR   BYTE   0BBH,080H-(02000h-PREMD) ;1D8A BB49      ZBSR PREMD read catalog
UNLORA  BYTE   0BBH,080H-(02000h-PRPAR) ;1D8C BB54      ZBSR PRPAR prepare parameters
UNLORB  LODA,R0 CIMATF,R3-              ;1D8E 0F4E40
        STRZ    R2                      ;1D91 C2
        LODA,R0 FSTBLK+finfo+fbix,R2    ;1D92 0E6C84
        ANDI,R0 07Fh                    ;1D95 447F      clear bit 7 indicating file not locked
        STRA,R0 FSTBLK+finfo+fbix,R2    ;1D97 CE6C84
        BRNR,R3 UNLORB                  ;1D9A 5B72
        BYTE   0BBH,080H-(02000h-SKPPK) ;1D9C BB75      ZBSR SKPPK
        BCTR,EQ UNLORA                  ;1D9E 186C
        BYTE   09BH,080H-(02000h-ENDMD) ;1DA0 9B67      ZBRR ENDMD
;
;                                       == lock file
LOCKR   BYTE   0BBH,080H-(02000h-PREMD) ;1DA2 BB49      ZBSR PREMD
LOCKRA  BYTE   0BBH,080H-(02000h-PRPAR) ;1DA4 BB54      ZBSR PRPAR
LOCKRB  LODA,R0 CIMATF,R3-              ;1DA6 0F4E40
        STRZ    R2                      ;1DA9 C2
        LODA,R0 FSTBLK+finfo+fbix,R2    ;1DAA 0E6C84
        IORI,R0 080h                    ;1DAD 6480      set bit 7 indicating file locked
        STRA,R0 FSTBLK+finfo+fbix,R2    ;1DAF CE6C84
        BRNR,R3 LOCKRB                  ;1DB2 5B72
        BYTE   0BBH,080H-(02000h-SKPPK) ;1DB4 BB75      ZBSR SKPPK
        BCTR,EQ LOCKRA                  ;1DB6 186C
        BYTE   09BH,080H-(02000h-ENDMD) ;1DB8 9B67      ZBRR ENDMD
;
;                                       == rename file
RENAM   BYTE   0BBH,080H-(02000h-PREMD) ;1DBA BB49      ZBSR PREMD
RENAMA  BYTE   0BBH,080H-(02000h-PRPAR) ;1DBC BB54      ZBSR PRPAR
        BSTR,UN CHFLK                   ;1DBE 3B3E
        BYTE   0BBH,080H-(02000h-SKPPK) ;1DC0 BB75      ZBSR SKPPK
        BSTA,UN GENAM                   ;1DC2 3F183E
        BSTA,UN GTPRM                   ;1DC5 3F1D16
        LODA,R3 MATNF                   ;1DC8 0F0E3F
        LODA,R0 EADRES                  ;1DCB 0C0E11
        COMI,R3 1                       ;1DCE E701
        BCTR,EQ RENAMB                  ;1DD0 1806
        IORA,R0 XOFXRS                  ;1DD2 6C0E10
        IORA,R0 LANRES                  ;1DD5 6C0E12
RENAMB  IORZ    R0                      ;1DD8 60
        BCFA,EQ INPER                   ;1DD9 9C18C2
RENAMC  LODA,R0 CIMATF,R3-              ;1DDC 0F4E40
        LODI,R1 8                       ;1DDF 0508
        ADDZ    R1                      ;1DE1 81
        STRZ    R2                      ;1DE2 C2
        BSTA,UN PSFDTD                  ;1DE3 3F1BED
        LODA,R0 XOFXRS                  ;1DE6 0C0E10
        BCTR,EQ RENAMD                  ;1DE9 1803
        STRA,R0 FSTBLK+finfo+part,R2    ;1DEB CE6C87
RENAMD  LODA,R0 LANRES                  ;1DEE 0C0E12
        BCTR,EQ RENAME                  ;1DF1 1803
        STRA,R0 FSTBLK+finfo+lang,R2    ;1DF3 CE6C85
RENAME  BRNR,R3 RENAMC                  ;1DF6 5B64
        BYTE   0BBH,080H-(02000h-SKPPK) ;1DF8 BB75      ZBSR SKPPK
        BCTR,EQ RENAMA                  ;1DFA 1840
        BYTE   09BH,080H-(02000h-ENDMD) ;1DFC 9B67      ZBRR ENDMD
;
;                                       == check if file is locked
CHFLK   LODA,R0 CIMATF,R3-              ;1DFE 0F4E40
        STRZ    R2                      ;1E01 C2
        LODA,R0 FSTBLK+finfo+fbix,R2    ;1E02 0E6C84
        BCTA,LT LKDER                   ;1E05 1E18D6
        BRNR,R3 CHFLK                   ;1E08 5B74
        RETC,UN                         ;1E0A 17
;
;                                       == delete file
DELET   BYTE   0BBH,080H-(02000h-PREMD) ;1E0B BB49      ZBSR PREMD
DELETA  BYTE   0BBH,080H-(02000h-PRPAR) ;1E0D BB54      ZBSR PRPAR
        BSTR,UN CHFLK                   ;1E0F 3B6D
        LODA,R3 MATNF                   ;1E11 0F0E3F
DELETB  LODA,R0 CIMATF,R3-              ;1E14 0F4E40
        STRA,R0 CATINX                  ;1E17 CC0E07
        BSTA,UN PLFDT                   ;1E1A 3F1BC4
        EORZ    R0                      ;1E1D 20
        STRA,R0 FSTBLK+finfo+fbix,R2    ;1E1E CE6C84
        BSTR,UN CALNB                   ;1E21 3B17
        LODZ    R1                      ;1E23 01
        STRZ    R2                      ;1E24 C2
        ADDA,R2 FBLKOF                  ;1E25 8E0E13
DELETC  LODA,R0 FSTBLK,R2-              ;1E28 0E4C00
        ANDI,R0 07Fh                    ;1E2B 447F      free blocks
        STRA,R0 FSTBLK,R2               ;1E2D CE6C00
        BDRR,R1 DELETC                  ;1E30 F976
        BRNR,R3 DELETB                  ;1E32 5B60
        BYTE   0BBH,080H-(02000h-SKPPK) ;1E34 BB75      ZBSR SKPPK
        BCTR,EQ DELETA                  ;1E36 1855
        BYTE   09BH,080H-(02000h-ENDMD) ;1E38 9B67      ZBRR ENDMD
;
;                                       == calculate number of blocks for file
CALNB   LODA,R1 FILS+1                  ;1E3A 0D0E15
        BCTR,EQ CALNBA                  ;1E3D 1802
        LODI,R1 1                       ;1E3F 0501
CALNBA  ADDA,R1 FILS                    ;1E41 8D0E14
        RETC,UN                         ;1E44 17
;
;                                       == clear file parameters (4 bytes)
CLPRM   EORZ    R0                      ;1E45 20
        LODI,R1 4                       ;1E46 0504
CLPRMA  STRA,R0 XOFXRS,R1-              ;1E48 CD4E10
        BRNR,R1 CLPRMA                  ;1E4B 597B
        RETC,UN                         ;1E4D 17
;
;                                       == save file
SAVRT   BYTE   0BBH,080H-(02000h-PREMD) ;1E4E BB49      ZBSR PREMD
SAVRTA  BSTR,UN CLPRM                   ;1E50 3B73
        BSTA,UN GENAM                   ;1E52 3F183E
        BYTE   0BBH,080H-(02000h-SKPKM) ;1E55 BB6D      ZBSR SKPKM skip comma
        BCFA,EQ SAVRTK                  ;1E57 9C1EDD
        ZBSR    *gthexv                 ;1E5A BBB4
        BCTA,EQ INPER                   ;1E5C 1C18C2
SAVRTB  ZBSR    *tinprv                 ;1E5F BBB0
        BCTR,EQ SAVRTB                  ;1E61 187C
        COMI,R0 "-"                     ;1E63 E42D
        BCFA,EQ SAVRTL                  ;1E65 9C1EE1
        LODI,R0 fila-mram               ;1E68 0416
        ZBSR    *pstbsv                 ;1E6A BBA8
        ZBSR    *gthexv                 ;1E6C BBB4
        BCTA,EQ INPER                   ;1E6E 1C18C2
        LODZ    R1                      ;1E71 01
        BCTA,LT INPER                   ;1E72 1E18C2
        LODI,R0 fila-mram               ;1E75 0416
        ZBSR    *cmtbsv                 ;1E77 BBA2
        BCFA,GT INPER                   ;1E79 9D18C2
        LODI,R0 tbsr-mram               ;1E7C 04FE
        ZBSR    *ictbsv                 ;1E7E BBA4
        LODI,R0 fila-mram               ;1E80 0416
        ZBSR    *sbtbsv                 ;1E82 BBAE
        LODI,R0 fils-mram               ;1E84 0414
        ZBSR    *pstbsv                 ;1E86 BBA8
        BSTA,UN GTPRM                   ;1E88 3F1D16
        BSTA,UN LOFNR                   ;1E8B 3F1CDA
        BCFA,EQ INPER                   ;1E8E 9C18C2
        LODA,R0 FSTBLK                  ;1E91 0C0C00
        IORI,R0 080h                    ;1E94 6480
        STRA,R0 FSTBLK                  ;1E96 CC0C00
        LODI,R2 0                       ;1E99 0600
SAVRTC  LODA,R0 FSTBLK+finfo+fbix,R2    ;1E9B 0E6C84    first block index
        BCTR,EQ SAVRTD                  ;1E9E 1807      branch if free
        ADDI,R2 8                       ;1EA0 8608
        BCFR,LT SAVRTC                  ;1EA2 9A77
        BCTA,UN CFLER                   ;1EA4 1F18CA
;
SAVRTD  STRA,R2 CATINX                  ;1EA7 CE0E07
        LODI,R2 0                       ;1EAA 0600
SAVRTE  BSTA,UN CALNB                   ;1EAC 3F1E3A
SAVRTF  COMI,R2 128                     ;1EAF E680
        BCFA,LT TLGER                   ;1EB1 9E18D2
        LODA,R0 FSTBLK,R2               ;1EB4 0E6C00
        BIRR,R2 SAVRTG                  ;1EB7 DA00
SAVRTG  BCFR,LT SAVRTH                  ;1EB9 9A05
        STRA,R2 FBLKOF                  ;1EBB CE0E13
        BCTR,UN SAVRTE                  ;1EBE 1B6C
;
SAVRTH  BDRR,R1 SAVRTF                  ;1EC0 F96D
        BSTA,UN CALNB                   ;1EC2 3F1E3A
        LODZ    R1                      ;1EC5 01
        STRZ    R2                      ;1EC6 C2
        ADDA,R2 FBLKOF                  ;1EC7 8E0E13
SAVRTI  LODA,R0 FSTBLK,R2-              ;1ECA 0E4C00
        IORI,R0 080h                    ;1ECD 6480      indicate used block for file
        STRA,R0 FSTBLK,R2               ;1ECF CE6C00
        BDRR,R1 SAVRTI                  ;1ED2 F976
        BSTA,UN MTCAS                   ;1ED4 3F1BFB
SAVRTJ  BYTE   0BBH,080H-(02000h-SKPPK) ;1ED7 BB75      ZBSR SKPPK
        BCTA,EQ SAVRTA                  ;1ED9 1C1E50
        RETC,UN                         ;1EDC 17
;
SAVRTK  BYTE  0BBH,080H-(02000h-PRPARB) ;1EDD BB60      ZBSR PRPARB
        BCTR,UN SAVRTM                  ;1EDF 1B05
;
SAVRTL  BSTA,UN GTPRMC                  ;1EE1 3F1D25
        BYTE  0BBH,080H-(02000h-PRPARA) ;1EE4 BB5A      ZBSR PRPARA
SAVRTM  BSTA,UN CHFLK                   ;1EE6 3F1DFE
SAVRTN  LODA,R3 MATNF                   ;1EE9 0F0E3F
        BCTR,EQ SAVRTJ                  ;1EEC 1869
        LODA,R0 CIMATF,R3-              ;1EEE 0F4E40
        STRA,R3 MATNF                   ;1EF1 CF0E3F
        STRA,R0 CATINX                  ;1EF4 CC0E07
        BSTA,UN PLFDT                   ;1EF7 3F1BC4
        BSTA,UN MTCASA                  ;1EFA 3F1C00
        BCTR,UN SAVRTN                  ;1EFD 1B6A
;
RUNRT   BYTE   0BBH,080H-(02000h-CHCEX) ;1EFF BB42      ZBSR CHCEX
        BSTA,UN GENAM                   ;1F01 3F183E
        BSTA,UN CLPRM                   ;1F04 3F1E45
        BSTA,UN LOFNR                   ;1F07 3F1CDA
        BCTA,EQ NICER                   ;1F0A 1C18C6
        BSTA,UN LOADRC                  ;1F0D 3F1D78
        BSTA,UN LOFNR                   ;1F10 3F1CDA
RUNRTA  LODA,R0 CIMATF,R3-              ;1F13 0F4E40
        STRZ    R2                      ;1F16 C2
        LODA,R0 FSTBLK+finfo+part,R2    ;1F17 0E6C87
        ANDI,R0 00Fh                    ;1F1A 440F
        COMI,R0 2                       ;1F1C E402
        BCFR,LT RUNRTB                  ;1F1E 9A07
        LODA,R0 FSTBLK+finfo+lang,R2    ;1F20 0E6C85
        COMI,R0 1                       ;1F23 E401      language is 1?
        BCTR,EQ RUNRTC                  ;1F25 1805      yes
RUNRTB  BRNR,R3 RUNRTA                  ;1F27 5B6A
        BCTA,UN RUNER                   ;1F29 1F18CE
;
RUNRTC  LODA,R0 CIMATF,R3               ;1F2C 0F6E40
        STRA,R0 CATINX                  ;1F2F CC0E07
        BSTA,UN PLFDT                   ;1F32 3F1BC4
        LODI,R1 EXTP2E-EXTP2            ;1F35 0504
RUNRTD  LODA,R0 EXTP2,R1-               ;1F37 0D5F4C
        STRA,R0 RUNBR,R1                ;1F3A CD6E02    move write bank and jump to ram
        BRNR,R1 RUNRTD                  ;1F3D 5978
        LODA,R0 EADRES                  ;1F3F 0C0E11
        STRA,R0 cpores                  ;1F42 CC0EF7
        BCTA,UN RUNBR                   ;1F45 1F0E02
;
        BYTE    data,0                  ;1F48
        BYTE    data,EXTP2E-EXTP2
EXTP2   WRTC,R0
        BCTA,UN *FILA
EXTP2E  equ     $
;
PRCAT   LODI,R1 CATTXT-CATTXTX-1        ;1F50 0515
        BYTE   0BBH,080H-(02000h-SKPKM) ;1F52 BB6D      ZBSR SKPKM
        BCFR,EQ PRCATA                  ;1F54 9809
        ZBSR    *tinprv                 ;1F56 BBB0
        COMI,R0 "X"                     ;1F58 E458
        BCFA,EQ INPER                   ;1F5A 9C18C2
        LODI,R1 0FFh                    ;1F5D 05FF
PRCATA  LODA,R0 CATTXTX,R1+             ;1F5F 0D3F7F
        ZBSR    wrtzv                   ;1F62 BB05
        COMI,R1 CATTXTE-CATTXTX-2       ;1F64 E53D
        BCFR,GT PRCATA                  ;1F66 9977
        BSTR,UN CNRUB                   ;1F68 3B05
        LODZ    R2                      ;1F6A 02
        ZBSR    *wchexv                 ;1F6B BBB8
        ZBRR    wrtcr                   ;1F6D 9B0B
;
;                                       == Calculate number of used blocks
CNRUB   LODI,R1 128                     ;1F6F 0580
        LODI,R2 0                       ;1F71 0600
CNRUBA  LODA,R0 FSTBLK,R1-              ;1F73 0D4C00
        BCFR,LT CNRUBB                  ;1F76 9A02
        ADDI,R2 1                       ;1F78 8601
CNRUBB  BRNR,R1 CNRUBA                  ;1F7A 5977
        RETC,UN                         ;1F7C 17
;
        BYTE    text,CATTXTE-CATTXTX
CATTXTX BYTE    cr,lf,"PHUNSY MDCR-006 1982"
CATTXT  BYTE    cr,lf,"CN:FILENAME:BEGA:ENDA:L:FB:LN:EA:NR:BU:"
CATTXTE EQU     $
;
REWRT   BSTR,UN CHCEX                   ;1FBE 3B02
        BCTR,UN CAREWZ                  ;1FC0 1B28
;
CHCEX   REDC,R0                         ;1FC2 30
        TMI,R0  mdcrcip                 ;1FC3 F410
        RETC,EQ                         ;1FC5 14
RFSTBZ  BCTA,UN RFSTB                   ;1FC6 1F1ACA
;
PREMD   BSTR,UN RFSTBZ                  ;1FC9 3B7B
        REDC,R0                         ;1FCB 30
        TMI,R0  mdcrwen                 ;1FCC F408
        RETC,EQ                         ;1FCE 14
        BSTR,UN CAREWZ                  ;1FCF 3B19
        BCTA,UN WRPER                   ;1FD1 1F18BE
;
;                                       == prepare parameters
PRPAR   BSTA,UN GENAM                   ;1FD4 3F183E
        BSTA,UN GTPRM                   ;1FD7 3F1D16
PRPARA  LODA,R0 EADRES                  ;1FDA 0C0E11
        BCFA,EQ INPER                   ;1FDD 9C18C2
PRPARB  BSTA,UN LOFNR                   ;1FE0 3F1CDA
        BCTA,EQ NICER                   ;1FE3 1C18C6
        RETC,UN                         ;1FE6 17
;
ENDMD   BSTA,UN WFSTB                   ;1FE7 3F1AE8
CAREWZ  BCTA,UN CAREW                   ;1FEA 1F1980
;
;                                       == skip until comma
SKPKM   ZBSR    *tinprv                 ;1FED BBB0
        BCTR,EQ SKPKM                   ;1FEF 187C      skip spaces
        COMI,R0 ","                     ;1FF1 E42C
        BCTR,UN SKPKMA                  ;1FF3 1B06
;
;                                       == skip until semicolon
SKPPK   ZBSR    *tinprv                 ;1FF5 BBB0
        BCTR,EQ SKPPK                   ;1FF7 187C      skip spaces
        COMI,R0 ";"                     ;1FF9 E43B
SKPKMA  RETC,EQ                         ;1FFB 14        semicolon or comma found
        STRA,R3 inpram                  ;1FFC CF0F00    found something else
        RETC,UN                         ;1FFF 17
;
        section ram
        org     00c00h
;
FSTBLK  ds      256                     ;first block, catalog
TMPBLK  ds      256                     ;temp 256 bytes data block
CHECKS  ds      1                       ;checksum
BLKNUM  ds      1                       ;cassette block number
RUNBR   ds      EXTP2E-EXTP2            ;run branch (routine placed in ram)
        ds      1                       ;not used
CATINX  ds      1                       ;catalog imndex (file number x8)
FNAME   ds      8                       ;these 16 bytes must stay together in the same order
XOFXRS  ds      1                       ;part - note these 8 bytes are in reverse order on cassette
EADRES  ds      1                       ;extra address (bank info)
LANRES  ds      1                       ;file language
FBLKOF  ds      1                       ;first block of file on cassette (0 if entry is free)
FILS    ds      2                       ;file zize
FILA    ds      2                       ;file address
MYTTB   ds      EXTP1E-EXTP1            ;memory to temp block (routine placed in ram)
TBTMY   equ     MYTTB+EXTP1B-EXTP1      ;temp block to memory (routine placed in ram)
MATNF   ds      1                       ;number of matching files
CIMATF  ds      16                      ;catalog index of matching files
;
        END                             ;
