rtsi.com/2014.01.www.rtsi.com.tar/www.rtsi.com/UNIFLEX/UNIFLEX/UniFLEX_Std.Utils1.tar.Z/UniFLEX_Std.Utils1.tar/utils1/shell

Text File | 1985-08-19 | 47KB | 2,495 lines

 opt pag,nol
 ttl UniFLEX Shell
 pag
 lib sysdef
 lib sysstat
 opt lis
 pag

 info UniFLEX shell
 info Version 1.08, Released August 19, 1985
 info Copyright, (C) 1983, by
 info Technical Systems Consultants, Inc.
 info All rights reserved.

 ifc &a,"notext"
 org 0
 else
 text
 endif

*
* Program parameters
*

ENTTY equ 29 device not terminal
ENOFL equ 8 no file
ENOTB equ 21 not binary
NFILES equ 16 number of files (max)
ASSIZ equ 5 number of async tasks
BUFSIZ equ 256 input line buffer size
SPACE equ $20 ascii space character
COMMA equ ', ascii comma
TAB equ $9 tab character
BHDBT equ $8a basic header byte
BHDBT2 equ $9a new basic header byte (v2.0)
PHDBT0 equ $8B Pascal (normal) header byte ***GDT
PHDBT1 equ $8c pascal (system) ***GDT
LTS equ '<
GTS equ '>
TPCH equ '~ time prompt character


*
* Program starts here
*

sh lbsr sinit do init
 sts sp save sp
 tst bgop background?
 bne sh00
* tst intflg interactive?
* beq sh0
sh00 sys cpint,2,1 if so, ignore ints
 sys cpint,3,1
sh0 lds sp reset stack ptr
 ldd ctrm check term status
 bne sh05
 tst termc still more line?
 bne sh12
sh05 tst pipmod in pipe?
 beq sh07
 clr pipmod clear out mode
 ldd pprdf close pipe files
 sys close
 ldd ppwrf
 sys close
sh07 clr pipmod clear out pipe
 clr ctrm clear exit status
 clr ctrm+1
 tst intflg interactive?
 beq sh1 if not, skip prompt
 ldd #0 set file desc
 sys ttyget,ttgbuf get tty params
 lda ttgbuf get stat flags
 anda #%10111110 clear schar mode (also raw)
 sta ttgbuf
 ldd #0 set file desc
 sys ttyset,ttgbuf set tty status
sh08 lbsr wrtpr output prompt
sh1 lbsr getlin get an input line
 bne sh11
 tst supf doing startup?
 lbeq sexit if so, terminate
 clr supf clear mode
 bra sh0 re-prompt
sh11 cmpb #1 only c.r.??
 beq sh0 if so, go to start
 ldx #buffer
 stx bufpt set buffer start
sh12 lbsr pars parse the line
 beq sh0 error?
sh13 lbsr scmnd check for shell command
 bne sh6
 clr execf clear "exec" flag
 jmp 0,x go do command
sh6 ldd #0 clear command
 std comnd
 ldx arglst point to command name
 beq sh9 null args?
 tst prflg paren command?
 bne sh92
 ldy #comnd point to command buffer
sh62 lda 0,x+ get a character
 sta 0,y+ xfr to command buffer
 bne sh62 end?
 leax -1,x back up to term
sh8 cmpx arglst back to beginning?
 beq sh9
 lda 0,-x get previous character
 cmpa #'/ is it /?
 bne sh8
 leax 1,x eat slash
sh9 stx arglst set first arg (cmnd name)
 lda comnd check for null command
 lbeq sh0
sh92 lda termc get term char
 cmpa #'| is it pipe?
 lbeq cpipe
 cmpa #'^
 lbeq cpipe if so, create pipe
sh95 lda termc check terminator
 cmpa #';
 beq sh96 if more commands follow
 cmpa #'&
 beq sh96 if background, possibly more follow
 tst execf check fork flag
 bne doit if no fork, act as child
sh96 sys fork do system fork call
 bra doit this is new task here
 lbes frkerr fork error?
 pshs d old task, save new ones id
 lda termc get term character
 cmpa #'| is it pipe?
 lbeq dpipe
 cmpa #'^ is it pipe?
 lbeq dpipe
 tst pipmod pipe active?
 beq sh97
 clr pipmod clear pipe mode
 ldd apprdf get read file
 sys close close it
sh97 lda termc get term character
 cmpa #'& is it async mode?
 lbeq async
pwait puls d get task id
 std syntid save it
pwait1 sys wait wait for task to die
 cmpd syntid is it the child?
 beq pwait2
 lbsr chasy check for async job termination
 bra pwait1 go wait some more
pwait2 stx ctrm save command term status
 beq pwait3 errors?
 tst intflg interactive mode?
 bne pwait3
 tst supf doing startup?
 beq pwai25
 ldd #linbuf
 std linpt
 std linend
 ldd ifd
 sys seek,0,0,2 seek to end of file
 bra pwait3
pwai25 tfr x,d get status
 sys term exit!
pwait3 lbsr abtrm report any abnormal terminations
 lbra rprt go report termd tasks

 pag

* execute command

doit sys cpint,11,0 enable "terminate" interrupt
 lda termc check for async
 cmpa #'&
 bne doit0
 ldd #5 lower priority by 5
 sys setpr
 bra doi12
doit0 cmpa #'| doing pipe?
 beq doi12
 cmpa #'^
 beq doi12
 tst bgop background option set?
 bne doi12
doit1 sys cpint,2,0
 sys cpint,3,0
doi12 ldd sifil test input redirection
 beq doi14
 lbsr opsi open new input
 lbes bdfil error?
doi14 tst sofil test for output redirection
 beq doi15
 lbsr opso open new output
 lbes bdfil error?
doi15 tst safil output append?
 beq doi16
 lbsr opsa open append file
 lbes bdfil error?
doi16 lbsr spipe set up pipe
 lda termc check for async
 cmpa #'&
 bne doi17
 tst pipmod in pipe?
 bne doi17
 ldd sifil new input file?
 bne doi17 if so, ok
 ldd #nldst set up null device
 std sifil
 lbsr opsi open as input
doi17 tst prflg check for paren string
 lbne dosub if so, do subshell
 clr rtcnt clear out retry counter
 sys exec,comnd,arglst exec program
 cmpd #ENOTB file not binary?
 beq trya
doitx1 lda comnd check first char
 cmpa #'/ is it path head?
 beq doit3
 inc rtcnt bump retry count
 sys exec,retry1,arglst try 'bin/...'
 cmpd #ENOTB not binary?
 beq trya
doitx2 inc rtcnt bump counter
 sys exec,retry2,arglst try '/bin/...'
 cmpd #ENOTB not binary?
 beq trya
doitx3 inc rtcnt bump retry count
 sys exec,retry3,arglst try '/usr/bin/...'
 cmpd #ENOTB
 beq trya
doit3 ldd #1 if here, error!
 sys write,ermsg1,ERSIZ1
 ldx #comnd
 ldd #0
doit4 lda 0,x+
 beq doit5
 incb
 bra doit4
doit5 tst b
 beq doit7
 std doit6+5 save as arg
 ldd #1 set file desc
doit6 sys write,comnd,0
doit7 ldd #1
 sys write,ermsg2,ERSIZ2
 ldd #$ff set error status
 sys term terminate this guy!

*
* trya
*
* Try to execute ascii file.
*

