;---------------------------------------
; #### #### # #### ####
;    #    # #    #    # PRODUCTIONS
; # ## # ## # # ## #  #
; #  # #  # # # #  #  #
; #### #  # # # ## ####
;
; Asterix Kernal, Version 1.1.39
;
; (C) 1990-91 Baird Productions
;
; Coding commence: 15/11/90
; Last ammendment: 23/2/91
;
;---------------------------------------
;  SYSTEM{$a0}DECLARATIONS

pam      = $2000 ;Page allocation map
dir      = $2100 ;File entries
dirlen   = 96    ;Max # of files  (56)
dirrow   = 32    ;Length of dir entries
dirend   = $2d00 ;End of dir      (2800)
vdrive   = $2d00 ;Start of Vdrive (2800)
vend     = $c000 ;End of Vdrive   (6000)
filepnt  = 22    ;Fpointer in dir
filemode = 24    ;Filemode
cmdpath  = 7

indr1    = $02 ;ZERO PAGE
indr2    = $04
stderr   = $06 ;File redirection,
stdin    = $07 ;a la UNIX
stdout   = $08
dircurr  = $09 ;Cur. dir level
protect  = $0b ;Cur. chmod
flength  = $0c ;below's length
fname    = $0e ;Vector to filename
pointer  = $10 ;Fmode 2&4

couttmp3 = $41
couttmp4 = $42
cout     = $43   ;output byte
coutnum  = $44   ;out fnum
couty    = $45
row      = $46
optmp1   = $47   ;open fnum
optmp2   = $48   ;1st page
opmode   = $49   ;guess
chktmp1  = $4a
indr3    = $4b   ;seeka,coutlen,pnt
seekb    = $4d
seekmode = $4e
t1       = $4f   ;inittmp,dread
inmode   = $50
chrinx   = $51
chriny   = $52
lstcnum  = $8b
lstcpnt  = $8c
lstcpage = $8d
lstpage  = $8e
lstnum   = $8f
lstpointh = $27
contmp   = $26

cbmpet   = 1
cbmasc   = 2
petcbm   = 3
asccbm   = 4
petasc   = 5
ascpet   = 6
ascdump  = 7
convmode = $40

;---------------------------------------

         *= $0820
         jmp $1000

         *= $0830
tty      .byte 1  ;Device table
con      .byte 2
kbd      .byte 3
prn      .byte 4
nul      .byte 5

;---------------------------------------
         *= $0900

         jmp init      ;KERNAL TABLE

         jmp open
         jmp openfnum
         jmp close
         jmp chrout
         jmp chrin
         jmp delete

         jmp gettype
         jmp getmode
         jmp findpage
         jmp calcdir
         jmp seek
         jmp chkexist
         jmp dirread

         jmp pageon
         jmp pageoff
         jmp convert

;---------------------------------------

strobe   .byte 2,20,0,164,0,0,0,0,0,0,0
buffer   .text "                     "
         .text "                     "
         .text "                     "
         .text "                     "

totdevs  = 6
device   .byte 1,0,0,0,217
         .text "/"
         .word 0
         .byte 6,0,0,0,75
         .text "tty"         ;1
         .byte 6,0,0,0,147
         .text "con"         ;2
         .byte 6,0,0,0,147
         .text "kbd"         ;3
         .byte 6,0,0,0,75
         .text "prn"         ;4
         .byte 6,0,0,0,219
         .text "nul"         ;5
         .byte 0,0,0,0,145
         .text "dev"
         .byte 0,0,0,0,217
         .text "bin"

permutes ;#0 Do nothing
         .byte 0,32,64,96,128,160,192
         .byte 224

         ;#1 CBM => PETASC
         .byte 64,32,192,224,0,96,128
         .byte 160

         ;#2 CBM => TrueASC
         .byte 96,32,64,160,0,192,128
         .byte 224

         ;#3 PETASC => CBM
         .byte 128,32,0,64,192,96,64
         .byte 96

         ;#4 TrueASC => CBM
         .byte 128,32,64,0,192,96,160
         .byte 224

         ;#5 PETASC => TrueASC
         .byte 0,32,96,64,128,160,64
         .byte 224

         ;#6 TrueASC => PETASC
         .byte 0,32,192,64,128,160,192
         .byte 224

         ;#7 Code => TrueASC (DUMP)
         .byte 96,32,64,96,96,64,96,64

