;---------------------------------------
; Asterix Shell, Version 1.8.61
;
; (C) 1990-91 Baird Productions
;
; Coding commence: 22/11/90
; Last ammendment: 27/9/91
;
;---------------------------------------

pam      = $2000   ;SYSTEM DECLARATIONS
dir      = $2100
dirlen   = 96      ;56
dirrow   = 32
dirend   = $2d00   ;2800
vdrive   = $2d00   ;2800
vend     = $c000   ;6000
exicute  = $c000   ;6000
execend  = $d000   ;6400
filelength = 22
filemode = 24
devdir   = 6
totdevs  = 6
cmdpath  = 7

indr1    = $02 ;ZERO PAGE
indr2    = $04
stderr   = $06
stdin    = $07
stdout   = $08
dircurr  = $09
protect  = $0b
flength  = $0c
fname    = $0e
pointer  = $10
indr3    = $12
indr4    = $14
endstr   = $17

wordtick = $58
nountick = $59
pipein   = $5a
nounend  = $5b
cmdfnum  = $5c
count    = $5d
t1       = $5e
t2       = $5f
stdost   = $60
stdonum  = $61
stdomode = $62
stdinum  = $63
stdist   = $64
declo    = $65
decmd    = $66
dechi    = $67
dwork    = $68
stdolen  = $6a
stdilen  = $6b
nountot  = $6c
flagtot  = $6d
stack    = $6e
pipeout  = $6f
pipeinum = $70
pipeonum = $71
wordtot  = $72
fnlen    = $b7

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

uparrow  = $7e
pound    = 124
atchar   = 96 ;What "@" becomes after
              ;my stupid convert routine
quotechar = 34
remchar  = 35
spc      = 32

convmode = $40

tty      = $0830 ;DEVICE TABLE
con      = tty+1
kbd      = con+1
prn      = kbd+1
nul      = prn+1

init     = $0900 ;KERNAL JUMP TABLE
open     = $0903
openfnum = $0906
close    = $0909
chrout   = $090c
chrin    = $090f
delfnum  = $0912
gettype  = $0915
getmode  = $0918
findpage = $091b
calcdir  = $091e
seek     = $0921
chkexist = $0924
dirread  = $0927
pageon   = $092a
pageoff  = $092d
convert  = $0930

strings  = $dc00
astl     = strings+640
asth     = astl+64
defstl   = asth+64
defsth   = defstl+64
alen     = defsth+64
deflen   = alen+64

;----------------
         *= $0840
bufsiz   = 79
buffer   .text "                     "
         .text "                     "
         .text "                     "
         .text "                     "
wordstart .text "                    "
wordlen  .text "                    "
quotelst .text "                    "
nountab  .text "                "
flaglst  .text "                "

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

         *= $1000
         jmp start  ;Shell routine table
         jmp main
         jmp linein
         jmp scandir2
         jmp error
         jmp strout
         jmp decout
         jmp hexout
         jmp nounnum
         jmp nounstart
         jmp flagchk
         jmp nounlen
         .word prmpt
         jmp opstdout
         jmp opstdin
         jmp stdwrite
         jmp stdread
         jmp clostdout
         jmp clostdin
         jmp writestr

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

start    jsr init
         jsr shinit

main     lda stdin
         cmp con
         bne main0
         jsr prompt
         bcc main0
         jmp bug

main0    jsr linein
         bcc main1
         cmp #12    ;If EOF then pop std
         beq *+5
         jmp bug
         ldy stack
         bne *+5
         jmp mainbarf
         jsr popstack
         jmp main


main1    jsr prepros
         bcc *+5
         jmp bug

         jsr parse

         lda wordstart
         cmp #255     ;Chk if blank line
         beq main

         lda #0
         sta wordtick
         sta pipein

main2    lda stdin          ;default I/O
         sta stdinum
         lda stdout
         sta stdonum

         ldx #1
         stx stdomode
         dex
         stx cmdfnum

         jsr verb
         bcc *+5
         jmp bug

         lda #0
         sta pipeout
         sta nountick
         inc wordtick

         jsr noun
         bcc *+5
         jmp bug

         jsr prep
         bcc *+5
         jmp bug

main3    lda cmdfnum  ;Check if internal
         beq run
         jsr moveprog  ;transfer routine
         bcc *+5
         jmp bug

run      lda pipein  ;Handle piped input
         beq run1
         lda stdinum
         cmp con
         beq run2
run7     lda #28       ;Clogged pipe
         jmp bug

run2     lda pipeinum
         sta stdinum

run1     lda pipeout      ;Piping output
         beq run3
         lda stdonum
         cmp tty
         bne run7
         jsr randfile
         sta pipeonum
         sta stdonum

run3     .byte 32       ;Exicute routine
startvec .word $ffd2
         bcs bug


run4     cmp #0   ;ignore remaining cmds
         beq run5
         cmp #1       ;Chk if autorepeat
         bne run5

         ldx nountick  ;If nouns remain
         inx
         stx nountick
         cpx nountot
         bcc run3

run5     ldx nounend
         cpx wordtot
         bcc *+8
         jsr delpipe
         jmp main