trya ldx #rtclst point to list
 lda rtcnt get retry count
 asla
 leax a,x point to retry number
 ldd 0,x get pointer
 std iopn2 set in open call
 std arglst
 std istata store in status call
 sys ind,istat status the file
 bes trya6 if cannot status the file
 lda statbuf+st_mod get mode flags
 bita #FSBLK+FSCHR check special files
 bne trya6 if a special file
 bita #FSDIR check for a directory
 bne trya7 if a directory resume retries
 sys ind,iopn open file
 bes trya6
 pshs d save file desc
 clr smbuf
 sys read,smbuf,2 read 1st 2 characters
 puls d get fd
 sys close close the file
 lda smbuf get 1st char
 bmi trybas basic file?
 cmpa #$20 is it ascii?
 blo trya6
 lda termc check term char
 cmpa #'& background?
 bne trya4
 ldd #plbst get '+b' string
 std sargls
 sys exec,cshell,bsrgls exec shell with '+b'
 lbra doit3
trya4 sys exec,cshell,sargls execute a shell
trya6 lbra doit3 report error

trya7 lda rtcnt go to retry address
 lsla
 ldx #rtnlst
 ldx a,x
 jmp 0,x

rtclst fdb comnd,retry1,retry2,retry3
rtnlst fdb doitx1,doitx2,doitx3,doit3

trybas cmpa #BHDBT is it basic file?
 beq trybs2
 cmpa #BHDBT2 new type?
trybs2 bne tryP try Pascal program ***GDT
 sys exec,cbasic,sargls try basic execution
 lbra doit3 error?

tryP cmpa #PHDBT0 normal Pascal program? ***GDT
 bne tryP1 no - try system ***GDT
 sys exec,Pscl0,sargls try Pascal execution ***GDT
 lbra doit3 error ***GDT

tryP1 cmpa #PHDBT1 system Pascal program? ***GDT
 lbne doit3 no - error ***GDT
 sys exec,Pscl1,sargls try to execute Pascal program ***GDT
 lbra doit3 error ***GDT

*
* Report fork error
*

frkerr ldd #1 set file desc
 sys write,frkmsg,FRKSIZ
 lbra rprt

 pag

* exit shell

sexit ldd ctrm get term cond
sexit4 sys term terminate this task!
 pag

*
* pars
*
* Parse the command line.  Return 'eq' if error.
*

pars ldd #0 zero out data
 std sifil
 std sofil
 std safil
 sta prflg
 deca set non zero
 sta soft
 ldd #fstlst set string pointer
 std fstpt
 ldd #arglst init pointers
 std argpt
 ldx bufpt point to command line
pars1 lda 0,x+ sjip leading spaces
 beq pars9 eol?
 cmpa #SPACE
 beq pars1
 cmpa #TAB is it tab?
 beq pars1
 leax -1,x back up to prev char
 stx bufpt save new pos
pars2 lda soft last term a soft one?
 beq pars7 if not, exit
 lbsr gword get a word
 tst quote quoted string?
 bne pars6
 lda 0,y get first chars of word
 ldx #sifil point to list
 cmpa #LTS is it '<'?
 beq pars4
 leax 2,x bump to next
 cmpa #GTS is it '>'?
 bne pars5
 ldd 2,x is it ok?
 bne pars8 error?
 ldd 0,x
 bne pars8
 ldb 1,y get 2nd char
 cmpb #GTS is it '>>'?
 bne pars4
 leax 2,x
pars4 ldd 0,x already defined?
 bne pars8 if so, error
 leay 1,y move past '>'
 cmpx #safil is it append?
 bne pars45
 leay 1,y
pars45 sty 0,x save file pointer
 tst 0,y null file name??
 beq pars8
 bra pars2 repeat
pars5 lbsr subst check for substitution
 beq pars2 null arg?
pars6 ldx argpt get arg pos
 sty 0,x++ save new arg
 stx argpt
 lbsr marg do arg matching
 bcc pars2 repeat
 bra pars10
pars7 ldx argpt get arg pos
 ldd #0 set null arg
 std 0,x set null term
 clz set status
 rts return
pars8 bsr synerr report error
 sez set error
 rts return
pars9 clr termc set eol
 rts return
pars10 clr termc clear out term
 tst intflg
 beq syner4 interactive?
 ldd #2 set st err
 sys write,argms,ARGMS output error message
 sez
 rts return

 pag

*
* synerr
*
* Report syntax error
*

synerr clr termc clear out term
 tst intflg interractive?
 beq syner4
 ldd #2 set file desc
 sys write,syrms,SYSIZ write error message
syner2 rts return
syner4 ldd #$ff set error status
 sys term exit!


*
* gword
*
* Parse a word and return pointer in Y.
*

gword ldx bufpt get buffer pos
 clr quote
 lda 0,x get 1st char
 cmpa #'( is it paren?
 lbeq bldpr
 cmpa #'" is it quote?
 beq gword1
 cmpa #'' is it quote?
 bne gword2
gword1 sta quote set quote mode
 leax 1,x skip the '
 stx bufpt save new start
gword2 lda 0,x+ get a character
 clr soft clear soft term flag
 bsr tsttrm test for term
 bne gword2 repeat til term
 ldy bufpt get start of word
 stx bufpt save new pos
 rts return

 pag

*
* tsttrm
*
* Test if char in A is term char.
*

tsttrm tst quote quoted arg?
 bne tsttr8
 cmpa #SPACE is it space?
 beq tsttr6
 cmpa #TAB is it tab?
 beq tsttr6
 inc soft set soft term flag
 cmpa #COMMA is it comma?
 beq tsttr4
tsttr1 clr soft
 tsta is it null term?
 bne tsttr2
 clr termc set term char to null
 rts return
tsttr2 bsr chktrm check for hard term
 beq tsttr4
 rts no term
tsttr4 sta termc save term character
 clr -1,x set null word term
tstt45 lda 0,x+ skip trailing spaces
 cmpa #SPACE
 beq tstt45
 cmpa #TAB is it tab?
 beq tstt45
 leax -1,x
 sez set term status
tsttr5 rts return
tsttr6 sta termc save term char
 clr -1,x set null word term
tsttr7 lda 0,x+ get next
 beq tsttr1
 cmpa #SPACE more spaces?
 beq tsttr7
 cmpa #TAB is it tab?
 beq tsttr7
 bsr chktrm check for hard term
 beq tsttr4
 leax -1,x
 inc soft set soft term flag
 sez set term status
 rts return
tsttr8 tsta term?
 beq tsttr1
 cmpa quote is it '?
 bne tsttr5
 lda #SPACE set up space term
 bra tsttr6

 pag

*
* chktrm
*
* Check if character in A is a hard term.
*

chktrm ldy #trmtab point to table
chktr2 cmpa 0,y+ look for char
 beq chktr4
 cmpy #trmend end of table?
 bne chktr2
 clz set no term
chktr4 rts return

trmtab fcb ';,'|,'^,'&
trmend equ *


*
* opsi
*
* Open new input file.
*

opsi ldd sifil get file name
 std iopn2 save in ind call
 sys ind,iopn open file for read
 bes opsi4 error?
 bsr opchk check for block device
 pshs d save file desc
opsi2 ldd #0 get input file desc
 sys close close it
 ldd 0,s get new fd
 sys dup dup this file
 puls d
 sys close close the file
 clc set status
opsi4 rts return

*
* opso
*
* Open new output file.
*

opso ldd sofil get file name
opso1 std icrt2 set in ind call
 sys ind,icrt creat file
 bes opso4 error?
 bsr opchk check for block device
 pshs d save file desc
opso2 ldd #1 get output file fd
 sys close close the file
 ldd 0,s get new fd
 sys dup dup this file
 puls d
 sys close now close it
 clc set status
opso4 rts return

 pag

*
* opsa
*

opsa ldd safil get file name
 std iopnw2 set up call
 sys ind,iopnw open for write
 bes opsa2
 bsr opchk check for block device
 pshs d save file desc
opsa1 ldd 0,s get file desc
 sys seek,0,0,2 seek to eof
 bra opso2
