A2osX/BIN/SH.S.CORE.txt
2020-03-09 17:24:08 +01:00

794 lines
14 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 lda #PUSHD.STACK
>STA.G PUSHD.STACK
.9 rts
*--------------------------------------
CORE.FUNCRESET >LDA.G hFuncList
beq .8
>PUSHA
>SYSCALL SListFree
>STZ.G hFuncList
.8 rts
*--------------------------------------
CORE.Load.YAX stx M32.ACC X = Code to Execute
>SYSCALL ArgVDup 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
jsr CORE.StkPushInputBufPtr
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
dec Skip ARG0 in count
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
*--------------------------------------
* CORE.Run
* Input : ZPInputBufPtr (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
jmp CORE.Run.Exit Ending 0, CS,A=0
.9 lda #E.UNEXPEOF
sec
jmp CORE.Run.Exit
CORE.Run.RTS rts
*--------------------------------------
CORE.Run jsr IO.Reset
>LDYAI 256
>SYSCALL GetMem
bcs CORE.Run.RTS
>STYA ZPArgVBuf
txa
>STA.G CORE.hArgVBuf
clc
.HS B0 BCS
CORE.Run.1 sec coming from PIPE OUT
ror
>STA.G CORE.bPipeIn
>LDYA ZPInputBufPtr Save Actual ptr for looping
>STYA ZPInputCmdPtr
>LDYA ZPArgVBuf Reset ArgV Buffer
>STYA ZPArgVBufPtr
lda #0
sta (ZPArgVBuf)
sec
ror CORE.IntCmd assume external
lda #S.PS.F.HOLD
sta CORE.PSFlags
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 jmp CORE.Run.Exit 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
jmp CORE.Run.Exit
*--------------------------------------
CORE.Run.5 >LDYA L.CORE.IO
jsr CORE.LookupInputBuf
bcs CORE.Run.6
jsr CORE.SkipCharsA
jsr CORE.IO.JMP
bcc CORE.Run.7
jmp CORE.Run.Exit
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.Exit
.3 >LDA.G CORE.bPipeOut
bpl .7
jsr IO.Pipe.Out
bcs CORE.Run.Exit
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.Exit
jmp CORE.Run.1 Loop with Pipe IN
.7 jsr CORE.ExecCmd
*--------------------------------------
CORE.Run.Exit php
pha
>LDA.G CORE.hArgVBuf
beq .1
>SYSCALL FreeMem
>STZ.G CORE.hArgVBuf
.1 pla
plp
rts
*--------------------------------------
* Input : ZPArgVBuf
*--------------------------------------
CORE.ExecCmd lda #0
sta (ZPArgVBufPtr)
>LDYA ZPArgVBuf
>STYA ZPArgVBufPtr
ldx CORE.IntCmd
bmi CORE.ExecExtCmd
jmp (J.CMD,x)
CORE.ExecExtCmd >PUSHW ZPArgVBuf
>PUSHB CORE.PSFlags
>SYSCALL ExecV
bcs .9
tax CPID
lda CORE.PSFlags
and #S.PS.F.HOLD
bne .4
>LDA.G CORE.bPipeOut
bmi .4
ldy #S.PS.hStdErr
lda (pPS),y
>PUSHA
>PUSHW L.MSG.PID
txa
>PUSHA
>PUSHBI 1
>SYSCALL FPrintF
rts
.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
.9 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
CORE.ArgV.Add.RTS
rts
*--------------------------------------
* ArgV
*--------------------------------------
CORE.ArgV.Add lda #C.SPACE
sta ZPTmpW
ldy #0
jsr CORE.GetCharNB
bcs CORE.ArgV.Add.RTS
cmp #'"'
bne .10
sta ZPTmpW
bra .1
.10 cmp #'('
bne .11
ldx #')'
stx ZPTmpW
bra .12
.11 cmp #'`'
bne .12
sta ZPTmpW
.12 sta (ZPArgVBufPtr),y
iny
.1 jsr CORE.GetNextChar
bcs .5
.2 cmp ZPTmpW
bne .3
jsr CORE.GetNextChar
bra .5
.3 ldx ZPTmpW
cpx #C.SPACE
bne .40
jsr CORE.IsEndCmd
bcc .5
.40 sta (ZPArgVBufPtr),y
iny
.4 jsr CORE.GetNextChar
bcc .2
.5 lda #0
sta (ZPArgVBufPtr),y
>LDYA ZPArgVBufPtr
>STYA ZPArgVBufPrev
>PUSHYA
>PUSHWI 0
>SYSCALL Expand
bcs .9
phx
>STYA ZPPtr1
ldy #$ff
.7 iny
lda (ZPPtr1),y
sta (ZPArgVBufPtr),y
bne .7
tya
beq .8 Empty string....
sec
adc ZPArgVBufPtr
sta ZPArgVBufPtr
bcc .8
inc ZPArgVBufPtr+1
.8 pla
>SYSCALL FreeMem
.9 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
*--------------------------------------
CORE.ArgV.NextChar
inc ZPArgVBufPtr
bne .8
inc ZPArgVBufPtr+1
.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.StkPullFree
.8 clc
rts
.3 jsr CORE.StkPull Get FOR sub cmd
beq .4 FOR List
jsr CORE.StkPullFree hVARNAME
jsr CORE.StkPullFClose hFILE/hPIPE
ldx #2 CmdPtr
jmp CORE.StkPopX
.4 jsr CORE.StkPullFree hVARNAME
jsr CORE.StkPullFClose hFILE/hPIPE
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.StkPushInputBufPtr
>LDYA ZPInputBufPtr
*--------------------------------------
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.StkPullFClose
jsr CORE.StkPull
>SYSCALL FClose
rts
*--------------------------------------
CORE.StkPullFree
jsr CORE.StkPull
>SYSCALL FreeMem
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