;Chk if the next noun is not quoted, and
;if ^ or ;

         inx
         stx wordtick
         dex
         lda quotelst,x
         beq *+5
         jmp main

         lda wordstart,x
         tax
         lda buffer,x
         cmp #";"
         bne *+8
         jsr delpipe
         jmp main2

         cmp #uparrow
         beq *+5
         jmp main

         jsr delpipe
         ldx pipeout
         beq run4
         lda pipeonum
         sta pipeinum
         jsr close
         lda #1
         sta pipein

         jmp main2


delpipe  lda pipein
         beq delp1
         lda pipeinum
         jmp delfnum
delp1    rts

mainbarf lda #29    ;Stack err
bug      jsr error
bugend   jmp main


;----------------
; Initialize shell params

shinit   lda #216
         sta protect
         lda con
         sta stdin
         lda tty
         sta stdout
         sta stderr
         jsr pageoff
         lda #0
         sta dircurr
         sta stack
         tay
shi1     sta strings,y
         sta strings+256,y
         sta strings+512,y
         sta strings+768,y
         iny
         bne shi1
         lda #<strings
         sta endstr
         lda #>strings
         sta endstr+1
         jmp pageon

;----------------
popstack lda stdin
         jsr close
         lda stdout
         jsr close

         ldy stack
         lda stackin,y
         sta stdin
         lda stackout,y
         sta stdout
         dec stack
         rts

;----------------
; Echo prompt to stdout

prompt   lda #<prmpt
         sta indr4
         lda #>prmpt
         sta indr4+1
         ldx stderr
         jmp strout

;----------------
; Input line from file

linein   ldy #bufsiz
         lda #0
line0    sta buffer,y
         dey
         bpl line0

fileline ldy #0
filein2  ldx stdin
         jsr chrin
         bcs linelong+2
         cmp #13
         beq filein1
         sta buffer,y
         iny
         cpy #bufsiz+1
         bne filein2
linelong lda #13
         sec
         rts
filein1  sty fnlen
         clc
         rts

;----------------
; VERB - Scan internal+curr dir

verb     lda #255      ;Chk internal 1st
         sta count
scanb    inc count           ;Go through
         ldy count       ;internal table
         ldx wordtick
         lda strlen,y       ;cmp lengths
         beq scand
         cmp wordlen,x
         bne scanb

         lda strlo,y     ;get string pos
         sta indr1
         lda strhi,y
         sta indr1+1
         lda wordlen,x
         sta scantmp
         lda wordstart,x
         tax
         ldy #0        ;Chk string
scanc    lda (indr1),y
         cmp buffer,x
         bne scanb
         iny
         inx
         dec scantmp
         bne scanc

         ldy count    ;Get routine start
         lda cmdlo,y
         sta startvec
         lda cmdhi,y
         sta startvec+1
         clc
         rts

scand    jsr scandir      ;1st scan curr
         bcc scanfound
         lda dircurr
         pha
         lda #cmdpath     ;2nd scan path
         sta dircurr
         jsr scandir
         tay            ;restore curr
         pla
         sta dircurr
         tya
         bcs scane
scanfound sta cmdfnum  ;I know U!
         clc
         rts

scane    lda #15       ;I dont
         sec
         rts


scandir  ldx wordtick ;scan 4 verb
    ;scandir2 requires nounnum
scandir2 lda wordlen,x
         sta flength
         clc
         lda wordstart,x
         adc #<buffer
         sta fname
         lda #0
         adc #>buffer
         sta fname+1
         jmp chkexist

;----------------
; Scan nounline. redirection,etc

noun     ldx #0
         stx nountot
         stx flagtot
         stx stdist
         stx stdost
         dex
         stx flaglst

noun0    ldx wordtick ;chk if more nouns
         lda wordstart,x
         bpl *+5
         jmp nounok

         pha
         tay
         lda buffer,y
         tay
         pla
         cpy #uparrow
         beq nounpipe
         cpy #";"
         bne noun4
         jmp nounok

nounpipe lda #1
         sta pipeout
         jmp nounok

noun4    tay
         lda wordlen,x ;get len of file
         sta t1
         dec t1
         lda buffer,y
         cmp #"-"
         beq nounflag

         ldx #5        ;chk for redirect
noun2    cmp redirtyp,x
         beq noun1
         dex
         bpl noun2

;not a redir, so put on nountab
         lda wordtick
         ldy nountot
         sta nountab,y
         iny
         lda #255     ;EO nouns mark
         sta nountab,y
         sty nountot
         bne noun3

;record start of filenouns
noun1    iny
         lda buffer,y   ;Chk if split
         beq nounbad
         cmp #spc ;by a space
         bne noun1a

         ldy wordtick   ;Get nxt wrd &
         iny            ;use that
         sty wordtick
         lda wordlen,y
         sta t1
         lda wordstart,y
         tay

noun1a   lda t1
         cpx #3
         beq nounr
         sta stdolen
         sty stdost
         stx stdomode
         jmp noun3

nounr    sty stdist
         sta stdilen

noun3    inc wordtick
         jmp noun0


nounflag lda t1      ;Chk length<>1
         beq nounbad1
         iny
         lda buffer,y
         cmp #spc
         beq nounbad1
         ldy flagtot
         sta flaglst,y
         iny
         lda #255
         sta flaglst,y
         sty flagtot
         bne noun3

nounbad1 lda #27   ;Bad flag
         .byte $2c