opsa2 cmpb #ENOFL is it no file error?
 bne opsa4
 ldd safil get file name
 bra opso1 go create it
opsa4 sec set error
 rts return

*
* opchk
*
* Check for block device
*

opchk pshs d save file desc
 sys ofstat,mfsb get status
 lda mfsb+4 get modes
 bita #2 is it block device?
 beq opchk2
 leas 4,s
 ldd #0 set status
 sec
 rts return
opchk2 puls d get file desc
 rts


*
* getlin
*
* Get an input line and put it in the buffer.
*

getlin ldx #buffer point to buffer
 clr 0,-s set count
getli2 bsr gtch get a character
 beq getli6 eof?
 sta 0,x+ save char in buffer
 inc 0,s bump count
 cmpa #$d is it cr?
 bne getli2
 clr -1,x set null term
 clz set status
getli4 puls b,pc return
getli6 tst supf doing startup?
 beq getli4 if not - exit
 inc intflg set interactive
 ldd ifd get file desc
 sys close close the input file
 ldd #0 reset input file to 0
 std ifd
 ldd #linbuf reset pointers
 std linpt
 std linend
 sez set status
 puls b,pc return

 pag

*
* gtch
*
* Get a character from linbuf
*

gtch pshs x save pointer
 tst coptf check c opt flag
 bne gctc
gtch2 ldx linpt get line pointer
 cmpx linend end of current?
 bne gtch4
 ldd ifd set file desc
 sys read,linbuf,512 read in data
 bes gtch6 error?
 cmpd #0 eof?
 beq gtch6
 ldx #linbuf set start pointer
 stx linpt
 leax d,x mark end of buffer
 stx linend set end
 ldx linpt reset to start
gtch4 lda 0,x+ get a character
 stx linpt save pointer
 clz set status
 puls x,pc return
gtch6 sez set eof status
 puls x,pc return


*
* gctc
*

gctc ldx cbpt get command pointer
 beq gctc6
 lda 0,x+ get a character
 beq gctc4
 cmpa #$d end of line?
 bne gctc5
 tst 0,x check for term
 bne gctc5
gctc4 lda #$d set end of line
 ldx #0 null out pointer
gctc5 stx cbpt set new pointer
 clz set ok status
gctc6 puls x,pc return

 pag

*
* bdfil
*
* Report bad redirection file
*

bdfil clr termc clear out term char
 tst intflg interactive?
 beq bdfil2
 pshs d
 ldd #2
 sys write,bdfms,BDSIZ output error
 puls d get status back
bdfil2 sys term term this task


*
* rprt
*
* Report any tasks which have terminated.
*

rprt ldx #attab point to async table
rprt2 tst 2,x check its activity
 bne rprt4
rprt3 leax 9,x move to next entry
 cmpx #atend end of table?
 bne rprt2
 lbra sh0 go to main loop
rprt4 pshs x save entry
 ldd 0,x get task id
 bsr prtid
 ldd #1 output message
 sys write,ttmsg,TTMSZ
 ldx 0,s get table pointer
 lda 3,x get term status
 lbsr ptmsg print term message
 puls x get entry
 ldd #0 zero out entry
 std 0,x
 std 2,x
 sta 4,x
 bra rprt3

 pag

*
* async
*
* Run a job async.
*

async ldx #attab point to async table
async2 ldd 0,x look for empty slot
 beq async4
 leax 9,x move to next entry
 cmpx #atend
 bne async2
 ldd #2 set file desc
 sys write,tmtms,TMTSZ output error
 lbra pwait wait for task
async4 puls d get task id
 std 0,x save in table
 clr 2,x set activity
 pshs d,x save pos
 sys time,asytim get current time
 ldx 2,s reset pos
 ldu #asytim point to time
 ldd 0,u xfr time
 std 5,x
 ldd 2,u
 std 7,x
 puls d,x
 bsr prtid print task id
 ldd #1 set file desc
 sys write,rtmsg,RTSZ
 lbra sh0 goto main loop

*
* prtid
*

prtid ldx #idbuf+3 point to buffer
 lbsr decstn convert to string
 addd #3
 std wrid2 save length
 ldx #idbuf point to buffer
 ldd #('*<<8)|'*
 std 0,x
 ldd #$2000|'T
 std 2,x
 ldd #1 set file desc
 sys ind,wrid write out id
 rts return

*
* chasy
*
* Check for terminated async job.
*

chasy ldy #attab point to async table
chasy2 cmpd 0,y look for this guy
 beq chasy4
 leay 9,y move to next entry
 cmpy #atend end of table?
 bne chasy2
 rts non found
chasy4 stx 3,y save term status
 inc 2,y set term stat
 rts return

 pag

*
* dpipe
*
* Create job as part of pipe
*

dpipe tst pipmod in pipe?
 beq dpipe2 if not, go ahead
 ldd apprdf get read file
 sys close close it
dpipe2 inc pipmod set pipe mode
 ldd pprdf get read file
 std apprdf save it
 ldd ppwrf get write file
 sys close it
 puls d get task id
 lbra sh0 goto main

*
* cpipe
*
* Create a pipe
*

cpipe sys crpipe create it
 bes cpipe2 error?
 std pprdf save read file
 stx ppwrf save write file
 lbra sh96 go continue

cpipe2 clr termc set null term
 ldd #2 set error chan
 sys write,nopms,NPSZ
 lbra sh0 goto main

 pag

*
* spipe
*
* Setup pipe io.
*

spipe lda termc check for pipe
 cmpa #'|
 beq spipe2
 cmpa #'^
 bne spipe4
spipe2 ldd #1 close standard output
 sys close
 ldd ppwrf get write file
 sys dup make file 1
 ldd ppwrf get write file
 sys close close it
 ldd pprdf get read file
 sys close close it
spipe4 tst pipmod in pipe mode?
 beq spipe6
 ldd #0 close standard input
 sys close
 ldd apprdf get read file
 sys dup dup it
 ldd apprdf get read file
 sys close close it
spipe6 rts return


 pag

*
* scmnd
*
* Check for shell command.  If it is, return
* 'eq' and address of command in X.
*

scmnd ldy #sctab point to command table
scmnd1 ldx arglst point to arg
scmnd2 lda 0,x+ get a character
 beq scmnd6 term char?
 tst 0,y end of command?
 beq scmnd4
 cmpa 0,y+ does it match?
 beq scmnd2 if so, do next char
scmnd4 tst 0,y+ find end of name
 bne scmnd4
 leay 2,y skip command address
 cmpy #scend end of table?
 bne scmnd1 if not, repeat
 clz set no find status
 rts return
scmnd6 tst 0,y end of command?
 bne scmnd4 if so, match!
 ldx 1,y get address
 sez set find status
 rts return

*
* chd
*
* Change dir command
*

chd ldd arglst+2 get 2nd arg
 bne chd1 default arg?
 ldd #defdir point to home
chd1 pshs d
 lda #chdir set up command
 pshs a
 leax 0,s point to call data
 sys indx do sys call
 lbec rprt error?
 ldd #2 set file desc
 sys write,ccdrms,CCDSZ output error
 lbra rprt goto main loop

*
* login
*
* Log in command.
*

login sys defacc,0 set default to 0
 sys status,utnam,mfsb get status
 ldd mfsb+11 get file size
 beq login2 if 0 - single user mode
 sys exec,logn,arglst exec login
login2 sys term term if error

 pag

*
* log
*
* log out command
*

log ldd #0 set term status
 sys term term shell

*
* wait
*
* Wait on asynch tasks.
*

cwait ldd #0
 std wtid set id to 0
 ldx arglst+2 get arg
 bne cwait6 is there one?
 ldx #attab point to task table