;---------------------------------------
; INITALISE everything

init     lda #55  ;Could use the norm
         sta 1    ;Kernal routines
         cli

         ldy #0
         sty row
         tya
init1    sta pam,y    ;0 pam
         iny
         bne init1

         ldx #dirlen  ;0 dir
         sta indr1
         lda #>dir
         sta indr1+1
init3    ldy #0
         tya
init2    sta (indr1),y
         iny
         cpy #dirrow
         bne init2
incrow   clc
         lda indr1
         adc #dirrow
         sta indr1
         lda indr1+1
         adc #0
         sta indr1+1
         dex
         bpl init3

         lda #1   ;declare Vdrive memory
         ldy #>vdrive
init4    sta pam,y
         iny
         cpy #>vend
         bne *+4       ;plus a bit extra
         ldy #$d0
         cpy #$dc
         bne init4

         lda #7          ;Instal device
         sta t1          ;covers + bin
         lda #<dir
         sta indr1
         lda #>dir
         sta indr1+1
         ldx #0
init6    ldy #0
init5    lda device,x
         sta (indr1),y
         inx
         iny
         cpy #8
         bne init5
         clc
         lda indr1
         adc #dirrow
         sta indr1
         lda indr1+1
         adc #0
         sta indr1+1

         dec t1
         bpl init6
         rts

;---------------------------------------
pageoff  sei
         pha
         lda #52
         sta 1
         pla
         rts

pageon   pha
         lda #55
         sta 1
         pla
         cli
         rts

;---------------------------------------
; Console output
emit     pha
         lda #petasc
         sta convmode
         pla
         jsr convert
         jsr $e684 ;Watch for "
         jsr $e716
nulwrt   clc
         rts

; Printer output
ciout    = $ffa8
mps802   pha
         lda #petasc
         sta convmode
         pla
         jsr convert
         jsr ciout
         clc
         rts

;
;  OUTPUT char A to file# X
clen     = couttmp3

chrout   stx coutnum
         sta cout
         sty couty
         cpx tty      ;trap devices
         beq emit
         cpx nul
         beq nulwrt
         cpx prn
         beq mps802

         txa
         jsr getsprot ;chk writeable
         and #2
         beq wrterr

         ldy #filemode
         lda (indr1),y ;Chk 4 fmode
         cmp #1
         beq cout3
         cmp #5
         beq cout3
         cmp #2
         beq cout3a
wrterr   lda #9
         ldx coutnum
         ldy couty
         sec
         rts

cout3a   lda pointer+1 ;Mode 2 REL write
         sta clen+1
         lda pointer
         sta clen
         jmp cout3b

cout3    dey      ;leftover from getmode
         lda (indr1),y ;getpointers
         sta clen+1
         dey
         lda (indr1),y
         sta clen

cout3b   lda coutnum
         cmp lstcnum
         sta lstcnum
         bne cout3d
         lda clen+1
         cmp lstcpnt
         sta lstcpnt
         bne cout3d
         ldx clen
         ldy lstcpage
         bne cout3c

cout3d   ldx clen           ;pntlo
         lda coutnum    ;f#
         ldy clen+1   ;pnthi
         jsr seek       ;Look for page
         bcs wrterr
cout3c   stx indr2
         sty indr2+1
         sty lstcpage
         lda coutnum
         jsr pageoff
         lda cout
         ldy #0
         sta (indr2),y
         jsr pageon

         ldy #2
         lda (indr1),y
         sta indr3
         iny
         lda (indr1),y
         sta indr3+1

         inc clen
         bne cout5z
         inc clen+1
cout5z   lda clen       ;CMP len&pnt
         cmp indr3
         lda clen+1
         sbc indr3+1
         bcc cout5

         lda clen
         sta indr3
         lda clen+1
         sta indr3+1