nounbad  lda #11   ;No file
         sec
         rts

nounok   stx nounend
         clc
         rts

redirtyp .byte spc,92,spc,60,spc,62
           ; " \ < >"

;----------------
; Check if .A is a flag (CC=yes)

flagchk  sta flagtmp
         tya
         pha
         ldy #255
cflag1   iny
         lda #255
         cmp flaglst,y
         beq cflag2
         lda flagtmp
         cmp flaglst,y
         bne cflag1

         clc        ;It's there
         .byte $24
cflag2   sec        ;It's not
         pla
         tay
         rts

;----------------
; Prepare redirection into files

prep     lda stdist        ;input prep
         beq prep1
         ldx stdilen
         jsr prepop
         bcs prepbad
         sta stdinum

prep1    lda stdost        ;output prep
         beq prepexit
         ldx stdolen
         jsr prepop
         sta stdonum
         bcc prepexit  ;No,doesn't exist
         lda stdomode  ;so prepare
         jsr open
         bcs prepbad
         sta stdonum
         jsr close
         bcs prepbad
         jmp prepexit

prepbad  lda #11
         sec
         rts
prepexit clc
         rts

prepop   stx flength  ;find fnum
         clc
         adc #<buffer
         sta fname
         lda #>buffer
         adc #0
         sta fname+1
         jsr chkexist ;chk curr dir
         bcc prepexit
         lda dircurr
         pha
         lda #devdir  ;chk dev dir
         sta dircurr
         jsr chkexist
         tax
         pla
         sta dircurr
         txa
         rts

;----------------
; Parse buffer, find start of words

parsetst lda #0
         .byte $2c
parse    lda #1
         sta parsetyp

         lda #255     ;Clr starts
         ldy #19
parse1   sta wordstart,y
         sta wordlen,y
         sta quotelst,y
         dey
         bpl parse1
         tax

parse2   iny
         lda buffer,y
         beq endparse
         cmp #spc
         beq parse2
         inx
         tya
         sta wordstart,x
         sta ystr

parse3   iny
         lda buffer,y
         beq parse4
         cmp #spc
         bne parse3

parse4   tya
         sec
         sbc wordstart,x
         sta wordlen,x

         lda parsetyp    ;If not parsing
         beq parse2      ;from prepros
         lda ystr        ;then handle "
         sty ystr
         tay
         lda buffer,y
         ldy ystr
         cmp #quotechar
         bne par2
         inc wordstart,x  ;Skip quote
         dec wordlen,x
         .byte $2c
par2     lda #0
par2a    sta quotelst,x
         jmp parse2


endparse stx wordtot
         ldx parsetyp
         ldy #0       ;Cnv hard/quoted
endp1    lda buffer,y ;spcs back
         cmp #128
         bne endp3
         cpx #0       ;Dont change
         beq endp3
         lda #spc
endp3    sta buffer,y
         cmp #0
         beq endp2
         iny
         bne endp1
endp2    clc
         rts

;----------------
; Preprocess input: remove #,quoting,etc

prepros  ldy #bufsiz
         lda #0
pre0     sta tmpbuf,y
         dey
         bpl pre0
         tax
         stx quote
         dex
         stx tabb
         stx tabt

pre1     inc tabb
         ldy tabb
         lda buffer,y
         beq preend
         cmp #spc
         beq prespace
         cmp #quotechar
         beq prequote
         cmp #remchar
         beq prerem
         cmp #pound
         beq precode

pre2     inc tabt
         ldx tabt
         sta tmpbuf,x
         jmp pre1


prequote lda quote
         eor #1
         sta quote
         beq pre1
         lda buffer-1,y
         cmp #spc ;Only "absolute
         bne pre1 ;quote" if entire word
         lda #quotechar
         bne pre2


prespace ldx quote ;Don't split quoted
         beq pre2  ;spaces
         lda #128      ;I'm 20 years old
         bne pre2      ;today!


prerem   ldx quote
         bne pre2
         jmp preend


precode  ldx quote
         beq pre2
         jsr prenyb
         bcs prebarf2
         asl a
         asl a
         asl a
         asl a
         sta pretmp1
         jsr prenyb
         bcs prebarf2
         ora pretmp1
         inc tabb
         inc tabb
         jmp pre2


prenyb   iny
         lda buffer,y
         sec
         sbc #48
         cmp #10
         bcc nybb1
         sbc #7
         cmp #16
         bcc nybb1
         cmp #42
         bcc nybb1a
         sbc #32
nybb1a   cmp #16
nybb1    rts


preend   ldx #bufsiz
preend1  lda tmpbuf,x
         sta buffer,x
         dex
         bpl preend1

         jmp aliasin   ;Xchange aliases


prebarf2 lda #30
         sec
         rts

;----------------
; Preprocessing - Use aliases
; dont change if quoted.

aliasin  jsr parsetst
         jsr pageoff
         ldy #bufsiz
         lda #0
alin2    sta tmpbuf,y
         dey
         bpl alin2
         sty wtick
         iny
         sty bufpnt


alin1    inc wtick
         ldy wtick
         lda wordlen,y
         cmp #255
         bne *+5
         jmp alexit
         sta wlen

         ldy #0              ;Cmp length
         sty ytick