cwait1 ldd 0,x look for active tasks
 bne cwait2 found one?
 leax 9,x get next entry
 cmpx #atend end of table?
 bne cwait1
 ldd #1 set file desc
 sys write,nchms,NCHSZ output error meg
 lbra sh0 go to main loop
cwait2 sys cpint,2,ctwait set int trap
 ldx #attab point to task table
cwait3 ldd 0,x check for task
 beq cwait4
 tst 2,x has it termed?
 beq cwait5
cwait4 leax 9,x get next entry
 cmpx #atend end of table?
 bne cwait3
cwai45 sys cpint,2,1 ignore ints
 lbra rprt go report tasks termed
cwait5 sys wait wait for task
 lbsr chasy update task table
 ldx #attab point to table
 bra cwait3 repeat loop
cwait6 lbsr decvt convert task id
 bne cwai75 error?
 std wtid set id
 sys cpint,2,ctwait set ints
 ldd wtid get task id
 ldx #attab point to task table
cwait7 cmpd 0,x look for task id
 beq cwait8
 leax 9,x get next entry
 cmpx #atend end of table?
 bne cwait7
cwai75 ldd #1 set file desc
 sys write,ntfms,NTSZ output error
 lbra sh0
cwait8 tst 2,x task active?
 bne cwai45
 sys wait wait for it
 lbsr chasy update info
 ldx #attab point to task table
 ldd wtid get task id
 bra cwait7

*
* ctwait
*

ctwait sys cpint,2,1 ignore ints
 ldd #rprt set new pc
 std 10,s
 rti return (exit 'wait')

 pag

*
* jobs
*
* Output list of running tasks.
*

jobs clr 0,-s set counter to 0
 ldx #attab point to task table
jobs1 ldd 0,x get task number
 bne jobs4
jobs2 leax 9,x bump to next entry
 cmpx #atend end of table?
 bne jobs1
 ldb 0,s+ get task count
 bne jobs3
 ldd #1 output error
 sys write,nchms,NCHSZ
jobs3 lbra rprt goto main loop
jobs4 inc 0,s bump count
 pshs x save index
 lbsr prtid print task id
 ldd #1 set file desc
 sys write,ttmsg,TTMSZ output message
 ldx 0,s get table entry
 ldd 5,x get time
 std asytim save in block
 ldd 7,x
 std asytim+2
 ldx #asytim point to time block
 lbsr tmloc convert time
 lbsr tasc
 ldd #1 set file desc
 sys write,tstr,25 output time
 puls x
 bra jobs2 repeat

*
* dprm
*
* Set default permissions (command)
*

dprm clr slot clear out value
 ldu #arglst+2 set arg ptr
dprm2 ldx 0,u++ get an arg
 beq dprm5 end of args?
 ldd 0,x++ get 1st 2 chars of arg
 cmpb #'- check if valid
 bne dprm4
 bsr setp set up perms
 bne dprm2 error?
dprm4 lbsr synerr report syntax error
 lbra rprt go to main loop
dprm5 ldb slot get value
 stb isdp2 set in os call
 sys ind,isdp set perms
 lbra rprt exit

*
* setp
*
* Get the permission value
*

setp pshs a save type
 bsr getp get rwx bits
 puls a get type
 beq setp6 error?
 cmpa #'u is it user?
 beq setp3
 cmpa #'o is it other?
 bne setp6 if not - error
setp2 aslb shift bits to other pos
 aslb
 aslb
setp3 orb slot or in with others
 stb slot save new
 clz set status
 rts return
setp6 sez set error
 rts return

*
* getp
*
* Process the rwx args
*

getp clr 0,-s save mask
getp2 clrb set count
 lda 0,x+ get char of arg
 beq getp6 end of arg?
 incb set for r
 cmpa #'r is it r?
 beq getp4
 aslb set for w
 cmpa #'w is it w?
 beq getp4
 aslb set for x
 cmpa #'x is it x?
 bne getp7
getp4 orb 0,s or in new mask bit
 stb 0,s save it
 bra getp2
getp6 clz set status
 puls b,pc return
getp7 sez set error
 puls b,pc return

*
* wrtpr
*
* Output prompt line.
*

wrtpr tst tprfl time prompt?
 beq wrtpr2
 sys time,shtime get current time
 ldx #shtime point to time
 lbsr tmloc convert time
 lbsr tasc
 ldd #1 set file desc
 sys write,tstr,5 output time
wrtpr2 ldd #1 set file desc
 ldu iwrtp3 null string?
 beq wrtpr4
 sys ind,iwrtp output prompt
wrtpr4 rts return

 pag

*
* stprm
*
* Set prompt command.
*

stprm clr tprfl clear time mode
 ldx arglst+2 get arg
 beq stprm2 is it null?
 lda 0,x get 1st char
 cmpa #TPCH requesting time prompt?
 bne stprm4
 sta tprfl set flag
 leax 1,x eat the +
 bra stprm4
stprm1 std iwrtp3 set in call
 lbra rprt go to main loop
stprm2 ldd #prompt set up default prompt
 std iwrtp2
 ldd #3 set length
 bra stprm1
stprm4 clrb set count to 0
 ldy #prmbuf point to prompt buffer
 sty iwrtp2 set in call
stprm5 lda 0,x+ xfr new prompt
 sta 0,y+
 beq stprm6 end?
 incb bump count
 cmpb #24 max yet?
 bne stprm5
 decb
stprm6 clra
 bra stprm1

 pag

*
* bldpr
*
* Build the paren string for sub shell.
*

bldpr leax 1,x skip paren
 ldb #1 set flags
 stb prflg
bldpr2 lda 0,x+ get a character
 beq bldpr8 error?
 cmpa #$d is it cr?
 beq bldpr8 error?
 cmpa #') end of list?
 beq bldpr4
 cmpa #'( nesting parens?
 bne bldpr2
 incb bump nest count
 bra bldpr2 repeat
bldpr4 decb dec the nest count
 bne bldpr2 zero level?
 clr soft
 lda #SPACE set space term
 sta -1,x
 lbsr tsttrm test term char
 ldy bufpt get buffer start
 leay 1,y skip ')'
 sty subrg2 save arg ptr
 sty bsbrg2
 stx bufpt save new buf ptr
 rts return
bldpr8 lbsr synerr set error
 lbra sh0 goto main loop

*
* dosub
*
* Do the sub shell execution.
*

dosub lda termc check for background
 cmpa #'&
 bne dosub4
 sys exec,cshell,bsubrg exec the shell
 sys term error terminate
dosub4 sys exec,cshell,subrg exec the shell
 sys term

 pag

*
* cfile
*
* Close all files
*

cfile ldd #3 start with file 3
 pshs d save file desc
cfile2 sys close close the file
 ldd 0,s get fd
 addd #1 bump by 1
 std 0,s
 cmpd #NFILES end of files?
 bne cfile2
 puls d,pc return

*
* subst
*
* Substitute arguments
*

subst pshs y save arg pointer
 lda 0,y get character
 cmpa #'$ is it param?
 beq subst2
subst1 puls y,pc return
subst2 lda 1,y check 2nd char
 beq subst7 if null, exit
 leax 1,y point to number
 bsr decvt convert to binary
 bne subst1
 cmpd #255 is it greater than 255?
 bhi subst1
 bra subst4
subst3 leas 2,s clean up stack
 rts return
subst4 ldx subpt get sub pointer
 beq subst3 is it null?
 pshs b
subst5 ldd 0,x check for null arg
 puls b
 beq subst3
 tstb found it?
 beq subst6 is this the one?
 leax 2,x bump to next
 decb dec the count
 pshs b
 bra subst5
subst6 ldy 0,x get arg pointer
subst7 leas 2,s fix stack
 clz set status
 rts return

*
* abtrm
*
* Report abnormal termination of tasks.
*