cout5    lda clen     ;move pnt,len back
         ldy #filepnt
         sta (indr1),y
         lda clen+1
         iny
         sta (indr1),y

         lda indr3
         ldy #2          ;move length
         sta (indr1),y
         lda indr3+1
         iny
         sta (indr1),y

         clc          ;OK exit
         ldy couty
         lda cout
         ldx coutnum
         rts

;---------------------------------------
; Console LineInput

linput   lda row
         beq conin
         tax       ;If line in mem, then
         inc row         ;push chars out
         lda buffer,x
         cmp #13
         bne lin2
         ldx #0
         stx row       ;Finished pushing
lin2     jmp chrfin

conin    ldy #79
         sta buffer,y
         dey
         bpl conin+2

kbd2     ldy strobe     ;Cursor
st1      lda $d012
         cmp #50
         bne st1
         lda strobe+1,y
         jsr $e716
         dey
         bpl st1
         lda #petasc
         sta convmode
         jsr $ffe4 ;chrin-ing from here
         jsr convert
         cmp #26   ;causes Y reg prob
         beq lineeot
         cmp #20
         beq kbddel
         cmp #13   ;Keep CR
         beq filein1
         cmp #32
         bcc kbd2
         cmp #127
         bcs kbd2

kbd3     ldx row
         sta buffer,x
         ldx tty
         jsr chrout
         ldx row
         inx
         stx row
         cpx #79
         beq linelong
         bne kbd2

kbddel   ldx row
         beq kbd2
         ldx tty
         jsr chrout
         ldx row
         dex
         lda #0
         sta buffer,x
         stx row
         jmp kbd2

lineeot  lda #12
         .byte $2c
linelong lda #13
         ldx #0
         stx row
         bne *+5
         jmp chrbad

filein1  ldx tty
         jsr chrout
         ldx row
         sta buffer,x
         cpx #0
         beq filein2
         ldx #1
filein2  stx row
         lda buffer
         jmp chrfin

; Console Get
keyin    jsr $ffe4
         cmp #0
         beq keyin
         cmp #26
         bne chrfin
         beq eoterr

chrbad   sec
         .byte $24
chrfin   clc
         ldx chrinx
         ldy chriny
         rts


;
; CHRIN - Get byte(A) from file X

infile   = chrinx

chrin    stx chrinx
         sty chriny

         cpx kbd
         beq keyin
         cpx con
         bne *+5
         jmp linput
         cpx nul
         beq eoterr

         txa
         jsr getsprot
         and #4
         bne chrin2

rederr   lda #10   ;Not a Readable file
         .byte $2c
eoterr   lda #12   ;EOT
         jmp chrbad

chrin2   ldy #filemode
         lda (indr1),y
         sta inmode
         cmp #3     ;Only 3 & 4 allowed
         bcc rederr
         cmp #5
         bcs rederr

chrin3   ldy #filepnt  ;Get pointer
         lda (indr1),y
         sta indr3
         iny
         lda (indr1),y
         sta indr3+1   ;find where 2
         lda inmode    ;seek from
         cmp #4
         beq chrin4
         ldx indr3
         stx pointer
         lda indr3+1
         sta pointer+1

         ldy infile
         cpy lstnum
         bne chrin4
         cmp lstpointh
         bne chrin4
         ldy lstpage
         beq chrin4a


chrin4   ldy #2         ;pointer>length?
         sec
         lda pointer
         sbc (indr1),y
         ldy #3
         lda pointer+1
         sbc (indr1),y
         bcs eoterr

         ldx pointer
         ldy pointer+1
         lda infile
         jsr seek
chrin4a  stx indr2
         sty indr2+1
         sty lstpage
         bcs rederr

         lda pointer+1
         sta lstpointh
         lda infile
         sta lstnum

         lda inmode
         cmp #3
         bne chrin5

incpoint clc
         ldy #filepnt
         lda pointer
         adc #1
         sta (indr1),y
         ldy #filepnt+1
         lda pointer+1
         adc #0
         sta (indr1),y

chrin5   jsr pageoff
         ldy #0
         lda (indr2),y
         jsr pageon
         jmp chrfin


;
; Get dir entry type of fnum(A)

gettype  ldy #4
         jsr dirread
         and #3
         rts

