Apple-2gs-SW
/
gno
mirror of https://github.com/GnoConsortium/gno.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
gno/kern/gno/shellcall.asm

1898 lines
33 KiB
NASM
Raw Permalink Blame History

* $Id: shellcall.asm,v 1.1 1998/02/02 08:19:48 taubert Exp $
**************************************************************************
*
* The GNO Shell Project
*
* Developed by:
* Jawaid Bazyar
* Tim Meekins
* Derek Taubert
*
**************************************************************************
*
* SHELLCALL.ASM
* By Tim Meekins
*
* This file contains routines for patching GS/OS to intercept Shell
* calls and do special things with certain GS/OS calls.
*
* Phase 1 Modifications to Orca 2.0 compat: (11/18/91)
* removal of old c-style calls, and fixing all routines to work
* directly from pBlock rather than a copy.
* Phase 2: (11/19-20/91)
* Addition of most pCount checking, and addition of routines
* that don't take strings as parameters
* Phase 3: (11/20/91)
* String manipulation changes/additions
* Phase 4: (11/21/91)
* The variable pCount calls (FastFile, etc) and calls that differ
* greatly from Orca 1.x.
**************************************************************************
case on
copy global.equates
mcopy m/shellcall.mac
shellLoc gequ 12
;
; Table of commands
;
ShellCallTbl DATA
dc a2'_Get_L_Info' ;$101 - GetLInfo
dc a2'_Set_L_Info' ;$102 - SetLInfo
dc a2'_GetLang' ;$103
dc a2'_SetLang' ;$104
dc a2'_Error' ;* $105 - Error
dc a2'_Set' ;* $106 - Set
dc a2'_Version' ;* $107 - Version
dc a2'_Read_Indexed' ;* $108 - ReadIndexed
dc a2'_Init_Wildcard' ;$109 - InitWildcard
dc a2'_Next_Wildcard' ;$10A - NextWildcard
dc a2'_Read_Variable' ;* $10B - ReadVariable
dc a2'NotImp' ;$10C
dc a2'_Execute' ;* $10D - Execute
dc a2'_FastFile' ;$10E - FastFile
dc a2'_Direction' ;* $10F - Direction
dc a2'_Redirect' ;* $110 - Redirect
dc a2'NotImp' ;$111
dc a2'NotImp' ;$112
dc a2'_Stop' ;* $113 - Stop
dc a2'_ExpandDevices' ;* $114 - ExpandDevices
dc a2'_UnsetVariable' ;* $115 - UnsetVariable
dc a2'_Export' ;* $116 - Export
dc a2'_PopVariables' ;* $117 - PopVariables
dc a2'_PushVariables' ;* $118 - PushVariables
dc a2'_SetStopFlag' ;* $119 - SetStopFlag
dc a2'_ConsoleOut' ;* $11A - ConsoleOut
dc a2'NotImp' ;$11B
dc a2'NotImp' ;$11C
dc a2'NotImp' ;$11D
dc a2'_KeyPress' ;$11E
dc a2'_ReadKey' ;$11F
END
;=========================================================================
;
; ($101) GetLInfo
;
;=========================================================================
_Get_L_Info START
_Get_L_Info name
ph2 cmdNum
ph4 pBlock
jsl cGetLInfo
jmp GSOSReturn
END
;=========================================================================
;
; ($102) SetLInfo
;
;=========================================================================
_Set_L_Info START
_Set_L_Info name
ph2 cmdNum
ph4 pBlock
jsl cSetLInfo
jmp GSOSReturn
END
;=========================================================================
;
; ($103) GetLang
;
;=========================================================================
_GetLang START
_GetLang name
PBLang equ 0
lda curLangNum
ldy #PBLang
sta [pBlock],y
lda #0
jmp GSOSReturn
;=========================================================================
;
; ($104) SetLang
;
;=========================================================================
_SetLang ENTRY
ldy #PBLang
lda [pBlock],y
sta curLangNum
lda #0
jmp GSOSReturn
curLangNum dc i2'1'
END
;=========================================================================
;
; ($105) Error
;
;=========================================================================
_Error START
_Error name
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #1
beq orca_1
lda #4
jmp GSOSReturn
orca_1 lda [pBlock]
jsl printError
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($106) Set
;
;=========================================================================
_Set START
_Set name
PBexport equ 8
varC equ shellLoc+0
valC equ shellLoc+4
lda cmdNum
and #$40 ;If bit $40 then c strings
beq orca_1
lda pCount
cmp #3
beq orca_2
lda #4
jmp GSOSReturn
orca_2 anop
ldy #2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl gs2cstr
phx
pha
sta varC
stx varC+2
ldy #6 ;$
lda [pBlock],y ;$
pha ;$
ldy #4 ;$
lda [pBlock],y ;$
pha ;$
jsl gs2cstr
phx
pha
sta valC
stx valC+2
jsl setvar
pei (varC+2) ; set the export flag according
pei (varC)
ldy #PBexport ; to the new parm in Orca 2.0
lda [pBlock],y
pha
jsl exportvar
bra orca_com
orca_1 ldy #2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl p2cstr
phx
pha
sta varC
stx varC+2
ldy #6 ;$
lda [pBlock],y ;$
pha ;$
ldy #4 ;$
lda [pBlock],y ;$
pha ;$
jsl p2cstr
phx
pha
sta valC
stx valC+2
jsl setvar
orca_com pei (varC+2)
pei (varC)
jsl ~NDISPOSE
pei (valC+2)
pei (valC)
jsl ~NDISPOSE
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($107) Version
;
;=========================================================================
_Version START
_Version name
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #1
beq orca_1
lda #4
jmp GSOSReturn
orca_1 ldy #2
lda #$2020
sta [pBlock],y
lda #$3032 ;version (3031 = 1.0) (3032 = 2.0)
sta [pBlock]
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($108) Read_Indexed
;
;=========================================================================
_Read_Indexed START
_Read_Indexed name
var_name equ 0
value equ 4
index equ 8
PBexport equ $A
var equ shellLoc+0
vn_tmp equ shellLoc+4
ldy #index ;$
lda [pBlock],y ;$
pha ;$
jsl indexvar
stx var+2
sta var
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #4
beq orca_2
lda #4
jmp GSOSReturn
orca_2 anop
ldy #2
lda var
ora var+2
bne orca21
jmp nomore
orca21 anop
ldy #12 ; copy the export flag
lda [var],y ; to the parameter block
ldy #PBexport
sta [pBlock],y
ldy #4+2
lda [var],y
pha
dey2
lda [var],y
pha
ldy #var_name+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl copyc2res
ldy #8+2
lda [var],y
pha
dey2
lda [var],y
pha
ldy #value+2 ;$
lda [pBlock],y ;$
pha ;$
ldy #value ;$
lda [pBlock],y ;$
pha ;$
jsl copyc2res
lda #0
jmp GSOSReturn
orca_1 anop
ldy #0
lda var
ora var+2
beq nomore
ldy #4+2
lda [var],y
pha
dey2
lda [var],y
pha
ldy #var_name+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl c2pstr
ldy #8+2
lda [var],y
pha
dey2
lda [var],y
pha
ldy #value+2 ;$
lda [pBlock],y ;$
pha ;$
ldy #value ;$
lda [pBlock],y ;$
pha ;$
jsl c2pstr
lda #0
jmp GSOSReturn
nomore phy
ldy #var_name+2 ;$
lda [pBlock],y ;$
sta vn_tmp+2 ;$
lda [pBlock] ;$
sta vn_tmp ;$
ldy #value+2
lda [pBlock],y
sta var+2
ldy #value
lda [pBlock],y
sta var
ply
lda #0
sta [vn_tmp],y
sta [var],y
jmp GSOSReturn
END
;=========================================================================
;
; ($109) Init_Wildcard
;
;=========================================================================
_Init_Wildcard START
_Init_Wildcard name
using globals
using KernelStruct
wildcard equ 0
iw_flags equ 4 ;I'm ignoring the flags (no prompting)
tbl equ shellLoc
ptr equ shellLoc+4
w_file equ shellLoc+8
w_dirpath equ shellLoc+12
w_pfx equ shellLoc+16
; DebugStr #debug
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #2
beq orca_2
lda #4
jmp GSOSReturn
orca_2 anop
ldy #wildcard+2
lda [pBlock],y
sta w_file+2
lda [pBlock]
sta w_file
lda [w_file]
inc a
inc a ; add two to get length of ds
pea 0
pha ; make a copy of the gs string
jsl ~NEW
pei (w_file+2)
pei (w_file)
stx w_file+2
sta w_file
phx
pha
jsl copygsstr
bra common
orca_1 anop
ldy #wildcard+2
lda [pBlock],y
sta w_file+2
pha ; push addr of p string for
lda [pBlock]
sta w_file
pha ; use later (by copy)
pea 0
lda [w_file] ; get length
and #$ff
inc a
inc a ; add two to get length of gs string
pha
jsl ~NEW
stx w_file+2
sta w_file
phx
pha
jsl copyp2gs ; convert to a GS string
common anop
stz WC_PathBuf
stz WC_Patt
lda [w_file]
; and #$FF
jeq done
;
; Find last separator and separate the file pattern from the path
;
tay
iny
strippat lda [w_file],y
and #$FF
cmp #':'
beq gotpat
cmp #'/'
beq gotpat
dey
cpy #1
bne strippat
;
; No path, so grab the current prefix
;
; Copy the pointer to prefix 0 straight out of the process structure
phy
ldx curProcInd
lda prefixh,x
sta w_pfx
lda prefixh+2,x
sta w_pfx+2
ldy #4
lda [w_pfx],y
sta WC_PathPtr
sta w_dirpath
ldy #6
lda [w_pfx],y
sta WC_PathPtr+2
sta w_dirpath+2
ply
bra gotpat2
;
; Copy the path and pattern
;
gotpat ld4 WC_PathBuf,(WC_PathPtr,w_dirpath)
gotpat2 sty tmp
ldx #0
iny
lda [w_file]
beq copiedpat
inc a ; +1, because y is postindexed
sta chk+1
short m
copypat anop
lda [w_file],y
cmp #'='
bne putpat
lda #'*'
putpat sta WC_Patt,x
inx
iny
chk cpy #0
bcc copypat
beq copypat
copiedpat lda #0
sta WC_Patt,x
ldx tmp
dex ; argh! this is nasty!
beq copiedpath
ldy #2
copypath lda [w_file],y
sta WC_PathBuf,y
iny
dex
bne copypath
copiedpath dey
dey
sty WC_PathBuf
long ai
;
; Expand the device
;
; lda tmp ;skip this
; beq fixGSOS
; ExpandDevices ExpParm
; jcs err
;fixGSOS lda WC_PathBuf
; xba
; sta WC_PathBuf
Open WC_OpenParms
jcs err
mv2 WC_OpenRef,(GDERef,CloseRef)
stz GDEbase
stz GDEdisp
ld2 6,GDEParm
GetDirEntry GDEParm
jcs err
pea 0
lda GDEentry
inc a
asl2 a
pha
jsl ~NEW
sta tbl
stx tbl+2
stz tbloff ; initialize offset to zero
ldx GDEentry
bne itsAlright
jmp nofiles ; there are no files in this directory!
itsAlright ldy #0
tya
clrtbl sta [tbl],y
iny2
sta [tbl],y
iny2
dex
bne clrtbl
ld2 5,GDEParm
ld2 1,(GDEbase,GDEdisp)
searchloop GetDirEntry GDEParm
jcs GDEerr
ldy buf
lda #0
sta buf+2,y
; WriteCString #buf+2
; WriteChar #13
; WriteChar #10
; WriteCString #WC_Patt
; WriteChar #13
; WriteChar #10
ph4 #WC_Patt
ph4 #buf+2
ph2 #0 ; case insensitive
jsl RegExp
cmp #0
beq searchloop
; WriteChar #10
* allocate space for the file/pathname. If bit 0 of flags is set, only
* use the filename, otherwise include the whole pathname.
ldy #iw_flags
lda [pBlock],y
and #1
bne fnameonly
pea 0
lda buf
inc a
inc a
clc
adc [w_dirpath] ; pointer to directory entry
pha
jsl ~NEW
sta ptr
stx ptr+2
ph4 WC_PathPtr
ph4 ptr
jsl copygsstr
ph4 #buf
ph4 ptr
jsl gsstrcat
bra commonptr
fnameonly pea 0
lda buf
inc a
inc a
pha
jsl ~NEW
sta ptr
stx ptr+2
ph4 #buf
ph4 ptr
jsl copygsstr
commonptr ldy tbloff
lda ptr
sta [tbl],y
iny2
lda ptr+2
sta [tbl],y
iny2
sty tbloff
jmp searchloop
GDEerr cmp #$61 ;End of directory?
bne err
nofiles ldy tbloff
lda #0
sta [tbl],y
iny2
sta [tbl],y
Close CloseParm
;
; do we need to delete the old table
;
lda truepid
asl2 a
tax
lda WCtbl,x
ora WCtbl+2,x
beq settbl
;
; delete old table
;
lda WCtbl,x
sta ptr
lda WCtbl+2,x
sta ptr+2
ldy #0
clrit lda [ptr],y
tax
iny2
lda [ptr],y
iny2
cmp #0
bne disp
cpx #0
beq nodisp
disp phy
pha
phx
jsl ~NDISPOSE
ply
bra clrit
nodisp pei (ptr+2)
pei (ptr)
jsl ~NDISPOSE
settbl lda truepid
asl a
tax
asl a
tay
lda #0
sta WCidx,x
lda tbl
sta WCtbl,y
lda tbl+2
sta WCtbl+2,y
done lda #0
err pha
pei (w_file+2)
pei (w_file)
jsl ~NDISPOSE
pla
jmp GSOSReturn
tmp ds 2
tbloff ds 2
CloseParm dc i'1'
CloseRef ds 2
GDEParm dc i'6'
GDERef ds 2
ds 2
GDEbase dc i'1'
GDEdisp dc i'1'
dc a4'GDBuf'
GDEentry ds 2
GDBuf dc i'67'
buf ds 65
WC_PathBuf ds 129
WC_Patt ds 40
WC_OpenParms dc i'2'
WC_OpenRef ds 2
WC_PathPtr ds 4
;debug str 'init_wilcard'
END
globals DATA
WCidx dc 32i2'0'
WCtbl dc 32i4'0'
END
;=========================================================================
;
; ($10A) Next_Wildcard
;
;=========================================================================
_Next_Wildcard START
_Next_Wildcard name
using globals
using KernelStruct
PBnextfile equ 0
tbl equ shellLoc
ptr equ shellLoc+4
nextfile equ shellLoc+8
ldy #PBnextfile+2 ;$
lda [pBlock],y ;$
sta nextfile+2 ;$
lda [pBlock] ;$
sta nextfile ;$
lda truepid
asl a
tay
asl a
tax
lda WCtbl,x
sta tbl
lda WCtbl+2,x
sta tbl+2
ora tbl
bne alloced
jmp erruer
alloced tyx
lda WCidx,x
tay
lda [tbl],y
iny2
ora [tbl],y
bne stillmore
jmp erruer
stillmore anop
iny2
tya
sta WCidx,x
dey2
dey2
lda [tbl],y
sta ptr
iny2
lda [tbl],y
sta ptr+2
* insert nextfile/nextfileGS check here
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #13
bcs badpcount
cmp #0
bne orca_2
badpcount lda #4
jmp GSOSReturn
orca_2 anop
ph4 ptr
ph4 nextfile
jsl copygs2res
lda ptr
ldy #PBnextfile
sta [pBlock],y
lda ptr+2
ldy #PBnextfile+2
sta [pBlock],y
lda pCount
cmp #1
bne doGFI
lda #0
bra doneNW
doGFI lda pBlock
sec
sbc #2
tax
lda pBlock+2
sbc #0
pha
phx
pea $2006 ; GetFileInfoGS
jsl $E100B0 ; GS/OS stack entry point
doneNW pha
lda nextfile
ldy #PBnextfile
sta [pBlock],y
lda nextfile+2
ldy #PBnextfile+2
sta [pBlock],y
pla
jmp GSOSReturn
* Copy the GSString to a PString in the form required by Next_Wildcard
* (the old P16 version), converting :'s to /'s along the way
orca_1 lda [ptr] ; copy a GS string
sta [nextfile] ; to the P-string output buffer
tay
iny
short a
copy lda [ptr],y
dey
cmp #':'
bne nocolon
lda #'/'
nocolon sta [nextfile],y
cpy #1
bne copy
long a
lda #0
jmp GSOSReturn
erruer anop
lda cmdNum
and #$40
beq orca_1a
ldy #2
lda #0
sta [nextfile],y
jmp GSOSReturn
orca_1a lda #0
short m
sta [nextfile]
long m
jmp GSOSReturn
END
;=========================================================================
;
; ($10B) Read_Variable
;
;=========================================================================
_Read_Variable START
_Read_Variable name
PBvar_name equ 0
PBvalue equ 4
PBexport equ 8
var_name equ shellLoc+0
value equ shellLoc+4
var equ shellLoc+8
lda cmdNum
and #$40 ;If bit $40 then c strings
beq orca_1
lda pCount
cmp #3
beq orca_2
lda #4
jmp GSOSReturn
orca_2 anop
ldy #PBvar_name+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl gs2cstr
phx
pha
phx
pha
jsl readvarrec
sta var
stx var+2
jsl ~NDISPOSE ; get rid of the temp C string
ldy #PBvalue+2 ;$
lda [pBlock],y ;$
sta value+2 ;$
ldy #PBvalue ;$
lda [pBlock],y ;$
sta value ;$
lda var
ora var+2
beq novar2
ldy #8
lda [var],y
sta var_name
ldy #10
lda [var],y
sta var_name+2
pei (var_name+2)
pei (var_name)
ph4 value
jsl copyc2res
ldy #12
lda [var],y
ldy #PBexport
sta [pBlock],y
lda #0
jmp GSOSReturn
novar2 anop
ldy #2
lda #0
sta [value],y
jmp GSOSReturn
orca_1 anop
; pei (var_name+2)
; pei (var_name)
ldy #PBvalue+2 ;$
lda [pBlock],y ;$
sta value+2 ;$
ldy #PBvalue ;$
lda [pBlock],y ;$
sta value ;$
ldy #PBvar_name+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl p2cstr
phx
pha
phx
pha
jsl readvar
sta var_name
stx var_name+2
jsl ~NDISPOSE
lda var_name
ora var_name+2
beq novar
pei (var_name+2)
pei (var_name)
pei (value+2)
pei (value)
jsl c2pstr
lda #0
jmp GSOSReturn
novar anop
lda #0
sta [value]
jmp GSOSReturn
END
;=========================================================================
;
; ($10D) Execute
;
;=========================================================================
_Execute START
_Execute name
using KernelStruct
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #2
beq orca_1
lda #4
jmp GSOSReturn
orca_1 jsl decBusy
; jsr decMutex
ldx curProcInd
lda executeHook,x
ora executeHook+2,x
bne validHook
lda #26
jsl incBusy
; jsr incMutex
jmp GSOSReturn
validHook anop
lda [pBlock]
bne nonewvar
PushVariables 0
nonewvar ldy #4
lda [pBlock],y
pha
dey2
lda [pBlock],y
pha
push3 #returnadr-1
ldx curProcInd
lda executeHook+2,x
short m
pha
long m
lda executeHook,x
dec a
pha
rtl ; jump to the routine
returnadr anop
pha
lda [pBlock]
bne nokillvar
PopVariables 0
nokillvar anop
jsl incBusy
pla
jmp GSOSReturn
END
;=========================================================================
;
; ($10E) FastFile
;
;=========================================================================
; fastfile.c does all the work
_FastFile START
_FastFile name
ph2 pCount
lda cmdNum
and #$40
pha ; osFlag (0 = P16, !0 = GSOS)
ph4 pBlock ; pointer to pBlock
jsl fastEntry ; har!
jmp GSOSReturn
END
;=========================================================================
;
; ($10F) Direction
;
;=========================================================================
_Direction START
_Direction name
using KernelStruct
using TextToolsInfo
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #2
beq orca_1
lda #4
jmp GSOSReturn
* redirection mapping
* 0,1 = none 0
* unless xxSlot != kernelStruct.ttyID, which is 1 (.printer)
* 2 = none 0 (no Orca-based redirection)
* 3 = disk 2
* 4 = pipe 2
* any others are 1 (generalized communication)
orca_1 lda [pBlock]
cmp #3
bcc noerr
lda #$53
jmp GSOSReturn ; Parameter out of range
noerr anop
lda truepid
asl a
asl a
asl a
asl a
asl a
asl a
pha
lda [pBlock]
asl a
clc
adc 1,s
tax
lda InDeviceType,x
cmp #2
bcc Rconsole
beq Rram
cmp #3
beq Rdisk
cmp #4
beq Rdisk
Rcomm ldy #2
lda #1
sta [pBlock],y
pla
lda #0
jmp GSOSReturn
Rram ldy #2
lda #0
sta [pBlock],y
pla
lda #0
jmp GSOSReturn
Rdisk ldy #2
lda #2
sta [pBlock],y
pla
lda #0
jmp GSOSReturn
Rconsole lda [pBlock]
asl a
asl a
clc
adc 1,s
tax
lda InSlot,x
ldx curProcInd
cmp ttyID,x
beq Rram ; no redirection
bra Rcomm
END
;=========================================================================
;
; ($110) Redirect
;
;=========================================================================
_Redirect START
_Redirect name
using KernelStruct
using TextToolsInfo
PBdevice equ 0
PBappend equ 2
PBfile equ 4
file equ shellLoc+0
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #3
beq orca_2
lda #4
jmp GSOSReturn
orca_2 ldy #PBfile+2
lda [pBlock],y
sta CRpathname+2
ldy #PBfile
lda [pBlock],y
sta CRpathname
mv4 CRpathname,(OPENpathname,destPathname)
bra redirectCom
orca_1 ldy #PBfile+2 ;$
lda [pBlock],y ;$
sta file+2 ;$
ldy #PBfile ;$
lda [pBlock],y ;$
sta file ;$
lda [file]
and #$00ff
cmp #65
bcc strokay
lda #$0053 ; oops- decimal error #s are boo-boo
jmp GSOSReturn
strokay ph4 file ; convert thingy to a GS string
ph4 #gspath+1
jsl copypstr
lda gspath+1
and #$00FF
sta gspath
ld4 gspath,(CRpathname,OPENpathname,destPathname)
redirectCom anop
; lda device
lda [pBlock] ;$
beq doOpen
; lda append
ldy #PBappend
lda [pBlock],y ;$
bne doOpen
doCreate anop
Create CRparm
bcc doOpen
cmp #$47 ; duplicate pathname?
beq delFile
cmp #$58
beq doOpen ; not a block device- Char device
jmp GSOSReturn
delFile Destroy destParm
bcc doCreate
jmp GSOSReturn
doOpen anop
ldx #1 ;$
; lda device
lda [pBlock] ;$
beq storeAccess
ldx #2 ;$
storeAccess stx OPENreqAccess ;$
lda [pBlock] ; get 'device' parameter
inc a ; I/O channel before we open
sta CLOSEparm+2
Close CLOSEparm ; the new one.
bcs openError1
Open OPENParm
bcc okay
openError1 jmp GSOSReturn ; error if >> on nonexistent file
okay anop
; lda append ; move mark to eof?
ldy #PBappend ;$ move mark to eof?
lda [pBlock],y ;$
beq noAppend
lda OPENrefNum
sta EOFref
sta MARKref
GetEOF EOFpb
bcs nonOkey
movelong EOFeof,MARKdisp
SetMark MARKpb
bcs nonOkey
bra noAppend
EOFpb dc i2'2'
EOFref dc i2'0'
EOFeof dc i4'0'
MARKpb dc i2'3'
MARKref dc i2'0'
MARKbase dc i2'0'
MARKdisp dc i4'0'
noAppend anop
pea $3 ; file redirection
pea $0
ph2 OPENrefNum
lda #$0F
clc
; adc device
adc [pBlock] ;$
xba
ora #$0C
tax
jsl $E10000 ; make the tool call
lda #0
nonOkey jmp GSOSReturn
gspath ds 66
CRparm dc i2'4'
CRpathname dc i4'gspath'
dc i2'$C3'
dc i2'$04'
dc i4'0'
destParm dc i2'1'
destPathname dc i4'gspath'
OPENParm dc i2'3'
OPENrefNum dc i2'0'
OPENpathname dc i4'gspath'
OPENreqAccess dc i2'0'
CLOSEparm dc i2'1'
dc i2'0'
END
;=========================================================================
;
; ($113) Stop
;
;=========================================================================
_Stop START
_Stop name
using KernelStruct
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #1
beq orca_1
lda #4
jmp GSOSReturn
orca_1 lda >truepid
asl a
tax
lda StopFlags,x
sta [pBlock]
jmp GSOSReturn
StopFlags ENTRY
dc 32i2'0'
END
;=========================================================================
;
; ($114) ExpandDevices
;
;=========================================================================
_ExpandDevices START
_ExpandDevices name
PBpathname equ 0
PBoutname equ 4
pathname equ shellLoc+0
lda cmdNum
and #$40
beq orca_1
ldy #PBpathname+2
lda [pBlock],y
sta inputPath+2
lda [pBlock]
sta inputPath
ldy #PBoutname+2
lda [pBlock],y
sta outputPath+2
ldy #PBoutname
lda [pBlock],y
sta outputPath
ExpandPath epParm
jmp GSOSReturn
orca_1 anop
ldy #PBpathname+2 ;$
lda [pBlock],y ;$
sta pathname+2 ;$
lda [pBlock] ;$
sta pathname ;$
lda [pathname]
and #$00FF
tay
sta inputbuf
beq nocopy1
short m
loop1 lda [pathname],y
sta inputbuf+1,y
dey
bne loop1
nocopy1 long m
ld4 inputbuf,inputPath
ld4 outputbuf,outputPath
ExpandPath epParm
bcs error
lda outputbuf+2
and #$00ff
tay
sta [pathname]
beq nocopy2
short a
loop2 lda outputbuf+3,y
sta [pathname],y
dey
bne loop2
nocopy2 long a
lda #0
error anop
jmp GSOSReturn
epParm anop
dc i2'3'
inputPath dc i4'inputbuf'
outputPath dc i4'outputbuf'
ed_flags dc i2'0'
inputbuf ds 66
outputbuf dc i2'68'
ds 66
END
;=========================================================================
;
; ($115) UnsetVariable
;
;=========================================================================
_UnsetVariable START
_UnsetVariable name
PBname equ 0
name equ shellLoc+0
lda cmdNum
and #$40
beq orca_1
orca_2 anop
ldy #PBname+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl gs2cstr
sta name
stx name+2
bra orca_com
orca_1 anop
ldy #PBname+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl p2cstr
sta name
stx name+2
orca_com anop
pei (name+2)
pei (name)
jsl unsetvar
pei (name+2)
pei (name)
jsl ~NDISPOSE
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($116) Export
;
;=========================================================================
_Export START
_Export name
PBname equ 0
PBflags equ 4
name equ shellLoc+0
lda cmdNum
and #$40 ;If bit $40 then c strings
beq orca_1
lda pCount
cmp #2
beq orca_2
lda #4
jmp GSOSReturn
orca_2 anop
ldy #PBname+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl gs2cstr
sta name
stx name+2
bra orca_com
orca_1 anop
; pei (name+2)
; pei (name)
ldy #PBname+2 ;$
lda [pBlock],y ;$
pha ;$
lda [pBlock] ;$
pha ;$
jsl p2cstr
sta name
stx name+2
orca_com anop
pei (name+2)
pei (name)
; pei (flags)
ldy #PBflags ;$
lda [pBlock],y ;$
pha ;$
jsl exportvar
pei (name+2)
pei (name)
jsl ~NDISPOSE
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($117) PopVariables
;
;=========================================================================
_PopVariables START
_PopVariables name
using KernelStruct
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #0
beq orca_1
lda #4
jmp GSOSReturn
orca_1 lda truepid
jsl popvartbl
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($118) PushVariables
;
;=========================================================================
_PushVariables START
_PushVariables name
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #0
beq orca_1
lda #4
jmp GSOSReturn
orca_1 jsl initvar
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($119) SetStopFlag
;
;=========================================================================
_SetStopFlag START
_SetStopFlag name
using KernelStruct
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #1
beq orca_1
lda #4
jmp GSOSReturn
orca_1 lda >truepid
asl a
tax
lda [pBlock]
sta StopFlags,x
jmp GSOSReturn
END
;=========================================================================
;
; ($11A) ConsoleOut
;
;=========================================================================
; does nothing if process is in the background (1/21/93 jb)
_ConsoleOut START
_ConsoleOut name
using KernelStruct
char equ 0
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #1
beq orca_1
lda #4
jmp GSOSReturn
orca_1 anop
jsr isBGProcess
bcs goaway
* Instead of calling the console's COUT, call down to the character device
* dispatcher with a write request.
jsl decBusy
pea 1
ph4 pBlock
ldx curProcInd
lda ttyID,x
; dec a don't need this since this is the actual
pha
jsl ttwrite value
jsl incBusy
goaway lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($11E) KeyPress
; New ORCA/Shell (2.0.1) call to see if input is pending, and if so
; what the input is.
; This routine is the compromise Mike W. and I worked out regarding
; directly accessing the keyboard from his compilers.
;
;=========================================================================
; Due to the fact that there's no way to 'unget' a character from
; a tty and that the only way to get the data this call wants is to
; read it via ioctl(FIONREAD) & read (which removes the char, making
; a subsequent _KeyRead work improperly), we have to peek at the
; console's input buffer directly to get our data. This is really icky,
; but we have sufficient checks to prevent the routine from snagging
; a foreground process' input.
_KeyPress START
_KeyPress name
using ADBData
using KernelStruct
key equ 0 key & mod. reg of keypress. Not valid
modifiers equ 2 if available == 0
available equ 4 == 1 if key avail, == 0 if not
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #3
beq orca_1
lda #4
jmp GSOSReturn
orca_1 anop
ldx curProcInd
lda ttyID,x
cmp #3 ; is controlling tty the console?
bne goaway ; leave w/o doing anything
jsr isBGProcess
bcs goaway ; ignore progs in the bg
php
sei ; temporarily shut off interrupts
lda >head ; if head == tail then there
cmp >tail ; is no data in the input buffer
beq noKeyWaiting
lda >tail ; get the character & modifiers
tax ; from the buffer, indexed by
lda keybuf,x
and #$00FF ; tail.
ldy #key ; store them in the parameter
sta [pBlock],y ; block after masking unneeded
lda modbuf,x ; portions out
and #$00FF
jsl ConvKMR2EM
ldy #modifiers
sta [pBlock],y
lda #1
ldy #available
sta [pBlock],y
plp ; restore interrupts
lda #0
jmp GSOSReturn
noKeyWaiting plp
goaway lda #0
ldy #available
sta [pBlock],y
lda #0
jmp GSOSReturn
END
;=========================================================================
;
; ($11F) ReadKey
; New ORCA/Shell (2.0.1) call to wait for an input character and
; return the key and modifiers in Event Manager format.
;
;=========================================================================
; ReadKey does a number of checks to maintain sanity. Currently, if the
; caller is in the BG no action occurs. If the process' controlling TTY
; is not the console, we do a ReadChar to get pause keys, at least (we
; can't get modifiers from a serial port!). If the tty is the console,
; we make a direct (fast) call to KEYIN in inout.asm
_ReadKey START
_ReadKey name
using KernelStruct
key equ 0 key & mod. reg of keypress. Not valid
modifiers equ 2 if available == 0
lda cmdNum
and #$40
beq orca_1
lda pCount
cmp #2 ; check the pCount
beq orca_1
lda #4
jmp GSOSReturn
orca_1 anop
jsr isBGProcess
bcs isbg
ldx curProcInd
lda ttyID,x
* cmp #3
* beq isConsole ; it's the console
pha ; do something sensible for non-console
pea 0
ldx #$220C ; TextTools/ReadChar
jsl $E10000
pla
and #$00FF
bra setKey
*isConsole anop
; phd
; lda InOutDP
; tcd
* jsl KEYIN
; pld
setKey pha
and #$00FF
ldy #key
sta [pBlock],y
pla
xba
and #$00FF
jsl ConvKMR2EM
ldy #modifiers
sta [pBlock],y
lda #0
jmp GSOSReturn
* We eventually might want to go ahead and suspend the background
* process for trying to read; this could be useful if some dork
* ever writes a program that uses these routines for input (God help
* us).
isbg lda #0
ldy #key
sta [pBlock],y
ldy #modifiers
sta [pBlock],y
* Convert the keyboard modifier reg. format to the Event Manager modifiers
* format.
ConvKMR2EM ENTRY
tay ; store the old value
ldx #0 ; initial modifier value
bit #%10000000 ; open apple?
beq x1
txa
ora #%0000000100000000
tax
x1 tya
bit #%01000000
beq x2
txa
ora #%0000100000000000
tax
x2 tya
bit #%00010000
beq x3
txa
ora #%0010000000000000
tax
x3 tya
bit #%00000100
beq x4
txa
ora #%0000010000000000
tax
x4 tya
bit #%00000010
beq x5
txa
ora #%0001000000000000
tax
x5 tya
bit #%00000001
beq xdone
txa
ora #%0000001000000000
tax
xdone txa
rtl
isBGProcess ENTRY
ldx curProcInd
lda ttyID,x
asl a
tax
lda ttyStruct,x
beq nopgrp
ldx curProcInd
cmp pgrp,x
beq nopgrp ; it's the foreground process
sec
rts
nopgrp clc
rts
END
Reference in New Issue View Git Blame Copy Permalink