abtrm lda ctrm get term status
 bne abtrm2 is it abnormal
 rts if not - return
abtrm2 ldy #comnd point to buffer
 ldb #$d set up cr
 stb 0,y+ set in buffer
 ldb #1 set count to 1
 bra ptmsg1

*
* ptmsg
*
* Print termination message.
*

ptmsg ldy #comnd point to out buffer
 clrb set count to 0
ptmsg1 pshs a save status
 asla
 ldx #tmstb point to message table
 ldx a,x get message pointer
ptmsg2 lda 0,x+ get a char
 incb bump the count
 sta 0,y+ save the char
 bne ptmsg2 repeat til null
 lda 0,s+ get status
 bpl ptmsg6 core dumped?
 decb back up count
 leay -1,y
 ldx #crdms point to 'core dump' message
ptmsg4 lda 0,x+ move the string
 incb
 sta 0,y+
 bne ptmsg4
ptmsg6 lda #$d get cr
 sta -1,y set at end of list
 clra
 std iwrt2 set write count
 ldd #1 set file desc
 sys ind,iwrt output string
 rts return

 pag

*
* decvt
*
* Decimal convert routine.  Convert ascii string
* pointed at by x and null terminated.
* Return number in D and ne if error.
*

decvt ldd #0 set up zero
 pshs d
decvt2 lda 0,x+ get character
 beq decvt4 end of list?
 cmpa #'0 check for valid number
 blo decvt3 error?
 cmpa #'9
 bhi decvt3
 anda #$F mask character
 pshs a save digit
 ldd 1,s get number
 aslb multiply by 8
 rola
 aslb
 rola
 aslb
 rola
 addd 1,s add in original twice
 addd 1,s
 addb 0,s+ add in new digit
 adca #0
 std 0,s save result
 bra decvt2 repeat
decvt3 clz set error
decvt4 puls d,pc return

 pag

*
* decst
*
* Convert the number in D into an ascii string
* representing a decimal number.  The string
* is pointed at by X (X should be set on entry!)
* Also on exit, D has the length of the string.
* The second entry point, 'decstn' will not print
* leading spaces for leading zeroes, but will
* suppress all leading zero info.  All strings
* start with a space.
*

decst pshs x save user pointer
 clr 0,-s set suppression flag
 bra decst2
*
decstn pshs x save user pointer
 clr 0,-s
 inc 0,s set for no fielding
decst2 pshs a
 lda #$20 setup leading space
 sta 0,x+ save in buffer
 puls a
 clr 0,-s set up bookkeeping
 clr 0,-s
 ldy #conlst point to constants
decst4 cmpd 0,y compare number to constant
 blo decst5
 subd 0,y do subtraction of constant
 inc 1,s bump digits counter
 bra decst4
decst5 pshs a save number
 tst 2,s zero digit?
 bne decst6
 tst 1,s any numbers output yet?
 bne decst6
 tst 3,s doing suppression?
 bne decst8
 lda #$20 set up space
 bra decst7
decst6 lda 2,s get digit count
 inc 1,s set 'got one' flag
 ora #$30 make ascii
decst7 sta 0,x+ save in buffer
decst8 puls a reset number
 clr 1,s clear out digit
 leay 2,y bump constant ptr
 cmpy #conend end of list?
 bne decst4
 leas 3,s clean up stack
 orb #$30 make last digit
 stb 0,x+ save in buffer
 clr 0,x null terminate string
 tfr x,d
 subd 0,s calculate string length
 puls x,pc return

 pag

*
* marg
*
* Check dor match list processing
*

marg tfr y,x get arg pointer
 tst quote quotes arg?
 bne marg9 if so - skip
 tst prflg paren command?
 bne marg9
 bsr sum do set up for match
 bes marg9 error?
 ldx argpt get arg pointer
 leax -2,x back up
 stx argpt
 stx starg save start arg
 lbsr opnmf open match file
 bes marg8 error?
marg4 lbsr cmntr compare names
 bes marg7 end of lists?
 bne marg4 match?
 inc mone set matched one flag
 ldx fstpt get string pointer
 ldu argpt get arg pointer
 stx 0,u++ save new arg
 stu argpt
 ldu #front get front part
 ldy #tstbuf+2 point to string
marg6 lda 0,u+ get char
 beq marg65 null?
 sta 0,x+ move it
 cmpx #fstlst+4096
 bhs marg10 overflow?
 bra marg6
marg65 cmpx #fstlst+4096
 bhs marg10
 lda 0,y+ get a character
 sta 0,x+ move the character
 bne marg65 end of arg?
 stx fstpt save string pointer
 bra marg4 repeat
marg7 ldd mffd get file desc
 sys close close the file
 tst mone any matches?
 beq marg8
 ldd #0 set null arg pointer
 std [argpt]
 ldx starg get starting arg pos
 lbra sort go sort args & return
marg8 ldx argpt fix up arg ptr
 leax 2,x
 stx argpt
marg9 clc clear error
 rts return
marg10 ldd mffd get file desc
 sys close close it
 sec set error
 rts

 pag

*
* sum
*
* Setup for match tests.
*

sum clr mone
 ldy #front point to front name buffer
sum2 lda 0,x+ get a character
 sta 0,y+ move to front buf
 beq sum6 end of string?
 cmpa #'* check for match char
 beq sum3
 cmpa #'?
 beq sum3
 cmpa #'[
 bne sum2
sum3 lda -1,y move back thru string
 cmpa #'/ look for '/'
 beq sum4
 leay -1,y
 leax -1,x
 cmpy #front or beginning of string
 bne sum3
sum4 clr 0,y set term char
 stx mtpt set match pointer
sum5 lda 0,x+ look at rest of string
 beq sum7 end?
 cmpa #'/ is it '/'?
 bne sum5
sum6 sec set error
 rts return
sum7 clc set ok status
 rts return

 pag

*
* opnmf
*
* Open match file.
*

opnmf sys open,front,0 open the file for read
 bes opnmf4 error?
 std mffd save file desc
 sys ofstat,mfsb get status
 lda mfsb+4 get mode byte
 bita #$8 is it dir?
 beq opnmf2 if not - error
 clc
 rts return
opnmf2 ldd mffd get fd
 sys close close the file
opnmf4 sec set error
 rts return

*
* cmntr
*
* Compare names for match test.  Return 'eq'
* if match, 'cs' if error or no more names.
*

cmntr ldd mffd get file desc
 sys read,tstbuf,16 read entry
 bes cmntr4 error?
 cmpd #0 eof?
 beq cmntr4
 clr tstbuf+16 set null term
 ldd tstbuf check for deleted entry
 beq cmntr repeat
 ldx mtpt get match string
 ldy #tstbuf+2 point to test name
 lda 0,y get 1st char
 cmpa #'. is it '.'?
 bne cmntr2
 leay 1,y skip char
 cmpa 0,x+ must match!
 bne cmntr3
cmntr2 bsr match do match test
cmntr3 clc set ok status
 rts return
cmntr4 sec set error
 rts return

 pag

*
* match
*
* See if the match string pointed at by X matches
* the string pointed at by Y.  Return 'eq' if
* they match.  This routine handles the following
* special match characters: *, ?, [...].
*

match pshs x,y save pointers
match1 lda 0,x+ get character
 beq match2 end of string?
 cmpa #'* is it star?
 beq mstar
 tst 0,y end of test string?
 beq match3
 cmpa #'? is it '?'
 beq mqust
 cmpa #'[ is it '[...]' ?
 beq mspcl
 cmpa 0,y+ compare characters
 beq match1 if match, repeat!
 puls x,y,pc return - no match
match2 tst 0,y end of test string?
 puls x,y,pc if so - match!
match3 clz set no match
match4 puls x,y,pc return

* match question mark

mqust leay 1,y anything matches!
 bra match1 repeat

