A2osX/BIN/SH.S.CORE.txt
2019-12-12 15:13:32 +01:00

777 lines
15 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
.LIST OFF
*--------------------------------------
CORE.Init >LDYAI 256
>SYSCALL GetMem
bcs .9
>STYA ZPArgVBuf
txa
>STA.G CORE.hArgVBuf
.9 rts
*--------------------------------------
CORE.Quit >LDA.G CORE.hArgVBuf
beq CORE.FUNCRESET
>SYSCALL FreeMem
CORE.FUNCRESET >LDA.G hFuncList
beq .8
>SYSCALL SListFree
>STZ.G hFuncList
.8 rts
*--------------------------------------
CORE.Load.YAX stx M32.ACC X = Code to Execute
jsr CORE.ArgV.Dup Y,A = ArgV
bcs .9
stx M32.ACC+1 X = hARGV
sta M32.ACC+2 A = ARGC
lda #8
jsr CORE.StkCheck
bcs .9
>LDYA ZPInputBuf
jsr CORE.StkPushYA
>LDYA ZPInputBufPtr
jsr CORE.StkPushYA
ldy #S.PS.ARGC
lda (pPS),y
jsr CORE.StkPush old ARGC
ldy #S.PS.hARGV
lda (pPS),y
jsr CORE.StkPush old hARGV
ldy #S.PS.ARGC
lda M32.ACC+2 new ARGC
sta (pPS),y
iny #S.PS.hARGV
lda M32.ACC+1
sta (pPS),y new hARGV
lda M32.ACC new code
jsr CORE.StkPush
* lda M32.ACC
>SYSCALL GetMemPtr
>STYA ZPInputBuf
>STYA ZPInputBufPtr
* clc
.9 rts
*--------------------------------------
* http://heirloom.sourceforge.net/sh/sh.1.html
*--------------------------------------
* Input : ZPArgVBuf (String)
* Tokenize ZPArgVBuf
* :LOOP
* if CmdSep=| :
* set hStdIn = hStdOut
* set hStdOut = Std
* GetCmd from line until | or EOL
* if CmdSep=| :
* create PIPE
* set hStdOut -> PIPE
* CORE.Exec &
* :LOOP
* else CORE.Exec
*--------------------------------------
* SET VAR = `cmd args`, FOR VAR IN `cmd args`
* create PIPE
* set hStdOut -> PIPE
* CORE.Exec `cmd args` &
* set READMODE
* set hStdIn = hStdOut
* set hStdOut = Std
*--------------------------------------
CORE.Run.EOF jsr CORE.StkPull
bcs *
cmp #$C0+C.. check CALL . CL context
beq .1
cmp #$C0+C.CALL
beq .1
cmp #$C0+C.CLEXEC
bne .9
.1 jsr CMD.EXIT.FILE
jsr IO.Reset
lda #0
sec
rts Ending 0, CS,A=0
.9 lda #E.UNEXPEOF
sec
rts
*--------------------------------------
CORE.Run.SYN lda #E.SYN
sec
rts
*--------------------------------------
CORE.Run jsr IO.Reset
clc
.HS B0 BCS
CORE.Run.1 sec coming from PIPE OUT
ror
>STA.G CORE.bPipeIn
>LDYA ZPInputBufPtr Save Actual cmd for looping
>STYA ZPInputCmdPtr
>LDYA ZPArgVBuf
>STYA ZPArgVBufPtr
lda #0 Reset ArgV Buffer
sta (ZPArgVBuf)
dec
* lda #$ff
sta CORE.IntCmd assume external
lda #S.PS.F.HOLD
sta CORE.PSFlags
.3 jsr CORE.GetCharNB
bcs CORE.Run.EOF
cmp #C.CR empty line ?
bne .33
jsr CORE.GetNextChar skip CR...
bra .8
.33 cmp #'#' commented line?
bne .4
.12 jsr CORE.SkipLine
.8 lda #0
clc
.9 rts EOL, CS,A=0
.4 >LDYA L.CMD internal command ?
jsr CORE.LookupInputBuf
bcc .41
.40 jsr CORE.ArgV.Add external cmd, go check context
bra .42
.41 stx CORE.IntCmd
asl CORE.IntCmd
jsr CORE.SkipCharsA
.42 jsr CORE.StkGet
bcs CORE.Run.7 no particular context, exec...
tax
lda CORE.IntCmd
bmi .45
and #$3F
cmp #C.SWITCH SWITCH....FI ?
bcs CORE.Run.7
.45 txa
bpl .43 context is FALSE, skip line
asl
bmi CORE.Run.7 parent context is true, exec
.43 jsr CORE.GetCharNB
bcs .44 EOF
cmp #C.CR
beq .44
cmp #';' TODO ";"
beq .44
jsr CORE.GetNextChar
bra .43
.44 jsr CORE.GetNextCharNB Skip EoL char
clc
.99 rts
*--------------------------------------
CORE.Run.5 >LDYA L.CORE.IO
jsr CORE.LookupInputBuf
bcs CORE.Run.6
jsr CORE.SkipCharsA
jsr CORE.IO.JMP
bcs CORE.Run.RTS
bra CORE.Run.7
CORE.Run.6 jsr CORE.ArgV.Add
CORE.Run.7 jsr CORE.GetCharNB
bcs .2 Nothing to skip
jsr CORE.IsEndCmd
bcs CORE.Run.5
tax
jsr CORE.GetNextCharNB Skip EoL char
cpx #'|' Pipe OUT ?
bne .2
sec
.1 .HS 90 BCC
.2 clc
ror
>STA.G CORE.bPipeOut
>LDA.G CORE.bPipeIn
bpl .3
jsr IO.Pipe.In
bcs CORE.Run.RTS
.3 >LDA.G CORE.bPipeOut
bpl CORE.ExecCmd
jsr IO.Pipe.Out
bcs CORE.Run.RTS
lda #S.PS.F.HOLD Run in the background...
trb CORE.PSFlags
lda #S.PS.F.CLOSEONX ...and close PIPE OUT on exit
tsb CORE.PSFlags
jsr CORE.ExecCmd
php
pha
lda CORE.IntCmd $ff if external
eor #$80
asl if cc Was external...
jsr IO.Reset.OutC restore Output, NO close if EXTERNAL
>LDA.G CORE.bPipeIn
bpl .6
jsr IO.Pop.In restore Input
.6 pla
plp
bcs CORE.Run.RTS
jmp CORE.Run.1 Loop with Pipe IN
CORE.Run.RTS rts
*--------------------------------------
* Input : ZPArgVBuf
*--------------------------------------
CORE.ExecCmd lda #0
sta (ZPArgVBufPtr)
>LDYA ZPArgVBuf
>STYA ZPArgVBufPtr
lda CORE.IntCmd
bmi CORE.ExecExtCmd
tax
jmp (J.CMD,x)
CORE.ExecExtCmd >PUSHB CORE.PSFlags
>LDYA ZPArgVBuf
>SYSCALL execv
bcs .9
tax CPID
lda CORE.PSFlags
and #S.PS.F.HOLD
bne .4
>LDA.G CORE.bPipeOut
bmi .4
txa
>PUSHA
>PUSHBI 1
>PUSHW L.MSG.PID
jmp IO.PrintErr
.4 >SLEEP Suspend this PID
sec
ldy #S.PS.RC CPID will update S.PS.RC
lda (pPs),y
bne .9
.8 clc
.9 rts
*--------------------------------------
CORE.SkipLine jsr CORE.GetNextCharNB
bcs .8 EOF
cmp #C.CR EOL
bne CORE.SkipLine
jsr CORE.GetNextChar skip CR...
.8 rts
*--------------------------------------
* search ZPInputBufPtr/ZPArgVBufPtr in Y,A table
*--------------------------------------
CORE.LookupInputBuf
sec
.HS 90 BCC
CORE.LookupArgVBuf
clc
>STYA ZPPtr1 Keywords table
>LDYA ZPArgVBufPtr
bcc CORE.Lookup
>LDYA ZPInputBufPtr
CORE.Lookup >STYA ZPPtr2
ldx #0
.1 ldy #$ff
.2 jsr .7 get next valid char in src text
bcs .3
.20 jsr ToUpperCase
eor (ZPPtr1),y match table char ?
asl compare only 7 bits
bne .4 no match...get next table keyword
bcc .2 not last char in this keyword
jsr .7 next char in text...
bcc .4 valid....failed
.8 tya Keyword Len
clc
rts
.3 dey
lda (ZPPtr1),y was last char in this keyword ?
bmi .8
iny
.41 jsr IncPtr1 skip chars to next keyword
.4 lda (ZPPtr1)
bpl .41
jsr IncPtr1
.6 inx
lda (ZPPtr1) Array Ending 0, lookup failed
bne .1
lda #E.SYN
sec
rts
.7 iny
lda (ZPPtr2),y Get Src text char...
beq .9 end of text
jsr CORE.IsSpaceOrEndCmd
bcc .9 end of valid chars
clc
rts
.9 sec
rts
*--------------------------------------
* ArgV
*--------------------------------------
CORE.ArgV.Dup >STYA ZPPtr1
phy
pha
lda #1
sta ZPPtr2
stz ZPPtr2+1
.1 jsr GetPtr1LenY
tya
beq .2
jsr AddAp1Ptr2
jsr AddYp1Ptr1
bra .1
.2 pla
ply
>STYA ZPPtr1
>LDYA ZPPtr2
>SYSCALL GetMem
bcs .9
>STYA ZPPtr2
phx
ldx #$ff Arg count-1 (skip $0)
.5 jsr StrCpyPtr1Ptr2
tya
beq .8
inx
jsr AddAp1Ptr2
jsr AddYp1Ptr1
bra .5
.8 txa A = Arg count, X = hARGV
plx
clc
.9 rts
*--------------------------------------
CORE.ArgV.Add >LDYA ZPArgVBufPtr
>STYA ZPArgVBufPrev Save String start of Expand
lda #C.SPACE
sta ZPTmpW
jsr CORE.GetCharNB
bcs .9
cmp #'"'
bne .10
sta ZPTmpW
bra .1
.10 cmp #'('
bne .11
ldx #')'
stx ZPTmpW
bra .12
.11 cmp #'`'
bne .12
sta ZPTmpW
.12 jsr CORE.ArgV.PutChar
.1 jsr CORE.GetNextChar
bcs .5
.2 cmp ZPTmpW
bne .3
jsr CORE.GetNextChar
bra .5
.3 ldy ZPTmpW
cpy #C.SPACE
bne .40
jsr CORE.IsEndCmd
bcc .5
.40 jsr CORE.ArgV.PutChar
.4 jsr CORE.GetNextChar
bcc .2
.5 lda #0
jsr CORE.ArgV.PutChar
>LDYA ZPArgVBufPrev
>SYSCALL ExpandStr
bcs .9
phx
>STYA ZPPtr1
>LDYA ZPArgVBufPrev
>STYA ZPArgVBufPtr
ldy #$ff
.7 iny
lda (ZPPtr1),y
beq .8
jsr CORE.ArgV.PutChar
bra .7
.8 tya
beq .81
lda #0
jsr CORE.ArgV.PutChar
.81 pla
>SYSCALL freemem
.9 rts
*--------------------------------------
CORE.ArgV.PutChar
sta (ZPArgVBufPtr)
CORE.ArgV.NextChar
inc ZPArgVBufPtr
bne .8
inc ZPArgVBufPtr+1
.8 rts
*--------------------------------------
CORE.ArgV.Next lda (ZPArgVBufPtr)
beq .8
>LDYA ZPArgVBufPtr
>STYA ZPArgVBufPrev
.1 jsr CORE.ArgV.NextChar
lda (ZPArgVBufPtr)
bne .1
jsr CORE.ArgV.NextChar
lda (ZPArgVBufPtr)
.8 rts
*--------------------------------------
* IO
*--------------------------------------
CORE.IO.JMP txa
asl
tax
jmp (J.CORE.IO,x)
CORE.IO.AMP lda #S.PS.F.HOLD
trb CORE.PSFlags
clc
CORE.IO.RTS rts
CORE.IO.IN lda #O.RDONLY+O.TEXT
jsr CORE.IO.Open
bcs CORE.IO.RTS
jmp IO.Set.In
CORE.IO.OUTA
CORE.IO.1OUTA lda #O.WRONLY+O.APPEND+O.CREATE+O.TEXT
bra CORE.IO.OUT.1
CORE.IO.OUT
CORE.IO.1OUT lda #O.WRONLY+O.TRUNC+O.CREATE+O.TEXT
CORE.IO.OUT.1 jsr CORE.IO.Open
bcs CORE.IO.RTS
jmp IO.Set.Out
CORE.IO.2OUTA lda #O.WRONLY+O.APPEND+O.CREATE+O.TEXT
bra CORE.IO.2OUT.1
CORE.IO.2OUT lda #O.WRONLY+O.TRUNC+O.CREATE+O.TEXT
CORE.IO.2OUT.1 jsr CORE.IO.Open
bcs CORE.IO.RTS
jmp IO.Set.Err
*--------------------------------------
CORE.IO.Open pha Open Mode
jsr CORE.GetCharNB
bcs .9 no arg left....
jsr CORE.ArgV.Add Get Filename
>LDYA ZPArgVBufPrev
>STYA ZPArgVBufPtr Discard filename
plx
jmp IO.FOpenYAX
.9 pla
lda #E.SYN
sec
rts
*--------------------------------------
* Input Buffer
*--------------------------------------
CORE.IsSpaceOrEndCmd
cmp #C.SPACE
beq CORE.IsEndCmd.8
CORE.IsEndCmd cmp #';'
beq CORE.IsEndCmd.8
cmp #C.CR
beq CORE.IsEndCmd.8
cmp #'|'
beq CORE.IsEndCmd.8
sec
rts
CORE.IsEndCmd.8 clc
rts
*--------------------------------------
CORE.GetCharNB jsr CORE.GetChar
bcs CORE.GetNextCharNB.RTS
jsr CORE.CheckCharNB
bcc CORE.GetNextCharNB.RTS
*--------------------------------------
CORE.GetNextCharNB
jsr CORE.GetNextChar
bcs CORE.GetNextCharNB.RTS
jsr CORE.CheckCharNB
bcs CORE.GetNextCharNB
CORE.GetNextCharNB.RTS
rts
*--------------------------------------
CORE.CheckCharNB
cmp #C.SPACE
beq .9
cmp #C.LF
beq .9
cmp #C.TAB
beq .9
clc
.9 rts
*--------------------------------------
CORE.GetNextChar
inc ZPInputBufPtr
bne CORE.GetChar
inc ZPInputBufPtr+1
*--------------------------------------
CORE.GetChar lda (ZPInputBufPtr)
beq .9
clc
rts
.9 sec
rts
*--------------------------------------
CORE.SkipCharsA clc
adc ZPInputBufPtr
sta ZPInputBufPtr
bcc .8
inc ZPInputBufPtr+1
.8 rts
*--------------------------------------
* Stack
*--------------------------------------
CORE.StkPopCtx jsr CORE.StkPull
CORE.StkPopCtxA and #$3F
cmp #C.IF
beq .8 IF : Nothing
ldx #2
cmp #C.WHILE WHILE : One Ptr = 2 bytes
beq CORE.StkPopX
cmp #C.SWITCH SWITCH : hValue
beq .2
ldx #1
cmp #C.CASE CASE : C.CASE + hValue
beq .1
cmp #C.FOR
beq .3
cmp #C.DEFAULT DEFAULT : C.DEFAULT + hValue
bne .9
.1 jsr CORE.StkPopX
.2 jsr CORE.StkPull
>SYSCALL freemem
.8 clc
rts
.3 jsr CORE.StkPull Get FOR sub cmd
beq .4 FOR List
jsr CORE.StkPull hVARNAME
>SYSCALL freemem
jsr CORE.StkPull hFILE/hPIPE
>SYSCALL fclose
ldx #2 CmdPtr
jmp CORE.StkPopX
.4 jsr CORE.StkPull hVARNAME
>SYSCALL freemem
jsr CORE.StkPull hFILE/hPIPE
>SYSCALL fclose
ldx #4 ListPtr,CmdPtr
jmp CORE.StkPopX
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
CORE.StkPopX lda (pData)
.1 dec
dex
bne .1
sta (pData)
clc
rts
*--------------------------------------
CORE.StkCheck sec
adc (pData) StackPtr
cmp #CORE.STACK.MAX
bcc .8
lda #E.STKOVERFLOW
* sec
.8 rts
*--------------------------------------
CORE.StkPushYAX phx
jsr CORE.StkPushYA
bcs CORE.StkPushYA.9
bra CORE.StkPush.1
*--------------------------------------
CORE.StkPushYA phy
jsr CORE.StkPush
bcc CORE.StkPush.1
CORE.StkPushYA.9
plx
CORE.StkPushYA.RTS
rts
*--------------------------------------
CORE.PushVarName
>LDYA ZPVarNamePtr
>SYSCALL strdup
bcs CORE.StkPushYA.RTS
txa
*--------------------------------------
CORE.StkPush pha
CORE.StkPush.1 lda (pData) StackPtr
inc
cmp #CORE.STACK.MAX
bcs .9
sta (pData) StackPtr
tay
pla
sta (pData),y
* clc
rts
.9 pla
lda #E.STKOVERFLOW
* sec
rts
*--------------------------------------
CORE.StkGetCtx jsr CORE.StkGet
tax
bcs .1 no context...
cmp #$C0+C.. in a call...
beq .1 CS
cmp #$C0+C.CALL
beq .1 CS
cmp #$C0+C.CLEXEC
beq .1 CS
and #$80 get current..
lsr becomes parent
bra .8
.1 lda #$40 ...set Parent = true
.8 sta CORE.TestResult
txa
rts
*--------------------------------------
CORE.StkPullInputBufPtr
jsr CORE.StkPull
bcs .9
sta ZPInputBufPtr
jsr CORE.StkPull
bcs .9
sta ZPInputBufPtr+1
.9 rts
*--------------------------------------
CORE.StkPull jsr CORE.StkGet
bcs .9
dey
pha
tya
sta (pData) StackPtr
pla
.9 rts
*--------------------------------------
CORE.StkGet lda (pData) StackPtr
beq .9
tay
lda (pData),y
clc
rts
.9 lda #E.STACKERROR
sec
rts
*--------------------------------------
MAN
SAVE USR/SRC/BIN/SH.S.CORE
LOAD USR/SRC/BIN/SH.S
ASM