alin3    ldy ytick
         inc ytick
         cpy #64
         beq alnotfnd
         lda alen,y
         beq alnotfnd
         cmp wlen
         bne alin3

chkstring sty alpnt          ;Cmp string
         ldx wtick
         lda wordstart,x
         tax
         lda buffer,x
         cmp #quotechar  ;Quoted-ignore!
         beq alin3

         lda astl,y
         sta smc2+1
         lda asth,y
         sta smc2+2

         ldy #0
alin6    cpy wlen
         beq alfnd
         lda buffer,x
smc2     cmp $e000,y
         bne alin3     ;Chk rest of list
         inx
         iny
         bne alin6


alnotfnd ldx wtick
         clc
         lda wordlen,x
         sta wlen
         lda wordstart,x
         adc #<buffer
         sta smc1+1
         lda #>buffer
         adc #0
         sta smc1+2
         jmp trans


aliasov  lda #31 ;Nice central location,
         sec     ;branching distance
         jmp pageon ;from the CBD


alfnd    ldy alpnt
         lda defstl,y
         sta smc1+1
         lda defsth,y
         sta smc1+2
         lda deflen,y
         sta wlen


trans    ldx bufpnt
         lda #spc
         sta tmpbuf-1,x
         ldy #0
tran1    cpy wlen
         beq alin4
smc1     lda $dc00,y
         sta tmpbuf,x
         iny
         inx
         cpx #bufsiz
         bne tran1
         jmp aliasov

alin4    inx
         stx bufpnt
         jmp alin1


alexit   ldy #bufsiz
alin5    lda tmpbuf,y
         sta buffer,y
         dey
         bpl alin5
         clc
         jmp pageon

;----------------
; Append Alias

alias    jsr pageoff   ;2 get at strings

         jsr nounnum     ;Chk 4 quote on
         lda quotelst,x          ;"name"
         beq albug3          ;manditory!

         jsr alchk       ;Chk exist
         bcs albug1      ;Already def'ed

         ldy #0          ;Find mt spot
al1      lda alen,y
         beq al2
         iny
         cpy #64
         bne al1
         beq albug2      ;Table full

al2      sty altmp
         lda endstr
         sta indr1
         sta astl,y
         lda endstr+1
         sta indr1+1
         sta asth,y

         jsr nounlen     ;Transfer alias
         sta translen
         sta alen,y
         jsr transal

         ldy altmp       ;Transfer def
         lda indr1
         sta defstl,y
         lda indr1+1
         sta defsth,y

         inc nountick
         jsr nounlen
         sta translen
         sta deflen,y
         jsr transal

         lda indr1
         sta endstr
         lda indr1+1
         sta endstr+1

         inc nountick
         lda #0
         clc
         jmp pageon


transal  jsr nounstart
         ldy #0
al3      lda buffer,x
         sta (indr1),y
         inx
         inc indr1
         bne *+4
         inc indr1+1
         dec translen
         bne al3
         rts


albug1   lda #32      ;Exists
         .byte $2c
albug2   lda #31      ;Overflow
         .byte $2c
albug3   lda #25      ;Not quoted
         .byte $2c
albug4   lda #33      ;Doesn't exist
         sec
         jmp pageon

;--------------
unalias  jsr pageoff
         jsr nounnum     ;Chk 4 quote
         lda quotelst,x
         beq albug3

         jsr alchk       ;Chk exist
         bcc albug4      ;Not def'ed

         ldy chktick
         lda astl,y   ;"A"
         sta indr1
         lda asth,y
         sta indr1+1

         clc          ;calc len
         lda alen,y
         adc deflen,y
         sta indr3

         clc          ;"B"=A+len
         lda indr1
         adc indr3
         sta indr2
         lda indr1+1
         adc #0
         sta indr2+1

         sec
         lda indr2    ;Len of alias+def
         sbc indr1
         sta indr3
         lda indr2+1
         sbc indr1+1
         sta indr3+1

         ldy #0        ;Gobble alias&def
gobble1  lda indr2
         cmp endstr
         bne gobble1a
         lda indr2+1
         cmp endstr+1
         beq gobble1b

gobble1a lda (indr2),y
         sta (indr1),y
         inc indr1
         bne *+4
         inc indr1+1
         inc indr2
         bne *+4
         inc indr2+1
         bne gobble1


gobble1b ldy chktick
gobble2  lda asth,y
         beq gobble2a
         sec
         lda astl+1,y
         sbc indr3
         sta astl,y
         lda asth+1,y
         sbc #0
         sta asth,y
         sec
         lda defstl+1,y
         sbc indr3
         sta defstl,y
         lda defsth+1,y
         sbc #0
         sta defsth,y

         lda alen+1,y
         sta alen,y
         lda deflen+1,y
         sta deflen,y
         iny
         cpy #63
         bcc gobble2

gobble2a lda #0
         sta astl+63
         sta asth+63
         sta defstl+63
         sta defsth+63
         sta alen+63
         sta deflen+63

         clc
         lda #1
         jmp pageon

;--------------
;Check in strings table if current noun
;is present. CC=Not there

alchk    lda #255
         sta chktick
         jsr nounlen
         sta chklen

alchk1   inc chktick
         ldy chktick
         cpy #64
         bne *+4