* match start ('*')

mstar tst 0,x end of match string?
 beq match4 if so - match!
mstar2 tst 0,y end of string?
 beq match3 if so - no match
 bsr match check reset of string
 beq match4 if 'eq' - match!
 leay 1,y skip a character
 bra mstar2 repeat

 pag

* match special list '[...]'

mspcl ldb 0,y+ get a character
mspcl2 lda 0,x+ get match char
 beq match3 if end - no match
 cmpa #'] end of special?
 beq match3 if so - no match
 cmpa #'- is it sep char?
 beq mspcl5
 cmpb -1,x compare the characters
 bne mspcl2 if no match - repeat
mspcl4 lda 0,x+ look for ']'
 beq match3 if null - no match!
 cmpa #']
 bne mspcl4
 bra match1 we have a match!
mspcl5 cmpb -2,x check 1st char in range (1-2)
 blo mspcl6 if lower, not here
 cmpb 0,x check 2nd char of range
 bls mspcl4 if 'ls' - match!
mspcl6 leax 1,x skip range char
 bra mspcl2 repeat

 pag

*
* sort routine
*
* General sort routine should be called with pointer
* to a list of pointers stored in X.  List is terminated
* by two zero bytes.  Each pointer in list points to
* a string which is terminated by a zero byte.
* On return, pointers in list are rearranged and all
* registers are destroyed.
*

sort ldd 0,x check first entry
 beq sort9 exit if null list
 ldd #$FFFF default end of list
 pshs x,d save begin and end
 leas -1,s did an exchange flag
sort1 ldx 3,s get begin of list
 clr 0,s show no exchange
sort2 ldd 2,x another entry?
 beq sort6 finished pass if not
 leay 2,x end of pass?
 cmpy 1,s
 beq sort6 skip if so
* compare current and next entry
 ldy 0,x get pointer to 1st
 ldu 2,x get pointer to 2nd
sort3 lda 0,y+ get char. from 1st
 beq sort5 no exchange if terminator
 ldb 0,u get char. from 2nd
 beq sort4 do exchange if terminator
 cmpa 0,u+ else, compare characters
 beq sort3 loop if equal
 blo sort5 skip if no exchange
* exchange two entries
sort4 ldy 2,x get 2nd entry
 ldd 0,x get 1st entry
 std 2,x swap them
 sty 0,x
 lda #1
 sta 0,s show exchange done
* do next two entries
sort5 leax 2,x bump current pointer
 bra sort2
* finished pass, see if another required
sort6 stx 1,s save new end pointer
 tst 0,s any exchanges in pass?
 bne sort1 another pass required
sort8 leas 5,s fix stack
sort9 clc
 rts

 pag

*
* tmloc
*
* Convert time pointed at by x to vector time (local).
*

tmloc ldd 0,x get time
 std ltime
 ldd 2,x
 std ltime+2
 lda 7,x get day light savings flag
 sta dlflg
 clr eutc init flag
 ldd 5,x get time zone
 bpl tmloc2 west of GMT?
 inc eutc if not - set flag
 coma and make pos number
 comb
 addd #1
tmloc2 std r0+2 save time zone
 ldd #60 calculate zone seconds
 std r1+2
 ldd #0 set hi bytes to 0
 std r0
 std r1
 lbsr lmul calculate time zone seconds
 ldd r0 get result
 std tzn save it
 ldd r0+2
 std tzn+2
 lbsr adjtim adjust time for zone
 ldx #ltime point to time
 lbsr tmutc convert to vector
 tst dlflg do dlst?
 beq tmloc6
 lbsr chkdl in dlst?
 bne tmloc6
tmloc5 ldd #3600 adjust for dlst
 addd ltime+2
 std ltime+2
 ldd ltime
 adcb #0
 adca #0
 std ltime
 ldx #ltime point to time
 lbsr tmutc convert to vector
 inc daylit set daylit flag
tmloc6 ldx #second point to vector
 rts return

 pag

*
* tmutc
*
* Convert the internal system time (4 bytes
* pointed at by X on entry) to an 18 byte
* vector representing the broken down time.
* The time in this form is UTC (Universal
* Coordinated Time).
*

tmutc ldd #0 set daylight savings word
 std daylit
 ldd 0,x get hi word of time
 std r0 save ir divide register
 ldd 2,x get lo word of time
 std r0+2
 ldd #60*60 seconds*minutes constant
 std r1 set up for divide
 lbsr ldiv min*sec=time % 3600
 ldd work hour*day=time / 3600
 pshs d save min*sec
 ldd #24 set up hours per day constant
 std r1
 lbsr ldiv hours= (hour*day) % 24
 ldd work day= (hour*day) / 24
 std hours set hours word
 ldd r0+2 get day number
 std day save the day
 addd #2 add in day bias (Jan 1 80 => Tue)
 std r0 set up for divide
 ldb #7 days per week constant
 stb r1
 lbsr div wday=(day+2) % 7
 ldb work get result
 clra make into word
 std wday set week day
 puls d get min*sec
 std r0 set up for divide
 ldb #60 seconds per minute
 stb r1
 lbsr div seconds= (min*sec) % 60
 ldb work minutes= (min*sec) / 60
 clra
 std second set seconds word
 ldd r0 get minutes
 std minute save it

 pag

* continue tutc for year and month data

 clr 0,-s clear year counter
tutc2 ldx #ylen point to year length table
 lda 0,s get year number
 bita #$3 is it leap year?
 bne tutc3
 leax 2,x if so, move to long year value
tutc3 ldd day get day number
 cmpd 0,x day in current year?
 blo tutc4 if 'lt' - we got the year!
 subd 0,x subtract off years days
 std day save new day count
 inc 0,s bump the year count
 bra tutc2 repeat
tutc4 std yday set day of year word
 puls b get year count
 addb #80 add to '1980'
 clra make 16 bits long
 std year save the year
 bitb #$3 is it leap year?
 bne tutc5
 ldd #29 if so, set Feb day count to 29
 std mdays+2
tutc5 ldx #mdays point to month-day table
 clr 0,-s set month count to zero
 ldd yday get day of the year
tutc6 cmpd 0,x in the month?
 blo tutc7 if 'lt' - we got the month!
 inc 0,s bump the month counter
 subd 0,x++ subtract of this month's days
 bra tutc6
tutc7 addd #1 add 1 to month day (day 1 is 1 - not 0!)
 std mday save the month day
 puls b get the month
 std month save it
 ldd #28 reset month - day table
 std mdays+2
 rts return

 pag

*
* chkdl
*
* Check if in dlst - return 'eq' if so.
*

chkdl ldd #119 check for last Sun in Apr
 bsr fixtim
 std fstdl first day of dlst
 ldd #303 last Sun in Oct
 bsr fixtim
 std lstdl last day of dlst
 ldd yday get day of year
 cmpd fstdl up to 1st day yet?
 blo chkdl6
 bhi chkdl4
 ldd hours on the 1st day - so
 cmpd #2 is it 2:00 AM yet?
 blo chkdl6
 bra chkdl5
chkdl4 ldd yday get day of year
 cmpd lstdl past last day of dlst?
 bhi chkdl6
 blo chkdl5
 ldd hours on the last day - so
 cmpd #1 is it 1:00 AM yet?
 bhs chkdl6
chkdl5 sez we are in dlst!
 rts return
chkdl6 clz not in dlst
 rts return

 pag

*
* adjtim
*
* Adjust time for time zone.
*

adjtim ldd ltime+2 get time
 tst eutc east of UTC?
 bne adjti2
 subd r0+2 subtract time zone minutes
 std ltime+2
 ldd ltime get hi part
 sbcb r0+1
 sbca r0
 bra adjti4