; Get sysprot

getsprot ldy #4
         jsr dirread
         lsr a
         lsr a
         lsr a
         lsr a
         lsr a
         rts


; Read DIR byte Y from fnum A

dirread  sty t1
         jsr calcdir
         ldy t1
         lda (indr1),y
         rts


; Get file(A) Open mode

getmode  ldy #filemode
         jmp dirread

; Calculate dir pos from fnum(A)

calcdir  clc
         adc #8    ;This is v.dependent
         sta indr1 ;on the current setup
         lda #1
         adc #0
         sta indr1+1  ;(264+a)*32
         asl indr1
         rol indr1+1
         asl indr1
         rol indr1+1
         asl indr1
         rol indr1+1
         asl indr1
         rol indr1+1
         asl indr1
         rol indr1+1
         rts

; Find unused page

findpage ldy #0
find1    lda pam,y ;Scans for pam=1
         cmp #1
         beq find2
         iny
         bne find1
         sec    ;Just flags nomem
         rts
find2    tya
         clc
         rts

;
; SEEK (f#(A),pointer(X,Y))
;    also splats indr1

seek     stx indr3   ;Store pointer
         sty indr3+1
         cmp #totdevs  ;Shouldn't B able
         bcc seek5         ;2 seek these

         jsr calcdir ;Find start page
         ldy #1
         lda (indr1),y
         sta seekb
         ldy #filemode
         lda (indr1),y
         sta seekmode

seek1    lda indr3+1 ;Find page for pntr
         beq seek2
         dec indr3+1
         ldy seekb
         lda pam,y
         cmp #2    ;Chk if 2(lastpage)
         beq seek4
         sta seekb
         bcs seek1
seek5    sec         ;huh? spastic link
         rts    ;(0 or 1)

seek4    lda seekmode ;Check if we're
         beq seek5    ;allowed to
         cmp #3
         beq seek5
         cmp #4
         beq seek5
         jsr findpage  ;link extra page
         bcc seek3
         rts     ;didn't find one, exit

seek3    ldy seekb ;relink 2nd last page
         sta pam,y
         sta seekb
         tay       ;EOF marker
         lda #2
         sta pam,y
         jmp seek1

seek2    ldx indr3
         ldy seekb
         clc
         rts


;
; CHKNAME Checks if fname,flength exists
;  Carry set=no

chkexist lda #255
         sta chktmp1
chkn3    inc chktmp1
         lda chktmp1
         cmp #dirlen
         bne *+3   ;end of dir
         rts
         jsr gettype
         beq chkn3   ;skip dels
         ldy #0
         lda (indr1),y ;check if in this
         cmp dircurr   ;dirlevel
         bne chkn3
         ldx flength
         dex
         txa
         clc         ;end of name in dir
         adc #6
         tay
         lda (indr1),y
         bne chkn3   ;wrong len
         lda fname
         sta smcb+1
         lda fname+1
         sta smcb+2
         dey
smcb     lda $e000,x
         cmp (indr1),y
         bne chkn3
         dey
         dex
         bpl smcb
         lda chktmp1 ;found, get fnum
         clc
         rts


;
; OPEN a file, Mode in A + fname,flength
; OPENFNUM Mode in A, X holds fnum

openfnum sta opmode
         txa
         jsr gettype  ;chk exists
         bne openf1
         jmp opnon

openf1   lda opmode
         cmp #6
         bcs operr
         cmp #5
         beq openf3
         cmp #3
         bcs openf2
openf3   txa
         jmp opold
openf2   txa
         jmp opcr6

open     sta opmode
         cmp #0      ;Check modes
         beq operr
         cmp #3
         bcc opwrite
         cmp #5
         beq opwrite
         bcs operr
         jmp opread

operr    lda #4
         sec
         rts

opwrite  jsr chkexist   ;chk if't exists
         bcs opcreate
         ldx opmode
         cpx #5
         beq *+5
         jmp opold
         jsr delete      ;It does&zap it
         bcs operr+2

    ;search for vacant dir spot
opcreate ldx #0
opcr1    cpx #dirlen
         bne opcr2
         lda #5
         sec
         rts
opcr2    txa
         jsr gettype
         beq opcr3
         inx
         jmp opcr1

opcr3    stx optmp1
opcr3a   jsr findpage  ;Find start blk
         bcc opcr7
         lda #7
         sec
         rts

opcr7    sta optmp2 ;Store 1st page
         tay
         lda #2
         sta pam,y  ;1st/last page
         ldy #0
         lda dircurr    ;Dirparent
         sta (indr1),y
         iny
         lda optmp2   ;Starting Page
         sta (indr1),y
         iny
         lda #0       ;Initlength=0
         sta (indr1),y
         iny
         sta (indr1),y
         iny
         ldx #0      ;Transfer fname
         lda fname
         sta smca+1
         lda fname+1
         sta smca+2
opcr4    iny
         cpx flength
         beq opcr5
smca     lda $e000,x
         sta (indr1),y
         inx
         cpx #17
         bne opcr4
         sec
         lda #6 ;Name 2 long
         rts

opcr5    lda #0     ;Pad namefield
         cpy #21
         beq opcr6
         sta (indr1),y
         iny
         bne opcr5
opcr6    ldy #4         ;Protection
         lda protect;dun last in case
         and #252     ;of err#6
         ora #3
         sta (indr1),y

         lda #0 ;Pointer=0
         ldy #filepnt
         sta (indr1),y
         iny
         sta (indr1),y
         jmp opcr8

opcr6a   lda optmp1 ;clean up Rdrive
         cmp #totdevs
         bcc opcr6b
         jsr delete
         jsr findpage          ;Find new
         bcs opcr3a           ;beginning
         tay
         lda #2
         sta pam,y
opcr6b   lda #0
         ldy #2
         sta (indr1),y
         iny
         sta (indr1),y
         jmp opcr6

opold    sta optmp1
         jsr getsprot
         and #2      ;chk if writable
         beq opnon
         lda opmode  ;Chk if mode 5
         cmp #5
         beq opcr6a
         ldy #2        ;if old file,
         lda (indr1),y ;pointer=length
         ldy #filepnt
         sta (indr1),y
         ldy #3
         lda (indr1),y
         ldy #filepnt+1
         sta (indr1),y

opcr8    ldy #filemode
         lda opmode    ;Set Write Mode
         sta (indr1),y
         lda optmp1    ;Using printer?
         cmp prn
         beq openprinter ;yes, open it.
opcr9    clc
         lda optmp1
         rts


opread   jsr chkexist ;Chk it's there
         bcc opred1
opnon    sec
         lda #11     ;It doesn't
         rts
opred1   sta optmp1  ;Ret fnum
         jsr getsprot;Shortcut&chk prot
         and #4
         beq opnon
         jmp opcr6   ;put mode,pointer


listen   = $ffb1
second   = $ff93

openprinter lda #4
         jsr listen
         lda #$67
         jsr second
         jmp opcr9


;
; CLOSE, fnum in A
unlsn    = $ffae

close    cmp prn
         bne close1
         pha
         jsr unlsn
         pla
close1   jsr getmode
         lda #0
         sta (indr1),y
         clc
closend  rts


;
; DELETE, fnum in A

delete   cmp #totdevs
         bcc delerr
         jsr calcdir
         ldy #4
         lda (indr1),y ;Change type =del
         tax
         and #3        ;Chk if directory
         cmp #1
         beq delerr
         txa
         and #252
         sta (indr1),y

         ldy #1
         lda (indr1),y
         tay
del1     lda pam,y  ;Clean up PAM
         pha
         lda #1
         sta pam,y
         pla
         tay
         cpy #2  ;2 means we've finished
         beq delend
         bcs del1

delerr   lda #17         ;<2 err
         sec
         rts

delend   clc
         rts

;
; CONVERT  - Text convert
; A=input, convmode($40)=0..5

convert  pha
         lda convmode
         asl a
         asl a
         asl a
         sta contmp
         pla
         pha
         and #224
         asl a
         rol a
         rol a
         rol a
         adc contmp
         stx contmp
         tax
         pla
         and #31
         ora permutes,x
         ldx contmp
         rts