alchk2   clc            ;Not found
         rts

         lda alen,y
         beq alchk2
         cmp chklen
         bne alchk1
         sta alchktmp
         lda astl,y
         sta indr1
         lda asth,y
         sta indr1+1
         jsr nounstart
         ldy #0
alchk3   lda buffer,x
         cmp (indr1),y
         bne alchk1
         inx
         inc indr1
         bne *+4
         inc indr1+1
         dec alchktmp
         bne alchk3

         sec         ;Alais exists
         rts

;---------------
; Transfer file into Execute mem
; (Using 'flashload' to speed things up)

movei    = dwork

moveprog lda #3
         ldx cmdfnum
         jsr openfnum
         bcs movebug

         ldx #0
         stx t1

         ldx #<exicute
         stx startvec
         ldx #>exicute
         stx startvec+1

         ldx #<exicute-2
         stx movei
         ldx #>exicute-2
         stx movei+1

         ldx cmdfnum  ;Chk if executible
         jsr chrin
         cmp #<exicute
         bne movebad
         jsr chrin
         cmp #>exicute
         bne movebad

         ldy #1
         lda cmdfnum
         jsr dirread

move1    tax
         stx t2
         ldy #0
move2    lda (t1),y
         sta (movei),y
         iny
         bne move2

         inc movei+1
         lda movei+1
         cmp #>execend
         beq movebad

         lda pam,x
         cmp #2
         bne move1


move3    lda cmdfnum
         jmp close


movebad  lda #22     ;Not exicutible
         .byte $2c
movebug  lda #15     ;Bad input
         pha
         jsr move3
         pla
         sec
         rts

;----------------
;    Error message handler
; String indexed by A, echoed to STDERR

error    cmp #3
         bcs error1
         lda #2
error1   cmp #24
         beq errslave
         jsr errslave
         lda #1     ;" Error" afterwards

errslave tax
         lda #<errtable
         sta indr4
         lda #>errtable
         sta indr4+1
err1     ldy #0
err2     lda (indr4),y
         cmp #255
         bne err6
         lda #2
         jmp errslave
err6     cpx #0
         beq err3
         iny
         cmp #"_"
         bne err2
         clc
         tya
         adc indr4
         sta indr4
         lda indr4+1
         adc #0
         sta indr4+1
         dex
         jmp err1

err3     ldx stderr
         jmp strout

;----------------
; Output string [indr4] termed by _
; PETASC assumed, and A contains fnum

strout   lda #petasc
         sta convmode
         ldy #0
str5     lda (indr4),y
         cmp #"_"
         beq str4-1
         jsr convert
         jsr chrout
         bcs str4
         iny
         bne str5

         clc
str4     rts