adjti2 addd r0+2 add in minutes
 std ltime+2
 ldd ltime
 adcb r0+1
 adca r0
adjti4 std ltime save new time
adjti5 rts return

*
* fixtim
*
* Return the closest day to the date in D
* which is a Sunday.
*

fixtim pshs d save day number
 ldd year get year
 bitb #$3 is it leap year?
 puls d
 bne fixti2
 addd #1 if so - bump day number
fixti2 pshs d save day number
 addd #420 add in 420 so no negatives result
 addd wday add in day of week
 subd yday subtract day of year
 std r0 save result
 ldb #7
 stb r1 set up for divide
 bsr div do: (day+420+wday-yday) % 7
 puls d get day number
 subb work
 sbca #0
 rts return day in d

 pag

*
* Divide routines for time conversion use.  'Ldiv'
* divides a 32 bit number (r0 -> r0+3) by a 16 bit
* number (r1 -> r1+1) and produces a 32 bit result
* in r0 and a 16 bit remainder in 'work'.  'Div'
* divides a 16 bit number (r0 -> r0+1) by an 8 bit
* number (r1) and produces a 16 bit result (r0)
* and an 8 bit remainder (work).
*

div lda #17 set up loop counter
 clrb do initialize
 stb work
 bra div2
div1 ldb work
 subb r1 do subtraction
 bcs div2 s3et new work?
 stb work yes!
div2 rol r0+1 do shift left
 rol r0
 rol work
 deca dec the loop count
 bne div1 repeat?
 com r0 fix up result
 com r0+1
 lsr work fix remainder
 rts


 pag

*
* Long divide
*

ldiv ldb #33 set loop counter
 pshs b
 ldd #0 do init
 std work
 bra ldiv2
ldiv1 ldd work do subtraction
 subd r1
 bcs ldiv2 work > r1 ?
 std work set new work value
ldiv2 rol r0+3 do shifting
 rol r0+2
 rol r0+1
 rol r0
 rol work+1
 rol work
 dec 0,s dec the loop count
 bne ldiv1
 com r0 compliment the result
 com r0+1
 com r0+2
 com r0+3
 lsr work adjust the remainder
 ror work+1
 puls b,pc return

 pag

*
* lmul
*
* Long multiply - 32 bits (r0) X 32 bits (r1).
* Result is in r0.
*

lmul ldb #32 set loop count
 pshs b
 ldd #0 init variables
 std work
 std work+2
 lsr r0 do initial shift
 ror r0+1
 ror r0+2
 ror r0+3
lmul1 bcc lmul2 need to add?
 ldd work+2
 addd r1+2
 std work+2
 ldd work
 adcb r1+1
 adca r1
 std work save result
lmul2 ror work do shifting
 ror work+1
 ror work+2
 ror work+3
 ror r0
 ror r0+1
 ror r0+2
 ror r0+3
 dec 0,s dec the loop count
 bne lmul1 repeat?
 puls b,pc return

 pag

*
* tasc
*
* Convert the time vector data (18 bytes) pointed
* at by x into an ascii string.  Return x pointing
* to the string.
*

tasc tfr x,u save vector pointer
 ldx #tstr point to string
 ldd 4,u get hours
 bsr cvt convert to ascii
 leax 1,x skip the ':'
 ldd 2,u get minutes
 bsr cvt convert to ascii
 leax 1,x skip the ':'
 ldd 0,u get seconds
 bsr cvt convert to ascii
 leax 1,x skip space
 ldd 6,u get day of week
 ldy #dtab point to day table
 bsr tasxfr xfr to string
 ldd 10,u get month
 ldy #mtab point to month table
 bsr tasxfr xfr to string
 ldd 8,u get month day
 bsr cvt convert to ascii
 leax 1,x
 ldd #('1<<8)|'9 set up '19'
 std 0,x save in string
 ldd 12,u get year
 cmpd #100 >100 (year 2000 yet?)
 blo tasc4
 subd #100 remove bias
 pshs d save year
 ldd #('2<<8)|'0 set up '20'
 std 0,x set in string
 puls d reset year
tasc4 leax 2,x
 bsr cvt convert year to ascii
 ldx #tstr point to string
 rts return

 pag

*
* tasxfr
*
* Transfer the 3 bytes of ascii indexed by b
* at y to location pointed at by x.
*

tasxfr pshs b index * 3
 aslb
 addb 0,s+
 leay b,y point to indexed data
 ldd 0,y xfr the data to x
 std 0,x++
 lda 2,y
 sta 0,x
 leax 2,x bump string pointer
 rts return

*
* cvt
*
* Convert number in b to ascii at x.
*

cvt lda #'0 set ascii 0
cvt2 cmpb #10 >10?
 blo cvt4
 subb #10 subtract off 10
 inca bump ascii
 bra cvt2 repeat
cvt4 addb #'0 make 1's ascii
 std 0,x++ save ascii at x
 rts return

 pag

 if *>$1000
 err Text Overflow into Data!
 endif

 ifc &a,"notext"
 org $1000
 else
 data $1000
 endif

*
* Shell data section
*

prompt fcc '++ '
PRSIZ equ *-prompt size of prompt
bdfms fcc "Can't open I/O file.",$d
BDSIZ equ *-bdfms
ermsg1 fcc "Can't execute '"
ERSIZ1 equ *-ermsg1
ermsg2 fcc "'",$d
ERSIZ2 equ *-ermsg2
syrms fcc 'Syntax error.',$d
SYSIZ equ *-syrms
ccdrms fcc "Can't change directories.",$d
CCDSZ equ *-ccdrms
ntfms fcc 'No such task.',$d
NTSZ equ *-ntfms
rtmsg fcc ' running.',$d
RTSZ equ *-rtmsg
ttmsg fcc ' - '
TTMSZ equ *-ttmsg
tmtms fcc 'Too many tasks ... waiting!',$d
TMTSZ equ *-tmtms
nopms fcc "Can't create pipe",$d
NPSZ equ *-nopms
nchms fcc 'No tasks active.',$d
NCHSZ equ *-nchms
frkmsg fcc "Can't fork task.",$d
FRKSIZ equ *-frkmsg
argms fcc "Match list overflow.",$d
ARGMS equ *-argms
crdms fcc ' (Core dumped)',0
utnam fcc '/act/utmp',0
nldst fcc '/dev/null',0
hmfl fcc '.home?',0
cshell fcc '/bin/shell',0
carg fdb cshln,cstrt,0
cshln fcc 'shell',0
cstrt fcc '.startup',0
cptst fcc '+c',0
bcptst fcc '+bc',0
cbasic fcc '/bin/basic',0
Pscl0 fcc '/bin/nrun',0 ***GDT
Pscl1 fcc '/bin/sys_rt',0 ***GDT
logn fcc '/etc/login',0
logr fdb 0
plbst fcc '+b',0
tmstb fdb tm0,tm1,tm2,tm3,tm4,tm5
 fdb tm6,tm7,tm8,tm9,tm10,tm11,tm12
tm0 fcc 'Ended.',0
tm1 fcc 'Hangup.',0
tm2 fcc 'INTERRUPT!',0
tm3 fcc 'Quit.',0
tm4 fcc 'EMT trap.',0
tm5 fcc 'Killed.',0
tm6 fcc 'Pipe.',0
tm7 fcc 'Argument.',0
tm8 fcc 'Trace.',0
tm7xx fcc 'Memory Fault.',0
tm8xx fcc 'EMT2 Trap.',0
tm9 fcc 'Time limit.',0
tm10 fcc 'Alarm.',0
tm11 fcc 'Terminated.',0
tm12 fcc 'Interrupt #12.',0

ylen fdb 365 year length
 fdb 366 leap year

mdays fdb 31,28,31,30,31,30,31,31,30,31,30,31


tstr fcc 'xx:xx:xx xxx xxx xx xxxx',$d,0

dtab fcc 'SunMonTueWedThuFriSat'

mtab fcc 'JanFebMarAprMayJunJulAugSepOctNovDec'

second fdb 0 seconds (0-59)
minute fdb 0 minutes (0-59)
hours fdb 0 hours (0-23)
wday fdb 0 week day (0-6) 0=Sunday
mday fdb 0 month day (1-31)
month fdb 0 month (0-11)
year fdb 0 year (80+)
yday fdb 0 day of year (0-355)
daylit fdb 0 daylight savings flag

* constants for convert

conlst fdb 10000
 fdb 1000
 fdb 100
 fdb 10
conend equ * end of list


r0 fdb 0,0 regs for div and mul
r1 fdb 0,0
work fdb 0,0
day fdb 0 day temp
ntime fdb 0,0 new time
eutc fcb 0 east of utc flag
fstdl fdb 0 1st day of dlst
lstdl fdb 0 last day of dlst
dlflg fcb 0 dlst flag
ltime fdb 0,0 local time
tzn fdb 0,0 time zone seconds


* command table

sctab fcc 'chd',0
 fdb chd
 fcc 'login',0
 fdb login
 fcc 'log',0
 fdb log
 fcc 'logout',0
 fdb log
 fcc 'wait',0
 fdb cwait
 fcc 'prompt',0
 fdb stprm
 fcc 'jobs',0
 fdb jobs
 fcc 'dperm',0
 fdb dprm
scend equ * end of table

execf fcb 0 no fork flag
subrg fdb cshln,cptst
subrg2 fdb 0,0
bsubrg fdb cshln,bcptst
bsbrg2 fdb 0,0
syntid fdb 0 sync task id
termc fcb 0 term character
soft fcb 0 soft term flag
ctrm fdb 0 termination status
intflg fcb 0 interactive mode flag
coptf fcb 0 c option flag
rtcnt fcb 0 retry counter
sp fdb 0 stack pointer
subpt fdb 0 subs pointer
prflg fcb 0 paren flag
pipmod fcb 0 pipe mode flag
pprdf fdb 0 pipe read file
ppwrf fdb 0 pipe write file
apprdf fdb 0 actual pipe read file
starg fdb 0 starting arg for sort
quote fcb 0 quoted string flag
slot fcb 0 default perm value
mone fcb 0 match flag
mffd fdb 0 match file desc
mtpt fdb 0 match pointer
fstpt fdb 0 final arg pointer
cbpt fdb 0 command line pointer
smbuf fdb 0 small buffer
tprfl fcb 0 time prompt flag
linpt fdb 0 line pointer
linend fdb 0 buffer end
bufpt fdb 0 buffer pointer
argpt fdb 0 argument pointer
sifil fdb 0 input file
sofil fdb 0 output file
safil fdb 0 append file
ttgbuf fdb 0,0,0 ttyget buffer
shtime fdb 0,0,0,0 shell time buffer
asytim fdb 0,0,0,0 task time
tmpfd fdb 0 temp file desc
bgop fcb 0 background option flag
supf fcb 0 startup flag
wtid fdb 0 wait task id
ifd fdb 0 input file desc

iopn fcb open ind open call
iopn2 fdb 0,0

icrt fcb create ind create call
icrt2 fdb 0,$1B

iopnw fcb open ind open write call
iopnw2 fdb 0,1

wrid fcb write
 fdb idbuf
wrid2 fdb 0

iwrt fcb write
 fdb comnd
iwrt2 fdb 0

iwrtp fcb write
iwrtp2 fdb prompt
iwrtp3 fdb 3

isdp fcb defacc,0
isdp2 fcb 0

istat fcb status
istata fdb 0 pointer to name
 fdb statbuf

statbuf rzb ST_SIZ

defdir fcc '/' default dir for chd
 rzb 47

retry3 fcc '/usr'
retry2 fcc '/'
retry1 fcc 'bin/'
comnd rzb 128 command name buffer

attab rzb 9*ASSIZ async table
atend equ *

idbuf rzb 8 output buffer for task id
tstbuf rzb 17 match test buffer

mfsb rzb 24 status buffer
prmbuf rzb 24 prompt buffer

front rzb 128 path name front for match

buffer rzb BUFSIZ input line buffer

bsrgls rzb 2
sargls rzb 2 shell arg start
arglst rzb 0 argument list for exec (overlays initialization)

*
* sinit
*
* Shell initialization
*

sinit sys systat,fstlst get system version
 lda fstlst+6 get system type
 bpl sini00 if not protected cpu
 ldx #tm7xx change error message table
 stx tmstb+2*7
sini00 lsla
 bpl sini01 if EMT2 not present
 ldx #tm8xx
 stx tmstb+2*8
sini01 clr coptf reset 'c' opt flag
 clr termc
 clr pipmod
 ldd #0 set input fd
 std ifd
 ldb #ASSIZ*9
 ldx #attab clear out async table
sini05 clr 0,x+
 decb
 bne sini05
 lbsr cfile close all files
 ldd #cshln get shell name
 std sargls save as arg
 std bsrgls
 ldx #linbuf set initial pointers
 stx linpt
 stx linend
 lda #1 set interactive mode
 sta intflg
 ldd #0 set file desc 0
 sys ttyget,ttgbuf
 bec sinit0 error?
 cmpb #ENTTY is it not a tty?
 bne sinit0
 clr intflg clear interactive mode
sinit0 ldd 2,s get arg count
 cmpd #1 any args?
 bhi sinit2
 lda [4,s] get 1st char of arg 1
 cmpa #'+ is it '+'?
 beq sinit4
sinit1 rts return
sinit2 bsr opts process options
 tst coptf 'c' option set?
 beq sinit3
sini25 rts return
sinit3 ldx subpt get arg pointer
 beq sini25 any left?
 ldd 0,x get arg
 beq sini25 null?
 clr intflg set non-interactive mode
 ldd [subpt] get file name pointer
sini35 std iopn2 set up sys call
 sys ind,iopn open file for read
 bes sini37 errors?
 std ifd save file desc
 bra sini25
sini37 tst supf startup?
 bne sinit6
 sys term exit
sinit4 sys open,hmfl,0 get home file
 bes sinit5 ignore errors
 pshs d save file desc
 sys read,defdir,48 read in dir name
 puls d get file desc
 sys close the file
 sys unlink,hmfl delete home file
sinit5 lda #1 set startup mode
 sta supf
 clr intflg clear interactive mode
 sys cpint,11,1 ignore TERMI ** version 5 ** DS
 ldd #cstrt get startup name
 bra sini35 go open & run it
sinit6 clr supf clear out startup mode
 inc intflg set interactive
 rts return

*
* opts
*
* Process options for shell call.
*

opts leax 8,s point to arg list
 stx subpt save it
 ldx 0,x get arg
 beq opts9 null?
 lda 0,x+ get 1st char
 cmpa #'+ is it '+'?
 bne opts9
opts2 lda 0,x+ get next char of arg
 beq opts8
 cmpa #'c is it c option?
 bne opts4
 sta coptf set option flag
 clr intflg set non-interactive
 ldd 10,s get string pointer
 std cbpt
 bra opts2

opts4 cmpa #'b is it b option?
 bne opts6
 stb bgop set option flag
 bra opts2

opts6 cmpa #'x is it "no fork"
 bne opts2 if not
 sta execf set "no fork"
 bra opts2

opts8 leax 10,s point to arg
 stx subpt set pointer
opts9 ldd [subpt] check for null args
 bne opts10
 std subpt
opts10 rts return

 ifc &a,"notext"
 org $1E00
 else
 bss $1E00
 endif

linbuf rmb 512 input buffer
fstlst rmb 4096


 end sh