;----------------
; Output a 5 digit number (leading 0's)

decout   php
         sed
         lda #0        ;Nifty routine of
         sta dechi      ;mine to convert
         sta decmd      ;binary into dec
         sta declo
         ldy #15
dec1     lsr dwork+1
         ror dwork
         bcc dec2
         clc
         lda declo
         adc pow2l,y
         sta declo
         lda decmd
         adc pow2m,y
         sta decmd
         lda dechi
         adc pow2h,y
         sta dechi
dec2     dey
         bpl dec1
         plp

         lda dechi  ;5 digits out
         jsr hex3
         lda decmd
         jsr hexout
         lda declo

hexout   pha
         lsr a      ;hex byte
         lsr a
         lsr a
         lsr a
         jsr hex3
         pla
         and #15
hex3     tax        ;hex nybble
         lda hextxt,x
         jmp stdwrite

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

nounnum  ldx nountick
         lda nountab,x
         tax
         rts

nounstart jsr nounnum
         lda wordstart,x
         tax
         rts

nounlen  jsr nounnum
         lda wordlen,x
         tax
         rts

;----------------
; Create a tmp file

randfile lda #<tmpname
         sta fname
         lda #>tmpname
         sta fname+1
         lda #5
         sta flength
         jsr chkexist
         bcs rand1     ;Not there

         lda tmpname+4 ;Decimal inc tmp#
         adc #1
         sta tmpname+4
         cmp #58
         bcc randfile
         lda #48
         sta tmpname+4
         clc
         lda tmpname+3
         adc #1
         sta tmpname+3
         jmp randfile  ;try again

rand1    lda #1
         jmp open

;----------------
; Change current directory

c7o      jsr nounnum   ;scan
         jsr scandir2
         bcc c7yes

         jsr nounlen    ;chk if / or ..
         tay
         cmp #3
         bcs c7no
         jsr nounstart
         lda buffer,x
         cmp #"."
         beq c7o1
         cmp #"/"
         bne c7no

         cpy #1       ;currdir=root
         bne c7no
         lda #0
         beq c7yes

c7o1     cpy #2
         bne c7no
         cmp buffer+1,x
         bne c7no
         lda dircurr
         ldy #0       ;currdir=parent
         jsr dirread
         jmp c7yes

c7no2    lda #19    ;Access
         .byte $2c
c7no     lda #18    ;No dir
         sec
         rts

c7yes    sta t1
         jsr gettype
         cmp #1
         bne c7no
         ldy #4
         lda (indr1),y  ;chk if R prot
         and #16
         beq c7no2

         lda t1
         sta dircurr
         clc
         lda #1
         rts

;----------------
; Make (mult) directory

c8o      jsr nounnum ;chk exist
         jsr scandir2
         bcs c81
c8no     lda #5      ;Dir exists
         sec
         rts

   ;We create a file, turn it into a
   ;directory, then splat it's PAM

c81      lda #1
         jsr open
         bcs c8no+2
         jsr close
         bcs c8no+2
         ldy #4
         lda #1
         ora protect
         sta (indr1),y
         ldy #1
         lda (indr1),y
         tay
         lda #1     ;return code in here
         sta pam,y
         clc
         rts

;----------------
; Remove (mult) directory

c1o      jsr nounnum  ;Get nxt word
         jsr scandir2
         bcs c1bug
         sta t2
         jsr calcdir
         lda indr1
         sta indr2
         lda indr1+1
         sta indr2+1
         ldy #0          ;chk dirparent
         sty t1
         lda (indr2),y
         cmp dircurr
         bne c1bug
         ldy #4          ;chk write prot
         lda (indr2),y
         and #8
         beq c1bug2

c1a      lda t1   ;find if any below
         cmp #dirlen
         beq c1b
         ldy #0
         jsr dirread
         inc t1
         cmp t2
         bne c1a
         ldy #4
         lda (indr1),y
         and #3
         beq c1a

c1bug3   lda #20       ;Not empty
         .byte $2c
c1bug2   lda #19       ;Access
         .byte $2c
c1bug    lda #18       ;no such dir
         sec
         rts

c1b      ldy #4        ;Splat prot
         lda (indr2),y
         and #252
         sta (indr2),y
         lda #1
         clc
         rts

;----------------
; Delete File

c3o      jsr nounnum
         jsr scandir2 ;Chk its there
         bcs err
         jsr delfnum  ;kill!
         bcs err+2

         lda #1  ;Repeat nouns
         .byte $2c
err      lda #11 ;No such file
         rts

;----------------
;Coldstart

cdo      jsr opstdout
         ldx stderr
         jsr writestr ;Conferm
         .word killtxt
         jsr clostdout

cd1      jsr $ffe4    ;Straight from the
         cmp #"y"     ;kbd to stop nasty
         beq kill     ;scripts
         cmp #"n"
         bne cd1
         lda #0
         clc
         rts

kill     pla
         pla
         jmp $1000

;----------------
;   Copy stdin to stdout
; Flags p:petasc  c:cbmasc
;       d:dumpasc s:cbmpet
;       t:petcbm  v:asccbm u:ascpet

c4flags  .byte spc,115,99,116,118,112
         .byte 117,100 ;"sctvpud"

c4o      lda #0
         sta cpmode
         ldy #7
c4o1     lda c4flags,y
         jsr flagchk
         bcs c4o0
         sty cpmode
         ldy #0
c4o0     dey
         bpl c4o1

         jsr opstdin
         bcs c4b
         jsr opstdout
         bcs c4b

c4a      jsr stdread
         bcs c4b
         ldx cpmode
         stx convmode
         jsr convert
         jsr stdwrite
         bcc c4a

c4b      pha
         jsr clostdin
         jsr clostdout
         pla
         cmp #12
         beq *+4
         sec
         rts
         lda #0
         clc
         rts

;----------------
; Rename a dir entry (file/dir)

c9o      jsr nounnum  ;1st file exist?
         stx t1
         jsr scandir2
         bcs c9err
         lda indr1
         sta indr2
         lda indr1+1
         sta indr2+1
         inc nountick
         jsr nounnum  ;2nd doesnt?
         stx t2
         jsr scandir2
         bcc c9err2

         ldx t1
         lda wordlen,x
         sta t1

         ldx t2
         lda wordlen,x
         sta t2
         lda wordstart,x
         tax

         ldy #5    ;replace filename
c9loop1  lda buffer,x
         sta (indr2),y
         inx
         iny
         dec t2
         bne c9loop1

         lda #0
c9loop2  cpy #21      ;pad filename
         beq c9bran1
         sta (indr2),y
         iny
         bne c9loop2

c9bran1  lda #0
         clc
         rts

c9err2   lda #23  ;File exists
         .byte $2c
c9err    lda #11  ;File doesnt
         sec
         rts

;----------------
; Exicute a script

c5barf   lda #29
         sec
         rts

c5o      jsr opstdin
         bcs c5barf+2
         jsr opstdout
         bcs c5barf+2

         ldy stack
         cpy #16
         beq c5barf

         iny
         lda stdin
         sta stackin,y
         lda stdout
         sta stackout,y
         sty stack

         lda stdinum
         sta stdin
         lda stdonum
         sta stdout
         jmp main

;----------------
; ECHO string to stdonum   2/2/1991
; Flag: "N" - No Newline

c2o      jsr opstdout
         bcs echoexit

         lda nountot
         beq cb2
         jsr nounlen
         sta t1
         jsr nounstart    ;Chk string
         tay

cb3      dec t1
         bmi cb2
         lda buffer,y
         iny
         jsr stdwrite
         jmp cb3

cb2      lda #78   ;"N"
         jsr flagchk
         bcc *+5
         jsr cr
         jsr clostdout    ;Exit
         bcs echoexit
         clc
         lda #1           ;Noun repeat
echoexit rts

;----------------
; ASCOUT - Print PETASC char to stdonum

space    lda #spc
         .byte $2c
cr       lda #13
ascout   ldx #petasc
         stx convmode
         jsr convert
         jmp stdwrite

;----------------
; 1541 interface commands,
;  $...  Read directory
;  @...  Send disk cmd, read err chan.
;  ?...  Get file from drive
;  *...  Send file to drive

st       = $90
iecbus   = $f3d5
dirfin   = $f642
tksa     = $ff96
acptr    = $ffa5
untalk   = $ffa8
talk     = $ffb4
fnadr    = $bb
fa       = $ba
sa       = $b9
tmp1     = $fb
tmp2     = $fc

c6o      jsr nounstart    ;Get 1st char
         lda buffer,x     ;X holds start
         cmp #"$"         ;of noun
         beq dosdir
         cmp #atchar
         bne *+5
         jmp doscmd
         cmp #"?"
         bne *+5
         jmp dosread
         cmp #"*"
         bne *+5
         jmp doswrite

         lda #15   ;Unknown cmd
         sec
         rts

;----------------
; Show directory to stdonum

dosdir   jsr opstdout

         jsr cr      ;Rough and ready
         lda #0      ;routine to print
         sta st      ;the 1541 directory
         jsr dosname

         lda #8        ;Ripped out of a
         sta fa        ;a "Your CBM" mag
         lda #$60
         sta sa
         jsr iecbus
         lda fa
         jsr talk
         lda sa
         jsr tksa
         ldy st
         bne finish
         ldy #6
dir1     sty tmp1
         jsr acptr
         ldx tmp2
         sta tmp2
         ldy st
         bne finish
         ldy tmp1
         dey
         bne dir1
         ldy tmp2
         sty dwork+1
         stx dwork
         jsr decout
         jsr space
dir2     jsr acptr
         ldx st
         bne finish
         tax
         beq nxtlin
         jsr ascout
         tax
         jmp dir2
nxtlin   jsr cr
         ldy #4
         bne dir1
finish   jsr dirfin
         clc
         lda #0
         rts

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

dosname  clc           ;Convert to a
         php           ;cbm file string
         ldx #ascpet
         stx convmode
         jsr nounstart
         plp
         php
         pha
         lda #<dosfile ;Carry set will
         adc #0        ;remove leading
         sta fnadr     ;char
         lda #>dosfile
         adc #0
         sta fnadr+1
         jsr nounlen
         sta fnlen
         pla
         tax

         ldy #0       ;Cnv ASC filename
dname1   lda buffer,x ;to PETSCII
         jsr convert
         sta dosfile,y
         inx
         iny
         cpy fnlen
         bne dname1

         plp
         bcc *+4
         dec fnlen
         rts

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

doscmd   lda buffer+1,x ;Send dos cmd
         beq derror
         sec
         jsr dosname+1
         ldy #0

derror   lda #0
         sta st
         lda #8
         sta fa
         jsr talk
         lda #$6f
         sta sa
         jsr tksa
         cpy #0
         bne *+11
         jsr iecbus
         jsr dirfin
         jmp derror

errin    ldy st
         bne endit
         jsr acptr
         jsr ascout
         cmp #13
         bne errin
endit    jsr dirfin
         clc
         lda #1
         rts

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

dosread  sec
         jsr dosname+1

         jsr nounstart ;Get Rdrive fname
         sec
         adc #<buffer
         sta fname
         lda #0
         adc #>buffer
         sta fname+1

         ldx fnlen
         beq dosr0
         stx flength
         lda #5
         jsr open
         bcc dosr1

dosr0    lda #5          ;Cant create
         sec
         rts

dosr1    sta tmp1   ;keep fnum
         lda #0
         sta st
         lda #8    ;open 1,8,2
         sta fa
         lda #$62
         sta sa
         jsr iecbus
         lda fa
         jsr talk
         lda sa
         jsr tksa

         jsr acptr   ;Chk existence
         ldx st
         beq dosr2+3
         lda #11
         bne dosr5

dosr2    jsr acptr
         ldx tmp1
         jsr chrout
         bcs dosr5
         lda st
         beq dosr2

dosclose jsr dirfin
         lda tmp1
         jsr close
         bcs dosr6
         lda #1
         clc
         rts

dosr5    pha
         lda tmp1           ;Remove file
         jsr delfnum
         jsr dosclose ;err doesnt matter
         pla
dosr6    sec
         rts

;----------------
ciout    = $ffa8
listen   = $ffb1
second   = $ff93

doswrite sec
         jsr dosname+1

         jsr nounstart ;Get Rdrive fname
         sec
         adc #<buffer
         sta fname
         lda #0
         adc #>buffer
         sta fname+1

         ldx fnlen
         beq dosr0
         stx flength
         lda #3
         jsr open
         bcc dosw1


dosw1    sta tmp1
         lda #0
         sta st
         lda #8     ;open 8,1
         sta fa
         lda #$61
         sta sa
         jsr iecbus
         lda fa
         jsr listen
         lda sa
         jsr second
         lda st
         bne dosw4

dosw2    ldx tmp1
         jsr chrin
         bcs dosw3
         jsr ciout
         lda st
         beq dosw2

dosw4    jsr dosclose
         lda #21
         sec
         rts

dosw3    cmp #12
         beq dosclose
         jsr dosclose
         sec
         rts

;----------------
; "EZ" routines

opstdout ldx stdonum
         lda stdomode
         jmp openfnum

opstdin  ldx stdinum
         lda #3
         jmp openfnum

stdwrite ldx stdonum
         jmp chrout

stdread  ldx stdinum
         jmp chrin

clostdout lda stdonum
         .byte $2c
clostdin lda stdinum
         jmp close

;---------------------------------------
writestr pla        ;get PC+1, the pntr
         clc        ;to the string
         adc #1
         sta indr3
         sta wrttmp
         pla
         adc #0
         sta indr3+1
         sta wrttmp+1

         ldy #0
         lda (indr3),y
         sta indr4
         iny
         lda (indr3),y
         sta indr4+1

         jsr strout  ;print string

         php         ;preserve status
         pla
         tay

         inc wrttmp  ;replace PC @
         bne write1  ;right location
         inc wrttmp+1
write1   lda wrttmp+1
         pha
         lda wrttmp
         pha

         tya         ;get status
         pha
         plp
         rts

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

strlo    .byte <c1,<c2,<c3,<c4,<c5,<c6
         .byte <c7,<c8,<c9,<cb,<cc
         .byte <cd
strhi    .byte >c1,>c2,>c3,>c4,>c5,>c6
         .byte >c7,>c8,>c9,>cb,>cc
         .byte >cd
strlen   .byte 5,4,2,2,2,4,2,5,3,5
         .byte 7,5,0
cmdlo    .byte <c1o,<c2o,<c3o,<c4o,<c5o
         .byte <c6o,<c7o,<c8o,<c9o
         .byte <alias,<unalias,<cdo
cmdhi    .byte >c1o,>c2o,>c3o,>c4o,>c5o
         .byte >c6o,>c7o,>c8o,>c9o
         .byte >alias,>unalias,>cdo

c1       ; "rmdir"
         .byte 114,109,100,105,114

c2       ; "echo"
         .byte 101,99,104,111

c3       ; "rm"
         .byte 114,109

c4       ; "cp"
         .byte 99,112

c5       ; "sh"
         .byte 115,104

c6       ; "disk"
         .byte 100,105,115,107

c7       ; "cd"
         .byte 99,100

c8       ; "mkdir"
         .byte 109,107,100,105,114

c9       ; "ren"
         .byte 114,101,110

cb       ; "alias"
         .byte 97,108,105,97,115

cc       ; "unalias"
         .byte 117,110,97,108,105,97,115

cd       ; "RESET"
         .byte 82,69,83,69,84


tmpname  .byte 116,109,112,48,48 ; tmp00

flagtmp  .byte 0
scantmp  .byte 0
parsetyp .byte 0
ystr     .byte 0
tabb     .byte 0
tabt     .byte 0
quote    .byte 0
pretmp1  .byte 0
wtick    .byte 0
wlen     .byte 0
bufpnt   .byte 0
ytick    .byte 0
alpnt    .byte 0
chktick  .byte 0
chknum   .byte 0
chklen   .byte 0
altmp    .byte 0
translen .byte 0
alchktmp .byte 0


errtable .text "_"    ;Null for algoryhm
         .text " Error_"
         .text "Illegal error_"   ;2
         .text "Empty directory_" ;3
         .text "Bad OPEN mode_"   ;4
         .text "Can't create_"    ;5
         .text "Filename length_" ;6
         .text "Ramdrive full_"   ;7
         .text "Can't close_"     ;8
         .text "File Write_"      ;9
         .text "File Read_"      ;10
         .text "No such file_"   ;11
         .text "End of File_"    ;12
         .text "Line too long_"  ;13
         .text "Spastic link_"   ;14
         .text "Unknown command_";15
         .text "Out of memory_"  ;16
         .text "Can't remove_"   ;17
         .text "No such directory_";18
         .text "Access_"         ;19
         .text "Directory not empty_";20
         .text "Disk write_"     ;21
         .text "Not executible_" ;22
         .text "File exists_"    ;23
         .text "Failed_"         ;24
         .text "Missing quote_"  ;25
         .text "Bad code_"       ;26
         .text "Flag_"           ;27
         .text "Clogged pipe_"   ;28
         .text "Shell stack_"    ;29
         .text "Preprocessor_"   ;30
         .text "Alias Expansion_";31
         .text "Alias exists_"   ;32
         .text "No such Alias_"  ;33
         .byte 255

tmpbuf   .text "                     "
         .text "                     "
         .text "                     "
         .text "                     "

stackin  .text "                 "
stackout .text "                 "

dosfile  .text "                  "

hextxt   .text "0123456789"
         .byte 65,66,67,68,69,70

pow2l    .byte 104,132,146,150,72,36,18
         .byte 86,40,100,50,22,8,4,2,1
pow2m    .byte $27,$63,129,64,32,16,5,2
         .byte 1,0,0,0,0,0,0,0
pow2h    .byte 3,1,0,0,0,0,0,0,0,0,0,0
         .byte 0,0,0,0

wrttmp   .word 0

cpmode   .byte 0

prmpt    .byte 13
         .text "]_                     "

killtxt  .text "Coldstart?_"


