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

Initial commit of GNO kernel and drivers

This commit is contained in:
taubert 1998-02-02 08:20:59 +00:00
parent 1d35e22c64
commit 3036f145f1
83 changed files with 37496 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
kern/drivers/Makefile Normal file
View File

@ -0,0 +1,35 @@
# $Id: Makefile,v 1.1 1998/02/02 08:17:50 taubert Exp $
.INCLUDE: /src/gno/paths.mk
all: modem printer null
modem: port.o msccf.o
$(LD) $(LDFLAGS) -l libsim -o $@ $<
chtyp -t 187 -a 32257 $@
modem: libsim
printer: port.o psccf.o
$(LD) $(LDFLAGS) -l libsim -o $@ $<
chtyp -t 187 -a 32257 $@
printer: libsim
null: null.o
$(LD) $(LDFLAGS) -o $@ $<
chtyp -t 187 -a 32257 $@
console: console.o inout.o box.root conpatch.o
$(LD) $(LDFLAGS) -o $@ $<
chtyp -t 187 -a 32257 $@
### Dependencies ###
box.root: box.mac console.equates
conpatch.asm: conpatch.mac
console.root: port.mac console.equates kern.equates ../gno/inc/tty.inc
inout.root: inout.mac console.equates kern.equates ../gno/inc/tty.inc
msccf.root: sccf.mac equates md.equates sccf.asm ../gno/inc/tty.inc
null.root: port.mac ../gno/inc/tty.inc
port.root: port.mac equates ../gno/inc/tty.inc
psccf.root: sccf.mac equates pr.equates sccf.asm ../gno/inc/tty.inc

73
kern/drivers/box.asm Normal file
View File

@ -0,0 +1,73 @@
* $Id: box.asm,v 1.1 1998/02/02 08:17:52 taubert Exp $
**************************************************************************
*
* The GNO Shell Project
*
* Developed by:
* Jawaid Bazyar
* Tim Meekins
* Derek Taubert
*
**************************************************************************
*
* BOX.ASM
* By Jawaid Bazyar
*
* Contains routines for drawing boxes using MouseText
*
**************************************************************************
case on
mcopy ../drivers/box.mac
copy ../drivers/console.equates
* EraseBox takes the same parameters as DrawBox, except the Accum
* is the character to fill the box with.
EraseBox START
sta EraseChar
lda <IODP_CV ; save cursor location
pha
lda <IODP_CH
pha
lda <IODP_TopMar
sta CurCV
lda <IODP_RightMar
sec
sbc <IODP_LeftMar
ina
sta TempWidth
VLoop lda CurCV
sta <IODP_CV
jsr VTAB
lda <IODP_LeftMar
sta <IODP_CH
HLoop lda EraseChar
ora #$80
ldy <IODP_CH
jsr StorChar
iny
sty <IODP_CH
cpy <IODP_RightMar
beq HLoop
bcc HLoop
inc CurCV
lda CurCV
cmp <IODP_BotMar
beq VLoop
bcc VLoop
pla
sta <IODP_CH
pla
sta <IODP_CV
jsr VTAB ;restore cursor location
rts
EraseChar dc i2'0'
TempWidth dc i2'0'
CurCV dc i2'0'
END

115
kern/drivers/box.mac Normal file
View File

@ -0,0 +1,115 @@
MACRO
&lab _NewHandle
&lab ldx #$0902
jsl $E10000
MEND
MACRO
&lab _DisposeHandle
&lab ldx #$1002
jsl $E10000
MEND
MACRO
&lab pulllong &addr1,&addr2
&lab ANOP
AIF C:&addr1=0,.a
AIF C:&addr2=0,.b
LCLC &C
&C AMID &addr1,1,1
AIF "&C"="[",.zeropage
pullword &addr1
sta &addr2
pullword &addr1+2
sta &addr2+2
MEXIT
.a
pullword
pullword
MEXIT
.b
pullword &addr1
pullword &addr1+2
MEXIT
.zeropage
ldy #&addr2
pullword &addr1,y
ldy #&addr2+2
pullword &addr1,y
MEND
MACRO
&lab pullword &SYSOPR
&lab ANOP
pla
AIF c:&SYSOPR=0,.end
sta &SYSOPR
.end
MEND
MACRO
&lab pushlong &addr,&offset
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
AIF "&C"="#",.immediate
AIF "&C"="[",.zeropage
AIF C:&offset=0,.nooffset
AIF "&offset"="s",.stack
pushword &addr+2,&offset
pushword &addr,&offset
MEXIT
.nooffset
pushword &addr+2
pushword &addr
MEXIT
.immediate
&REST AMID &addr,2,L:&addr-1
dc I1'$F4',I2'(&REST)|-16'
dc I1'$F4',I2'&REST'
MEXIT
.stack
pushword &addr+2,s
pushword &addr+2,s
MEXIT
.zeropage
ldy #&offset+2
pushword &addr,y
ldy #&offset
pushword &addr,y
MEND
MACRO
&lab pushword &SYSOPR
&lab ANOP
AIF c:&SYSOPR=0,.b
LCLC &C
&C AMID "&SYSOPR",1,1
AIF ("&C"="#").AND.(S:LONGA),.immediate
lda &SYSOPR
pha
MEXIT
.b
pha
MEXIT
.immediate
LCLC &REST
LCLA &BL
&BL ASEARCH "&SYSOPR"," ",1
AIF &BL>0,.a
&BL SETA L:&SYSOPR+1
.a
&REST AMID "&SYSOPR",2,&BL-2
dc I1'$F4',I2'&REST'
MEND
MACRO
&lab _SysFailMgr
&lab ldx #$1503
jsl $E10000
MEND
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

81
kern/drivers/conpatch.asm Normal file
View File

@ -0,0 +1,81 @@
* $Id: conpatch.asm,v 1.1 1998/02/02 08:17:53 taubert Exp $
case on
mcopy ../drivers/conpatch.mac
PatchDeskManager START
phd
pha
pha
pea $0000 ; system tool set
pea $0005 ; Desk Manager
_GetTSPtr
tsc
tcd
ldy #$002d ; ($b * 4) + 1
lda [$1],y
sta >CONOLDSAVEALL+1
dey
lda [$1],y
inc A
sta >CONOLDSAVEALL
iny
lda #>ConSaveAllPatch ; -1
sta [$1],y
dey
lda #ConSaveAllPatch-1
sta [$1],y
ldy #$0031 ; ($c * 4) + 1
lda [$1],y
sta >CONOLDRESTALL+1
dey
lda [$1],y
inc A
sta >CONOLDRESTALL
iny
lda #>ConRestAllPatch ; -1
sta [$1],y
dey
lda #ConRestAllPatch-1
sta [$1],y
pla
pla
pld
rtl
END
UnpatchDeskManager START
phd
pha
pha
pea $0000 ; system tool set
pea $0005 ; Desk Manager
_GetTSPtr
tsc
tcd
ldy #$002d ; ($b * 4) + 1
lda >CONOLDSAVEALL+1
sta [$1],y
dey
lda >CONOLDSAVEALL
dec A
sta [$1],y
ldy #$0031 ; ($c * 4) + 1
lda >CONOLDRESTALL+1
sta [$1],y
dey
lda >CONOLDRESTALL
dec A
sta [$1],y
pla
pla
pld
rtl
END

6
kern/drivers/conpatch.mac Normal file
View File

@ -0,0 +1,6 @@
MACRO
&lab _GetTSPtr
&lab ldx #$0901
jsl $E10000
MEND

505
kern/drivers/console.asm Normal file
View File

@ -0,0 +1,505 @@
* $Id: console.asm,v 1.1 1998/02/02 08:17:54 taubert Exp $
************************************************************
*
* CONSOLE device driver
*
************************************************************
case on
mcopy ../drivers/port.mac
copy ../gno/inc/tty.inc
copy ../drivers/console.equates
copy ../drivers/kern.equates
**************************************************************************
consoleSem gequ $3C ; output code semaphore
ConsoleHeader START
contty ENTRY
ds t_open
* Line Discipline entry points
dc i4'ConInit'
dc i4'ConDeInit'
dc i4'ConIOCTL'
dc i4'0' ; ttread and ttwrite must be
dc i4'0' ; set up by InstallDriver
dc i4'CON_mutex'
dc i4'CON_demutex'
dc i4'CON_out_enq'
dc i4'CON_in_enq'
dc i4'CON_out_deq'
dc i4'CON_in_deq'
dc i4'CON_size_inq'
dc i4'CON_size_outq'
ds t_signalIO-editInd
dc i4'CON_signalIO'
dc i2'$FFFF' ; noone selecting
dc i4'CON_select'
dc i4'0' ; t_selwakeup set during install
END
CON_mutex START KERN2
CON_demutex ENTRY
CON_in_enq ENTRY
CON_out_deq ENTRY
rtl
END
CON_in_deq START KERN2
; using InOutData
; phd
; lda >InOutDP
; tcd
jsl KEYIN
; pld
rtl
END
CON_select START KERN2
res equ 0
subroutine (2:ttyn,2:which,2:pid),2
lda #1
sta res
lda which ; which I/O to check?
cmp #SEL_READ
bne trywrite
jsl CON_size_inq ; # bytes in in q
cmp #0
bne done
willwait anop
* record that the process wants to do I/O
lda >contty+t_select_proc ; see if someone's here already
cmp #$FFFF ; nope
beq nocollision
cmp pid ; is it us?
beq nocollision
lda >contty+privFlags
ora #TS_RCOLL
sta >contty+privFlags
bra none
nocollision anop
lda pid ; set select_proc field to
sta >contty+t_select_proc ; current process ID
bra none
trywrite cmp #SEL_WRITE
bne doexcept
bra done ; we can always write to console
doexcept anop ; there are no exceptions on console
none lda #0 ; no data, return 0
sta res
done anop
return 2:res
END
CON_size_inq START KERN2
using ADBData
php
sei
short m
lda >head
sec
sbc >tail
long m
and #$00FF
plp
rtl
END
CON_size_outq START KERN2
lda #0
rtl
END
CON_out_enq START KERN2
; using InOutData
; phd
; lda >InOutDP
; tcd
; lda 6,s
lda 4,s
jsl COUT
; pld
lda 2,s
sta 4,s
lda 1,s
sta 3,s
pla
rtl
END
* This function does nothing in the console driver
CON_signalIO START KERN2
lda 2,s
sta 4,s
lda 1,s
sta 3,s
pla
rtl
END
ConInit START
dTermioPtr equ 0
result equ 4
subroutine (2:devNum),6
ld4 contty,dTermioPtr
stz result
* Initialize default values for terminal settings
ldy #sg_flags
lda #CRMOD+ECHO
sta [dTermioPtr],y
short m
lda #0
sta [dTermioPtr] ; ispeed
ldy #sg_ospeed
sta [dTermioPtr],y ; ospeed
ldy #t_intrc
lda #'C'-64
sta [dTermioPtr],y ; t_intrc
ldy #t_suspc
lda #'Z'-64
sta [dTermioPtr],y
ldy #t_quitc
lda #'\'-64
sta [dTermioPtr],y
ldy #t_startc
lda #'Q'-64
sta [dTermioPtr],y
ldy #t_stopc
lda #'S'-64
sta [dTermioPtr],y
ldy #t_eofc
lda #'D'-64
sta [dTermioPtr],y
ldy #t_brkc
lda #-1
sta [dTermioPtr],y
ldy #t_dsuspc
lda #'Y'-64
sta [dTermioPtr],y
ldy #t_rprntc
lda #'R'-64
sta [dTermioPtr],y
ldy #sg_erase
lda #$7F
sta [dTermioPtr],y
long m
ldy #local
lda #LCRTERA+LCTLECH
sta [dTermioPtr],y
ldy #ws_row
lda #24
sta [dTermioPtr],y
ldy #ws_col
lda #80
sta [dTermioPtr],y
ldy #ws_xpixel
lda #0
sta [dTermioPtr],y
ldy #ws_ypixel
sta [dTermioPtr],y
return 2:result
END
ConDeInit START
subroutine (2:devNum),0
return
END
* Character translation & such is handled here, to keep it out
* of TextTool's silly assumptions. Fortunately, pipes donna have this
* prollem.
ConIOCTL START KERN2
using ADBData
using InOutData
retval equ 0
subroutine (4:tioc,4:dataPtr,2:devNum),2
lda tioc
and #$FF00
xba
cmp #'f'
beq chkfile
cmp #'t'
beq tioctl
err lda #-1
sta retval
jmp goaway
chkfile lda tioc
and #$7F
cmp #127
bne err
php
sei
short m
lda >head
sec
sbc >tail
long m
and #$00FF
* bpl okey
* eor #$FFFF
* inc a
*okey anop
sta [dataPtr]
plp
stz retval
jmp goaway
tioctl anop
lda tioc
and #$7F
cmp #25
bcc okay2
eor #$7F
cmp #26
bcc okay1
jmp invalid
okay1 anop
asl a
asl a
inc a
inc a
tax
jmp (tNTable,x)
okay2 anop
asl a
asl a
inc a
inc a
tax
jmp (tPTable,x)
goaway return 2:retval
tPTable anop
dc i2'0',a2'TIOCGETD'
dc i2'1',a2'TIOCSETD'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'8',a2'TIOCGETP'
dc i2'9',a2'TIOCSETP'
dc i2'10',a2'TIOCSETN'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'16',a2'TIOCFLUSH'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'19',a2'TIOCSETK'
dc i2'20',a2'TIOCGETK'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'23',a2'TIOCSVECT'
dc i2'24',a2'TIOCGVECT'
tNTable anop
dc i2'127',a2'invalid'
dc i2'126',a2'invalid'
dc i2'125',a2'invalid'
dc i2'124',a2'invalid'
dc i2'123',a2'invalid'
dc i2'122',a2'invalid'
dc i2'121',a2'invalid'
dc i2'120',a2'invalid'
dc i2'119',a2'invalid'
dc i2'118',a2'invalid'
dc i2'117',a2'invalid'
dc i2'116',a2'invalid'
dc i2'115',a2'TIOCOUTQ'
dc i2'114',a2'TIOCSTI'
dc i2'113',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'111',a2'TIOCSTOP'
dc i2'110',a2'TIOCSTART'
dc i2'109',a2'invalid'
dc i2'108',a2'invalid'
dc i2'107',a2'invalid'
dc i2'106',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'104',a2'invalid'
dc i2'103',a2'invalid'
invalid lda #-1
sta retval
jmp goaway
*****************************************************
dc i2'0',a2'TIOCGETD'
dc i2'1',a2'TIOCSETD'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'8',a2'TIOCGETP'
dc i2'9',a2'TIOCSETP'
dc i2'10',a2'TIOCSETN'
TIOCGETD anop
TIOCSETD anop
TIOCSETN anop
TIOCSETP anop
TIOCGETP stz retval
jmp goaway
TIOCGVECT anop
php
sei
lda >COUT+1
sta [dataPtr]
ldy #2
lda >COUT+3
and #$00FF
sta [dataPtr],y
ldy #4
lda >KEYIN+1
sta [dataPtr],y
ldy #6
lda >KEYIN+3
and #$00FF
sta [dataPtr],y
plp
stz retval
jmp goaway
TIOCSVECT anop
php
sei
lda [dataPtr]
sta >COUT+1
ldy #1
lda [dataPtr],y
sta >COUT+2
ldy #4
lda [dataPtr],y
sta >KEYIN+1
iny
lda [dataPtr],y
sta >KEYIN+2
plp
stz retval
jmp goaway
TIOCOUTQ lda #0
sta [dataPtr]
stz retval
jmp goaway
TIOCSTOP lda >OutStopped
bne isStopped
lda #1
sta >OutStopped
isStopped stz retval
jmp goaway
TIOCSTART lda >OutStopped
beq isStopped
lda #0
sta >OutStopped
bra isStopped
TIOCFLUSH php
sei
short m
lda >tail
sta >head
long m
plp
stz retval
jmp goaway
* simulate terminal input (this code is borrowed from INOUT.ASM/OurADB
TIOCSTI anop
php
sei
phd
lda >InOutDP
tcd
short m
lda >head
tax
lda [dataPtr]
sta >keybuf,x
ldy #1
lda [dataPtr],y
sta >modbuf,x
inx
txa
sta >head
; this chunk unblocks any process that was waiting on keyboard input
long ai
lda >blockCP
cmp #$FFFF
beq check4select
ldy #2
lda [IODP_procPtr],y
cmp #pBlocked ; is it still blocked?
bne done ; nope, leave it alone
lda #pReady
sta [IODP_procPtr],y ; restart the process
lda #$FFFF
sta >blockCP
; check for select here.
check4select lda >contty+t_select_proc
cmp #$FFFF
beq done
* someone is selecting on us, so call selwakeup with the process ID
* and our collision flag
pha
lda >contty+privFlags
and #TS_RCOLL
pha
jsl contty+t_selwakeup
lda >contty+privFlags
and #TS_RCOLL.EOR.$FFFF
sta >contty+privFlags
lda #$FFFF
sta >contty+t_select_proc
done anop
pld
plp
stz retval
jmp goaway
TIOCSETK anop
lda [dataPtr]
sta >keyMaps
stz retval
jmp goaway
TIOCGETK anop
lda >keyMaps
sta [dataPtr]
stz retval
jmp goaway
END

38
kern/drivers/console.equates Normal file
View File

@ -0,0 +1,38 @@
* $Id: console.equates,v 1.1 1998/02/02 08:18:11 taubert Exp $
*********************************************************************
*
* TEXT TOOL DP LOCATIONS
*
*********************************************************************
IODP_CH gequ $00
IODP_CV gequ $02
IODP_BASL gequ $04 ;thru $07
IODP_BASH gequ $05
IODP_InvFlag gequ $08
IODP_gInsertFlag gequ $0A ; insert or replace cursor?
IODP_LongTemp gequ $0C ; temporary dereferencing pointer
IODP_LongTemp2 gequ $10
IODP_BLTop gequ $14 ; Pointer to bottom of TOP block
IODP_BLBot gequ $16 ; Pointer to top of bottom block
IODP_TopLine gequ $18 ; Top line displayed on screen
IODP_CurLine gequ $1A ; line the cursor is on
IODP_CurCol gequ $1C ; column the cursor is in
IODP_LeftCol gequ $1E ; Leftmost column displayed (sideways scrolling)
IODP_BufBank gequ $20 ; Bank number of 64K memory buffer
IODP_LeftMar gequ $22
IODP_RightMar gequ $24
IODP_TopMar gequ $26
IODP_BotMar gequ $28
IODP_Scroll gequ $2A
IODP_ScrollFlag gequ $2A
IODP_GlobalCoords gequ $2C
IODP_AutowrapFlag gequ $2E
IODP_GotoFlag gequ $30 ; state of goto x,y
IODP_CurChar gequ $32 ; current character under the cursor
IODP_CurFlag gequ $34 ; =1 if cursor on
IODP_CurState gequ $36 ; =1 if curchar, = 0 if screen char
IODP_dTermioPtr gequ $38
IODP_procPtr gequ $3C
IODP_TextDPSize gequ $40

70
kern/drivers/equates Normal file
View File

@ -0,0 +1,70 @@
* $Id: equates,v 1.1 1998/02/02 08:18:13 taubert Exp $
* The size in bytes of the input and output buffers (each is BUF_SIZE bytes)
BUF_SIZE gequ 4096
IncBusyFlag gequ $E10064
DecBusyFlag gequ $E10068
* Direct-page equates
ibuf_hand gequ 0
obuf_hand gequ 4
in_buf gequ 8
out_buf gequ 12
ibuf_head gequ 16 ; *
ibuf_tail gequ 18 ; *
ibuf_mark gequ 20 ; *
ibuf_size gequ 22 ; *
obuf_head gequ 24 ; *
obuf_tail gequ 26 ; *
obuf_mark gequ 28 ; *
obuf_size gequ 30 ; *
ibuf_fcon gequ 32
obuf_fcon gequ 34 ; *
fcon_type gequ 36 ; *
fcon_status gequ 38 ; * initialize to non-zero
dTermioPtr gequ 40
blockProc gequ 44
procPtr gequ 46
tmpProcID gequ 50
lastChar gequ 52 ; *
lastInt gequ 54 ; *
reg5Status gequ 56 ; *
tx_in_progress gequ 58 ; *
UDISPATCH2 gequ $E1000C user tool locator entry type 2
INTMGRV gequ $E10010 system Interrupt Manager
pReady gequ $02
pBlocked gequ $03
* Port-independent hardware/firmware equates and parameters
v_Main gequ $E10010
v_AppleTalk gequ $E10020
v_Serial gequ $E10024
TheVect gequ v_Serial
SccControl gequ $E0C038
SccControlB gequ $E0C038
SccControlA gequ $E0C039
SccData gequ $E0C03A
SccDataB gequ $E0C03A
SccDataA gequ $E0C03B
*DTR gequ $EA
DTR gequ $6A ; for channel 2
SerFlag gequ $E10104
* 100 - read
* 010 - write
* 001 - exceptional
Tx_empty gequ %00000100
Rx_empty gequ %00000001
* fcon_type values
FCON_NONE gequ 0 no flowcontrol
FCON_XON gequ 1 XON/XOFF flowcontrol
FCON_RTS gequ 2 rts/cts flowcontrol

1887
kern/drivers/inout.asm Normal file
View File

File diff suppressed because it is too large Load Diff

337
kern/drivers/inout.mac Normal file
View File

@ -0,0 +1,337 @@
MACRO
&lab _DelHeartBeat
&lab ldx #$1303
jsl $E10000
MEND
MACRO
&lab _ReadBParam
&lab ldx #$0C03
jsl $E10000
MEND
MACRO
&lab _SetHeartBeat
&lab ldx #$1203
jsl $E10000
MEND
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab lsr3 &a
&lab lsr &a
lsr &a
lsr &a
mend
MACRO
&lab asl3 &a
&lab asl &a
asl &a
asl &a
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab SetVector &a1
&lab ph2 &a1(1)
ph4 &a1(2)
tool $1003
mend
MACRO
&lab IntSource &a1
&lab ph2 &a1
tool $2303
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab pushlong &addr,&offset
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
AIF "&C"="#",.immediate
AIF "&C"="[",.zeropage
AIF C:&offset=0,.nooffset
AIF "&offset"="s",.stack
pushword &addr+2,&offset
pushword &addr,&offset
MEXIT
.nooffset
pushword &addr+2
pushword &addr
MEXIT
.immediate
&REST AMID &addr,2,L:&addr-1
dc I1'$F4',I2'(&REST)|-16'
dc I1'$F4',I2'&REST'
MEXIT
.stack
pushword &addr+2,s
pushword &addr+2,s
MEXIT
.zeropage
ldy #&offset+2
pushword &addr,y
ldy #&offset
pushword &addr,y
MEND
MACRO
&lab pushword &SYSOPR
&lab ANOP
AIF c:&SYSOPR=0,.b
LCLC &C
&C AMID "&SYSOPR",1,1
AIF ("&C"="#").AND.(S:LONGA),.immediate
lda &SYSOPR
pha
MEXIT
.b
pha
MEXIT
.immediate
LCLC &REST
LCLA &BL
&BL ASEARCH "&SYSOPR"," ",1
AIF &BL>0,.a
&BL SETA L:&SYSOPR+1
.a
&REST AMID "&SYSOPR",2,&BL-2
dc I1'$F4',I2'&REST'
MEND
MACRO
&lab _NewHandle
&lab ldx #$0902
jsl $E10000
MEND
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _GetVector
&lab ldx #$1103
jsl $E10000
MEND
MACRO
&lab _SetVector
&lab ldx #$1003
jsl $E10000
MEND
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

17
kern/drivers/kern.equates Normal file
View File

@ -0,0 +1,17 @@
* $Id: kern.equates,v 1.1 1998/02/02 08:18:14 taubert Exp $
*********************************************************************
*
* Kernel process state IDs
*
*********************************************************************
NPROC gequ 32
pUnused gequ $00
pRunning gequ $01
pReady gequ $02
pBlocked gequ $03
pNew gequ $04 ; ready, but no int info
pSuspended gequ $05
pWait gequ $06
pWaitSigCH gequ $07
pPaused gequ $08

11
kern/drivers/md.equates Normal file
View File

@ -0,0 +1,11 @@
* $Id: md.equates,v 1.1 1998/02/02 08:18:15 taubert Exp $
* Specific equates for the modem port version of the driver
CtlPanBaud gequ $12
PortControl gequ $E0C038
PortData gequ $E0C03A
PortNum gequ 2 SIM modem port number
Channel_Rx gequ %00000100
Channel_Tx gequ %00000010
Reg11 gequ %01010000 modem
PortReset gequ %01000000

10
kern/drivers/msccf.asm Normal file
View File

@ -0,0 +1,10 @@
* $Id: msccf.asm,v 1.1 1998/02/02 08:17:58 taubert Exp $
* Note that there's not much in this file- just a copy for macros,
* a copy for defining the port memory locations & values, and
* a copy for the generic low level port driver code itself
mcopy sccf.mac
copy equates
copy ../gno/inc/tty.inc
copy md.equates
copy sccf.asm

85
kern/drivers/null.asm Normal file
View File

@ -0,0 +1,85 @@
* $Id: null.asm,v 1.1 1998/02/02 08:18:00 taubert Exp $
************************************************************
*
* NULL device driver
*
************************************************************
case on
mcopy port.mac
copy ../gno/inc/tty.inc
NullHeader START
ds t_open
* For speed/simplicity we use a non-standard, non-documented line
* discipline for the .null device
dc i4'NullInit2'
dc i4'NullDeInit'
dc i4'NullIOCTL'
dc i4'NullRead'
dc i4'NullWrite'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
dc i4'NullNoFunc'
ds t_signalIO-editInd
dc i4'NullNoFunc' ; t_signalIO
dc i2'$FFFF' ; t_select_proc
dc i4'NullSelect' ; t_select
dc i4'0' ; t_selwakeup jmp set during install
NullNoFunc anop
rtl
END
NullInit2 START
result equ 0
subroutine (2:devNum),2
stz result
return 2:result
END
NullDeInit START
subroutine (2:devNum),0
return
END
NullWrite START
count equ 0
retval equ 2
subroutine (2:reqCount,4:dataPtr,2:devNum),4
stz retval
lda reqCount
sta count
return 4:count
END
NullRead START
count equ 0
retval equ 2
subroutine (2:reqCount,4:dataPtr,2:devNum),4
stz count
lda #$4C
sta retval
return 4:count
END
NullIOCTL START
retval equ 0
subroutine (4:tioc,4:dataPtr,2:devNum),2
stz retval
return 2:retval
END
NullSelect START
res equ 0
subroutine (2:ttyn,2:which,2:pid),2
lda #1
sta res
return 2:res
END

840
kern/drivers/port.asm Normal file
View File

@ -0,0 +1,840 @@
* $Id: port.asm,v 1.1 1998/02/02 08:18:01 taubert Exp $
*
* 12/15/94 - select code added - Derek Taubert
*
case on
mcopy port.mac
copy ../gno/inc/tty.inc
copy equates
SerialHeader START
dtty ENTRY
ds t_open
* Line Discipline entry points
dc i4'DInit'
dc i4'DDeInit'
dc i4'DIOCTL'
dc i4'0' ; ttread and ttwrite must be
dc i4'0' ; set up by InstallDriver
dc i4'D_mutex'
dc i4'D_demutex'
dc i4'D_out_enq'
dc i4'D_in_enq'
dc i4'D_out_deq'
dc i4'D_in_deq'
dc i4'D_size_inq'
dc i4'D_size_outq'
ds t_signalIO-editInd
dc i4'nullfunc' ; t_signalIO
dc i2'$FFFF' ; t_select_proc
dc i4'D_select' ; t_select
dc i4'0' ; t_selwakeup jmp set up during install
END
D_in_enq START
rtl
END
D_mutex START
rtl
END
D_demutex START
rtl
END
D_select START
res equ 0
subroutine (2:ttyn,2:which,2:pid),2
jsl IncBusyFlag
lda #1
sta res
lda which ; which I/O to check?
cmp #SEL_READ
bne trywrite
jsl D_size_inq ; # bytes in in q
cmp #0
bne done
willwait anop
* record that the process wants to do I/O
lda >dtty+t_select_proc ; see if someone's here already
cmp #$FFFF ; nope
beq nocollision
cmp pid ; is it us?
beq nocollision
lda >dtty+privFlags
ora #TS_RCOLL
sta >dtty+privFlags
bra none
nocollision anop
lda pid ; set select_proc field to
sta >dtty+t_select_proc ; current process ID
bra none
trywrite cmp #SEL_WRITE
bne doexcept
bra done ; we can always write
; jsl D_left_outq ; # bytes avail in out q
; cmp #0
; bne done
; bra willwait
doexcept anop ; there are no exceptions
none lda #0 ; no data, return 0
sta res
done jsl DecBusyFlag
return 2:res
END
D_in_deq START
using SerialData
phb
phk
plb
phd
lda >SerialDP
tcd
jsr lowRead
pld
plb
rtl
END
D_out_deq START
rtl
END
nullfunc START
lda 2,s
sta 4,s
lda 1,s
sta 3,s
pla
rtl
END
D_size_inq START
using SerialData
phd
lda >SerialDP
tcd
lda <ibuf_mark
pld
rtl
END
D_size_outq START
using SerialData
phd
lda >SerialDP
tcd
lda <obuf_mark
pld
rtl
END
;D_left_outq START
; using SerialData
;
; phd
; lda >SerialDP
; tcd
; lda <obuf_size
; sec
; sbc <obuf_mark
; pld
; rtl
; END
* out_enq(int char)
D_out_enq START
using SerialData
phb
phk
plb
phd
lda >SerialDP
tcd
lda 7,s
jsr WriteBuffer
pld
plb
lda 2,s
sta 4,s
lda 1,s
sta 3,s
pla
rtl
END
lowRead START
; php need to turn off interrupts to
; sei prevent the driver from hanging
WaitMore anop
* Check for data in the buffer
lda <ibuf_mark if a single char comes through
bne GotIt while we're trying to sleep
* block process (will be unblocked by Read intr. completion routine)
jsl dtty+t_GetProcInd ; get pointer to process entry
sta procPtr
stx procPtr+2
; php
; sei
ldy #2 ; set it to blocked state
lda #pBlocked
sta [procPtr],y
; lda tmpProcID ; tell the intr handler which process
lda #1 ; tell intr handler a process is asleep
sta blockProc ; to awaken
ldy #84 ; index of waitDone field
lda #0
sta [procPtr],y ; set to zero, moron
cop $7F
; plp
ldy #84
lda [procPtr],y
beq WaitMore ; thar's a character
cmp #1
beq WaitMore
lda #-1
sta blockProc
lda #$7E43 ; abort the transfer
bra intr
GotIt anop
; plp restore interrupts
lda #-1
sta blockProc
jsr ReadBuffer
intr anop
rts
END
DInit START
using SerialData
hand equ 0
ptr equ 4
result equ 12
bufHand equ 14
subroutine (2:devNum),18
stz result
* ph4 #nhInit
* _ErrWriteString
ph4 #0
ph4 #256
ph2 dtty+t_userid
ph2 #$C005
ph4 #0
_NewHandle
cmp #0
beq noerr
memErr lda #$54 ; GS/OS out of memory
sta result
jmp goaway
noerr pla
sta hand
sta DPHandle
pla
sta hand+2
sta DPHandle+2
lda [hand]
sta ptr
sta SerialDP
ldy #2
lda [hand],y
sta ptr+2
pha
pha
ph4 #BUF_SIZE*2
ph2 dtty+t_userid
pea $C008 ; anywhere in memory
pea 0 ; no special location
pea 0
_NewHandle
pla
sta bufHand
sta |bufHandle
pla
sta bufHand+2
sta |bufHandle+2
ora bufHand
bne didAlloc
ph4 >DPHandle
_DisposeHandle
bra memErr
didAlloc lda [bufHand]
tax
ldy #2
lda [bufHand],y
sta bufHand+2
stx bufHand
; lda #$20 ; use CTS sighupping by default
lda #$00 ; use no sighupping by default
sta >DHUP
lda SerialDP
phd
tcd
; mv4 >dtermioPtr,dTermioPtr
ld4 dtty,dTermioPtr
* Initialize default values for terminal settings
ldy #4
lda #CRMOD+ECHO
sta [dTermioPtr],y
lda #0
short m
* default baud rate either comes from the Control panel, or
* from a previous stty command. doing stty 0 on the port
* will force a reset to the control panel next time the port is opened
* sta [dTermioPtr] ; ispeed
* ldy #1
* sta [dTermioPtr],y ; ospeed
ldy #t_intrc
lda #3
sta [dTermioPtr],y ; t_intrc
ldy #t_suspc
lda #'Z'-64
sta [dTermioPtr],y
ldy #t_quitc
lda #'\'-64
sta [dTermioPtr],y
ldy #t_startc
lda #'Q'-64
sta [dTermioPtr],y
ldy #t_stopc
lda #'S'-64
sta [dTermioPtr],y
ldy #t_eofc
lda #'D'-64
sta [dTermioPtr],y
ldy #t_brkc
lda #-1
sta [dTermioPtr],y
* lda #11
* ldy #t_ispeed
* sta [dTermioPtr],y
long m
* Initialize the port and parameters
ldy #privFlags
lda #0
sta [dTermioPtr],y
ldy #ws_row
sta [dTermioPtr],y
iny2
sta [dTermioPtr],y
iny2
sta [dTermioPtr],y
iny2
sta [dTermioPtr],y
jsr ComInit set the initial baud rate
pld
pea 0
pei (ptr)
pei (bufHand+2)
pei (bufHand)
lda bufHand
clc
adc #BUF_SIZE
tax
lda bufHand+2
adc #0
pha
phx
jsl StartSerial
sta result
cmp #0 error in startup?
beq goaway Nope
cmp #7
bcs unknownErr
asl a map SIM error to a reasonable
tax GS/OS driver error code
lda ErrorMap,x
sta result
ph4 >DPHandle
_DisposeHandle
ph4 >bufHandle
_DisposeHandle
goaway return 2:result
unknownErr sta result assume some other error
bra goaway
nhErr str 'Modem:NewHandle failed'
nhInit str 'Modem:Init'
ErrorMap anop
dc i2'0'
dc i2'$29' SIMAlreadyInst
dc i2'$27' SIMInvalidAddr
dc i2'$29' SIMATalkActive
dc i2'$27' SIMNotInstalled
dc i2'$22' SIMInvalidPort
dc i2'$26' SIMNotFound
END
DDeInit START
using SerialData
subroutine (2:devNum),0
* ph4 #detxt
* _ErrWriteString
jsl EndSerial
ph4 >DPHandle
_DisposeHandle
ph4 >bufHandle
_DisposeHandle
return
detxt str 'DeInit Modem'
END
DIOCTL START
using SerialData
retval equ 0
dpPtr equ 2
subroutine (4:tioc,4:dataPtr,2:devNum),6
lda SerialDP
sta dpPtr
stz dpPtr+2
lda tioc
and #$FF00
xba
cmp #'f'
beq chkfile
cmp #'t'
beq tioctl
err lda #-1
sta retval
bra goaway
* FIONREAD
chkfile lda tioc
and #$7F
cmp #127
bne err
ldy #ibuf_mark
lda [dpPtr],y how many bytes in input buffer?
sta [dataPtr] lda is an atomic operation :-)
stz retval
bra goaway
tioctl anop
lda tioc
and #$7F
cmp #23
bcc okay2
and #$7F
eor #$7F
cmp #26
bcc okay1
jmp invalid
okay1 anop
asl a
asl a
inc a
inc a
tax
jmp (tNTable,x)
okay2 anop
asl a
asl a
inc a
inc a
tax
jmp (tPTable,x)
goaway return 2:retval
tPTable anop
dc i2'0',a2'TIOCGETD'
dc i2'1',a2'TIOCSETD'
dc i2'2',a2'invalid'
dc i2'3',a2'invalid'
dc i2'4',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'8',a2'TIOCGETP'
dc i2'9',a2'TIOCSETP'
dc i2'10',a2'TIOCSETN'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'16',a2'TIOCFLUSH'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'21',a2'TIOCSHUP'
dc i2'22',a2'TIOCGHUP'
tNTable anop
dc i2'127',a2'invalid'
dc i2'126',a2'invalid'
dc i2'125',a2'invalid'
dc i2'124',a2'invalid'
dc i2'123',a2'TIOCSBRK'
dc i2'122',a2'TIOCCBRK'
dc i2'121',a2'TIOCSDTR'
dc i2'120',a2'TIOCCDTR'
dc i2'119',a2'invalid'
dc i2'118',a2'invalid'
dc i2'117',a2'invalid'
dc i2'116',a2'invalid'
dc i2'115',a2'TIOCOUTQ'
dc i2'114',a2'TIOCSTI'
dc i2'113',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'111',a2'TIOCSTOP'
dc i2'110',a2'TIOCSTART'
dc i2'109',a2'invalid'
dc i2'108',a2'invalid'
dc i2'107',a2'invalid'
dc i2'106',a2'invalid'
dc i2'-1',a2'invalid'
dc i2'104',a2'invalid'
dc i2'103',a2'invalid'
invalid lda #-1
sta retval
jmp goaway
*****************************************************
TIOCSHUP anop
lda [dataPtr]
sta >DHUP
; jsr InstComplete
stz retval
jmp goaway
TIOCGHUP anop
lda >DHUP
sta [dataPtr]
stz retval
jmp goaway
TIOCGETD anop
TIOCSETD anop
TIOCSETN anop
TIOCGETP stz retval
jmp goaway
TIOCSETP anop
phd
lda >SerialDP
tcd
jsr SetWord $$$ SETWORD SET BAUD RATE
pld
stz retval
jmp goaway
TIOCFLUSH anop
php
sei
lda dataPtr
ora dataPtr+2
bne notNull
ldx #0
notNull lda [dataPtr] get the type of operation
tax
cpx #2
beq clrOutQ
lda #0 zero out the buffer information
ldy #ibuf_head
sta [dpPtr],y
ldy #ibuf_tail
sta [dpPtr],y
ldy #ibuf_mark
sta [dpPtr],y
clrOutQ cpx #1
beq doneFLUSH
lda #0 zero out the buffer information
ldy #obuf_head
sta [dpPtr],y
ldy #obuf_tail
sta [dpPtr],y
ldy #obuf_mark
sta [dpPtr],y
doneFLUSH plp
stz retval
jmp goaway
TIOCOUTQ ldy #obuf_mark
lda [dpPtr],y
sta [dataPtr]
stz retval
jmp goaway
TIOCSTOP anop
TIOCSTART anop
lda #-1
sta retval
jmp goaway ; we don't support these
TIOCSDTR jsr DTRON ; these don't need DP
jmp goaway
TIOCCDTR jsr DTROFF
jmp goaway
TIOCSBRK jsr BRKON
stz retval
jmp goaway
TIOCCBRK jsr BRKOFF
stz retval
jmp goaway
* simulate terminal input (this code is borrowed from INOUT.ASM/OurADB
TIOCSTI anop
; this chunk stores the byte in the buffer
lda [dataPtr]
tax
php
sei
phd
lda >SerialDP
tcd
ldy <ibuf_head
txa
short m
sta [in_buf],y
long m
iny
sty <ibuf_head
cpy <ibuf_size
bcc stok
ldy #0
stok sty <ibuf_head
inc <ibuf_mark
; this chunk unblocks any process that was waiting on keyboard input
lda blockProc
cmp #-1
beq check4select
ldy #2
lda [procPtr],y
cmp #pBlocked ; is it still blocked?
bne done ; nope, leave it alone
lda #pReady
sta [procPtr],y ; restart the process
; this was in the console code but not here
lda #-1
sta blockProc
;
; check for select here.
check4select anop
lda >dtty+t_select_proc
cmp #$FFFF
beq done
* someone is selecting on us, so call selwakeup with the process ID
* and our collision flag
pha
lda >dtty+privFlags
and #TS_RCOLL
pha
jsl dtty+t_selwakeup
lda >dtty+privFlags
and #TS_RCOLL.EOR.$FFFF
sta >dtty+privFlags
lda #$FFFF
sta >dtty+t_select_proc
done anop
pld
plp
stz retval
jmp goaway
END
checkIntr START
using SerialData
php
long ai
and #$7f
pha
short m
ldy #sg_flags
lda [dTermioPtr],y
bit #$20 ; RAW mode?
beq x9 ; yep, no character checking
brl notty
x9 ldy #t_quitc
lda [dTermioPtr],y
cmp #-1
beq x0
cmp 1,s
beq gotQQ
x0 ldy #t_suspc
lda [dTermioPtr],y
cmp #-1
beq x1
cmp 1,s
beq gotZ
x1 ldy #t_intrc
lda [dTermioPtr],y
cmp #-1
beq notty
cmp 1,s
beq gotC
*x2 lda >OutStopped
* bne x3
* ldy #t_stopc
* lda [dTermioPtr],y
* cmp #-1
* beq x3
* cmp 1,s
* beq gotS
*x3 ldy #t_startc
* lda [dTermioPtr],y
* cmp #-1
* beq notty
* cmp 1,s
* beq gotQ
bra notty
*gotS long m
* pla
* lda #1
* sta >OutStopped
* plp
* sec
* rts
*gotQ long m
* pla
* lda >OutStopped
* beq notQ
* lda #0
* sta >OutStopped
* plp
* sec
* rts
*notQ anop ;oops!
* plp
* clc
* rts
gotQQ long m
lda #3
bra gotSIG
gotZ long m
lda #18
bra gotSIG
gotC long m
lda #2
gotSIG anop
phx
phy
pha
lda <ibuf_head
dec a
bpl notNeg
lda <ibuf_size
dec a
notNeg sta <ibuf_head ; remove the character
dec <ibuf_mark
lda 1,s
pha ; push signal number
ph2 >dtty+t_devNum ; push our device number
jsl dtty+t_sendSignal
pla ; prolly don't need to, but what
ply ; the hell...
plx
pla ; the character
plp ; ready? Let's go!
sec
rts
notty anop
long m
pla
plp
clc
rts
END
SerialData DATA
SerialDP dc i2'0'
DPHandle dc i4'0'
bufHandle dc i4'0'
DHUP dc i2'$00'
ourSerFlag dc i2'0'
CurBaud dc i2'0'
baudTbl dc i2'0' 0 - no baud! (hangup)
dc i2'$08FE' 1 - 50 baud
dc i2'$05FE' 2 - 75 baud
dc i2'$0415' 3 - 110 baud
dc i2'$035B' 4 - 134.5 baud
dc i2'$02FE' 5 - 150 baud
dc i2'$0000' 6 - 200 baud ($23E) or 57600
dc i2'$017E' 7 - 300 baud
dc i2'$00BE' 8 - 600 baud
dc i2'$005E' 9 - 1200 baud
dc i2'$003E' 10 - 1800 baud
dc i2'$002E' 11 - 2400 baud
dc i2'$0016' 12 - 4800 baud
dc i2'$000A' 13 - 9600 baud
dc i2'$0004' 14 - 19200 baud
dc i2'$0001' 15 - 38400 baud
* Firmware to UNIX baud-rate number conversion
RevBDTab dc i2'1' 50
dc i2'2' 75
dc i2'3' 110
dc i2'4' 134.5
dc i2'5' 150
dc i2'7' 300
dc i2'8' 600
dc i2'9' 1200
dc i2'10' 1800
dc i2'11' 2400
dc i2'0' 3600
dc i2'12' 4800
dc i2'0' 7200
dc i2'13' 9600
dc i2'14' 19200
END

303
kern/drivers/port.mac Normal file
View File

@ -0,0 +1,303 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab _NewHandle
&lab ldx #$0902
jsl $E10000
MEND
MACRO
&lab _DisposeHandle
&lab ldx #$1002
jsl $E10000
MEND
MACRO
&lab str &string
&lab dc i1'l:&string',c'&string'
MEND
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab LD4 &val,&adr
&lab lcla &count
lda #<&val
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda #+(&val)|-16
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend

11
kern/drivers/pr.equates Normal file
View File

@ -0,0 +1,11 @@
* $Id: pr.equates,v 1.1 1998/02/02 08:18:16 taubert Exp $
* Specific equates for the modem port version of the driver
CtlPanBaud gequ $6
PortControl gequ $E0C039
PortData gequ $E0C03B
PortNum gequ 1 SIM modem port number
Channel_Rx gequ %00100000
Channel_Tx gequ %00010000
Reg11 gequ %11010000 printer
PortReset gequ %10000000

10
kern/drivers/psccf.asm Normal file
View File

@ -0,0 +1,10 @@
* $Id: psccf.asm,v 1.1 1998/02/02 08:18:03 taubert Exp $
* Note that there's not much in this file- just a copy for macros,
* a copy for defining the port memory locations & values, and
* a copy for the generic low level port driver code itself
mcopy sccf.mac
copy equates
copy ../gno/inc/tty.inc
copy pr.equates
copy sccf.asm

761
kern/drivers/sccf.asm Normal file
View File

@ -0,0 +1,761 @@
* $Id: sccf.asm,v 1.1 1998/02/02 08:18:04 taubert Exp $
case on
* Install an interrupt handler into the SIM tool. This uses the SIM
* library so it's really easy
InstallInt START
ph4 #IntVect
pea PortNum
jsl INSTALLINTVECT
rts
oldVect ENTRY
dc i4'0'
END
* Remove our SCC interrupt handler from the Main Interrupt Vector
RemoveInt START
ph4 #IntVect
pea PortNum
jsl REMOVEINTVECT
rts
END
IntVect START
using SerialData
longa off
longi off
php
long x
; JAWAID! *whap*
; check_stuff needs RR0 contents, not RR3!
; tay we need this for check_stuff
bit #Channel_Rx
beq t_Tx_Int
phb
phk
plb
phd
long m
lda SerialDP
tcd
short m
; *whap*
; sty <lastInt store the int value for check_stuff
lp1 ldy <ibuf_head
lda #1
sta >PortControl
lda >PortControl
pha
lda >PortData
sta <lastChar ; for post-processing
sta [in_buf],y
iny
cpy <ibuf_size
bne noWrap1
ldy #0
noWrap1 sty <ibuf_head
ldx <ibuf_mark
inx
stx <ibuf_mark
cpx #3072
bcc noFCON
jsr turn_flow_off hold your horses!
noFCON jsr check_stuff ; reload Y from dp at lp1
pla
and #$60
beq weepers
lda #0
sta >PortControl ; error reset
lda #$30
sta >PortControl
weepers lda #0 ; Reset high IUS
sta >PortControl
lda #$38
sta >PortControl
lda >PortControl
bit #1
bne lp1 ; more data!
pld
plb
gohome anop
plp
clc
rtl
notOurIntr anop
plp
sec
rtl
t_Tx_Int anop
bit #Channel_Tx
beq statusInt
lda <obuf_fcon
bne turnOffTxInt
; phy
phd
long m
lda >SerialDP
tcd
short m
phb
phk
plb
doTxChar ldy <obuf_mark
beq turnOffTxInt
tya
ldy <obuf_tail
lda [out_buf],y
sta >PortData
iny
cpy <obuf_size
bne noWrap
ldy #0
noWrap sty <obuf_tail
ldx <obuf_mark
dex
stx <obuf_mark
lda #0 ; Reset high IUS
sta >PortControl
lda #$38
sta >PortControl
plb
pld
; ply
bra gohome
turnOffTxInt lda #%00101000
sta >PortControl
lda #0
sta <tx_in_progress
plb
pld
; ply
bra gohome
* Must be a status interrupt
statusInt anop
; phy
phd
long m
lda >SerialDP
tcd
short m
phb
phk
plb
lda >PortControl
bit #%00100000 ; check status of CTS line
bne turniton
lda #1
sta <obuf_fcon
reset lda #0 ; Reset high IUS
sta >PortControl
lda #$38
sta >PortControl
plb
pld
; ply
jmp gohome
turniton lda <obuf_fcon
beq reset
stz <obuf_fcon
jmp doTxChar
END
longa off
longi on
check_stuff START
using SerialData
lda >PortControl
; *whap*
; lda <lastInt
bit DHUP
bne sighupit
lda <lastChar
jsr checkIntr
bcs goaway ; send a signal!
lda blockProc
cmp #-1
beq checkselect
ldy #2
lda [procPtr],y
cmp #pBlocked ; is it still blocked?
bne checkselect ; nope, leave it alone
lda #pReady
sta [procPtr],y ; restart the process
; check for select here.
checkselect anop
long m
lda >dtty+t_select_proc
cmp #$FFFF
beq done
* someone is selecting on us, so call selwakeup with the process ID
* and our collision flag
pha
lda >dtty+privFlags
and #TS_RCOLL
pha
jsl >dtty+t_selwakeup
lda >dtty+privFlags
and #TS_RCOLL.EOR.$FFFF
sta >dtty+privFlags
lda #$FFFF
sta >dtty+t_select_proc
done anop
short m
goaway anop
rts
* we lost carrier detect, so send a sighup signal
sighupit anop
long m
lda #$FFFF
sta >$E00408
pea 1 ; push signal number
lda >dtty+t_devNum
pha ; push our device number
jsl dtty+t_sendSignal
* short m ; see done, above
bra done
END
longa on
longi on
* ReadBuffer and WriteBuffer expect the D register to be set properly
* (i.e., to SerialDP)
ReadBuffer START
using SerialData
php
short m
sei
ldy <ibuf_tail
cpy <ibuf_head
beq nodata
lda [in_buf],y
iny
cpy <ibuf_size
bcc noWrap
ldy #0
noWrap sty <ibuf_tail
long m
ldx <ibuf_mark
dex
stx <ibuf_mark
pha
lda <fcon_status
bne fc_is_off
cpx #1024
bcs fc_is_off
short m
jsr turn_flow_on
long m
fc_is_off pla
and #$FF
plp
sec
rts
nodata long m
plp
clc
rts
END
WriteBuffer START
using SerialData
tay ; save character in Y
tryagain php
short m
sei
ldx <obuf_mark
beq bufEmpty
cpx #BUF_SIZE-1
beq noRoom
addToBuffer tya ; put character back in A
ldy <obuf_head
sta [out_buf],y
iny
cpy <obuf_size
bcc noWrap
ldy #0
noWrap sty <obuf_head
long m
inx
stx <obuf_mark
bra wasData
longa off
bufEmpty anop
; lda >PortControl
; lda >PortControl
; bit #Tx_empty see if something is in the Tx latch
; beq addToBuffer and if so stick char in the buffer
lda <tx_in_progress
bne addToBuffer
tya
sta >PortData
lda #1
sta <tx_in_progress
wasData plp
sec
rts
noRoom long m
plp
bra tryagain
plp
clc
rts
END
WriteByteOld START
subroutine (2:ch),0
lda ch
short m
pha
flowCheck lda >PortControl ; check the CTS line to make sure
bit #%00100000 ; the printer can accept data...
beq flowCheck ; if not, then wait for it
txfull lda >PortControl ; make sure the transmit buffer
bit #%00000100 ; is empty
beq txfull
pla
sta >PortData ; write our data!
long m
return
END
InitSCC START
php
sei
short m
lda >PortControl
lda #$09
sta >PortControl
lda #%00000010+PortReset channel reset, turn intrs off
sta >PortControl
nop
nop
nop
nop
nop
nop
nop
nop
ldx #0
a_ian_loop lda async_data,x
cmp #$FF
beq a_ian_leap
sta >PortControl
* What's the timer for?
inx
bra a_ian_loop
a_ian_leap anop
long m
plp
rtl
async_data dc i1'$04,$44' X16 clock mode, 1 stop bit
dc i1'$02,$00' no interrupt vector
dc i1'$03,%11100000' rx 8 bits/char, rx off, auto enables
dc i1'$05,$62' DTR = 0, tx 8 bits/char, tx off, RTS = 1
dc i1'$09,%0010' no reset, all ints off
dc i1'$0A,$00' NRZ data encoding
dc i1'$0B,Reg11' xtal on, rx clock = brg out, tx clock = brg_out
initBaudLo ENTRY
dc i1'$0C,$04' low byte of brg time constant
initBaudHi ENTRY
dc i1'$0D,$00' high byte of brg time constant
dc i1'$0E,$80' source = brg, brg clock = xtal, brg off
dc i1'$0E,$01' brg on, brg clock = xtal
dc i1'$03,%11100001' rx 8 bits/char, rx on
dc i1'$05,DTR' DTR = 0, tx 8 bits/char, tx on, RTS = 1
dc i1'$0F,%00101000' interrupt on CTS status change
* dc i1'$01,%00010001' rx char ints enable
* dc i1'$09,%00001010' master interrupt enable
dc i1'$FF'
END
InitSCC2 START
using SerialData
php
sei
short m
lda >PortControl
lda #1
sta >PortControl
lda #%00010010 ; intr on all rx and tx
sta >PortControl
lda #9
sta >PortControl
lda #%1010
sta >PortControl
; hum, just for kicks...
lda #0
sta >PortControl ; error reset
lda #$30
sta >PortControl
lda #0 ; Reset high IUS
sta >PortControl
lda #$38
sta >PortControl
plp
rts
END
longa on
longi on
DeInitSCC START
using SerialData
* Turn off the SCC's interrupt generation completely
php
sei
short m
lda >PortControl
lda #9
sta >PortControl
lda #%0010
sta >PortControl
lda #1
sta >PortControl
lda #0
sta >PortControl
lda >PortData
lda #%11010000
sta >PortControl
nop
nop
nop
nop
nop
lda #%00101000
sta >PortControl
nop
nop
nop
nop
nop
lda #9
sta >PortControl
lda #%1010
sta >PortControl
; lda >SerFlag
; and #%11111000
; sta >SerFlag
; lda >ourSerFlag
; and #%11111000
; sta >ourSerFlag
long m
plp
rts
END
StartSerial START
using SerialData
result equ 0
subroutine (4:dp,4:inb,4:outb),2
stz result
lda inb
ldy #in_buf
sta [dp],y
lda inb+2
ldy #in_buf+2
sta [dp],y
lda outb
ldy #out_buf
sta [dp],y
lda outb+2
ldy #out_buf+2
sta [dp],y
phd
lda dp
sta >SerialDP
tcd ; 'return' will restore this
lda #0
sta <ibuf_mark
sta <obuf_mark
sta <ibuf_head
sta <obuf_head
sta <ibuf_tail
sta <obuf_tail
sta <obuf_fcon
sta <tx_in_progress
sta <lastInt
sta <lastChar
lda #4096
sta <ibuf_size
sta <obuf_size
lda #1
sta <fcon_status
lda #FCON_RTS
sta <fcon_type
lda #DTR
sta <reg5Status
jsl InitSCC
jsr InstallInt
sta |temp tells if there was an error
cmp #0
bne handlerErr
jsr InitSCC2 only start intrs if handler was
handlerErr pld properly installed
lda temp
sta result
return 2:result
temp dc i2'0'
END
FlushOutQ START
using SerialData
phd
lda >SerialDP
tcd
lp lda <obuf_mark
bne lp
pld
rts
END
EndSerial START
subroutine (0:foo),0
jsr FlushOutQ
jsr DeInitSCC ; turn off interrupts, etc.
jsr RemoveInt
return
END
* usually called at interrupt time, requires that D point to the driver's
* direct page and expects short memory and long index
longa off
longi on
turn_flow_off START
lda fcon_status
beq alreadyOff flow is already off
lda fcon_type
beq noFlowControl they don't want flowcontrol
cmp #FCON_XON xon/xoff?
bne doRTS
lda #'S'-64
jsr priorityWrite
stz fcon_status
noFlowControl anop
alreadyOff rts
doRTS lda #5
sta >PortControl
lda #DTR+$80
sta >PortControl
sta <reg5Status
stz fcon_status
rts
END
turn_flow_on START
lda fcon_status
bne alreadyOn flow is already on
lda fcon_type
beq noFlowControl they don't want flowcontrol
cmp #FCON_XON xon/xoff?
bne doRTS
lda #'Q'-64
jsr priorityWrite
lda #1
sta fcon_status
noFlowControl anop
alreadyOn rts
doRTS lda #5
sta >PortControl
lda #DTR
sta >PortControl
sta <reg5Status
lda #1
sta fcon_status
rts
END
longa on
longi on
DTRON START
using SerialData
phd
lda >SerialDP
tcd
php
short m
sei
lda #5
sta >PortControl
lda #DTR
sta >PortControl
sta <reg5Status
plp
long m
pld
rts
END
DTROFF START
using SerialData
phd
lda >SerialDP
tcd
php
sei
short m
lda #5
sta >PortControl
lda #DTR+$80
sta >PortControl
sta <reg5Status
plp
long m
pld
rts
END
BRKON START
rts we really need to do something here :)
END
BRKOFF START
rts
END
priorityWrite START
brk $10
rts
END
longa on
longi on
ComInit start
using SerialData
ldy #sg_ispeed
lda [dTermioPtr],y
and #$00FF
bne dontCP
pha
ph2 #CtlPanBaud
_ReadBParam
pla
asl a
tax
lda RevBDTab,x
dontCP ldy #sg_ispeed
short m
sta [dTermioPtr],y
ldy #sg_ospeed
sta [dTermioPtr],y
long m
and #$FF
asl a
tax
short m
lda baudTbl,x set the initial baud rate
sta |initBaudLo+1 (in the register setup table)
xba
sta |initBaudHi+1
long m
; jsr SetWord we only support 8N1 right now!
; jsr InstComplete install completion routine! ack!
rts
END
* Set the baud rate, and parity for a connection
SetWord START
using SerialData
php
sei
ldy #sg_ispeed
lda [dTermioPtr],y
and #$0F
asl a
tax
lda >baudTbl,x
sta CurBaud
* reset the baud rate in the SCC
tax
short m
lda >PortControl
lda #$0C
sta >PortControl
txa
sta >PortControl
lda #$0D
sta >PortControl
txa
xba
sta >PortControl
long m
realFIN plp
rts
end

249
kern/drivers/sccf.mac Normal file
View File

@ -0,0 +1,249 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _ReadBParam
&lab ldx #$0C03
jsl $E10000
MEND
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend

51
kern/gno/Makefile Normal file
View File

@ -0,0 +1,51 @@
# $Id: Makefile,v 1.1 1998/02/02 08:18:19 taubert Exp $
.INCLUDE: /src/gno/paths.mk
PROG= kern
OBJS= main.o patch.o kern.o sys.o signal.o ctool.o sem.o \
queue.o data.o diag.o resource.o tty.o select.o gsos.o \
p16.o pipe.o shellcall.o fastfile.o texttool.o driver.o \
util.o var.o ep.o err.root regexp.root stat.o ports.o \
sleep.o pty.o net.o \
inout.o console.o box.root conpatch.o
CFLAGS+=-DKERNEL
.SOURCE: ../drivers
$(PROG): $(OBJS)
gsh -c ${mktmp prefix 13 /lang/orca/libraries; $(LD) $(LDFLAGS) -o $@ $<}
compile +w $(PROG).rez keep=$@
chtyp -t s16 $@
$(PROG): $(PROG).rez
# dependencies
data.o: conf.h kernel.h proc.h q.h sem.h
diag.o: proc.h sys.h
ep.o: proc.h sys.h
fastfile.o: proc.h sys.h
main.o: proc.h gno.h sys.h sem.h tty.h
net.o: gno.h proc.h sys.h kernel.h net.h
patch.o: proc.h gno.h sys.h sem.h conf.h
ports.o: conf.h kernel.h proc.h gno.h
queue.o: q.h conf.h proc.h kernel.h sys.h
sem.o: sys.h sem.h proc.h q.h conf.h kernel.h gno.h
signal.o: conf.h kernel.h proc.h sys.h gno.h
sleep.o: proc.h sys.h kernel.h
stat.o: proc.h sys.h kernel.h
sys.o: conf.h proc.h kernel.h kvm.h gno.h sys.h
driver.o: m/driver.mac global.equates inc/tty.inc
err.o: m/err.mac
gsos.o: m/gsos.mac global.equates inc/gsos.inc inc/tty.inc
p16.o: m/p16.mac global.equates inc/gsos.inc inc/tty.inc
pipe.o: m/pipe.mac inc/kern.inc inc/gsos.inc
pty.o: inc/tty.inc
regexp.o: m/regexp.mac
resource.o: inc/gsos.inc
select.o: m/select.mac inc/tty.inc inc/gsos.inc inc/kern.inc global.equates
shellcall.o: m/shellcall.mac global.equates
texttool.o: m/texttool.mac global.equates
tty.o: m/tty.mac inc/tty.inc
util.o: m/util.mac
var.o: m/var.mac

88
kern/gno/TODO Normal file
View File

@ -0,0 +1,88 @@
todo
====
- select() on pipes
- make console driver a loaded driver
- check drive full error code
- GetLang/SetLang
- access devices via /dev
- find out why tcp/ip takes so damn long to quit sometimes
- check p8 launching
- write up driver interface specs
revamp loaded driver interfaces so we can have stuff like /dev/audio
- how can we pass back correct error codes from SOCKrdwr to read() and write()
lib routines?
- create types, document diff between pid, kern pid, and kern table offset
baz.todo
========
- Rewrite the texttools to properly support texttools features
regardless of redirection. At the same time, implement a simple
buffering scheme for the texttools to greatly improve texttools
redirection. (must be tied into PGClose so we properly flush the
buffers all the time).
libs
====
- tc[gs]etattr, TIOCGETA, TIOCSETA
- getlogin
- sigemptyset, sigaddset, sigprocmask
reported bugs
=============
1/1/95 - init messages appearing on single line
done
====
10/27/97 wait() fixed to return -1, ECHILD if no children
11/5/96 select() should re-start after signal
should return EINTR after signal
with wait & *wait = 0 should basically not block
semaphore and KERNkill code re-worked to not spaz out GNO for
EINTR cases
4/30/96 commonSwait wasn't working right for EINTR when != procBLOCKED
3/31/96 libc: fixed %m and LOG_PID in vsprintf() (data bank problems)
libc: added gettimeofday()
libc: added setre[gu]id()
3/11/96 fixed stack deallocation problems in KERNkill and KERNexecve
3/7/96 fdCount++ was misplaced in dup2()
2/13/96 select() timeout now works (YEA!)
1/6/96 gs/os files working with select()
select() returns the proper value
? filed& filed& -> bogus process due to context switch during KERNkill()
socket close swait() problem fixed by removing some swait()
dependencies from socket close code
1/25/95 echo code in tty.asm wasn't calling signalIO like it should
have, select() on ptys seems to work now
1/15/95 2.0.6b4 released
1/12/95 ctool.asm: stuff added on 1/7/95 had incorrect entries (-1 doh!)
ps entry for init is now FUCK, FUCK, FUCKED! why? ACK! don't
link gno with lenviron installed!
1/11/95 2.0.6b3 released
1/10/95 receiveCommon - $0080.EOR.$FFFF was evaluating to $0000, thanx
a lot, mikey. This was causing the flags to get all fucked up
and bank 0 space was disappearing because UserShutDown() was
being used on forked memids instead of DisposeAll()
1/9/95 serial drivers were checking RR3 for SIGHUPing rather than
RR0
serial drivers do no SIGHUPing by default now - the special
condition interrupt enable and interrupt handler need to be
re-writen properly to handle different values for DHUP
1/7/95 more net stuff: shutdown(), getpeeraddr(), getsockaddr(), and
[gs]etsockopt() were added to the kern and libc
1/2/95 2.0.6b1 released
added version resource to kern
fixed InOutStart/End calling (I fuqed it up while playing with
making the console driver loadable)
libc: fixed strerror w/ network stuff
2.0.6b2 released
1/1/95 modem, printer drivers working with select()
correct orcalib from baz
welcome version 2.0.6b1
libc: added hosname stuff
libc: updated perror w/ network stuff
kernVersion returns $0206 now
12/?/94 null driver is now a loaded driver, and select() should work
right on it...
12/15/94 select() on sockets (ha! ha! bitch!)
12/12/94 Pass ioctl() on sockets directly to the usrreq routine
(do not pass go, do not collect $200)

19
kern/gno/conf.h Normal file
View File

@ -0,0 +1,19 @@
/* $Id: conf.h,v 1.1 1998/02/02 08:18:21 taubert Exp $ */
/* conf.h - configuration and size constants */
/* the following defines can be changed but not deleted */
#define NPROC 32 /* max user processes */
/* the following defines can be changed or deleted */
#define GNOVERSION "for GS/OS 3.0 on Apple IIgs (65816) (5/28/91) - Jawaid Bazyar"
#define MESSAGE /* message passing available */
#define NSEM 200 /* total number of semaphores */
#define RTCLOCK /* system has a real-time clock */
#define QUANTUM 100 /* milliseconds a process is allowed
to run without being rescheduled */
#define DEBUG_RESCHED /* if defined, displays information \
about the processes being scheduled */
/* note: most of these are meaningless on the IIgs */

1175
kern/gno/ctool.asm Normal file
View File

File diff suppressed because it is too large Load Diff

50
kern/gno/data.c Normal file
View File

@ -0,0 +1,50 @@
/* $Id: data.c,v 1.1 1998/02/02 08:18:22 taubert Exp $ */
/* data.c - nulluser, sysinit
global data structures
*/
#pragma optimize 79
#define INITSTK 2000 /* stack size of initial process */
#define INITPRIO 20 /* priority of initial process */
#define INITNAME "user_main" /* name of initial process */
#include "conf.h"
#include "kernel.h"
#include "proc.h"
#include "q.h"
#if defined(NSEM)
#include "sem.h"
#endif /* defined(NSEM) */
/* declarations of major kernel variables */
/* Not needed- we store our processTable elsewhere */
/* struct pentry _proctab[NPROC];*/ /* process table */
#if defined(NSEM)
struct sentry *_semaph;
/*struct sentry _semaph[NSEM]; /* semaphore table */
int _nextsem; /* next semaphore slot to use in screate */
#endif /* defined(NSEM) */
/*struct qstruct nq[NQS];*/
struct qstruct *nq;
struct qstruct *q_free;
#ifdef NOTDEFINED
/* active system status */
int _numproc; /* number of live user processes */
int _currpid; /* id of currently running process */
/* real-time clock variables and sleeping process queue pointers */
int _slnempty; /* FALSE if the sleep queue is empty */
int *_sltop; /* address of key part of top entry in */
/* the sleep queue of sleeping processes */
int _clockq; /* head of queue of sleeping processes */
int _rdyhead; /* head of ready list (q indices) ... */
int _rdytail; /* ... and the tail */
#endif

81
kern/gno/diag.c Normal file
View File

@ -0,0 +1,81 @@
/* $Id: diag.c,v 1.1 1998/02/02 08:18:23 taubert Exp $ */
/* kernel diagnostics and error routines */
#pragma optimize 79
#include "proc.h"
#include "sys.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
struct intState {
word irq_A;
word irq_X;
word irq_Y;
word irq_S; /* +06 */
word irq_D;
byte irq_P;
byte irq_B;
byte irq_e;
byte irq_K; /* +13 */
word irq_PC; /* +14 */
word dummy[2]; /* +16 */
word lastTool; /* +20 */
};
extern kernelStructPtr kp;
#pragma databank 1
void traceback(word stack)
{
word j;
for (j = stack; (j<stack+256) && (j<0xC000);) {
kern_printf("[%04X]:", j);
for (; j < (j&0xfff0)+0x10; j++) {
kern_printf(" %02X", *((byte *)j));
}
kern_printf("\n\r");
}
}
void PRINTBRK(word stack, struct intState *p)
{
int pid;
struct pentry *pr;
pr = &(kp->procTable[Kgetpid()]);
asm {
tsc
sta >0x600
}
printf("BRK: pid: %d St: %04X\n",pr->flpid,stack);
/* traceback(stack); */
printf("A:%04X X:%04X Y:%04X S:%04X D:%04X B:%02X P:%02X PC:%02X%04X\n"
"e:%02X Last Tool: %04X\n",
p->irq_A, p->irq_X, p->irq_Y, p->irq_S, p->irq_D, p->irq_B, p->irq_P,
p->irq_K, p->irq_PC,p->irq_e,p->lastTool);
printf("proc: PC:%02X%04X P:%04X\n",pr->irq_K, pr->irq_PC, pr->irq_P);
}
void PANIC(char *str)
{
word stack;
disableps(); /* shut down context switching */
*((byte *) 0xE0C022l) = 0x1F;
asm {
tsc
sta >stack
lda >0xE0C029
and #0xFF7F
sta >0xE0C029
}
traceback(stack+2);
kern_printf("SYSTEM PANIC: %s\n\r",str);
noway:
goto noway;
}
#pragma databank 0

231
kern/gno/driver.asm Normal file
View File

@ -0,0 +1,231 @@
* $Id: driver.asm,v 1.1 1998/02/02 08:19:18 taubert Exp $
* GNO- the only IIgs Operating System left!
************************************************************
*
* Input/Output Drivers for TextTools
*
* .null
* GNO console
* redirection supervisory driver
* pipe interface driver for TextTools
*
************************************************************
*
* Our texttool driver scheme supports two types-
* standard and supervisory. Standard drivers must
* support the same calls as a RAM-based texttools
* driver. Supervisory drivers must support In/Out/Err
* calls. They may call lower-level RAM-based protocol
* drivers if they wish (and likely will).
*
************************************************************
*
* modified select stuff - Derek Taubert - 12/14/94
*
mcopy m/driver.mac
case on
copy global.equates
copy inc/tty.inc
copy inc/gsos.inc
getTTindex START KERN2
getTTindex name
using KernelStruct
lda >truepid
asl a
asl a
asl a
asl a
asl a
asl a
tax
rts
END
* given a GSstring as input, searches our device table for a match.
* if a match is found, the internal device number is returned.
* Note that these device numbers are the index+1, as 0 is not a valid
* pipe/refNum/device/.. number. However, the TextTools use index+0,
* so keep this in mind.
findDevice START KERN2
findDevice name
using KernelStruct
ind equ 0
retval equ ind+2
space equ retval+2
subroutine (4:gsosp),space
ldy #2
lda [gsosp],y
and #$FF
cmp #'.' ; is this a driver name?
bne notadriver
ph4 #dottty
ph4 gsosp
jsl GScaseEqual
cmp #0
beq findloop1
lda >curProcInd
tax
lda >ttyID,x
sta retval ; get the 'controlling' tty #
bra goaway
findloop1 stz ind
findloop lda ind
asl a
asl a
tax
lda >DeviceNames+2,x
ora >DeviceNames,x
beq nodevice
lda >DeviceNames+2,x
pha
lda >DeviceNames,x
pha
ph4 gsosp
jsl GScaseEqual
cmp #0
beq nodevice
* we have a device match.
lda ind
sta retval
bra goaway
nodevice lda ind
inc a
cmp #38
bcs notadriver
sta ind
bra findloop
notadriver lda #$FFFF
sta retval
goaway return 2:retval
dottty dc i2'4'
dc c'.tty'
END
getProcPtr START
getProcPtr name
using KernelStruct
lda >curProcInd
tay
clc
adc #KernelStruct
ldx #^KernelStruct
rtl
END
* Installs a driver into the system by adding the pointer
* to the driver's header block into the system driver table.
InstallDriver START KERN2
InstallDriver name
subroutine (4:header,2:deviceNum,2:userID),0
lda deviceNum
asl a
asl a
tax
lda header
sta >DeviceBlock,x
lda header+2
sta >DeviceBlock+2,x
ldy #t_devNum
lda deviceNum
sta [header],y
ldy #t_GetProcInd
lda tempGetPP
sta [header],y
ldy #t_GetProcInd+2
lda tempGetPP+2
sta [header],y
ldy #t_userid
lda userID
sta [header],y
ldy #t_sendSignal
lda tempQsig
sta [header],y
ldy #t_sendSignal+2
lda tempQsig+2
sta [header],y
ldy #t_BGCheck
lda tempBG
sta [header],y
ldy #t_BGCheck+2
lda tempBG+2
sta [header],y
ldy #t_selwakeup
lda tempSWU
sta [header],y
ldy #t_selwakeup+2
lda tempSWU+2
sta [header],y
; initialize to the standard line discipline
lda #0 ; line discipline code
ldy #t_linedisc
sta [header],y
ldy #privFlags
sta [header],y
ldy #st_flags
sta [header],y
lda deviceNum
beq nullDev
ldy #t_read+2
lda [header],y
ldy #t_read
ora [header],y
bne skipR
lda #ttread ; standard LD read routine
sta [header],y
lda #^ttread
ldy #t_read+2
sta [header],y
skipR anop
ldy #t_write+2
lda [header],y
ldy #t_write
ora [header],y
bne skipW
lda #ttwrite ; standard LD write routine
sta [header],y
lda #^ttwrite
ldy #t_write+2
sta [header],y
skipW anop
; the driver's open routine must initialize the other line discipline
; vectors if they are not set up as static assignments (e.g. dc i4'CON_mutex')
; allocate the edit buffer.
ph4 #4096
jsl malloc
ldy #editBuf
sta [header],y
txa
ldy #editBuf+2
sta [header],y
nullDev return
tempAlloc jmp >asmSemNew
tempDealloc jmp >asmSemDispose
tempWait jmp >asmWait
tempSignal jmp >asmSignal
tempBG jmp >BGCheck
tempQsig jmp >ttyQSignal
tempGetPP jmp >getProcPtr
tempSWU jmp >selwakeup
END

398
kern/gno/ep.c Normal file
View File

@ -0,0 +1,398 @@
/* $Id: ep.c,v 1.1 1998/02/02 08:18:25 taubert Exp $ */
/* Things to do before this code can be installed:
kernel must mutex all prefixes
this code should be changed from using GetPrefix to grabbing
the prefixes directly from the process entry
*/
#pragma optimize 79
segment "KERN2 ";
#include "proc.h"
#include "sys.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include "/lang/orca/libraries/orcacdefs/ctype.h"
#include <gsos.h>
unsigned short err;
extern kernelStructPtr kp;
typedef GSString255Ptr Gstr;
ExpandPathRecGS ep;
PrefixRecGS gp;
/* this is for P16_EXPANDPATH */
struct P16String {
byte length;
char text[255];
} ;
typedef struct P16String P16String, *P16StringPtr;
#define PRIME 31
#define NUM_NP 20
struct h {
Gstr pfx;
Gstr exp_pfx;
struct h *next;
};
struct h h_pool[NUM_NP];
unsigned int pool_ind = 0;
struct h *h_table[PRIME];
typedef struct stack {
Gstr name;
unsigned short ind;
char sep;
} *stackPtr;
struct stack the_stack[3];
unsigned short stack_ind = 0;
void printGS(Gstr path)
{
unsigned short i;
for (i = 0; i < path->length; i++) fputc(path->text[i],stderr);
}
static unsigned long
hashpjw(Gstr s,unsigned short leng)
{
char *p;
unsigned long h = 0, g;
unsigned short i;
for (i = 1; i < leng; i++) {
h = (h << 4) + (toupper(s->text[i]));
if (g = h & 0xF0000000) {
h ^= (g >> 24);
h ^= g;
}
}
return h % PRIME;
}
void init_htable(void)
{
FILE *np;
Gstr p,map;
unsigned short hent;
unsigned short i;
short x;
char *line,*pt,*pt1;
for (i = 0; i < NUM_NP; i++) {
h_pool[i].pfx = NULL;
h_pool[i].exp_pfx = NULL;
}
line = malloc(128l);
np = fopen("9/etc/namespace","r");
if (np != NULL) {
while (!feof(np)) {
if (pool_ind == NUM_NP) {
printf("warning: more than 20 entries in the /etc/namespace file\n");
break;
}
p = malloc(19);
map = malloc(67);
fgets(line,127,np);
if ((line[0] == 0) || (line[0] == '\n')) continue;
pt = line;
/* find end of first string */
while ((*pt != 0) && (!isspace(*pt))) pt++;
if (*pt == 0) PANIC("invalid namespace specifier");
/* find start of second string */
*pt++ = 0;
while ((*pt != 0) && (isspace(*pt))) pt++;
if (*pt == 0) PANIC("invalid namespace specifier");
pt1 = pt;
/* find end of second string */
while ((*pt != 0) && (!isspace(*pt))) pt++;
*pt = 0;
strcpy(p->text,line);
strcpy(map->text,pt1);
p->length = strlen(p->text);
map->length = strlen(map->text);
hent = (unsigned short) hashpjw(p,p->length);
h_pool[pool_ind].next = h_table[hent];
h_table[hent] = &h_pool[pool_ind];
h_pool[pool_ind].pfx = p;
h_pool[pool_ind].exp_pfx = map;
/* printf("prefix: ");
printGS(p);
printf(" location: %d pool: %d\n",hent,pool_ind); */
pool_ind++;
}
fclose(np);
} else printf("warning: could not locate :etc:namespace\n");
free(line);
}
#undef TOLOWER
#define TOLOWER(c) isupper(c) ? _tolower(c) : c
int
strincmp (const char *s1, const char *s2, size_t n)
{
unsigned int c1, c2;
size_t i;
for (i=0; i<n; i++) {
c1 = TOLOWER(*s1);
c2 = TOLOWER(*s2);
if (c1 == '\0' && c2 == '\0') {
return 0;
} else if (c1 == c2) {
s1++; s2++;
} else {
/* don't do subtraction -- see man page */
return (c1 > c2) ? 1 : -1;
}
}
return 0;
}
/* needs a fully expanded GS string */
Gstr match(Gstr fname, unsigned short leng, char sep)
{
unsigned short i,hent;
struct h *l;
i = 1;
while ((i < leng) && (fname->text[i] != sep)) i++;
hent = (unsigned short) hashpjw(fname,i);
l = h_table[hent];
while (l != NULL) {
/* make sure vol. name is same length as hashed entry */
if ((l->pfx->length == i)
&& (!strincmp(fname->text+1,l->pfx->text+1,i-1))) break;
l = l->next;
}
if (l == NULL) return NULL;
else return l->exp_pfx;
}
unsigned short isSeparator(char c)
{
if ((c == ':') || (c == '/')) return 1;
else return 0;
}
void push(Gstr x, unsigned short y, char sep)
{
the_stack[stack_ind].name = x;
the_stack[stack_ind].ind = y;
the_stack[stack_ind].sep = sep;
stack_ind++;
}
stackPtr top(void)
{
if (!stack_ind) return NULL;
else return &the_stack[stack_ind-1];
}
stackPtr pop(void)
{
if (!stack_ind) return NULL;
else return &the_stack[--stack_ind];
}
void clearstack(void)
{
stack_ind = 0;
}
ResultBuf32 rbuf;
Gstr go = NULL;
static word nullGSOS = 0;
#pragma databank 1
Gstr gno_ExpandPath(Gstr i_path, int num, word npFlag)
{
unsigned short i,j,pfxNum,oldlen,outind,outind2;
Gstr g_out,g1;
char SEP,nSEP;
Gstr g;
stackPtr sp;
extern int OldGSOSSt(word callnum, void *pBlock);
if (go == NULL) go = malloc(1024l);
if (i_path->length > 1024) return (Gstr) 0xFFFF0040l;
g_out = go;
rbuf.bufSize = 32;
ep.pCount = 3;
ep.flags = 0;
/* Separator conversion and determination */
i = 0;
while ((i < i_path->length) && !isSeparator(i_path->text[i])) i++;
if (i == i_path->length) SEP = ':';
else SEP = i_path->text[i]; /* grab the separator character */
push(i_path,0,SEP); /* use this separator here */
if (!isSeparator(i_path->text[0])) {
/* Scan for first component */
i = 0;
while ((i < i_path->length) && (i_path->text[i] != SEP)) i++;
/* Check for * prefix */
if ( ((i == 1) && (i_path->text[0] == '*')) ||
/* Check for device prefix */
((i > 1) && (i_path->text[0] == '.') && (i_path->text[1] != '.')) )
{
/* Expand the prefix with old expandpath (source is input string
* with length temporarily set to trick ExpandPath).
* Add to copy stack, fix length.
*/
oldlen = i_path->length;
i_path->length = i;
ep.inputPath = (Gstr) i_path;
ep.outputPath = (ResultBuf255Ptr) &rbuf;
err = OldGSOSSt(0x200e,&ep);
/* ExpandPathGS(&ep); */
i_path->length = oldlen;
if (rbuf.bufString.text[0] == '.') {
clearstack();
g_out = (Gstr) &rbuf.bufString;
goto goaway;
}
push((Gstr) &rbuf.bufString,i,':');
goto phase2;
}
/* Check for @ prefix, add to copy stack if present */
else if ((i == 1) && (i_path->text[0] == '@')) {
push((Gstr) PROC->prefix[0],i,':');
goto phase2;
}
/* Check for numeric prefix */
else if (isdigit(i_path->text[0])) {
/* Do a GetPrefix call on the parsed prefix number
* add to copy stack
*/
j = 0; pfxNum = 0;
while ((j < i) && (isdigit(i_path->text[j]))) {
pfxNum = (pfxNum * 10) + (i_path->text[j] - '0');
j++;
}
if (j == i) {
if (pfxNum > 31) {
clearstack();
return (Gstr) 0xFFFF0040l; /* syntax error */
}
g = (Gstr) PROC->prefix[pfxNum+1];
if (g == NULL) push((Gstr) &nullGSOS,i,':');
else push(g,i,':');
goto phase2;
} /* if j != i, there was a non-numeral in the prefix number,
so fall through to concat prefix 0 onto it */
}
/* else expand by prefix 0 (adding the pfx 0 ptr directly to the stack) */
g = (Gstr) PROC->prefix[num+1];
if (g == NULL) push((Gstr) &nullGSOS,0,':');
else push(g,0,':');
}
phase2:
/* Check for named prefix */
if (!npFlag) {
g = top()->name;
/* SEP = top()->sep; */
i = 1;
while ((i < g->length) && (g->text[i] != top()->sep)) i++;
/* If there's a match, add the result string to the top of the stack */
if (i > 1)
if (g1 = match(g,i,SEP))
push(g1,i,':');
}
/* Start at the top of the stack
scan each path component, checking for '.' or '..' removing bits
as appropriate
copy each component into the output buffer
at the end of the string, pop the stack
if the stack is empty, we're done, so return */
nSEP = ':';
outind = i = 0;
while (sp = pop()) {
g = sp->name;
/* nSEP = sp->sep;*/
if (top() == NULL) nSEP = SEP;
oldlen = g->length;
if (g->text[oldlen-1] == nSEP) oldlen--;
while (i < oldlen) {
g_out->text[outind++] = ':';
if (g->text[i] == nSEP) i++;
j = i; /* beginning of segment */
/* locate end of segment */
while ((i < oldlen) && (g->text[i] != nSEP)) i++;
if ((i-j == 1) && (g->text[j] == '.')) outind--;
else if ((i-j == 2) && (g->text[j] == '.') && (g->text[j+1] == '.')) {
outind2 = outind-2;
while ((outind2 > 0) && (g_out->text[outind2] != ':')) outind2--;
if (outind2 != 0) outind = outind2; /* move outind back */
else outind--; /* just zap the colon */
}
else
while (j < i) g_out->text[outind++] = g->text[j++];
}
i = sp->ind;
}
g_out->length = outind;
goaway:
if (kp->gsosDebug & 2) {
fprintf(stderr,"EP[");
printGS(g_out); fprintf(stderr,"]\n");
}
if ((g_out->length == 1) && (g_out->text[0] == ':')) g_out->length = 0;
return g_out;
}
GSString255 p_buf;
Gstr p16_ExpandPath(P16StringPtr path, int num, word npFlag)
{
p_buf.length = path->length;
memcpy(p_buf.text, path->text, (longword) p_buf.length);
return gno_ExpandPath((Gstr) &p_buf,num,npFlag);
}
#pragma databank 0
#ifndef KERNEL
char in[80];
int main(int argc, char *argv[])
{
unsigned l;
Gstr g,g1;
init_htable();
while (1) {
gets(in);
l = strlen(in);
g = malloc(l+2);
memcpy(g->text,in,l);
g->length = l;
g1 = GNO_EXPANDPATH(g,0);
printGS(g1);
printf("\n");
free(g);
}
}
#endif

298
kern/gno/err.asm Normal file
View File

@ -0,0 +1,298 @@
* $Id: err.asm,v 1.1 1998/02/02 08:19:20 taubert Exp $
**************************************************************************
*
* The GNO Shell Project
*
* Developed by:
* Jawaid Bazyar
* Tim Meekins
* Derek Taubert
*
**************************************************************************
*
* ERR.ASM
* By Tim Meekins
*
* Displays error messages for
* GS/OS
* Loader
* Memory Manager
* Resource manager
* GNO ($FFxx)
*
**************************************************************************
mcopy m/err.mac
case on
printError START KERN2
proc
sta err
cmp #0
bne gooderr
procendL
gooderr anop
Int2Hex (err,#str1+1,#4)
ErrWriteCString #str1
ldx #0
findtoolloop lda tooltbl+2,x
bmi foundtool
lda err
and #$FF00
cmp tooltbl,x
beq foundtool
add2 @x,#8,@x
bra findtoolloop
foundtool lda tooltbl+6,x
tay
lda tooltbl+4,x
ErrWriteString @ya
ldx #0
finderrloop lda errtbl,x
cmp #$FFFF
beq founderr
cmp err
beq founderr
add2 @x,#6,@x
bra finderrloop
founderr lda errtbl+4,x
tay
lda errtbl+2,x
ErrWriteLine @ya
procendL
err ds 2
str1 dc c'$0000 ',h'00'
tooltbl dc i4'$0000',a4'tstr1'
dc i4'$0200',a4'tstr3'
dc i4'$1100',a4'tstr2'
dc i4'$1E00',a4'tstr4'
dc i4'$FF00',a4'tstr5'
dc i4'-1',a4'tstr0'
errtbl dc i'$0001',a4'err0001'
dc i'$0004',a4'err0004'
dc i'$0005',a4'err0005'
dc i'$0006',a4'err0006'
dc i'$0007',a4'err0007'
dc i'$0010',a4'err0010'
dc i'$0011',a4'err0011'
dc i'$001F',a4'err001F'
dc i'$0020',a4'err0020'
dc i'$0021',a4'err0021'
dc i'$0022',a4'err0022'
dc i'$0023',a4'err0023'
dc i'$0024',a4'err0024'
dc i'$0025',a4'err0025'
dc i'$0026',a4'err0026'
dc i'$0027',a4'err0027'
dc i'$0028',a4'err0028'
dc i'$0029',a4'err0029'
dc i'$002B',a4'err002B'
dc i'$002C',a4'err002C'
dc i'$002D',a4'err002D'
dc i'$002E',a4'err002E'
dc i'$002F',a4'err002F'
dc i'$0040',a4'err0040'
dc i'$0042',a4'err0042'
dc i'$0043',a4'err0043'
dc i'$0044',a4'err0044'
dc i'$0045',a4'err0045'
dc i'$0046',a4'err0046'
dc i'$0047',a4'err0047'
dc i'$0048',a4'err0048'
dc i'$0049',a4'err0049'
dc i'$004A',a4'err004A'
dc i'$004B',a4'err004B'
dc i'$004C',a4'err004C'
dc i'$004D',a4'err004D'
dc i'$004E',a4'err004E'
dc i'$004F',a4'err004F'
dc i'$0050',a4'err0050'
dc i'$0051',a4'err0051'
dc i'$0052',a4'err0052'
dc i'$0053',a4'err0053'
dc i'$0054',a4'err0054'
dc i'$0055',a4'err0055'
dc i'$0056',a4'err0056'
dc i'$0057',a4'err0057'
dc i'$0058',a4'err0058'
dc i'$0059',a4'err0059'
dc i'$005A',a4'err005A'
dc i'$005B',a4'err005B'
dc i'$005C',a4'err005C'
dc i'$005D',a4'err005D'
dc i'$005E',a4'err005E'
dc i'$005F',a4'err005F'
dc i'$0060',a4'err0060'
dc i'$0061',a4'err0061'
dc i'$0062',a4'err0062'
dc i'$0063',a4'err0063'
dc i'$0064',a4'err0064'
dc i'$0065',a4'err0065'
dc i'$0067',a4'err0067'
dc i'$0069',a4'err0069'
dc i'$0070',a4'err0070'
dc i'$0071',a4'err0071'
dc i'$0201',a4'err0201'
dc i'$0202',a4'err0202'
dc i'$0203',a4'err0203'
dc i'$0204',a4'err0204'
dc i'$0205',a4'err0205'
dc i'$0206',a4'err0206'
dc i'$0207',a4'err0207'
dc i'$0208',a4'err0208'
dc i'$1101',a4'err1101'
dc i'$1102',a4'err1102'
dc i'$1103',a4'err1103'
dc i'$1104',a4'err1104'
dc i'$1105',a4'err1105'
dc i'$1107',a4'err1107'
dc i'$1108',a4'err1108'
dc i'$1109',a4'err1109'
dc i'$110A',a4'err110A'
dc i'$110B',a4'err110B'
dc i'$1E01',a4'err1E01'
dc i'$1E02',a4'err1E02'
dc i'$1E03',a4'err1E03'
dc i'$1E04',a4'err1E04'
dc i'$1E05',a4'err1E05'
dc i'$1E06',a4'err1E06'
dc i'$1E07',a4'err1E07'
dc i'$1E08',a4'err1E08'
dc i'$1E09',a4'err1E09'
dc i'$1E0A',a4'err1E0A'
dc i'$1E0B',a4'err1E0B'
dc i'$1E0C',a4'err1E0C'
dc i'$1E0D',a4'err1E0D'
dc i'$1E0E',a4'err1E0E'
dc i'$FF00',a4'errFF00'
dc i'$FF02',a4'errFF02'
dc i'$FF03',a4'errFF03'
dc i'$FF04',a4'errFF04'
dc i'$FF05',a4'errFF05'
dc i'$FF06',a4'errFF06'
dc i'$FFFF',a4'errFFFF'
tstr0 str 'Unknown '
tstr1 str 'GS/OS: '
tstr2 str 'Loader: '
tstr3 str 'Memory Manager: '
tstr4 str 'Resource: '
tstr5 str 'GNO: '
err0001 str 'Bad GS/OS call number'
err0004 str 'Parameter count out of range'
err0005 str 'Parameter pointer out of range'
err0006 str 'Communication error in IWM'
err0007 str 'GS/OS is busy'
err0010 str 'Device wasn''t found'
err0011 str 'Invalid device number requested'
err001F str 'Interrupt devices are not supported'
err0020 str 'Invalid request'
err0021 str 'Invalid control or status code'
err0022 str 'Bad call parameter'
err0023 str 'Character device not open'
err0024 str 'Character device already open'
err0025 str 'Interrupt table full'
err0026 str 'Resources not available'
err0027 str 'Disk I/O error'
err0028 str 'No device connected'
err0029 str 'Driver is busy'
err002B str 'Device is write-protected'
err002C str 'Invalid byte count'
err002D str 'Invalid block address'
err002E str 'Disk has been switched'
err002F str 'Device off line or no media present'
err0040 str 'Invalid pathname syntax'
err0042 str 'Too many files open'
err0043 str 'Invalid reference number'
err0044 str 'Subdirectory does not exist'
err0045 str 'Volume not found'
err0046 str 'File not found'
err0047 str 'Create or rename with existing name'
err0048 str 'Volume full'
err0049 str 'Volume directory full'
err004A str 'Version error (Incompatible file format)'
err004B str 'Unsupported storage type'
err004C str 'End of file encountered'
err004D str 'Position out of range'
err004E str 'Access not allowed'
err004F str 'Buffer too small'
err0050 str 'File is already open'
err0051 str 'Directory error'
err0052 str 'Unknown volume type'
err0053 str 'Parameter out of range'
err0054 str 'Out of memory'
err0055 str 'Block table full'
err0056 str 'Invalid buffer'
err0057 str 'Duplicate volume name'
err0058 str 'Not a block device'
err0059 str 'Level specified outside of legal range'
err005A str 'Block number too large'
err005B str 'Invalid path names for ChangePath'
err005C str 'Not an executable'
err005D str 'Operating system not supported'
err005E str '/RAM cannot be removed'
err005F str 'Too many applications on stack'
err0060 str 'Data unavailable'
err0061 str 'End of directory has been reached'
err0062 str 'Invalid FST call class'
err0063 str 'File does not contain required resource'
err0064 str 'FST ID is invalid'
err0065 str 'Invalid FST operation'
err0067 str 'Device exists with same name as replacement name'
err0069 str 'I/O terminated due to NewLine'
err0070 str 'Cannot expand device, resource fork already exists'
err0071 str 'Cannot add resource fork to this type of file'
err0201 str 'Unable to allocate block'
err0202 str 'Illegal operation on an empty handle'
err0203 str 'Empty handle expected for this operation'
err0204 str 'Illegal operation on a locked or immovable block'
err0205 str 'Attempt to purge an unpurgable block'
err0206 str 'Invalid handle'
err0207 str 'Invalid user ID'
err0208 str 'Illegal operation with specified attributes'
err1101 str 'Entry not found'
err1102 str 'OMF version error'
err1103 str 'Pathname error'
err1104 str 'File not in load file'
err1105 str 'Loader is busy'
err1107 str 'File version error'
err1108 str 'User ID error'
err1109 str 'Segment number out of sequence'
err110A str 'Illegal load record found'
err110B str 'Load segment is foreign'
err1E01 str 'Resource fork not empty'
err1E02 str 'Resource fork not correctly formatted'
err1E03 str 'No converter routine for resource type'
err1E04 str 'No current resource file'
err1E05 str 'Specified resource ID is already in use'
err1E06 str 'Specified resource not found'
err1E07 str 'Specified ID does not match an open file'
err1E08 str 'User ID not found'
err1E09 str 'No more resource IDs available'
err1E0A str 'Index is out of range'
err1E0B str 'System file is already open'
err1E0C str 'Resource has been changed'
err1E0D str 'Another converted already logged in'
err1E0E str 'Volume full'
errFF00 str 'Too many arguments'
errFF02 str 'Extra < encountered'
errFF03 str 'Illegal < syntax'
errFF04 str 'Extra > encountered'
errFF05 str 'Illegal > syntax'
errFF06 str '> and | conflict'
errFFFF str 'error'
END

715
kern/gno/fastfile.c Normal file
View File

@ -0,0 +1,715 @@
/* $Id: fastfile.c,v 1.1 1998/02/02 08:18:27 taubert Exp $ */
/*
fastfile.c
C routines to duplicate the Orca Shell fastfile system
I wouldn't do this except the Orca compilers require FastFile.
*/
#pragma optimize 72
#include "proc.h"
#include "sys.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include "/lang/orca/libraries/orcacdefs/stddef.h"
#include <ctype.h>
#include <gsos.h>
#include <shell.h>
#include <memory.h>
#include <misctool.h>
#include <orca.h>
typedef struct {
int action;
int index;
int flags;
handle fileHandle;
GSString255Ptr pathName;
int access;
int fileType;
long auxType;
int storageType;
TimeRec createDate;
TimeRec modDate;
void *option;
long fileLength;
long blocksUsed;
} my_FastFileGSPB;
#pragma lint -1
void printGS(GSString255Ptr path);
/*#define DEBUG*/
#ifdef DEBUG
#define PRINT(arg) fprintf(stderr,arg)
#else
#define PRINT(arg)
#endif
segment "KERN3 ";
extern void gnoSetHandleID(word, handle);
struct ffentry {
int action;
int index;
int flags;
handle fileHandle;
GSString255Ptr pathnameGS;
char *pathnameP;
FileInfoRecGS info;
int hidden;
struct ffentry *next;
};
typedef struct ffentry ffentry, *ffentryPtr;
/*extern int OLDGSOSST(word callnum, void *pBlock); */
ffentryPtr ffList = NULL;
unsigned InFastFile = 0;
int pstrlen(char *p)
{ return p[0]; }
extern void copygs2res(void *,void*);
void p2gs(char *src, GSString255Ptr gs)
{
gs->length = pstrlen(src);
memcpy(gs->text,src+1,gs->length);
}
ffentryPtr NewFF(GSString255Ptr pathnameGS)
{
GSString255Ptr pathGS;
char *path;
ffentryPtr newEntry;
int tmp;
path = malloc((size_t) (pathnameGS->length+1));
path[0] = pathnameGS->length;
memcpy(path+1,pathnameGS->text,(size_t) path[0]);
/* perhaps we should change the seps AFTER we copy the contents of
the string */
for (tmp = 1; tmp <= path[0]; tmp++)
if (path[tmp] == ':') path[tmp] = '/';
pathGS = malloc((size_t) (pathnameGS->length+2));
pathGS->length = pathnameGS->length;
memcpy(pathGS->text,pathnameGS->text,pathGS->length);
newEntry = malloc(sizeof(ffentry));
/* link into the list */
newEntry->next = ffList;
ffList = newEntry;
newEntry->pathnameP = path;
newEntry->pathnameGS = pathGS;
newEntry->fileHandle = NULL;
newEntry->hidden = 0;
return newEntry;
}
#pragma databank 1
void DeleteFF(ffentryPtr p)
{
ffentryPtr prev;
prev = ffList;
if (prev != p)
while (prev != NULL) {
if (prev->next == p) break;
prev = prev->next;
}
if (prev == NULL) { fprintf(stderr,"entry not found in DeleteFF\n");
return; }
if (p->pathnameGS != NULL) nfree(p->pathnameGS);
if (p->pathnameP != NULL) nfree(p->pathnameP);
if (p->fileHandle != NULL) {
HUnlock(p->fileHandle);
DisposeHandle(p->fileHandle);
}
if (prev == p) { ffList = prev->next; }
else { prev->next = p->next; }
nfree(p);
}
ffentryPtr FindIndFF(int index)
{
ffentryPtr p;
int step = 0;
p = ffList;
while (p != NULL) {
if (step == index) break;
step++;
p = p->next;
}
return p;
}
ffentryPtr FindFF(GSString255Ptr path)
{
ffentryPtr p;
extern int GScaseEqual(void*,void*);
p = ffList;
while (p != NULL) {
if (GScaseEqual(path,p->pathnameGS) && (!p->hidden) ) break;
p = p->next;
}
return p;
}
#pragma databank 0
FileInfoRecGS fi;
CreateRecGS cr;
NameRecGS ds;
OpenRecGS op;
IORecGS re;
ExpandPathRecGS pcep;
int cl[2];
int upToDate(ffentryPtr p)
{
FileInfoRecGS f;
word dateBuf[8];
if (p->flags & 0x8000) {
f.pCount = 7;
f.pathname = p->pathnameGS;
GetFileInfoGS(&f);
if (toolerror()) printf("GetFileInfo err %04X\n",toolerror());
if (memcmp(&f.modDateTime,&p->info.modDateTime,sizeof(TimeRec)))
return 0;
/* memcpy(dateBuf,&f.modDateTime,sizeof(TimeRec));
ConvSeconds(9,0l,(Pointer)dateBuf);
if ((dateBuf[0] != p->info.mod_date) ||
(dateBuf[1] != p->info.mod_time)) return 0; */
/* memcpy(dateBuf,&f.createDateTime,sizeof(TimeRec));
ConvSeconds(9,0l,(Pointer)dateBuf);
if ((dateBuf[0] != p->info.create_date) ||
(dateBuf[1] != p->info.create_time)) return 0; */
}
return 1;
}
void ffErr(int err)
{
/* fprintf(stderr,"FastFile error: %04X\n",err); */
}
handle loadFile(GSString255Ptr pathGS, ffentryPtr p)
{
handle fileHandle;
word dateBuf[8];
char asciiBuf[30];
longword secs;
int err;
p->hidden = 1;
op.pCount = 13;
op.pathname = pathGS;
op.requestAccess = readEnable;
op.resourceNumber = 0;
op.optionList = NULL;
/* err = OLDGSOSST(0x2010,&op); */
/* if (err) { ffErr(err); return NULL; } */
OpenGS(&op); /* to prevent conflict with Open-remove code */
if (_toolErr) { ffErr(_toolErr); p->hidden = 0; return NULL; }
fileHandle = NewHandle(op.eof,userid() | 0x0100, 0x8000, NULL);
if (fileHandle == NULL) { p->hidden = 0; ffErr(toolerror()); return NULL; }
re.pCount = 4;
re.refNum = op.refNum;
re.dataBuffer = *fileHandle;
re.requestCount = op.eof;
/*err = OLDGSOSST(0x2012,&re);*/
ReadGS(&re);
if (err) { ffErr(err); }
cl[0] = 1;
cl[1] = op.refNum;
CloseGS(cl);
/*err = OLDGSOSST(0x2014,cl);*/
p->fileHandle = fileHandle;
p->info.eof = op.eof;
p->info.blocksUsed = op.blocksUsed;
p->info.resourceEOF = op.resourceEOF;
p->info.resourceBlocks = op.resourceBlocks;
p->info.access = op.access;
p->info.fileType = op.fileType;
p->info.auxType = op.auxType;
p->info.storageType = op.storageType;
memcpy(&p->info.createDateTime,&op.createDateTime,sizeof(TimeRec));
memcpy(&p->info.modDateTime,&op.modDateTime,sizeof(TimeRec));
/* memcpy(dateBuf,&op.createDateTime,sizeof(TimeRec));
ConvSeconds(9,0l,(Pointer)dateBuf);
p->info.create_date = dateBuf[0];
p->info.create_time = dateBuf[1];
memcpy(dateBuf,&op.modDateTime,sizeof(TimeRec));
ConvSeconds(9,0l,(Pointer)dateBuf);
p->info.mod_date = dateBuf[0];
p->info.mod_time = dateBuf[1];
p->info.blocks_used = op.blocksUsed; */
p->hidden = 0;
return fileHandle;
}
/*
the entry point for all fastFile routines. The assembly code just
calls fastEntry with the address of the paramBlock (real one, not the
copy)
osFlag = 0 for P16, 1 for GS/OS strings
ff must point to the first parameter, not the pCount in the new scheme
osFlag will always be 0 for now. I won't guess at what the Orca 2.0
call format's going to be.
*/
#pragma databank 1
int fastEntry(FastFilePB *ff, int osFlag, int pCount)
{
my_FastFileGSPB *fg = (my_FastFileGSPB *) ff;
ffentryPtr p;
handle fileHandle,tmpHandle;
GSString255Ptr pathCopy;
ResultBuf255Ptr epRes;
int tmp,err;
char *tmps;
int dateBuf[4];
extern void printGS(GSString255Ptr path);
err = 0;
/* all calls but Indexed Load take path as input, so condition it */
InFastFile = 1;
if (ff->action != 1) {
if (!osFlag) {
pathCopy = malloc(pstrlen(ff->pathname)+2);
p2gs(ff->pathname,pathCopy);
pcep.inputPath = pathCopy;
} else pcep.inputPath = fg->pathName;
epRes = malloc(sizeof(ResultBuf255));
epRes->bufSize = 255;
pcep.outputPath = epRes;
pcep.pCount = 3;
pcep.flags = (!osFlag) ? 0x8000 : 0;
ExpandPathGS(&pcep);
if (!osFlag) nfree(pathCopy);
pathCopy = &epRes->bufString;
/* for (tmp = 0; tmp < pathCopy->length; tmp++)
if (pathCopy->text[tmp] == ':') pathCopy->text[tmp] = '/'; */
}
switch (ff->action) {
case 0: /* Load */
case 2: /* Load from Memory */
#ifdef DEBUG
if (ff->action == 0) printf("Load "); else printf("Load Memory ");
printGS(pathCopy); printf("\n");
#endif
p = FindFF(pathCopy); /* find matching entry */
if (p == NULL) {
if (ff->action == 2) { err = 0x46; break; } /* file not found */
else p = NewFF(pathCopy); /* make a new entry */
}
if ((p->fileHandle != NULL) && /* handle allocated? */
(*p->fileHandle != NULL) && /* handle purged? */
(upToDate(p))) /* memory copy up to date? */
{
#ifdef DEBUG
printGS(p->pathnameGS);
printf(" up to date\n");
#endif
HLock(p->fileHandle);
/*if (!osFlag) ff->pathname = p->pathnameP;*/
goto setpath; /* set the pathname */
break;
}
/* handle was purged or image was not up to date. We dispose
here and loadFile will allocate a new one */
if (p->fileHandle != NULL) DisposeHandle(p->fileHandle);
fileHandle = loadFile(pathCopy,p);
if (fileHandle == NULL) {
err = toolerror();
DeleteFF(p);
}
else p->flags = ff->flags;
setpath: if (!osFlag)
ff->pathname = p->pathnameP;
/* printf("Load(Mem): flags:%04X\n",p->flags);*/
break;
/* Mike is totally off his rocker. FastFile $01 returns a pointer to a
resultBuffer. Hopefully the new version uses a GS/OS resultBuf. */
case 1: /* Indexed Load */
PRINT("<indexed load ");
#ifdef DEBUG
printf("(%d)> ",ff->index);
#endif
retryil:
p = FindIndFF(ff->index); /* find matching entry */
if (p == NULL) { err = 0x46; break; }
if ((*p->fileHandle != NULL)) { /*&& /* handle purged? */
/* (upToDate(p))) { */ /* memory copy up to date? */
if (!osFlag)
ff->pathname = p->pathnameP;
else { copygs2res(fg->pathName,p->pathnameGS); }
HLock(p->fileHandle);
ff->flags = p->flags;
break;
/* Mike copies it to a result buffer, but that's not safe in
a concurrent environment. This will do, as everyone assumes
you can't write to the pathname field */
}
/* handle was purged or image was not up to date. We dispose
here and loadFile will allocate a new one */
DisposeHandle(p->fileHandle);
/* if the file was not on disk, do not attempt to load it!
remove it from the FF system and retry the Indexed_Load call */
/* if (!(p->flags & 0x8000)) { */
DeleteFF(p);
goto retryil;
/* } */
fileHandle = loadFile(p->pathnameGS,p);
if (fileHandle == NULL) { InFastFile = 0; return toolerror(); }
ff->flags = p->flags;
if (!osFlag)
ff->pathname = p->pathnameP;
else { copygs2res(fg->pathName,p->pathnameGS); }
break;
case 3: /* Save */
PRINT("Save:");
#ifdef DEBUG
printGS(pathCopy); printf("\n");
#endif
p = FindFF(pathCopy);
if (p != NULL) {
PRINT("save:file existed\n");
if (ff->file_handle == p->fileHandle)
p->fileHandle = NULL; /* don't kill the block */
DeleteFF(p);
}
p = NewFF(pathCopy); /* create a new entry */
p->flags = ff->flags;
p->fileHandle = ff->file_handle;
p->info.eof = (osFlag ? fg->fileLength : ff->file_length);
cr.access = p->info.access = (osFlag ? fg->access : ff->access);
cr.fileType = p->info.fileType =
(osFlag ? fg->fileType : ff->file_type);
cr.auxType = p->info.auxType =
(osFlag ? fg->auxType : ff->aux_type);
if (!osFlag) {
dateBuf[0] = ff->create_date;
dateBuf[1] = ff->create_time;
ConvSeconds(8,0l,(Pointer)dateBuf);
memcpy(&p->info.createDateTime,dateBuf,sizeof(TimeRec));
dateBuf[0] = ff->mod_date;
dateBuf[1] = ff->mod_time;
ConvSeconds(8,0l,(Pointer)dateBuf);
memcpy(&p->info.modDateTime,dateBuf,sizeof(TimeRec));
} else {
memcpy(&p->info.modDateTime,&fg->modDate,sizeof(TimeRec));
memcpy(&p->info.createDateTime,&fg->createDate,sizeof(TimeRec));
}
cr.pCount = 4;
cr.pathname = p->pathnameGS;
doCreate:
CreateGS(&cr);
if (toolerror()) { err = toolerror();
if (err != 0x47) { DeleteFF(p); break; }
err = 0;
ds.pCount = 1;
ds.pathname = pathCopy;
p->hidden = 1;
DestroyGS(&ds);
p->hidden = 0;
if (!_toolErr) goto doCreate;
/*err = OLDGSOSST(0x2002,&ds);*/
/*if (!err) goto doCreate;*/
err = _toolErr; DeleteFF(p); break;
}
op.pCount = 2;
op.pathname = p->pathnameGS;
p->hidden = 1;
OpenGS(&op);
if (_toolErr) { err = _toolErr; DeleteFF(p); p->hidden = 0; break; }
/*err = OLDGSOSST(0x2010,&op);
if (err) { DeleteFF(p); p->hidden = 0; break; } */
re.pCount = 4;
re.refNum = op.refNum;
re.dataBuffer = *p->fileHandle;
re.requestCount = p->info.eof;
/*err = OLDGSOSST(0x2013,&re);*/
WriteGS(&re);
cl[0] = 1; cl[1] = op.refNum;
CloseGS(cl);
/*OLDGSOSST(0x2014,cl);*/
p->hidden = 0;
fi.pCount = 10;
fi.optionList = NULL;
fi.pathname = p->pathnameGS;
GetFileInfoGS(&fi);
p->info.blocksUsed = fi.blocksUsed;
/* tmpHandle = NewHandle(GetHandleSize(p->fileHandle),
userid() | 0x0100, 0x8000, NULL);
HandToHand(p->fileHandle,tmpHandle,
GetHandleSize(p->fileHandle)); */
/*p->fileHandle = tmpHandle;*/
gnoSetHandleID(userid(),p->fileHandle);
err = 0; break;
case 4: /* Add */
PRINT("Add ");
#ifdef DEBUG
printGS(pathCopy); printf("\n");
#endif
p = FindFF(pathCopy); /* is there already one? */
if (p != NULL)
DisposeHandle(p->fileHandle);
else p = NewFF(pathCopy);
if (!osFlag) {
p->info.access = ff->access;
p->info.fileType = ff->file_type;
p->info.auxType = ff->aux_type;
p->info.storageType = ff->storage;
dateBuf[0] = ff->create_date;
dateBuf[1] = ff->create_time;
ConvSeconds(8,0l,(Pointer)dateBuf);
memcpy(&p->info.createDateTime,dateBuf,sizeof(TimeRec));
dateBuf[0] = ff->mod_date;
dateBuf[1] = ff->mod_time;
ConvSeconds(8,0l,(Pointer)dateBuf);
memcpy(&p->info.modDateTime,dateBuf,sizeof(TimeRec));
p->info.blocksUsed = ff->blocks_used;
p->info.eof = ff->file_length;
} else {
memcpy(&p->info.access,&fg->access,36l);
}
p->flags = ff->flags;
p->fileHandle = NewHandle(GetHandleSize(fg->fileHandle),
userid() | 0x0100, 0x8000, NULL);
HandToHand(fg->fileHandle,p->fileHandle,
GetHandleSize(fg->fileHandle));
/* printf("Add: flags: %04X,handle:$%06lX\n",p->flags,
p->fileHandle); */
if (p->flags & 0x4000)
SetPurge(2,p->fileHandle);
else SetPurge(0,p->fileHandle);
break;
case 5:
case 6:
#ifdef DEBUG
if (ff->action == 5) printf("Delete ");else printf("Remove ");
printGS(pathCopy); printf("\n");
#endif
p = FindFF(pathCopy); /* find the file */
if (p == NULL) { err = 0x46; break; }
if (ff->action == 6) p->fileHandle = NULL;
DeleteFF(p);
break;
case 7: /* Purge */
PRINT("<Purge ");
#ifdef DEBUG
printGS(pathCopy); printf("> ");
#endif
p = FindFF(pathCopy); /* find matching entry */
if (p == NULL) { err = 0x46; break; } /* file not found */
if (p->flags & 0x4000) {
SetPurge(2,p->fileHandle);
HUnlock(p->fileHandle);
}
break;
}
if (ff->action != 1) nfree(epRes);
if (!err)
switch (ff->action) {
case 0: /* argh! why'd Mike stick Pathname in the middle of the */
case 1: /* return values instead of the beginning? */
case 2:
if (!osFlag) {
ff->file_handle = p->fileHandle;
ff->file_length = p->info.eof;
ff->access = p->info.access;
ff->file_type = p->info.fileType;
ff->aux_type = p->info.auxType;
ff->storage = p->info.storageType;
memcpy(dateBuf,&p->info.createDateTime,sizeof(TimeRec));
ConvSeconds(9,0l,(Pointer)dateBuf);
ff->create_date = dateBuf[0];
ff->create_time = dateBuf[1];
memcpy(dateBuf,&p->info.modDateTime,sizeof(TimeRec));
ConvSeconds(9,0l,(Pointer)dateBuf);
ff->mod_date = dateBuf[0];
ff->mod_time = dateBuf[1];
/* ff->create_date = p->info.createDate;
ff->create_time = p->info.createTime;
ff->mod_date = p->info.modDate;
ff->mod_time = p->info.modTime; */
ff->blocks_used = p->info.blocksUsed;
if (ff->action == 1) ff->flags = p->flags;
}
else switch (pCount) {
case 14: fg->blocksUsed = p->info.blocksUsed;
case 13: fg->fileLength = p->info.eof;
case 12: fg->option = p->info.optionList;
case 11: memcpy(&fg->modDate,&p->info.modDateTime,sizeof(TimeRec));
case 10: memcpy(&fg->createDate,&p->info.createDateTime,
sizeof(TimeRec));
case 9: fg->storageType = p->info.storageType;
case 8: fg->auxType = p->info.auxType;
case 7: fg->fileType = p->info.fileType;
case 6: fg->access = p->info.access;
default: fg->fileHandle = p->fileHandle;
if (ff->action == 1) fg->flags = p->flags;
}
}
/* if (err) printf("[err:%04X] ",err); */
InFastFile = 0;
return err;
}
extern kernelStructPtr kp;
typedef struct {
char *sFile;
char *dFile;
char *parms;
char *iString;
byte merr;
byte merrf;
byte lops;
byte kflag;
unsigned long mFlags;
unsigned long pFlags;
unsigned long org;
} oLInfoPB;
typedef struct {
GSString255Ptr sFile;
GSString255Ptr dFile;
GSString255Ptr parms;
GSString255Ptr iString;
byte merr;
byte merrf;
byte lops;
byte kflag;
unsigned long mFlags;
unsigned long pFlags;
unsigned long org;
} oLInfoRec;
void convcol2sl(char *p)
{
int i;
for (i = 1; i <= p[0]; i++)
if (p[i] == ':') p[i] = '/';
}
int cSetLInfo(oLInfoPB *pBlock, int cmdNum)
{
oLInfoRec *tmp;
extern void copyp2gs(void *, void *);
extern void copygsstr(void *, void *);
/* $$$ tmp = kp->procTable[Kgetpid()].LInfo; */
tmp = PROC->LInfo;
if (tmp == NULL) { tmp = malloc(sizeof(oLInfoRec));
/* $$$ kp->procTable[Kgetpid()].LInfo = tmp; */
PROC->LInfo = tmp;
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
tmp->sFile = tmp->dFile = tmp->parms = tmp->iString = NULL;
#else
tmp->sFile = NULL;
tmp->dFile = NULL;
tmp->parms = NULL;
tmp->iString = NULL;
#endif
}
if (tmp->sFile != NULL) {
nfree(tmp->sFile);
nfree(tmp->dFile);
nfree(tmp->iString);
nfree(tmp->parms);
}
if (cmdNum == 0x0102) {
tmp->sFile = malloc(pBlock->sFile[0] + 2);
copyp2gs(tmp->sFile,pBlock->sFile);
tmp->dFile = malloc(pBlock->dFile[0] + 2);
copyp2gs(tmp->dFile,pBlock->dFile);
tmp->parms = malloc(pBlock->parms[0] + 2);
copyp2gs(tmp->parms,pBlock->parms);
tmp->iString = malloc(pBlock->iString[0] + 2);
copyp2gs(tmp->iString,pBlock->iString);
} else {
tmp->sFile = malloc( ((oLInfoRec *) pBlock)->sFile->length + 2);
copygsstr(tmp->sFile,pBlock->sFile);
tmp->dFile = malloc( ((oLInfoRec *) pBlock)->dFile->length + 2);
copygsstr(tmp->dFile,pBlock->dFile);
tmp->parms = malloc( ((oLInfoRec *) pBlock)->parms->length + 2);
copygsstr(tmp->parms,pBlock->parms);
tmp->iString = malloc( ((oLInfoRec *) pBlock)->iString->length + 2);
copygsstr(tmp->iString,pBlock->iString);
}
tmp->merr = pBlock->merr;
tmp->merrf = pBlock->merrf;
tmp->lops = pBlock->lops;
tmp->kflag = pBlock->kflag;
tmp->mFlags = pBlock->mFlags;
tmp->pFlags = pBlock->pFlags;
tmp->org = pBlock->org;
return 0;
}
int cGetLInfo(oLInfoPB *pBlock, int cmdNum)
{
oLInfoRec *tmp;
extern void copygs2p(void *, void *);
extern void copygs2res(void *, void *);
/* $$$ tmp = kp->procTable[Kgetpid()].LInfo; */
tmp = PROC->LInfo;
if (tmp == NULL) return 0;
if (cmdNum == 0x0101) {
copygs2p(pBlock->sFile,tmp->sFile);
convcol2sl((char *)pBlock->sFile);
copygs2p(pBlock->dFile,tmp->dFile);
convcol2sl((char *)pBlock->dFile);
copygs2p(pBlock->iString,tmp->iString);
copygs2p(pBlock->parms,tmp->parms);
}
else {
copygs2res(pBlock->sFile,tmp->sFile);
copygs2res(pBlock->dFile,tmp->dFile);
copygs2res(pBlock->iString,tmp->iString);
copygs2res(pBlock->parms,tmp->parms);
}
pBlock->merr = tmp->merr;
pBlock->merrf = tmp->merrf;
pBlock->lops = tmp->lops;
pBlock->kflag = tmp->kflag;
pBlock->mFlags = tmp->mFlags;
pBlock->pFlags = tmp->pFlags;
pBlock->org = tmp->org;
return 0;
}
#pragma databank 0

28
kern/gno/global.equates Normal file
View File

@ -0,0 +1,28 @@
*********************************************************************
*
* GSOS/P16/Shell Call DP locations
*
*********************************************************************
pBlock gequ 0
cmdNum gequ 4
procEnt gequ 6
temp0 gequ 6
pCount gequ 10
*********************************************************************
*
* Kernel process state IDs
*
*********************************************************************
NPROC gequ 32
pUnused gequ $00
pRunning gequ $01
pReady gequ $02
pBlocked gequ $03
pNew gequ $04 ; ready, but no int info
pSuspended gequ $05
pWait gequ $06
pWaitSigCH gequ $07
pPaused gequ $08

92
kern/gno/gno.h Normal file
View File

@ -0,0 +1,92 @@
/* $Id: gno.h,v 1.1 1998/02/02 08:18:29 taubert Exp $ */
/*
gno.h
libgno interface file for GNO Kernel
v1.0b2
Copyright 1991-1998, Procyon Inc.
*/
#include <types.h>
#ifndef udispatch
#define udispatch 0xE10008
#endif
extern pascal int kernVersion() inline(0x0403, udispatch);
extern pascal int kernStatus() inline(0x0603, udispatch);
#ifndef KERNEL
int getppid(void);
int fork(void *subr);
int exec(char *filename,char *cmdline);
int tcnewpgrp(int fdtty);
int settpgrp(int fdtty);
int tctpgrp(int fdtty, int pid);
int setdebug(int code);
void *setsystemvector(void *vect);
int pipe(int filedes[2]);
int getpgrp(int pid);
int setpgrp(int pid,int pgrp);
int ioctl(int d, unsigned long request, void *argp);
/* 'dup()' appears in fcntl.h, dup2() should too, but I'm not rewriting
any more O**A C header files */
int dup2(int filedes, int filedes2);
void SetGNOQuitRec(word,void *,word);
unsigned int sleep(unsigned int);
#ifdef __stdio__
FILE *fdopen(int,char*);
#endif
int execve(char *filename,char *cmdline);
int fork2(void *subr, int stack, int prio, char *name, int nargs, ...);
int screate(int count);
int ssignal(int sem);
int swait(int sem);
int scount(int sem);
int sdelete(int sem);
int getpid(void);
int kill(int pid, int sig);
int wait(union wait *status);
void *signal(int sig, void (*func)());
longword sigblock(longword mask);
longword sigsetmask(longword mask);
longword alarm(longword seconds);
longword alarm10(longword tenths);
int sigpause(longword mask);
longword procrecvclr(void);
longword procreceive(void);
longword procrecvtim(int timeout);
int procsend(int pid, unsigned long msg);
#else
int kern_printf(const char *, ...);
int KERNexecve(int *ERRNO, char *cmdline, char *filename);
int Kscreate(int *ERRNO, int count);
int KERNssignal(int *ERRNO, int sem);
int Kscount(int *ERRNO, int sem);
int KERNsdelete(int *ERRNO, int sem);
int KERNkill(int *ERRNO, int signum, int pid);
void *Ksignal(int *ERRNO, void (*func)(), int sig );
longword Ksigblock(int *ERRNO, longword mask);
longword Ksigsetmask(int *ERRNO, longword mask);
int KERNkvmsetproc(int *ERRNO, struct kvmt *kd);
#define Kexecve(__e, __p1, __p2) \
{ asm { pha } KERNexecve(__e, __p1, __p2); asm { pla } }
#define Kssignal(__e, __p1) \
{ asm { pha } KERNssignal(__e, __p1); asm { pla } }
#define Ksdelete(__e, __p1) \
{ asm { pha } KERNsdelete(__e, __p1); asm { pla } }
#define Kkill(__e, __p1, __p2) \
{ asm { pha } KERNkill(__e, __p1, __p2); asm { pla } }
#define Kkvmsetproc(__e, __p1) \
{ asm { pha } KERNkvmsetproc(__e, __p1); asm { pla } }
extern int errno;
#endif

2281
kern/gno/gsos.asm Normal file
View File

File diff suppressed because it is too large Load Diff

23
kern/gno/inc/gsos.inc Normal file
View File

@ -0,0 +1,23 @@
* $Id: gsos.inc,v 1.1 1998/02/02 08:20:54 taubert Exp $
* if you change FDsize, look for the comment "a * FDsize". You must
* change code there.
FDsize gequ 16
FDrefNum gequ 0 ; type and level must be so
FDrefType gequ 2
FDrefLevel gequ 4
FDrefFlags gequ 6
FDNLenableMask gequ 8
FDNLnumChars gequ 10
FDNLtable gequ 12
FDgsos gequ 0 ; refTypes
FDpipe gequ 1
FDtty gequ 2
FDsocket gequ 3
FDTCount gequ 0
FDTLevel gequ 2
FDTLevelMode gequ 4
FDTfdTableSize gequ 6
FDTTable gequ 8

9
kern/gno/inc/kern.inc Normal file
View File

@ -0,0 +1,9 @@
* $Id: kern.inc,v 1.1 1998/02/02 08:20:57 taubert Exp $
* These equates are used in code that calls setHoldSig.
hsHoldSig gequ 1
hsNoHoldSig gequ 0
FL_SELECTING gequ $100
PS_SLEEP gequ 9

132
kern/gno/inc/tty.inc Normal file
View File

@ -0,0 +1,132 @@
* $Id: tty.inc,v 1.1 1998/02/02 08:20:59 taubert Exp $
* Select codes
SEL_READ gequ 0
SEL_WRITE gequ 1
SEL_EXCEPT gequ 2
* Error codes
EINVAL gequ 6 ; Invalid argument
EBADF gequ 7 ; bad file descriptor
EINTR gequ 14 ; Interrupted system call
ENOTTY gequ 20 ; Not a terminal
* privFlags:
HUPCL gequ 1 ; hang up modem on last close
EXCL gequ 2 ; don't allow any more opens
TS_RCOLL gequ 4 ; select collision flag
* tty mode flags
CBREAK gequ $0002 /* half-cooked mode */
LCASE gequ $0004 /* simulate lower case */
ECHO gequ $0008 /* echo input */
CRMOD gequ $0010 /* map \r to \r\n on output */
RAW gequ $0020 /* no i/o processing */
ODDP gequ $0040 /* get/send odd parity */
EVENP gequ $0080 /* get/send even parity */
LCRTBS gequ $0001 /* do backspacing for crt */
LPRTERA gequ $0002 /* \ ... / erase */
LCRTERA gequ $0004 /* " \b " to wipe out char */
LTILDE gequ $0008 /* hazeltine tilde kludge */
LMDMBUF gequ $0010 /* start/stop output on carrier intr */
LLITOUT gequ $0020 /* literal output */
LTOSTOP gequ $0040 /* SIGSTOP on background output */
LFLUSHO gequ $0080 /* flush output to terminal */
LNOHANG gequ $0100 /* no SIGHUP on carrier drop */
LPASS8OUT gequ $0200 /* 8 bit no parity for cooked output */
LCRTKIL gequ $0400 /* kill line with " \b " */
LPASS8 gequ $0800 /* 8 bit no parity for cooked input */
LCTLECH gequ $1000 /* echo control chars as ^X */
LPENDIN gequ $2000 /* tp->t_rawq needs reread */
LDECCTQ gequ $4000 /* only ^Q starts after ^S */
LNOFLSH gequ $8000 /* no output flush on signal */
B0 gequ 0
B50 gequ 1
B75 gequ 2
B110 gequ 3
B134 gequ 4
B150 gequ 5
B200 gequ 6
B300 gequ 7
B600 gequ 8
B1200 gequ 9
B1800 gequ 10
B2400 gequ 11
B4800 gequ 12
B9600 gequ 13
B19200 gequ 14
EXTA gequ 14
B38400 gequ 15
EXTB gequ 15
* Definition of the tty structure
sg_ispeed gequ 0 input speed
sg_ospeed gequ 1 output speed
sg_erase gequ 2 erase character
sg_kill gequ 3 kill character
sg_flags gequ 4 mode flags
local gequ 6 local mode flags (new driver)
t_intrc gequ 8
t_quitc gequ 9
t_startc gequ 10
t_stopc gequ 11
t_eofc gequ 12
t_brkc gequ 13
t_suspc gequ 14
t_dsuspc gequ 15
t_rprntc gequ 16
t_flushc gequ 17
t_werasc gequ 18
t_lnextc gequ 19
ws_row gequ 20
ws_col gequ 22
ws_xpixel gequ 24
ws_ypixel gequ 26
t_open gequ 28
t_close gequ 32
t_ioctl gequ 36
t_read gequ t_ioctl+4
t_write gequ t_read+4
mutex gequ t_write+4
demutex gequ mutex+4
out_enq gequ demutex+4
in_enq gequ out_enq+4
out_deq gequ in_enq+4
in_deq gequ out_deq+4
size_inq gequ in_deq+4
size_outq gequ size_inq+4
editInd gequ size_outq+4
editBegin gequ editInd+2
st_flags gequ editBegin+2
editBuf gequ st_flags+2 ; 4K input editing buffer
t_linedisc gequ editBuf+4
t_devNum gequ t_linedisc+2
privFlags gequ t_devNum+2 ;
t_sendSignal gequ privFlags+2 ; a jml statement
t_BGCheck gequ t_sendSignal+4
t_GetProcInd gequ t_BGCheck+4
t_userid gequ t_GetProcInd+4
t_signalIO gequ t_userid+2
t_select_proc gequ t_signalIO+4
t_select gequ t_select_proc+2 ; the select function pointer
t_selwakeup gequ t_select+4 ; set during install
ttyRecSize gequ t_selwakeup+4
* pty structure additions - these are actually maintained in bank 0
p_bufAptr gequ 0
p_bufBptr gequ p_bufAptr+4
p_Aleft gequ p_bufBptr+4
p_Bleft gequ p_Aleft+2
p_sem gequ p_Bleft+2
p_Ahead gequ p_sem+2
p_Atail gequ p_Ahead+2
p_Bhead gequ p_Atail+2
p_Btail gequ p_Bhead+2
ptyRecSize gequ p_Btail+2

2314
kern/gno/kern.asm Normal file
View File

File diff suppressed because it is too large Load Diff

13
kern/gno/kern.rez Normal file
View File

@ -0,0 +1,13 @@
/*
* $Id: kern.rez,v 1.1 1998/02/02 08:20:08 taubert Exp $
*/
#include "Types.rez" // include the type definitions
resource rVersion (1) {
{2,0,6,release,0},
verUS,
"GNO Kernel (network)",
"Copyright 1991-1998, Procyon, Inc."
};

40
kern/gno/kernel.h Normal file
View File

@ -0,0 +1,40 @@
/* $Id: kernel.h,v 1.1 1998/02/02 08:18:30 taubert Exp $ */
/* kernel.h - disable, enable, halt, restore */
/* Symbolic constants used throughout Xinu */
#ifndef NULL
#define NULL (void*)0l
#endif
typedef char Bool; /* Boolean type */
#define FALSE 0 /* Boolean constants */
#define TRUE 1
#define SYSCALL int /* system call */
#define LOCAL static /* local procedure */
#define INTPROC int /* interrupt procedure */
#define PROCESS int /* process declaration */
#define RESCHYES 1 /* tell ready to reschedule */
#define RESCHNO 0 /* tell not ready to reschedule */
#define MININT 0100000 /* minimum short integer (-32768) */
#define MAXINT 0077777 /* maximum short integer */
#define MINSTK 40 /* minimum process stack size */
#define OK 0 /* returned when system call ok */
#define SYSERR -1 /* returned when system call fails */
/* actually these just fiddle with the interrupt from the timer */
#define disableps() asm { jsl 0xE10064 }
#define enableps() asm { jsl 0xE10068 }
#define _resched() asm { cop 0x7f }
#define disable(oldmask) disableps()
#define enable() (void) KERNsigsetmask(&errno, 0)
#define restore(oldmask) enableps()
extern int _rdyhead, _rdytail;
extern int mapPID(int);
extern int allocPID(void);
#define mpid2KToff(__m) ((__m) << 7)

32
kern/gno/kvm.h Normal file
View File

@ -0,0 +1,32 @@
/* $Id: kvm.h,v 1.1 1998/02/02 08:18:32 taubert Exp $ */
/*
Kernel VM access routines
written June 4, 1991 by Jawaid Bazyar
mod. October 17, 1991 for new call paradigm
Copyright 1991-1998 Procyon, Inc.
Note that there is absolutely no VM involved here, I simply kept the
same names as BSD/SunOS for compatibility.
*/
#ifndef __KVM_H__
#define __KVM_H__
#include "proc.h"
struct kvmt {
int procIndex; /* don't futz with this */
int pid; /* you can use this to determine pid */
struct pentry kvm_pent;
};
typedef struct kvmt kvmt;
kvmt *kvm_open(void);
int kvm_close(kvmt *k);
struct pentry *kvmgetproc(kvmt *kd, int pid);
struct pentry *kvmnextproc(kvmt *kd);
int kvmsetproc(kvmt *kd);
#endif /* __KVM_H__ */

293
kern/gno/m/ctool.mac Normal file
View File

@ -0,0 +1,293 @@
MACRO
&lab ErrWriteChar &a1
&lab ph2 &a1
Tool $190c
mend
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab _ErrWriteString
&lab ldx #$1D0C
jsl $E10000
MEND
MACRO
&lab str &string
&lab dc i1'l:&string',c'&string'
MEND
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab asl2 &a
&lab asl &a
asl &a
mend
MACRO
&lab IntSource &a1
&lab ph2 &a1
tool $2303
mend
MACRO
&lab _WriteCString
&lab ldx #$200C
jsl $E10000
MEND
MACRO
&lab _QDStatus
&lab ldx #$0604
jsl $E10000
MEND
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

247
kern/gno/m/driver.mac Normal file
View File

@ -0,0 +1,247 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
macro
&l dosin &adr
&l dc i"l:~&sysname&syscnt"
~&sysname&syscnt dc c"&adr"
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab LD4 &val,&adr
&lab lcla &count
lda #<&val
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda #+(&val)|-16
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

221
kern/gno/m/err.mac Normal file
View File

@ -0,0 +1,221 @@
MACRO
&lab Int2Hex &a1
&lab ph2 &a1(1)
ph4 &a1(2)
ph2 &a1(3)
Tool $220b
mend
MACRO
&lab ErrWriteLine &a1
&lab ph4 &a1
Tool $1b0c
mend
MACRO
&lab ErrWriteString &a1
&lab ph4 &a1
Tool $1d0c
mend
MACRO
&lab ErrWriteCString &a1
&lab ph4 &a1
Tool $210c
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab Str &string
&lab dc i1'L:&string'
dc c"&string"
mend
MACRO
&lab proc &rg
&lab anop
aif c:&rg,.cc
lclc &rg
.cc
aif c:&reg,.dd
gblc &reg
.dd
&reg setc ""
phb
aif l:&rg=0,.bb
&reg setc &rg
lcla &plen
lclc &ch
lcla &i
&plen seta l:&reg
&i seta 0
.aa
aif &i=&plen,.bb
&i seta &i+1
&ch amid &reg,&i,1
ph&ch
ago ^aa
.bb
phk
plb
mend
MACRO
&lab procendL
&lab anop
lclc &ch
lcla &plen
&plen seta l:&reg
.aa
aif &plen=0,.bb
&ch amid &reg,&plen,1
pl&ch
&plen seta &plen-1
ago ^aa
.bb
plb
rtl
mend
MACRO
&lab add2 &arg1,&arg2,&dest
lclc &char
&lab clc
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .add
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .add
.x1
txa
ago .add
.y1
tya
.add
adc &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

527
kern/gno/m/gsos.mac Normal file
View File

@ -0,0 +1,527 @@
MACRO
&lab pushlong &addr,&offset
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
AIF "&C"="#",.immediate
AIF "&C"="[",.zeropage
AIF C:&offset=0,.nooffset
AIF "&offset"="s",.stack
pushword &addr+2,&offset
pushword &addr,&offset
MEXIT
.nooffset
pushword &addr+2
pushword &addr
MEXIT
.immediate
&REST AMID &addr,2,L:&addr-1
dc I1'$F4',I2'(&REST)|-16'
dc I1'$F4',I2'&REST'
MEXIT
.stack
pushword &addr+2,s
pushword &addr+2,s
MEXIT
.zeropage
ldy #&offset+2
pushword &addr,y
ldy #&offset
pushword &addr,y
MEND
MACRO
&lab pushword &SYSOPR
&lab ANOP
AIF c:&SYSOPR=0,.b
LCLC &C
&C AMID "&SYSOPR",1,1
AIF ("&C"="#").AND.(S:LONGA),.immediate
lda &SYSOPR
pha
MEXIT
.b
pha
MEXIT
.immediate
LCLC &REST
LCLA &BL
&BL ASEARCH "&SYSOPR"," ",1
AIF &BL>0,.a
&BL SETA L:&SYSOPR+1
.a
&REST AMID "&SYSOPR",2,&BL-2
dc I1'$F4',I2'&REST'
MEND
MACRO
&lab ErrWriteChar &a1
&lab ph2 &a1
Tool $190c
mend
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab str &string
&lab dc i1'l:&string',c'&string'
MEND
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab movelong &from,&to1,&to2
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &from,1,1
&REST AMID &from,2,L:&from-1
AIF "&C"="[",.zeropage
AIF C:&to2=0,.a
AIF ("&to1"="s").or.("&to1"="x").or.("&to1"="y"),.indexed
moveword &from,&to1,&to2
AGO .b
.a
moveword &from,&to1
.b
AIF "&C"="#",.immediate
AIF C:&to2=0,.c
moveword &from+2,&to1+2,&to2+2
MEXIT
.c
moveword &from+2,&to1+2
MEXIT
.immediate
AIF C:&to2=0,.d
moveword #^&REST,&to1+2,&to2+2
MEXIT
.d
moveword #^&REST,&to1+2
MEXIT
.zeropage
moveword &from,&to1,&to2
ldy #&to1+2
lda &from,y
sta &to2+2
MEXIT
.indexed
lda &from,&to1
sta &to2
lda &from+2,&to1
sta &to2+2
MEND
MACRO
&lab moveword &from,&to1,&to2
&lab ANOP
LCLC &C
&C AMID &from,1,1
AIF "&C"="[",.zeropage
lda &from
sta &to1
AIF C:&to2=0,.a
sta &to2
.a
MEXIT
.zeropage
AIF "&to1"="0",.b
ldy #&to1
lda &from,y
sta &to2
MEXIT
.b
lda &from
sta &to2
MEND
MACRO
&lab dey2
&lab dey
dey
mend
MACRO
&lab LD2 &val,&adr
&lab lcla &count
lda #&val
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab FindHandle &a1,&a2
&lab pha
pha
ph4 &a1
tool $1a02
pl4 &a2
mend
MACRO
&lab _GetUserID
&lab ldx #$1011
jsl $E10000
MEND
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _LGetPathname2
&lab ldx #$2211
jsl $E10000
MEND
MACRO
&lab LD4 &val,&adr
&lab lcla &count
lda #<&val
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda #+(&val)|-16
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

454
kern/gno/m/kern.mac Normal file
View File

@ -0,0 +1,454 @@
MACRO
&lab pushlong &addr,&offset
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
AIF "&C"="#",.immediate
AIF "&C"="[",.zeropage
AIF C:&offset=0,.nooffset
AIF "&offset"="s",.stack
pushword &addr+2,&offset
pushword &addr,&offset
MEXIT
.nooffset
pushword &addr+2
pushword &addr
MEXIT
.immediate
&REST AMID &addr,2,L:&addr-1
dc I1'$F4',I2'(&REST)|-16'
dc I1'$F4',I2'&REST'
MEXIT
.stack
pushword &addr+2,s
pushword &addr+2,s
MEXIT
.zeropage
ldy #&offset+2
pushword &addr,y
ldy #&offset
pushword &addr,y
MEND
MACRO
&lab pushword &SYSOPR
&lab ANOP
AIF c:&SYSOPR=0,.b
LCLC &C
&C AMID "&SYSOPR",1,1
AIF ("&C"="#").AND.(S:LONGA),.immediate
lda &SYSOPR
pha
MEXIT
.b
pha
MEXIT
.immediate
LCLC &REST
LCLA &BL
&BL ASEARCH "&SYSOPR"," ",1
AIF &BL>0,.a
&BL SETA L:&SYSOPR+1
.a
&REST AMID "&SYSOPR",2,&BL-2
dc I1'$F4',I2'&REST'
MEND
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab str &string
&lab dc i1'l:&string',c'&string'
MEND
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _DelHeartBeat
&lab ldx #$1303
jsl $E10000
MEND
MACRO
&lab _ReadBParam
&lab ldx #$0C03
jsl $E10000
MEND
MACRO
&lab _SetHeartBeat
&lab ldx #$1203
jsl $E10000
MEND
MACRO
&lab _GetVector
&lab ldx #$1103
jsl $E10000
MEND
MACRO
&lab _SetVector
&lab ldx #$1003
jsl $E10000
MEND
MACRO
&lab _GetInterruptState
&lab ldx #$3103
jsl $E10000
MEND
MACRO
&lab move3 &from,&to1,&to2
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &from,1,1
&REST AMID &from,2,L:&from-1
AIF C:&to2=0,.a
moveword &from,&to1,&to2
AGO .b
.a
&lab moveword &from,&to1
.b
AIF "&C"="#",.immediate
AIF C:&to2=0,.c
move1 &from+2,&to1+2,&to2+2
MEXIT
.c
move1 &from+2,&to1+2
MEXIT
.immediate
AIF C:&to2=0,.d
move1 #^&REST,&to1+2,&to2+2
MEXIT
.d
move1 #^&REST,&to1+2
MEND
MACRO
&lab moveword &from,&to1,&to2
&lab ANOP
LCLC &C
&C AMID &from,1,1
AIF "&C"="[",.zeropage
lda &from
sta &to1
AIF C:&to2=0,.a
sta &to2
.a
MEXIT
.zeropage
AIF "&to1"="0",.b
ldy #&to1
lda &from,y
sta &to2
MEXIT
.b
lda &from
sta &to2
MEND
MACRO
&lab move1 &from,&to1,&to2
&lab ANOP
shortm
lda &from
sta &to1
AIF C:&to2=0,.a
sta &to2
.a
longm
MEND
MACRO
&lab longm
&lab ANOP
rep #%00100000
longa on
MEND
MACRO
&lab shortm
&lab ANOP
sep #%00100000
longa off
MEND
MACRO
&lab _MMStartUp
&lab ldx #$0202
jsl $E10000
MEND
MACRO
&lab _SetTSPtr
&lab ldx #$0A01
jsl $E10000
MEND
MACRO
&lab _EventAvail
&lab ldx #$0B06
jsl $E10000
MEND
MACRO
&lab _GetNextEvent
&lab ldx #$0A06
jsl $E10000
MEND
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

352
kern/gno/m/p16.mac Normal file
View File

@ -0,0 +1,352 @@
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab pushlong &addr,&offset
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
AIF "&C"="#",.immediate
AIF "&C"="[",.zeropage
AIF C:&offset=0,.nooffset
AIF "&offset"="s",.stack
pushword &addr+2,&offset
pushword &addr,&offset
MEXIT
.nooffset
pushword &addr+2
pushword &addr
MEXIT
.immediate
&REST AMID &addr,2,L:&addr-1
dc I1'$F4',I2'(&REST)|-16'
dc I1'$F4',I2'&REST'
MEXIT
.stack
pushword &addr+2,s
pushword &addr+2,s
MEXIT
.zeropage
ldy #&offset+2
pushword &addr,y
ldy #&offset
pushword &addr,y
MEND
MACRO
&lab pushword &SYSOPR
&lab ANOP
AIF c:&SYSOPR=0,.b
LCLC &C
&C AMID "&SYSOPR",1,1
AIF ("&C"="#").AND.(S:LONGA),.immediate
lda &SYSOPR
pha
MEXIT
.b
pha
MEXIT
.immediate
LCLC &REST
LCLA &BL
&BL ASEARCH "&SYSOPR"," ",1
AIF &BL>0,.a
&BL SETA L:&SYSOPR+1
.a
&REST AMID "&SYSOPR",2,&BL-2
dc I1'$F4',I2'&REST'
MEND
MACRO
&lab movelong &from,&to1,&to2
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &from,1,1
&REST AMID &from,2,L:&from-1
AIF "&C"="[",.zeropage
AIF C:&to2=0,.a
AIF ("&to1"="s").or.("&to1"="x").or.("&to1"="y"),.indexed
moveword &from,&to1,&to2
AGO .b
.a
moveword &from,&to1
.b
AIF "&C"="#",.immediate
AIF C:&to2=0,.c
moveword &from+2,&to1+2,&to2+2
MEXIT
.c
moveword &from+2,&to1+2
MEXIT
.immediate
AIF C:&to2=0,.d
moveword #^&REST,&to1+2,&to2+2
MEXIT
.d
moveword #^&REST,&to1+2
MEXIT
.zeropage
moveword &from,&to1,&to2
ldy #&to1+2
lda &from,y
sta &to2+2
MEXIT
.indexed
lda &from,&to1
sta &to2
lda &from+2,&to1
sta &to2+2
MEND
MACRO
&lab moveword &from,&to1,&to2
&lab ANOP
LCLC &C
&C AMID &from,1,1
AIF "&C"="[",.zeropage
lda &from
sta &to1
AIF C:&to2=0,.a
sta &to2
.a
MEXIT
.zeropage
AIF "&to1"="0",.b
ldy #&to1
lda &from,y
sta &to2
MEXIT
.b
lda &from
sta &to2
MEND
MACRO
&lab dey2
&lab dey
dey
mend
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _LGetPathname
&lab ldx #$1111
jsl $E10000
MEND
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

329
kern/gno/m/pipe.mac Normal file
View File

@ -0,0 +1,329 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab str &string
&lab dc i1'l:&string',c'&string'
MEND
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab _SetHandleSize
&lab ldx #$1902
jsl $E10000
MEND
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab _DisposeHandle
&lab ldx #$1002
jsl $E10000
MEND
MACRO
&lab _NewHandle
&lab ldx #$0902
jsl $E10000
MEND
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab dey2
&lab dey
dey
mend
MACRO
&lab getpid
&lab case on
jsl getpid
case off
MEND
MACRO
&lab _HLock
&lab ldx #$2002
jsl $E10000
MEND
MACRO
&lab _HUnlock
&lab ldx #$2202
jsl $E10000
MEND
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

278
kern/gno/m/pty.mac Normal file
View File

@ -0,0 +1,278 @@
MACRO
&lab _NewHandle
&lab ldx #$0902
jsl $E10000
MEND
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

210
kern/gno/m/regexp.mac Normal file
View File

@ -0,0 +1,210 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab LD2 &val,&adr
&lab lcla &count
lda #&val
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab add2 &arg1,&arg2,&dest
lclc &char
&lab clc
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .add
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .add
.x1
txa
ago .add
.y1
tya
.add
adc &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab if2 &var,&rel,&val,&label
&lab ago .skip
ble
bgt
.skip
lclc &char1
lclc &char2
&char1 amid &var,1,1
&char2 amid &var,2,1
aif "&char1"="@",.index
lda &var
.cmp
cmp &val
ago .branch
.index
aif "&char2"="x",.x1
aif "&char2"="X",.x1
aif "&char2"="y",.y1
aif "&char2"="Y",.y1
ago ^cmp
.x1
cpx &val
ago .branch
.y1
cpy &val
.branch
&char1 amid &rel,1,1
aif "&char1"="@",.done
b&rel &label
.done
mend
MACRO
&lab bgt &loc
&lab beq *+4
bcs &loc
mend
MACRO
&lab ble &loc
&lab bcc &loc
beq &loc
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

355
kern/gno/m/resource.mac Normal file
View File

@ -0,0 +1,355 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _SetTSPtr
&lab ldx #$0A01
jsl $E10000
MEND
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab _GetTSPtr
&lab ldx #$0901
jsl $E10000
MEND
MACRO
&lab _GetMapHandle
&lab ldx #$261E
jsl $E10000
MEND
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

442
kern/gno/m/select.mac Normal file
View File

@ -0,0 +1,442 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND
MACRO
&lab _PostEvent
&lab ldx #$1406
jsl $E10000
MEND
MACRO
&lab _ClampMouse
&lab ldx #$1C03
jsl $E10000
MEND
MACRO
&lab _SetAbsClamp
&lab ldx #$2A03
jsl $E10000
MEND
MACRO
&lab _SetMouse
&lab ldx #$1903
jsl $E10000
MEND
MACRO
&lab _HomeMouse
&lab ldx #$1A03
jsl $E10000
MEND
MACRO
&lab _ReadMouse
&lab ldx #$1703
jsl $E10000
MEND
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&LAB ~SETM
&LAB ANOP
AIF C:&~LA,.B
GBLB &~LA
GBLB &~LI
.B
&~LA SETB S:LONGA
&~LI SETB S:LONGI
AIF S:LONGA.AND.S:LONGI,.A
REP #32*(.NOT.&~LA)+16*(.NOT.&~LI)
LONGA ON
LONGI ON
.A
MEND
MACRO
&LAB ~RESTM
&LAB ANOP
AIF (&~LA+&~LI)=2,.I
SEP #32*(.NOT.&~LA)+16*(.NOT.&~LI)
AIF &~LA,.H
LONGA OFF
.H
AIF &~LI,.I
LONGI OFF
.I
MEND
MACRO
&LAB PL4 &N1
LCLC &C
&LAB ANOP
AIF S:LONGA=1,.A
REP #%00100000
.A
&C AMID &N1,1,1
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.F
&N1 AMID &N1,2,L:&N1-2
PLA
STA (&N1)
LDY #2
PLA
STA (&N1),Y
AGO .D
.B
AIF "&C"<>"[",.C
PLA
STA &N1
LDY #2
PLA
STA &N1,Y
AGO .D
.C
PLA
STA &N1
PLA
STA &N1+2
.D
AIF S:LONGA=1,.E
SEP #%00100000
.E
MEXIT
.F
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PH4 &N1
LCLC &C
&LAB ANOP
&C AMID &N1,1,1
AIF "&C"="#",.D
AIF S:LONGA=1,.A
REP #%00100000
.A
AIF "&C"<>"{",.B
&C AMID &N1,L:&N1,1
AIF "&C"<>"}",.G
&N1 AMID &N1,2,L:&N1-2
LDY #2
LDA (&N1),Y
PHA
LDA (&N1)
PHA
AGO .E
.B
AIF "&C"<>"[",.C
LDY #2
LDA &N1,Y
PHA
LDA &N1
PHA
AGO .E
.C
LDA &N1+2
PHA
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA +(&N1)|-16
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PH8 &N1
MACRO
&LAB MUL4 &N1,&N2,&N3
&LAB ~SETM
PH4 &N1
PH4 &N2
JSL ~MUL4
AIF C:&N3,.A
PL4 &N1
AGO .B
.A
PL4 &N3
.B
~RESTM
MEND

432
kern/gno/m/shellcall.mac Normal file
View File

@ -0,0 +1,432 @@
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab dey2
&lab dey
dey
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab MV2 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab LD2 &val,&adr
&lab lcla &count
lda #&val
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab GSStr &string
&lab dc i2'L:&string'
dc c"&string"
mend
MACRO
&lab Destroy &a1
&lab gsos $2002,&a1
mend
MACRO
&lab Create &a1
&lab gsos $2001,&a1
mend
MACRO
&lab SetMark &a1
&lab gsos $2016,&a1
mend
MACRO
&lab GetEOF &a1
&lab gsos $2019,&a1
mend
MACRO
&lab Open &a1
&lab gsos $2010,&a1
mend
MACRO
&lab GetPrefixGS &a1
&lab gsos $200A,&a1
mend
MACRO
&lab Close &a1
&lab gsos $2014,&a1
mend
MACRO
&lab gsos &a1,&a2
&lab jsl $E100A8
dc i2'&a1'
dc i4'&a2'
mend
MACRO
&lab jcs &loc
&lab bcc *+5
jmp &loc
mend
MACRO
&lab asl2 &a
&lab asl &a
asl &a
mend
MACRO
&lab LD4 &val,&adr
&lab lcla &count
lda #<&val
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda #+(&val)|-16
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab GetDirEntry &a1
&lab gsos $201C,&a1
mend
MACRO
&lab movelong &from,&to1,&to2
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &from,1,1
&REST AMID &from,2,L:&from-1
AIF "&C"="[",.zeropage
AIF C:&to2=0,.a
AIF ("&to1"="s").or.("&to1"="x").or.("&to1"="y"),.indexed
moveword &from,&to1,&to2
AGO .b
.a
moveword &from,&to1
.b
AIF "&C"="#",.immediate
AIF C:&to2=0,.c
moveword &from+2,&to1+2,&to2+2
MEXIT
.c
moveword &from+2,&to1+2
MEXIT
.immediate
AIF C:&to2=0,.d
moveword #^&REST,&to1+2,&to2+2
MEXIT
.d
moveword #^&REST,&to1+2
MEXIT
.zeropage
moveword &from,&to1,&to2
ldy #&to1+2
lda &from,y
sta &to2+2
MEXIT
.indexed
lda &from,&to1
sta &to2
lda &from+2,&to1
sta &to2+2
MEND
MACRO
&lab moveword &from,&to1,&to2
&lab ANOP
LCLC &C
&C AMID &from,1,1
AIF "&C"="[",.zeropage
lda &from
sta &to1
AIF C:&to2=0,.a
sta &to2
.a
MEXIT
.zeropage
AIF "&to1"="0",.b
ldy #&to1
lda &from,y
sta &to2
MEXIT
.b
lda &from
sta &to2
MEND
macro
&lab popvariables &dcb
&lab ~setm
jsl $E100A8
dc i2'$0117'
dc i4'&dcb'
~restm
mend
macro
&lab pushvariables &dcb
&lab ~setm
jsl $E100A8
dc i2'$0118'
dc i4'&dcb'
~restm
mend
macro
&lab ~restm
&lab anop
aif (&~la+&~li)=2,.i
sep #32*(.not.&~la)+16*(.not.&~li)
aif &~la,.h
longa off
.h
aif &~li,.i
longi off
.i
mend
macro
&lab ~setm
&lab anop
aif c:&~la,.b
gblb &~la
gblb &~li
.b
&~la setb s:longa
&~li setb s:longi
aif s:longa.and.s:longi,.a
rep #32*(.not.&~la)+16*(.not.&~li)
longa on
longi on
.a
mend
MACRO
&lab push3 &addr,&reg
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
&REST AMID &addr,2,L:&addr
AIF C:&reg>0,.indexed
AIF "&C"="#",.immediate
lda &addr+1
pha
AGO .a
.immediate
lda #(&REST)|-8
pha
.a
phb
lda &addr
sta 1,s
MEXIT
.indexed
lda &addr+1,&reg
pha
phb
lda &addr,&reg
sta 1,s
MEND
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
macro
&lab ExpandPath &a1
&lab gsos $200E,&a1
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

490
kern/gno/m/texttool.mac Normal file
View File

@ -0,0 +1,490 @@
MACRO
&lab pulllong &addr1,&addr2
&lab ANOP
AIF C:&addr1=0,.a
AIF C:&addr2=0,.b
LCLC &C
&C AMID &addr1,1,1
AIF "&C"="[",.zeropage
pullword &addr1
sta &addr2
pullword &addr1+2
sta &addr2+2
MEXIT
.a
pullword
pullword
MEXIT
.b
pullword &addr1
pullword &addr1+2
MEXIT
.zeropage
ldy #&addr2
pullword &addr1,y
ldy #&addr2+2
pullword &addr1,y
MEND
MACRO
&lab pullword &SYSOPR
&lab ANOP
pla
AIF c:&SYSOPR=0,.end
sta &SYSOPR
.end
MEND
MACRO
&lab pushlong &addr,&offset
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
AIF "&C"="#",.immediate
AIF "&C"="[",.zeropage
AIF C:&offset=0,.nooffset
AIF "&offset"="s",.stack
pushword &addr+2,&offset
pushword &addr,&offset
MEXIT
.nooffset
pushword &addr+2
pushword &addr
MEXIT
.immediate
&REST AMID &addr,2,L:&addr-1
dc I1'$F4',I2'(&REST)|-16'
dc I1'$F4',I2'&REST'
MEXIT
.stack
pushword &addr+2,s
pushword &addr+2,s
MEXIT
.zeropage
ldy #&offset+2
pushword &addr,y
ldy #&offset
pushword &addr,y
MEND
MACRO
&lab pushword &SYSOPR
&lab ANOP
AIF c:&SYSOPR=0,.b
LCLC &C
&C AMID "&SYSOPR",1,1
AIF ("&C"="#").AND.(S:LONGA),.immediate
lda &SYSOPR
pha
MEXIT
.b
pha
MEXIT
.immediate
LCLC &REST
LCLA &BL
&BL ASEARCH "&SYSOPR"," ",1
AIF &BL>0,.a
&BL SETA L:&SYSOPR+1
.a
&REST AMID "&SYSOPR",2,&BL-2
dc I1'$F4',I2'&REST'
MEND
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab movelong &from,&to1,&to2
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &from,1,1
&REST AMID &from,2,L:&from-1
AIF "&C"="[",.zeropage
AIF C:&to2=0,.a
AIF ("&to1"="s").or.("&to1"="x").or.("&to1"="y"),.indexed
moveword &from,&to1,&to2
AGO .b
.a
moveword &from,&to1
.b
AIF "&C"="#",.immediate
AIF C:&to2=0,.c
moveword &from+2,&to1+2,&to2+2
MEXIT
.c
moveword &from+2,&to1+2
MEXIT
.immediate
AIF C:&to2=0,.d
moveword #^&REST,&to1+2,&to2+2
MEXIT
.d
moveword #^&REST,&to1+2
MEXIT
.zeropage
moveword &from,&to1,&to2
ldy #&to1+2
lda &from,y
sta &to2+2
MEXIT
.indexed
lda &from,&to1
sta &to2
lda &from+2,&to1
sta &to2+2
MEND
MACRO
&lab moveword &from,&to1,&to2
&lab ANOP
LCLC &C
&C AMID &from,1,1
AIF "&C"="[",.zeropage
lda &from
sta &to1
AIF C:&to2=0,.a
sta &to2
.a
MEXIT
.zeropage
AIF "&to1"="0",.b
ldy #&to1
lda &from,y
sta &to2
MEXIT
.b
lda &from
sta &to2
MEND
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab _SetTSPtr
&lab ldx #$0A01
jsl $E10000
MEND
MACRO
&lab _GetTSPtr
&lab ldx #$0901
jsl $E10000
MEND
MACRO
&lab if2 &var,&rel,&val,&label
&lab ago .skip
ble
bgt
.skip
lclc &char1
lclc &char2
&char1 amid &var,1,1
&char2 amid &var,2,1
aif "&char1"="@",.index
lda &var
.cmp
cmp &val
ago .branch
.index
aif "&char2"="x",.x1
aif "&char2"="X",.x1
aif "&char2"="y",.y1
aif "&char2"="Y",.y1
ago ^cmp
.x1
cpx &val
ago .branch
.y1
cpy &val
.branch
&char1 amid &rel,1,1
aif "&char1"="@",.done
b&rel &label
.done
mend
MACRO
&lab bgt &loc
&lab beq *+4
bcs &loc
mend
MACRO
&lab ble &loc
&lab bcc &loc
beq &loc
mend
MACRO
&lab inx2
&lab inx
inx
mend
MACRO
&lab push3 &addr,&reg
&lab ANOP
LCLC &C
LCLC &REST
&C AMID &addr,1,1
&REST AMID &addr,2,L:&addr
AIF C:&reg>0,.indexed
AIF "&C"="#",.immediate
lda &addr+1
pha
AGO .a
.immediate
lda #(&REST)|-8
pha
.a
phb
lda &addr
sta 1,s
MEXIT
.indexed
lda &addr+1,&reg
pha
phb
lda &addr,&reg
sta 1,s
MEND
MACRO
&lab WriteChar &a1
&lab ph2 &a1
Tool $180c
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab _ReadChar
&lab ldx #$220C
jsl $E10000
MEND
MACRO
&lab eor2 &arg1,&arg2,&dest
&lab anop
lclc &char
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .add
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .add
.x1
txa
ago .add
.y1
tya
.add
eor &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab _SetInGlobals
&lab ldx #$090C
jsl $E10000
MEND
MACRO
&lab _SetOutGlobals
&lab ldx #$0A0C
jsl $E10000
MEND
MACRO
&lab _SetErrGlobals
&lab ldx #$0B0C
jsl $E10000
MEND
MACRO
&lab _SetInputDevice
&lab ldx #$0F0C
jsl $E10000
MEND
MACRO
&lab _SetOutputDevice
&lab ldx #$100C
jsl $E10000
MEND
MACRO
&lab _SetErrorDevice
&lab ldx #$110C
jsl $E10000
MEND
MACRO
&lab _FWEntry
&lab ldx #$2403
jsl $E10000
MEND
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

407
kern/gno/m/tty.mac Normal file
View File

@ -0,0 +1,407 @@
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
macro
&lab ph4 &n1
aif "&n1"="*",.f
lclc &c
&lab anop
&c amid &n1,1,1
aif "&c"="#",.d
aif s:longa=1,.a
rep #%00100000
.a
aif "&c"<>"{",.b
&c amid &n1,l:&n1,1
aif "&c"<>"}",.g
&n1 amid &n1,2,l:&n1-2
ldy #2
lda (&n1),y
pha
lda (&n1)
pha
ago .e
.b
aif "&c"<>"[",.c
ldy #2
lda &n1,y
pha
lda &n1
pha
ago .e
.c
aif "&c"<>"<",.c1
&n1 amid &n1,2,l:&n1-1
pei &n1+2
pei &n1
ago .e
.c1
lda &n1+2
pha
lda &n1
pha
ago .e
.d
&n1 amid &n1,2,l:&n1-1
pea +(&n1)|-16
pea &n1
ago .f
.e
aif s:longa=1,.f
sep #%00100000
.f
mexit
.g
mnote "Missing closing '}'",16
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND
MACRO
&lab _PostEvent
&lab ldx #$1406
jsl $E10000
MEND
MACRO
&lab _ClampMouse
&lab ldx #$1C03
jsl $E10000
MEND
MACRO
&lab _SetAbsClamp
&lab ldx #$2A03
jsl $E10000
MEND
MACRO
&lab _SetMouse
&lab ldx #$1903
jsl $E10000
MEND
MACRO
&lab _HomeMouse
&lab ldx #$1A03
jsl $E10000
MEND
MACRO
&lab _ReadMouse
&lab ldx #$1703
jsl $E10000
MEND
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
macro
&l sub &parms,&work
&l anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+4+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
macro
&l ret &r
&l anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+2
sta &worklen+&totallen+2
lda &worklen+1
sta &worklen+&totallen+1
.i
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend

373
kern/gno/m/util.mac Normal file
View File

@ -0,0 +1,373 @@
MACRO
&lab if2 &var,&rel,&val,&label
&lab ago .skip
ble
bgt
.skip
lclc &char1
lclc &char2
&char1 amid &var,1,1
&char2 amid &var,2,1
aif "&char1"="@",.index
lda &var
.cmp
cmp &val
ago .branch
.index
aif "&char2"="x",.x1
aif "&char2"="X",.x1
aif "&char2"="y",.y1
aif "&char2"="Y",.y1
ago ^cmp
.x1
cpx &val
ago .branch
.y1
cpy &val
.branch
&char1 amid &rel,1,1
aif "&char1"="@",.done
b&rel &label
.done
mend
MACRO
&lab bgt &loc
&lab beq *+4
bcs &loc
mend
MACRO
&lab ble &loc
&lab bcc &loc
beq &loc
mend
MACRO
&lab add2 &arg1,&arg2,&dest
lclc &char
&lab clc
&char amid &arg1,1,1
aif "&char"="@",.at1
lda &arg1
ago .add
.at1
&char amid &arg1,2,1
aif "&char"="x",.x1
aif "&char"="X",.x1
aif "&char"="y",.y1
aif "&char"="Y",.y1
ago .add
.x1
txa
ago .add
.y1
tya
.add
adc &arg2
&char amid &dest,1,1
aif "&char"="@",.at2
sta &dest
ago .b
.at2
&char amid &dest,2,1
aif "&char"="x",.x2
aif "&char"="X",.x2
aif "&char"="y",.y2
aif "&char"="Y",.y2
ago .b
.x2
tax
ago .b
.y2
tay
.b
mend
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab long &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi on
&t seta &t+16
ago ^c
.m
longa on
&t seta &t+32
ago ^c
.b
aif &t=0,.d
rep #&t
.d
mend
MACRO
&lab short &stat
&lab anop
lcla &t
lcla &len
lclc &ch
&t seta 0
&len seta l:&stat
.a
aif &len=0,.b
&ch amid &stat,&len,1
aif ("&ch"="x").or.("&ch"="y").or.("&ch"="i"),.i
aif ("&ch"="a").or.("&ch"="m"),.m
.c
&len seta &len-1
ago ^a
.i
longi off
&t seta &t+16
ago ^c
.m
longa off
&t seta &t+32
ago ^c
.b
aif &t=0,.d
sep #&t
.d
mend
MACRO
&lab LD2 &val,&adr
&lab lcla &count
lda #&val
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab ErrWriteChar &a1
&lab ph2 &a1
Tool $190c
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab dey2
&lab dey
dey
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

378
kern/gno/m/var.mac Normal file
View File

@ -0,0 +1,378 @@
MACRO
&lab ph4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk1
rep #%00100000
.chk1
aif "&char"<>"{",.chk2
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
ldy #2
lda (&parm),y
pha
lda (&parm)
pha
ago .shorten
.chk2
aif "&char"<>"[",.absolute
ldy #2
lda &parm,y
pha
lda &parm
pha
ago .shorten
.absolute
lda &parm+2
pha
lda &parm
pha
ago .shorten
.at
&char1 amid &parm,2,1
&char2 setc &char1
ph&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
ph&char2
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea +(&parm)|-16
pea &parm
ago .done
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab pl4 &parm
lclc &char
lclc &char1
lclc &char2
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"<>"{",.chk
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ldy #2
pla
sta (&parm),y
ago .shorten
.chk
aif "&char"<>"[",.chk2
pla
sta &parm
ldy #2
pla
sta &parm,y
ago .shorten
.chk2
aif "&char"<>"@",.absolute
&char1 amid &parm,2,1
&char2 setc &char1
pl&char1
aif l:&parm<3,.chk2a
&char2 amid &parm,3,1
.chk2a
pl&char2
ago .shorten
.absolute
pla
sta &parm
pla
sta &parm+2
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab LD2 &val,&adr
&lab lcla &count
lda #&val
&count seta 1
.loop
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop
.done
mend
MACRO
&lab MV4 &src,&adr
&lab lcla &count
lda &src
&count seta 1
.loop1
sta &adr(&count)
&count seta &count+1
aif &count>c:&adr,.part2
ago ^loop1
.part2
lda &src+2
&count seta 1
.loop2
sta &adr(&count)+2
&count seta &count+1
aif &count>c:&adr,.done
ago ^loop2
.done
mend
MACRO
&lab iny2
&lab iny
iny
mend
MACRO
&lab dey2
&lab dey
dey
mend
MACRO
&lab jeq &loc
&lab bne *+5
jmp &loc
mend
MACRO
&lab jne &loc
&lab beq *+5
jmp &loc
mend
MACRO
&lab jmi &loc
&lab bpl *+5
jmp &loc
mend
MACRO
&lab subroutine &parms,&work
&lab anop
aif c:&work,.a
lclc &work
&work setc 0
.a
gbla &totallen
gbla &worklen
&worklen seta &work
&totallen seta 0
aif c:&parms=0,.e
lclc &len
lclc &p
lcla &i
&i seta c:&parms
.b
&p setc &parms(&i)
&len amid &p,2,1
aif "&len"=":",.c
&len amid &p,1,2
&p amid &p,4,l:&p-3
ago .d
.c
&len amid &p,1,1
&p amid &p,3,l:&p-2
.d
&p equ &totallen+3+&work
&totallen seta &totallen+&len
&i seta &i-1
aif &i,^b
.e
tsc
sec
sbc #&work
tcs
inc a
phd
tcd
phb
phk
plb
mend
MACRO
&lab return &r
&lab anop
lclc &len
aif c:&r,.a
lclc &r
&r setc 0
&len setc 0
ago .h
.a
&len amid &r,2,1
aif "&len"=":",.b
&len amid &r,1,2
&r amid &r,4,l:&r-3
ago .c
.b
&len amid &r,1,1
&r amid &r,3,l:&r-2
.c
aif &len<>2,.d
ldy &r
ago .h
.d
aif &len<>4,.e
ldx &r+2
ldy &r
ago .h
.e
aif &len<>10,.g
ldy #&r
ldx #^&r
ago .h
.g
mnote 'Not a valid return length',16
mexit
.h
aif &totallen=0,.i
lda &worklen+1
sta &worklen+&totallen+1
lda &worklen
sta &worklen+&totallen
.i
plb
pld
tsc
clc
adc #&worklen+&totallen
tcs
aif &len=0,.j
tya
.j
rtl
mend
MACRO
&lab UDivide &a1,&a2
&lab pha
pha
ph2 &a1(1)
ph2 &a1(2)
Tool $0b0b
pl2 &a2(1)
pl2 &a2(2)
mend
MACRO
&lab tool &a1
&lab ldx #&a1
jsl $e10000
mend
MACRO
&lab ph2 &parm
lclc &char
&lab anop
aif c:&parm=0,.done
&char amid &parm,1,1
aif "&char"="#",.immediate
aif "&char"="@",.at
aif s:longa=1,.chk
rep #%00100000
.chk
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
lda (&parm)
pha
ago .shorten
.absolute
lda &parm
pha
ago .shorten
.immediate
&parm amid &parm,2,l:&parm-1
pea &parm
ago .done
.at
&char amid &parm,2,1
ph&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing closing '}'",16
mend
MACRO
&lab pl2 &parm
lclc &char
&lab anop
aif s:longa=1,.start
rep #%00100000
.start
&char amid &parm,1,1
aif "&char"="@",.at
aif "&char"<>"{",.absolute
&char amid &parm,l:&parm,1
aif "&char"<>"}",.error
&parm amid &parm,2,l:&parm-2
pla
sta (&parm)
ago .shorten
.absolute
pla
sta &parm
ago .shorten
.at
&char amid &parm,2,1
pl&char
.shorten
aif s:longa=1,.done
sep #%00100000
.done
mexit
.error
mnote "Missing Closing '}'",16
mend
MACRO
&lab asl2 &a
&lab asl &a
asl &a
mend
MACRO
&lab add4 &arg1,&arg2,&dest
&lab anop
lclc &ch
&ch amid &arg2,1,1
clc
lda &arg1
adc &arg2
sta &dest
lda &arg1+2
aif "&ch"="#",.a
adc &arg2+2
ago .b
.a
adc &arg2|-16
.b
sta &dest+2
mend
MACRO
&lab name
&lab anop
aif DebugSymbols=0,.pastName
brl pastName&SYSCNT
dc i'$7771'
dc i1'L:&lab',c'&lab'
pastName&SYSCNT anop
.pastName
MEND

455
kern/gno/main.c Normal file
View File

@ -0,0 +1,455 @@
/* $Id: main.c,v 1.1 1998/02/02 08:18:33 taubert Exp $ */
segment "KERN2 ";
#pragma stacksize 1024
#pragma optimize 79
#include "proc.h"
#include "gno.h"
#include "sys.h"
#include "sem.h"
#include "tty.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include <memory.h>
#include <gsos.h>
#include <event.h>
#include <locator.h>
#include <loader.h>
#include <texttool.h>
#include <orca.h>
#include <sys/ioctl.h>
#include <sys/ports.h>
#include <shell.h>
#include <sys/errno.h>
#include <signal.h>
#ifndef udispatch
#define udispatch 0xE10008
#endif
extern pascal int kernStatus() inline(0x0603, udispatch);
struct pentry *procPtr;
#ifdef UNUSED_CODE
static void prResultString(ResultBuf255Ptr r)
{
int i;
putchar('(');
for (i = 0; i < r->bufString.length; i++) putchar(r->bufString.text[i]);
putchar(')');
printf("[%d]",r->bufString.length);
putchar('\n');
}
#endif
kernelStructPtr kp;
int sysR;
char initX[80] = "9/gsh", initCmd[80] = "gsh";
static void doShell(void)
{
int cl[2];
GSString32 ttyPath = { 6, ".ttyco" };
OpenRecGS o;
FILE *initf;
#ifdef DEBUG_FIRST_FORK
WriteCString("\n\rInside doShell\n\r");
ReadChar(0);
#endif
/* we don't want processes to inherit the sys.resources fd */
cl[0] = 1; cl[1] = 0; CloseGS(cl);
o.pCount = 3;
o.pathname = (GSString255Ptr) &ttyPath; /* our console driver mabob */
o.requestAccess = readEnable;
OpenGS(&o); /* open stdin */
o.requestAccess = writeEnable;
OpenGS(&o); /* open stdout */
o.requestAccess = writeEnable;
OpenGS(&o); /* open stderr */
initf = fopen("9/initrc","r");
if (initf) {
fgets(initX,80,initf);
initX[strlen(initX)-1] = 0; /* take off trailing \r */
fgets(initCmd,80,initf);
initCmd[strlen(initCmd)-1] = 0; /* take off trailing \r */
fclose(initf);
}
cl[0] = 0;
PUSH_VARIABLES(cl);
#ifdef DEBUG_FIRST_FORK
WriteCString("Calling Kexecve()\n\r");
ReadChar(0);
#endif
Kexecve(&errno,initCmd,initX);
WriteCString("\n\rCould not locate: ");
WriteCString(initX);
WriteCString("\n\r");
if (initf)
WriteCString("error in INITRC configuration file\n\r");
else
WriteCString("could not find INITRC configuration file\n\r");
WriteCString("Press a key to exit GNO\n\r");
ReadChar(0);
}
GSString255Ptr __C2GSMALLOC(char *s)
{
GSString255Ptr g;
size_t l;
l = strlen(s);
g = malloc(l+2);
g->length = l;
memcpy(g->text,s,l);
return g;
}
static int numDrivers;
static int driverUserID[16];
GSString255Ptr DeviceNames[40];
extern void InstallDriver(int,int,void *);
static void setuppty(void)
{
char pty[] = ".ptyq0";
char tty[] = ".ttyq0";
const char conv[] = "0123456789abcdef";
unsigned int ptyno, slotno;
extern PTYMastHeader;
extern PTYSlaveHeader;
slotno = 6;
for (ptyno = 0; ptyno < 16; ptyno++) {
tty[5] = pty[5] = conv[ptyno];
DeviceNames[slotno] = __C2GSMALLOC(pty);
DeviceNames[slotno+1] = __C2GSMALLOC(tty);
InstallDriver(kp->userID, slotno, &PTYMastHeader);
InstallDriver(kp->userID, slotno+1, &PTYSlaveHeader);
slotno+=2;
}
}
static void setuptty(void)
{
static char line[80];
char *line1;
FILE *ttys;
word ILuserID;
InitialLoadOutputRec il_rec;
int e;
static GSString255 filename;
int devNum;
static char devname[20];
extern ConsoleHeader;
numDrivers = 0;
strcpy(line,"9:dev:"); /* all loaded devices are referenced from 9:dev */
line1 = line+6;
setuppty(); /* install 16 pty devices */
/* .ttyco is not loadable quite yet... */
DeviceNames[3] = __C2GSMALLOC(".ttyco");
InstallDriver(kp->userID,3,&ConsoleHeader);
ttys = fopen("9/etc/tty.config","r");
while (!feof(ttys)) {
fgets(line1,80,ttys);
if (strlen(line1) < 2) continue; /* skip blank lines */
if (line1[0] == '#') continue; /* skip comment lines */
sscanf(line,"%s %d %s", filename.text, &devNum, devname);
filename.length = strlen(filename.text);
#ifdef DEBUG_DRIVER_LOAD
printf("filename:%s, devNum:%d, devname:%s\n",filename.text,devNum,devname);
#endif
DeviceNames[devNum] = __C2GSMALLOC(devname);
/* InitialLoad device file */
ILuserID = (kp->userID & 0xF0FF) | (((devNum+2) & 0xf) << 8);
il_rec = InitialLoad2(ILuserID, (Pointer)&filename, 1, 1);
if ((e = toolerror())) {
printf("Could not load driver: %s, error: %04X\n",filename.text,e);
} else {
InstallDriver(ILuserID & 0xF0FF, devNum, il_rec.startAddr);
driverUserID[numDrivers++] = ILuserID;
}
}
fclose(ttys);
}
static char *pg = "\pProcyon~GNOME~";
QuitRecGS quitParms;
static PrefixRecGS pr;
static GetRefNumRecGS grn;
int main(int argc, char *argv)
{
extern void NullProcess(void);
extern void test(void);
extern void ROUTINE5(void);
extern CKernData;
extern TEXTTOOLSINFO;
extern void TESTPROC(void);
extern void InitRefnum(void);
extern void AddRefnum(int,int);
extern void init_htable(void);
extern void initPTY(void);
extern int pinit(int);
extern void GetDaMouseMod(void);
extern void InOutStart(void);
extern void InOutEnd(void);
int newPID,stat;
handle fstack;
extern kernTable[];
ResultBuf255Ptr p0;
GSString255Ptr sysRpath;
struct pentry *p;
word state;
byte slot, statereg;
int i;
char *kptr;
GSString255Ptr *pfxRec;
handle emdp;
extern snooperInfo;
word nargs = 0;
TextStartUp();
SetInGlobals(0xFF,0x00);
SetOutGlobals(0xFF,0x00);
SetErrGlobals(0xFF,0x00);
SetInputDevice(pascalType,3l);
SetOutputDevice(pascalType,3l);
SetErrorDevice(pascalType,3l);
InitTextDev(input);
InitTextDev(output);
InitTextDev(errorOutput);
kernStatus();
if (!toolerror()) {
printf("GNO Kernel already active\n");
exit(1);
}
MessageByName(1,(Pointer)&snooperInfo);
quitParms.pCount = 0;
TLStartUp();
printf("%c\nGNO Kernel v2.0.6 (network)\n",12);
printf("Copyright 1991-1998, Procyon, Inc.\n%c",6);
/* initialize kernel queues, etc */
SetTSPtr(0x8000, 3, (Pointer)kernTable);
kp = (kernelStructPtr) &CKernData;
#ifdef DEBUG_STARTUP
printf("\nmain thinks kp is :%08lX\n",kp);
#endif
kp->userID = userid();
#ifdef DEBUG_GSOS
kp->gsosDebug = ~0;
#endif
emdp = NewHandle(0x0100l,kp->userID,0xC005,0l);
i = _toolErr;
EMStartUp((word)*emdp,0,0,0,0,0,kp->userID);
#ifdef DEBUG_STARTUP
printf("After EMStartUp\n");
#endif
GetDaMouseMod();
/* mouseMode = ReadMouse(); */
#ifdef DEBUG_STARTUP
printf("After GetDaMouseMod\n");
#endif
/* start up kernel subsections */
_seminit();
#ifdef DEBUG_STARTUP
printf("After _seminit\n");
#endif
p0 = malloc(sizeof(ResultBuf255));
p0->bufSize = 255;
procPtr = p = &(kp->procTable[0]);
p->userID = kp->userID & 0xF0FF;
p->ttyID = 3;
p->prefix = malloc(33*sizeof(GSString255Ptr));
for (i = -1; i < 32; i++) {
pr.pCount = 2;
pr.prefixNum = i;
pr.buffer.getPrefix = p0;
GetPrefixGS(&pr);
p->prefix[i+1] = malloc(p0->bufString.length+2);
copygsstr(p->prefix[i+1],&p0->bufString);
}
nfree(p0);
p->siginfo = malloc(sizeof(struct sigrec));
memset(p->siginfo, 0, sizeof(struct sigrec));
/* allocate the file table with the initial number of files */
i = sizeof(fdentry)*(FD_SIZE-1);
p->openFiles = malloc(sizeof(fdtable)+i);
memset(p->openFiles, 0, sizeof(fdtable)+i);
p->openFiles->fdTableSize = FD_SIZE;
p->alarmCount = 0l;
sysRpath = malloc(sizeof(GSString255));
strcpy(sysRpath->text,"*:system:system.setup:sys.resources");
sysRpath->length = strlen(sysRpath->text);
grn.pCount = 4;
grn.pathname = sysRpath;
grn.resNum = 1;
GetRefNumGS(&grn);
nfree(sysRpath);
sysR = grn.refNum;
if (sysR == 0) {
printf("FATAL SYSTEM ERROR: Sys.Resources file isn't open!\n"
"hit a key to exit\n");
ReadChar(0);
exit(1);
}
p->openFiles->fdCount = 1;
p->openFiles->fdLevelMode = 0x8000;
p->openFiles->fdLevel = 1;
p->openFiles->fds[sysR-1].refNum = sysR;
p->openFiles->fds[sysR-1].refLevel = 30;
InitRefnum();
#ifdef DEBUG_STARTUP
printf("After InitRefnum\n");
#endif
AddRefnum(0 /*FDgsos*/, sysR);
asm {
lda 0xE0C035
sta state
sep #0x30
lda 0xE0C02D
sta slot
lda 0xE0C068
sta statereg
rep #0x30
}
p->irq_state = state;
p->irq_SLTROM = slot;
p->irq_STATEREG = statereg;
p->ticks = 0l;
p->flags = FL_FORKED | FL_COMPLIANT;
p->parentpid = -1;
p->LInfo = NULL;
p->executeHook = NULL;
p->flpid = 1;
p->waitq = NULL;
p->args = "BYTEWRKSNullProcess\0";
p->alarmCount = 0l;
p->SANEwap = (word) GetWAP(0,0xA);
pinit(MAXMSGS);
init_htable();
setuptty(); /* initialize the tty subsystem and load drivers */
initPTY();
#ifdef DEBUG_STARTUP
printf("After initPTY\n");
#endif
/* do when console driver is loaded */
InOutStart();
#ifdef DEBUG_STARTUP
printf("After InOutStart\n");
#endif
patchTools();
#ifdef DEBUG_STARTUP
printf("After patchTools\n");
#endif
/* Last chance to use a printf() in the kernel's context */
InitKernel();
/*
* Orca/C 2.0.1 fd based printf()s won't work from this point on in
* the kernel's context (NullProcess) because gno doesn't use
* fd -1 -2 -3 like Orca does, and fd 1 2 3 aren't open.
* printf()s in the tool routines will however work in the context of
* the caller's process. Note that a printf() in the kernel in a tool
* routine will end up on fd 2 3 of the calling process, NOT the
* kernel. Use kern_printf() inside a tool routine to display
* information in the kernel's context (via TextTools). Make sure
* you fflush() any printf()s to stdout before returning to the caller,
* or your output could end up buffered and sent to a completely
* different process the next time printf() is called.
*/
stdin->_file = 1; /* Attempt to send printf information inside */
stdout->_file = 2; /* tool routines to the standard locations */
stderr->_file = 3; /* in the caller's context. */
SendRequest(0x8000,sendToName,(long)pg,0l,NULL);
/*
* Re-setup text tool information for kernel debug output now that
* we've patched the hell out of everything.
*/
SetInGlobals(0xFF,0x00);
SetOutGlobals(0xFF,0x00);
SetErrGlobals(0xFF,0x00);
SetInputDevice(pascalType,3l);
SetOutputDevice(pascalType,3l);
SetErrorDevice(pascalType,3l);
WriteCString("\n\r\n\r\n\r");
commonFork(doShell, 1024, 0, NULL, &nargs, &errno);
/*
* this is the kernel null process. it must NEVER call the assembly
* _resched routine, or the time slice variable will grow uncontrollably
* if no other processes are Ready
*/
NullProcess();
endGNO:
SendRequest(0x8001,sendToName,(long)pg,0l,NULL);
unpatchTools();
/* Shut down the Event Manager */
EMShutDown();
DisposeHandle(emdp);
DeInitKern();
/* do when console driver is shutdown */
InOutEnd();
for (stat = 0; stat < numDrivers; stat++)
UserShutDown(driverUserID[stat],0);
TLShutDown();
HUnlockAll(kp->userID);
SetPurgeAll(2,kp->userID);
QuitGS(&quitParms);
}
#include <stdarg.h>
/* turn off debug 25 and on debug 8 for vararg function */
#pragma debug 0
#pragma optimize 79
#define KP_BUFSIZ 256
int kern_printf(const char *format, ...)
{
static char buffer[KP_BUFSIZ]; /* pray this is large enough (need vsnprintf) */
va_list list;
int ret;
va_start(list, format);
ret = vsprintf(buffer, format, list);
if (ret >= KP_BUFSIZ) {
asm {brk 0xbf}
}
WriteCString(buffer);
va_end(list);
return ret;
}

430
kern/gno/net.c Normal file
View File

@ -0,0 +1,430 @@
/* $Id: net.c,v 1.1 1998/02/02 08:18:36 taubert Exp $ */
/*
* GNO/ME Network Support
*
* Copyright 1994-1998, Procyon Enterprises Inc.
*
* Written by Derek Taubert and Jawaid Bazyar
*
* KERNInstallNetDriver(inf *netcore,int *ERRNO)
* KERNsocket(int domain, int type, int protocol, int *ERRNO)
* KERNbind(int fd, struct sockaddr *my_addr, int addrlen, int *ERRNO)
* KERNconnect(int fd, struct sockaddr *serv_addr, int addrlen, int *ERRNO)
* KERNlisten(int fd, int backlog, int *ERRNO)
* KERNaccept(int fd, struct sockaddr *rem_addr, int *addrlen, int *ERRNO)
* KERNrecvfrom(int fd, void *buf, size_t len, unsigned int flags, struct sockaddr *rem_addr, int *addrlen, int *ERRNO)
* KERNsendto(int fd, void *buf, size_t len, unsigned int flags, struct sockaddr *rem_addr, int addrlen, int *ERRNO)
* KERNrecv(int fd, void *buf, size_t len, unsigned int flags, int *ERRNO)
* KERNsend(int fd, void *buf, size_t len, unsigned int flags, int *ERRNO)
*
* KERNgetpeername(int s, struct sockaddr *peer_addr, int *addrlen, int *ERRNO)
* KERNgetsockname(int s, struct sockaddr *sock_addr, int *addrlen, int *ERRNO)
* KERNgetsockopt(int s, int level, int optname, void *optval, int *optlen, int *ERRNO)
* KERNsetsockopt(int s, int level, int optname, void *optval, int optlen, int *ERRNO)
*/
#include "gno.h"
#include "proc.h"
#include "sys.h"
#include "kernel.h"
#include "net.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include <locator.h>
#include <orca.h>
#include <memory.h>
#include <sys/errno.h>
#include <sys/socket.h>
#include <sys/ioctl.h>
/*#define DEBUG
#include <debug.h>*/
#pragma optimize 79
segment "KERN3 ";
extern void selwakeup(int col_flag, int pid);
int (*pr_usrreq)(int socknum, int req, void *m, size_t *m_len,
struct sockaddr *addr, int *addrlen, void *rights) = NULL;
#pragma databank 1
int SOCKioctl(void *dataptr, longword tioc, int sock)
{
if (!pr_usrreq) return EPFNOSUPPORT;
return (*pr_usrreq)(sock,PRU_CONTROL,(void *)&tioc,NULL,(struct sockaddr *)dataptr,NULL,NULL);
}
/* socket number to select on, and flags */
int SOCKselect(int pid, int fl, int sock)
{
if (!pr_usrreq) return EPFNOSUPPORT;
sock++; /* downfall of optimization in calling routine */
(*pr_usrreq)(sock,PRU_SELECT,NULL,(size_t *)&pid,(struct sockaddr *)&fl,NULL,NULL);
return (fl != 0) ? 1 : 0;
}
int SOCKclose(int sock)
/* Called from inside GS/OS, has to return special error codes */
{
int err = 0;
if (!pr_usrreq) return EPFNOSUPPORT|0x4300;
(*pr_usrreq)(
sock,
PRU_DISCONNECT,
NULL,
NULL,
NULL,
NULL,
NULL);
err = (*pr_usrreq)(
sock,
PRU_DETACH,
NULL,
NULL,
NULL,
NULL,
NULL);
return (!err) ? 0 : 0x4300 | err;
}
/* returns the refNum field of a file descriptor if that fd is a socket,
and is valid. Otherwise, returns -ERRNO */
int getsocknum(int fd)
{
fdentryPtr fdp;
extern fdentryPtr getFDptr(int);
if (!pr_usrreq) return -EPFNOSUPPORT;
fdp = getFDptr(fd);
if (fdp == NULL) return -EBADF;
if (fdp->refType != rtSOCKET) return -ENOTSOCK; /* Not a socket */
return fdp->refNum;
}
struct rwPBlock {
word ref;
void *buffer;
size_t reqCount;
size_t xferCount;
word cachePriority;
};
int SOCKrdwr(struct rwPBlock *pb, word cmd, int sock)
/* Called from inside GS/OS, has to return special error codes */
{
size_t len;
int err;
if (!pr_usrreq) return 0x4300|EPFNOSUPPORT;
len = pb->reqCount;
err = (*pr_usrreq) (
sock,
(((cmd & 0xFF) == 0x12) ? PRU_RCVD : PRU_SEND),
pb->buffer,
&len,
NULL,
NULL,
NULL);
pb->xferCount = len;
return (err == 0) ? 0 : err | 0x4300;
}
#pragma toolparms 1
pascal int KERNInstallNetDriver(void *netcore,int domain,int *ERRNO)
{
pr_usrreq = netcore;
/* don't need domain yet, we only support one type of network */
return 0;
}
pascal int KERNsocket(int domain, int type, int protocol, int *ERRNO)
{
int fd,sock;
fdentryPtr fdp;
fdtablePtr fdt;
if ((domain != PF_INET) || (!pr_usrreq)) {
*ERRNO = EPFNOSUPPORT;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
type,
PRU_ATTACH,
&sock,
(size_t *)selwakeup,
(struct sockaddr *) &protocol,
NULL,
NULL)) return -1;
disableps();
fdt = PROC->openFiles;
fdt->fdCount++;
fdp = allocFD(&fd);
fdp->refNum = sock;
fdp->refType = rtSOCKET;
fdp->refFlags = 0;
fdp->refLevel = fdt->fdLevel | fdt->fdLevelMode;
fdp->NLenableMask = 0;
fdp->NLnumChars = 0;
fdp->NLtable = NULL;
AddRefnum(rtSOCKET,sock);
enableps();
return fd;
}
pascal int KERNbind(int fd, struct sockaddr *my_addr, int addrlen, int *ERRNO)
{
int err,sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_BIND,
NULL,
NULL,
my_addr,
&addrlen,
NULL)) return -1;
return 0;
}
pascal int KERNconnect(int fd, struct sockaddr *serv_addr, int addrlen, int *ERRNO)
{
int sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_CONNECT,
NULL,
NULL,
serv_addr,
&addrlen,
NULL)) return -1;
return 0;
}
pascal int KERNlisten(int fd, int backlog, int *ERRNO)
{
int sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_LISTEN,
&backlog,
NULL,
NULL,
NULL,
NULL)) return -1;
return 0;
}
pascal int KERNaccept(int fd, struct sockaddr *rem_addr, int *addrlen, int *ERRNO)
{
int newfd,sock;
fdentryPtr fdp;
fdtablePtr fdt;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_ACCEPT,
&newfd,
(size_t *)selwakeup,
rem_addr,
addrlen,
NULL)) return -1;
disableps();
fdt = PROC->openFiles;
fdt->fdCount++;
fdp = allocFD(&fd);
fdp->refNum = newfd;
fdp->refType = rtSOCKET;
fdp->refFlags = 0;
fdp->refLevel = fdt->fdLevel | fdt->fdLevelMode;
fdp->NLenableMask = 0;
fdp->NLnumChars = 0;
fdp->NLtable = NULL;
AddRefnum(rtSOCKET,newfd);
enableps();
return fd;
}
pascal int KERNrecvfrom(int fd, void *buf, size_t len, unsigned int flags, struct sockaddr *rem_addr, int *addrlen, int *ERRNO)
{
int sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
(flags & MSG_OOB) ? PRU_RCVOOB : PRU_RCVD,
buf,
&len,
rem_addr,
addrlen,
NULL)) return -1;
return len;
}
pascal int KERNsendto(int fd, void *buf, size_t len, unsigned int flags, struct sockaddr *rem_addr, int addrlen, int *ERRNO)
{
int sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
(flags & MSG_OOB) ? PRU_SENDOOB : PRU_SEND,
buf,
&len,
rem_addr,
&addrlen,
NULL)) return -1;
return len;
}
pascal int KERNrecv(int fd, void *buf, size_t len, unsigned int flags, int *ERRNO)
{
int sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
(flags & MSG_OOB) ? PRU_RCVOOB : PRU_RCVD,
buf,
&len,
NULL,
NULL,
NULL)) return -1;
return len;
}
pascal int KERNsend(int fd, void *buf, size_t len, unsigned int flags, int *ERRNO)
{
int sock;
if ((sock = getsocknum(fd)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
(flags & MSG_OOB) ? PRU_SENDOOB : PRU_SEND,
buf,
&len,
NULL,
NULL,
NULL)) return -1;
return len;
}
pascal int KERNgetpeername(int s, struct sockaddr *peer_addr, int *addrlen, int *ERRNO) {
int sock;
if ((sock = getsocknum(s)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_PEERADDR,
NULL,
NULL,
peer_addr,
addrlen,
NULL)) return -1;
return 0;
}
pascal int KERNgetsockname(int s, struct sockaddr *sock_addr, int *addrlen, int *ERRNO) {
int sock;
if ((sock = getsocknum(s)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_SOCKADDR,
NULL,
NULL,
sock_addr,
addrlen,
NULL)) return -1;
return 0;
}
pascal int KERNgetsockopt(int s, int level, int optname, void *optval, int *optlen, int *ERRNO) {
int sock;
if ((sock = getsocknum(s)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_CO_GETOPT,
&level,
(size_t *)&optname,
(struct sockaddr *)optval,
optlen,
NULL)) return -1;
return 0;
}
pascal int KERNsetsockopt(int s, int level, int optname, void *optval, int optlen, int *ERRNO) {
int sock;
if ((sock = getsocknum(s)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_CO_SETOPT,
&level,
(size_t *)&optname,
(struct sockaddr *)optval,
&optlen,
NULL)) return -1;
return 0;
}
pascal int KERNshutdown(int s, int how, int *ERRNO)
{
int sock;
if ((sock = getsocknum(s)) < 0) {
*ERRNO = -sock;
return -1;
}
if (*ERRNO = (*pr_usrreq)(
sock,
PRU_SHUTDOWN,
&how,
NULL,
NULL,
NULL,
NULL)) return -1;
return 0;
}
#pragma toolparms 0
#pragma databank 0

35
kern/gno/net.h Normal file
View File

@ -0,0 +1,35 @@
/* $Id: net.h,v 1.1 1998/02/02 08:18:39 taubert Exp $ */
/*
* GNO/ME Network Support
*
* Copyright 1994-1998, Procyon Enterprises Inc.
*
* Written by Derek Taubert and Jawaid Bazyar
*
*/
/* Request types for pr_usrreq() */
#define PRU_ABORT 0
#define PRU_ACCEPT 1
#define PRU_ATTACH 2
#define PRU_BIND 3
#define PRU_CONNECT 4
#define PRU_CONNECT2 5
#define PRU_CONTROL 6
#define PRU_DETACH 7
#define PRU_DISCONNECT 8
#define PRU_LISTEN 9
#define PRU_PEERADDR 10
#define PRU_RCVD 11
#define PRU_RCVOOB 12
#define PRU_SEND 13
#define PRU_SENDOOB 14
#define PRU_SENSE 15
#define PRU_SHUTDOWN 16
#define PRU_SOCKADDR 17
#define PRU_CO_GETOPT 18
#define PRU_CO_SETOPT 19
#define PRU_SELECT 20

821
kern/gno/p16.asm Normal file
View File

@ -0,0 +1,821 @@
* $Id: p16.asm,v 1.1 1998/02/02 08:19:33 taubert Exp $
**************************************************************************
*
* P16.ASM
* By Jawaid Bazyar
*
* This file contains routines for patching Prodos 16 calls to maintain
* the information the kernel needs to keep track of things.
*
**************************************************************************
copy global.equates
mcopy m/p16.mac
copy inc/gsos.inc
copy inc/tty.inc
case on
* if you change FDsize, look for the commend "a * FDsize". You must
* change code there.
rfPIPEREAD gequ 1 ;* read end of the pipe *
rfPIPEWRITE gequ 2 ;* write end of the pipe *
rfCLOSEEXEC gequ 4 ;* close this file on an exec() *
rfP16NEWL gequ 8 ;* special prodos-16 newline mode *
P16table START
dc a2'P16Standard' ; $2001 CREATE
dc a2'P16Standard' ; $2002 DESTROY
dc a2'NotImpP16' ; $2003
dc a2'P16ChangePath' ; $2004 CHANGE_PATH
dc a2'P16Standard' ; $2005 SET_FILE_INFO
dc a2'P16Standard' ; $2006 GET_FILE_INFO
dc a2'NotImpP16' ; $2007
dc a2'NotImpP16' ; $2008 VOLUME
dc a2'P16SetPrefix' ; $2009 SET_PREFIX
dc a2'PGGetPrefix' ; $200A GET_PREFIX
dc a2'P16Standard' ; $200B CLEAR_BACKUP_BIT
dc a2'NotImpP16' ; $200C
dc a2'NotImpP16' ; $200D
dc a2'NotImpP16' ; $200E
dc a2'NotImpP16' ; $200F
dc a2'P16Open' ; $2010 OPEN
dc a2'P16NewLine' ; $2011 NEWLINE
dc a2'P16RdWr' ; $2012 READ
dc a2'P16RdWr' ; $2013 WRITE
dc a2'PGClose' ; $2014 CLOSE
dc a2'P16RefCommon' ; $2015 FLUSH
dc a2'P16RefCommon' ; $2016 SET_MARK
dc a2'P16RefCommon' ; $2017 GET_MARK
dc a2'P16RefCommon' ; $2018 SET_EOF
dc a2'P16RefCommon' ; $2019 GET_EOF
dc a2'P16SetLevel' ; $201A SET_LEVEL
dc a2'P16GetLevel' ; $201B GET_LEVEL
dc a2'P16RefCommon' ; $201C GET_DIR_ENTRY
dc a2'NotImpP16' ; $201D
dc a2'NotImpP16' ; $201E
dc a2'NotImpP16' ; $201F
dc a2'NotImpP16' ; $2020 GET_DEV_NUM
dc a2'NotImpP16' ; $2021 GET_LAST_DEV
dc a2'NotImpP16' ; $2022 READ_BLOCK
dc a2'NotImpP16' ; $2023 WRITE_BLOCK
dc a2'NotImpP16' ; $2024 FORMAT
dc a2'NotImpP16' ; $2025 ERASE_DISK
dc a2'NotImpP16' ; $2026
dc a2'P16GetName' ; $2027 GET_NAME
dc a2'NotImpP16' ; $2028 GET_BOOT_VOL
dc a2'P16Quit' ; $2029 QUIT
dc a2'NotImpP16' ; $202A GET_VERSION
dc a2'NotImpP16' ; $202B
dc a2'NotImpP16' ; $202C D_INFO
dc a2'NotImpP16' ; $202D
dc a2'NotImpP16' ; $202E
dc a2'NotImpP16' ; $202F
dc a2'NotImpP16' ; $2030
dc a2'NotImpP16' ; $2031 ALLOC_INTERRUPT
dc a2'NotImpP16' ; $2032 DEALLOC_INTERRUPT
END
P16SetPrefix START
using KernelStruct
pfxRec equ 10
pfxInd equ 14
pfxpCount equ 16
pfxpfxNum equ 18
pfxpathname equ 20
newPath equ 24
ldy #prefixh-CKernData ; copy the handle of the prefix rec
lda [procEnt],y ; out of the process table
sta pfxRec ; we dereference it later
iny2
lda [procEnt],y
sta pfxRec+2
pea 1
lda [pBlock]
pha ; pfx# for expandpath
ldy #4
lda [pBlock],y
pha
ldy #2
lda [pBlock],y
pha
jsl p16_ExpandPath ; call our C routine
sta pfxpathname
stx pfxpathname+2 ; store result
cpx #$FFFF ; did an error occur?
bne noerr
jmp GSOSReturn
noerr anop
lda [pBlock]
inc a
asl a
asl a
sta pfxInd
tay
iny2
lda [pfxRec],y
pha
dey2
lda [pfxRec],y
pha
ora 3,s
bne dodispose
pla
pla
bra nodispose
dodispose jsl ~NDISPOSE
nodispose lda [pfxpathname]
inc a
inc a
inc a
pea 0
pha
jsl ~NEW
sta newPath
stx newPath+2
ldy pfxInd ; copy the addr of the new mem into the
sta [pfxRec],y ; prefix record
iny2
txa
sta [pfxRec],y
ph4 pfxpathname ; copy the string
ph4 newPath
jsl copygsstr
lda [newPath]
inc a
tay
lda [newPath],y ; check to see if there's a
and #$00FF
cmp #':' ; separator at the end of the
beq alright
short m ; prefix, and if not, then
lda #':'
iny ; add one. Note that we alloced
sta [newPath],y ; one extra byte for this possibility
long m
dey
tya
sta [newPath]
alright lda #0
jmp GSOSReturn
END
P16Standard START
oldPath equ 10
pathName equ 14
tmpLength equ 18
exppath equ 20
lda [pBlock]
sta oldPath
ldy #2
lda [pBlock],y
sta oldPath+2
pea 0
pushword #0
pushlong oldPath
jsl p16_ExpandPath
cpx #$FFFF
bne noerr
jmp GSOSReturn
noerr anop
sta exppath
stx exppath+2
* ph4 exppath
phx
pha
jsl findDevice
cmp #$FFFF
beq notdevice
lda #$0058 ; not a block device!
bra goaway
notdevice anop
ldx exppath+2
lda exppath
ldy #0
sta pathName
inc a ; part of 'fix string'
sta [pBlock],y
bne incr
inx
incr txa
iny2
sta pathName+2 ; $$$ if the inx is taken, this is
sta [pBlock],y ; incorrect (pathname+2 is)
lda [pathName]
sta tmpLength
xba
sta [pathName]
* short m
* ldy #1
* sta [pathName],y
* long m
ph4 pBlock
ph2 cmdNum
jsl OldGSOSSt
* movelong pBlock,pb ; $$$ switch to stack-based
* lda cmdNum
* sta cn
* jsl OldGSOS
*cn dc i2'0' ; set to same call # we are
*pb dc i4'0'
pha ; return any error we get
lda tmpLength
sta [pathName]
lda cmdNum
cmp #$0002
beq docff
cmp #$0005
bne noff
docff anop
ldx oldPath+2
lda oldPath
jsr PcheckFF
noff anop
lda oldPath
sta [pBlock]
ldy #2
lda oldPath+2
sta [pBlock],y
pla
goaway jmp GSOSReturn
END
P16Open START
using KernelStruct
temp1 equ 10
pathName equ 14
tmpLength equ 18
files equ 20
fd equ 24
fdptr equ 26
ldy #2
lda [pBlock],y
sta temp1
ldy #4
lda [pBlock],y
sta temp1+2
ldy #openFiles-CKernData ; copy the handle of the prefix rec
lda [procEnt],y ; out of the process table
sta files ; we dereference it later
iny2
lda [procEnt],y
sta files+2
pea 0
ph2 #0
ph4 temp1
jsl p16_ExpandPath
cpx #$FFFF
bne noerr
jmp GSOSReturn
noerr anop
ldy #2
sta pathName
inc a
sta [pBlock],y
bne incr
inx
incr txa
iny2
sta pathName+2
sta [pBlock],y
lda [pathName]
sta tmpLength
xba
sta [pathName]
movelong pBlock,pb
lda cmdNum
sta cn
jsl OldGSOS
cn dc i2'0' ; set to same call # we are
pb dc i4'0'
pha ; return any error we get
cmp #0
bne error
lda [pBlock]
pha
ph2 #0
jsl AddRefnum
lda [files] ; inc the number of open files,
inc a
sta [files]
pea 0 ; allocate a file descriptor
tdc
clc
adc #fd
pha
jsl allocFD
sta fdptr
stx fdptr+2
; rederef the openFiles pointer
ldy #openFiles-CKernData
lda [procEnt],y
sta files
iny2
lda [procEnt],y
sta files+2
lda [pBlock]
ldy #FDrefNum
sta [fdptr],y ; and store the new refnum in the list
lda fd
sta [pBlock] ; and store it
ldy #FDTLevel
lda [files],y
ldy #FDTLevelMode
ora [files],y
ldy #FDrefLevel
sta [fdptr],y ; store file level with refnum
error anop
lda tmpLength
sta [pathName]
ldx temp1+2
lda temp1
jsr PcheckFF
ldy #2
lda temp1
sta [pBlock],y
ldy #4
lda temp1+2
sta [pBlock],y
pla
jmp GSOSReturn
END
P16Quit START
using KernelStruct
ldx curProcInd
lda flags,x
ora #%00001000 ; FL_NORMTERM
sta flags,x
ldy #4 ; push the flags word
lda [pBlock],y
pha
ldy #2 ; push the pathname
lda [pBlock],y
pha
ldy #0
lda [pBlock],y
pha
ora 3,s
beq noPname
jsl p2cstr
phx
pha ; push the coverted pathname
noPname anop
jsl CommonQuit
jmp GSOSReturn ; only returns on error
END
P16SetLevel START
using KernelStruct
files equ 10
ldy #openFiles-CKernData ; copy the handle of the prefix rec
lda [procEnt],y ; out of the process table
sta files ; we dereference it later
iny2
lda [procEnt],y
sta files+2
okay anop
ldy #FDTLevel
lda [pBlock]
sta [files],y
lda #$8000
ldy #FDTLevelMode
sta [files],y
lda #0
error jmp GSOSReturn
END
P16GetLevel START
using KernelStruct
files equ 10
ldy #openFiles-CKernData ; copy the handle of the prefix rec
lda [procEnt],y ; out of the process table
sta files ; we dereference it later
iny2
lda [procEnt],y
sta files+2
okay anop
ldy #2
lda [files],y
sta [pBlock]
lda #0
error jmp GSOSReturn
END
P16ChangePath START
temp1 equ 10
temp2 equ 14
oldpathres equ 18
newmem equ 22
pea 0
pushword #0
ldy #2
lda [pBlock],y
pha
lda [pBlock]
pha ; push source onto stack
jsl p16_ExpandPath
cpx #$FFFF
bne noerr
jmp GSOSReturn
noerr phx
pha ; push source addr for copy
stx oldpathres+2
sta oldpathres
pea $0000
lda [oldpathres]
clc
adc #2
pha
jsl ~NEW
stx newmem+2
sta newmem
stx pathname+2
sta pathname
phx
pha ; push dest address
ora pathname+2
beq memoryErr
jsl copygsstr ; copy the expanded path to temp
pea 0
pushword #0
ldy #6
lda [pBlock],y
pha
dey2
lda [pBlock],y
pha ; push source onto stack
jsl p16_ExpandPath
cpx #$FFFF
bne noerr1
ph4 newmem
jsl ~NDISPOSE
jmp GSOSReturn
noerr1 anop
stx newpathname+2
sta newpathname
pushlong #chPathPB
pea $2004
jsl OldGSOSSt
pha ; return any error we get
pushlong newmem
jsl ~NDISPOSE
interdict anop
pla
jmp GSOSReturn
memoryErr pla
pla
pea $0054
bra interdict
chPathPB anop
dc i2'2'
pathname dc i4'0'
newpathname dc i4'0'
END
* Flush 2015 +2
* GetDirEntry 201C +2
* GetEOF 2019 +2 tty,pipe
* GetMark 2017 +2 tty,pipe
* GetRefInfo 2039 +2
* SetEOF 2018 +2 tty,pipe
* SetMark 2016 +2 tty,pipe
P16RefCommon START
oldRN equ 10
fdPtr equ 12
lda [pBlock]
sta oldRN
pha
cmp #0
bne notzero
lda cmdNum
cmp #$0015
jeq FlushSpecial
pla
lda #$43
jmp GSOSReturn
notzero jsl getFDptr
sta fdPtr
stx fdPtr+2
ora fdPtr+2
beq refIsBad
lda [fdPtr]
cmp #0
bne okay
refIsBad lda #$43
jmp GSOSReturn
okay anop
ldy #FDrefType
lda [fdPtr],y
cmp #FDgsos
beq typeOkay
jmp notGSOS
typeOkay lda [fdPtr]
sta [pBlock]
ph4 pBlock
ph2 cmdNum
jsl OldGSOSSt
pha
lda oldRN
sta [pBlock]
pla
jmp GSOSReturn
notGSOS lda #$58
jmp GSOSReturn
FlushSpecial anop
ph4 pBlock
ph2 cmdNum
jsl OldGSOSSt
jmp GSOSReturn
END
P16NewLine START
oldRN equ 10
fdrec equ 12
trueRN equ 16
lda [pBlock]
sta oldRN
pha
jsl getFDptr
sta fdrec
stx fdrec+2
ora fdrec+2
beq refIsBad
ldy #FDrefNum
lda [fdrec],y
cmp #0
bne okay
refIsBad lda #$43
jmp GSOSReturn
okay anop
sta trueRN
ldy #FDrefType
lda [fdrec],y
cmp #FDpipe
beq nlPipe
ldy #FDrefNum
lda trueRN
sta [pBlock]
ph4 pBlock
ph2 cmdNum
jsl OldGSOSSt
pha
lda oldRN
sta [pBlock]
pla
jmp GSOSReturn
nlPipe anop
ldy #2
lda [pBlock],y
ldy #FDNLenableMask
sta [fdrec],y
beq noerror
ldy #FDrefFlags
lda [fdrec],y
and #rfP16NEWL
sta [fdrec],y ; tell 'em it's a P16 NewLine
ldy #4
lda [pBlock],y
ldy #FDNLnumChars
sta [fdrec],y
noerror lda #0
jmp GSOSReturn
END
P16RdWr START
using KernelStruct
files equ 10
fdrec equ 14
rn equ 18
ldx curProcInd
lda openFiles,x
sta files
lda openFiles+2,x
sta files+2
lda [pBlock]
sta rn
pha
jsl getFDptr
sta fdrec
stx fdrec+2
ora fdrec+2
bne refIsOk
lda #$43
jmp GSOSReturn
refIsOk ldy #FDrefType
lda [fdrec],y
asl a
tax
jmp (rdwrtable,X)
rdwrtable dc i2'doGSOS'
dc i2'doPipe'
dc i2'doTTY'
dc i2'doSocket'
*******************
doGSOS anop
ldy #FDrefNum
lda [fdrec],y
sta [pBlock]
ph4 pBlock
ph2 cmdNum
jsl OldGSOSSt
pha
lda rn
sta [pBlock]
pla
jmp GSOSReturn
*******************
doPipe anop
jsl decBusy
ph4 pBlock
ldy #FDrefNum
lda [fdrec],y
pha
lda cmdNum
cmp #$0012
beq pread
jsl pipeHiWrite
bra goback
pread ph4 fdrec
jsl pipeHiRead
goback anop
jsl incBusy
jmp GSOSReturn
*******************
doTTY anop
jsl decBusy
ldy #6
lda [pBlock],y
pha
ldy #4
lda [pBlock],y
pha
ldy #2
lda [pBlock],y
pha
lda cmdNum
cmp #$0012
beq tread
ldy #FDrefNum
lda [fdrec],y
dec a
pha
ldy #t_write
jsl LineDiscDispatch
bra goaway2
tread ldy #FDrefNum
lda [fdrec],y
dec a
pha
ldy #t_read
jsl LineDiscDispatch
goaway2 anop
phx
ldy #10
sta [pBlock],y ; to provide a way for TTYs to
lda #0
ldy #12
sta [pBlock],y ; bug! must clear hi word o'transCnt
jsl incBusy
pla
jmp GSOSReturn
*******************
doSocket anop
ldy #FDrefNum
lda [fdrec],y
pha
ph2 cmdNum
ph4 pBlock
jsl SOCKrdwr
jmp GSOSReturn
END
P16GetName START
using KernelStruct
pathptr equ 10
resptr equ 14
outind equ 18
inind equ 20
pathlen equ 22
* Note that forked processes will get the name of their parent
ldy #2
lda [pBlock],y
sta resptr+2
lda [pBlock]
sta resptr
ldx curProcInd ; get the full pathname of
lda procUserID,x ; the process.
pha
pha ; space for tool call. ARGH!!!
pha
pea $1
_LGetPathname
pl4 pathptr
lda [pathptr]
and #$00FF
sta pathlen
inc a
tay
short m
loop lda [pathptr],y
cmp #'/'
beq gotfname
dey
bra loop
gotfname long m
iny
sty inind
lda [pathptr] ; get length
sec
sbc inind ; length of filename
clc
adc #1 ; minus the length word
sta [resptr] ; store length of filename
ldy #1
sty outind
short m
cploop ldy inind
lda [pathptr],y
ldy outind
sta [resptr],y
ldy inind
cpy pathlen
bcs donecopy
long m
inc inind
inc outind
short m
bra cploop
donecopy long m
lda #0
jmp GSOSReturn
END

109
kern/gno/patch.c Normal file
View File

@ -0,0 +1,109 @@
/* $Id: patch.c,v 1.1 1998/02/02 08:18:40 taubert Exp $ */
segment "KERN2 ";
#pragma optimize 79
#include "proc.h"
#include "gno.h"
#include "sys.h"
#include "sem.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include <memory.h>
#include <gsos.h>
#include <event.h>
#include <locator.h>
struct patchEntry {
word toolNum;
longword oldFunc,newFunc;
longword *chainPoint;
};
/* tool patch entry points */
extern byte NULLTOOLFUNC;
extern byte OURSYSFAILMGR;
extern byte SaveAllPatch;
extern byte RestAllPatch;
extern byte QDSTARTUPPATCH;
extern byte SANESUPATCH;
extern byte SANESDPATCH;
extern byte SANESTPATCH;
extern byte TDISPOSEHAND;
extern byte NewGetNextEvent, NewEMStartUp, NewGetOSEvent, NewOSEventAvail,
NewEMShutDown,NewEventAvail;
/* tool patch 'old' vectors, for patches that want to call the old routine */
extern longword OLDSAVEALL, OLDRESTALL, OLDQDSTARTUP, OLDSANESU, OLDDISPHAND;
extern longword OldGetNextEvent, OldOSEventAvail, OldGetOSEvent, OldEventAvail;
static struct patchEntry patchArray[] = {
{ 0x0B05, 0l, (longword) (&SaveAllPatch), &OLDSAVEALL },
{ 0x0C05, 0l, (longword) (&RestAllPatch), &OLDRESTALL },
{ 0x0204, 0l, (longword) (&QDSTARTUPPATCH), &OLDQDSTARTUP },
{ 0x020A, 0l, (longword) (&SANESUPATCH), &OLDSANESU },
{ 0x0201, 0l, (longword) (&NULLTOOLFUNC), NULL },
{ 0x0301, 0l, (longword) (&NULLTOOLFUNC), NULL },
{ 0x1503, 0l, (longword) (&OURSYSFAILMGR), NULL },
{ 0x030A, 0l, (longword) (&SANESDPATCH), NULL },
{ 0x060A, 0l, (longword) (&SANESTPATCH), NULL },
/* { 0x1002, 0l, (longword) (&TDISPOSEHAND), &OLDDISPHAND }, */
{ 0x0206, 0l, (longword) (&NewEMStartUp), NULL },
{ 0x0A06, 0l, (longword) (&NewGetNextEvent), &OldGetNextEvent },
{ 0x0B06, 0l, (longword) (&NewEventAvail), &OldEventAvail },
{ 0x1606, 0l, (longword) (&NewGetOSEvent), &OldGetOSEvent },
{ 0x1706, 0l, (longword) (&NewOSEventAvail), &OldOSEventAvail },
{ 0x0306, 0l, (longword) (&NewEMShutDown), NULL },
{ ~0, 0l, 0l, NULL}};
void patchTools(void)
{
longword *TLfunc;
int i;
word Tool, Func;
i = 0;
while ((Tool = patchArray[i].toolNum) != ~0) {
Func = (Tool & 0xFF00) >> 8;
Tool &= 0xff;
TLfunc = (longword *) GetTSPtr(0x0000, Tool);
patchArray[i].oldFunc = TLfunc[Func];
if (patchArray[i].chainPoint) {
if (*(patchArray[i].chainPoint)) {
/* takes care of jmp >$000000 patches */
*(patchArray[i].chainPoint) |= ((TLfunc[Func]+1) << 8);
} else {
/* takes care of dc i4'0' patches */
*(patchArray[i].chainPoint) = TLfunc[Func]+1;
}
}
#ifdef DEBUG_TOOL_PATCH
printf("%lx %lx %lx %lx %lx\n", &TLfunc[Func], patchArray[i].oldFunc,
patchArray[i].chainPoint, *(patchArray[i].chainPoint),
patchArray[i].newFunc);
#endif
TLfunc[Func] = patchArray[i].newFunc-1;
#ifdef DEBUG_TOOL_PATCH
printf(" %lx\n", TLfunc[Func]);
#endif
i++;
}
}
void unpatchTools(void)
{
longword *TLfunc;
int i;
word Tool, Func;
i = 0;
while ((Tool = patchArray[i].toolNum) != -1) {
Func = (Tool & 0xFF00) >> 8;
Tool &= 0xff;
TLfunc = (longword *) GetTSPtr(0x0000, Tool);
TLfunc[Func] = patchArray[i].oldFunc;
i++;
}
}

1329
kern/gno/pipe.asm Normal file
View File

File diff suppressed because it is too large Load Diff

341
kern/gno/ports.c Normal file
View File

@ -0,0 +1,341 @@
/* $Id: ports.c,v 1.1 1998/02/02 08:18:41 taubert Exp $ */
#include "conf.h"
#include "kernel.h"
#include "proc.h"
#include "gno.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include <sys/errno.h>
#include <sys/ports.h>
#pragma optimize 79
struct ptnode *ptfree; /* list of free queue nodes */
struct pt ports[NPORTS];
int ptnextp;
extern void PANIC(char *s);
#ifdef KERNEL
segment "KERN2 ";
#else
#include "tests/testports.c"
#endif
/*
* pinit - initialize all ports
*/
SYSCALL pinit(int maxmsgs)
{
int i;
struct ptnode *next,*prev;
if ( (ptfree=malloc(maxmsgs*sizeof(struct ptnode)))==NULL )
PANIC("pinit - insufficient memory");
for (i = 0; i < NPORTS; i++) {
ports[i].ptstate = PTFREE;
ports[i].ptseq = 0;
}
ptnextp = NPORTS - 1;
/* link up free list of message pointer nodes */
for (prev = next = ptfree; --maxmsgs > 0; prev = next)
prev->ptnext = ++next;
prev->ptnext = NULL;
return(OK);
}
#pragma databank 1
#pragma toolparms 1
/*
* pcreate - create a port that allows "count" outstanding messages
*/
pascal SYSCALL KERNpcreate(int count, int *ERRNO)
{
int ps;
int i,p;
struct pt *ptptr;
if (count < 0) return SYSERR;
disableps();
for (i = 0; i < NPORTS; i++) {
if ((p = ptnextp--) < 0)
ptnextp = NPORTS - 1;
if ((ptptr = &ports[p])->ptstate == PTFREE) {
ptptr->ptstate = PTALLOC;
ptptr->ptname = PTUNNAMED;
ptptr->ptssem = Kscreate(ERRNO, count);
if (ptptr->ptssem == SYSERR) {
bad: ptptr->ptstate = PTFREE;
*ERRNO = ENOMEM;
enableps();
return SYSERR;
}
ptptr->ptrsem = Kscreate(ERRNO, 0);
if (ptptr->ptrsem == SYSERR) {
Ksdelete(ERRNO, ptptr->ptssem);
goto bad;
}
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
ptptr->pthead = ptptr->pttail = NULL;
#else
ptptr->pthead = NULL;
ptptr->pttail = NULL;
#endif
ptptr->ptseq++;
ptptr->ptmaxcnt = count;
enableps();
return p;
}
}
enableps();
*ERRNO = ENOMEM;
return SYSERR;
}
/*
* psend - send a message to a port by enqueueing it
*/
pascal SYSCALL KERNpsend(int portid, long int msg, int *ERRNO)
{
int ps;
struct pt *ptptr;
int seq;
struct ptnode *freenode;
disableps();
if (isbadport(portid) ||
(ptptr = &ports[portid])->ptstate != PTALLOC) {
enableps();
return SYSERR;
}
/* wait for space and verify port is still allocated */
seq = ptptr->ptseq;
if (commonSwait(ERRNO,ptptr->ptssem,procBLOCKED,BLOCKED_PRECEIVE) == SYSERR) {
enableps();
/* *ERRNO set in commonSwait() */
return SYSERR;
}
if (ptptr->ptstate != PTALLOC || ptptr->ptseq != seq) {
enableps();
return SYSERR;
}
if (ptfree == NULL)
PANIC("Ports - out of nodes");
freenode = ptfree;
ptfree = freenode->ptnext;
freenode->ptnext = NULL;
freenode->ptmsg = msg;
if (ptptr->pttail == NULL) {
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
ptptr->pthead = ptptr->pttail = freenode;
#else
ptptr->pthead = freenode;
ptptr->pttail = freenode;
#endif
} else {
(ptptr->pttail)->ptnext = freenode;
ptptr->pttail = freenode;
}
Kssignal(ERRNO, ptptr->ptrsem);
enableps();
return OK;
}
/*
* preceive - receive a message from a port, blocking if port empty
*/
pascal long SYSCALL KERNpreceive(int portid, int *ERRNO)
{
int ps;
struct pt *ptptr;
int seq;
long int msg;
struct ptnode *nxtnode;
disableps();
if (isbadport(portid) ||
(ptptr = &ports[portid])->ptstate != PTALLOC) {
enableps();
return SYSERR;
}
/* wait for message and verify that the port is still allocated */
seq = ptptr->ptseq;
/* sleep, and return EINTR/SYSERR if we were interrupted */
if (commonSwait(ERRNO,ptptr->ptrsem,procBLOCKED,BLOCKED_PRECEIVE) == SYSERR) {
enableps();
/* *ERRNO set in commonSwait() */
return SYSERR;
}
if (ptptr->ptstate != PTALLOC || ptptr->ptseq != seq) {
enableps();
return SYSERR;
}
/* dequeue first message that is waiting in the port */
nxtnode = ptptr->pthead;
msg = nxtnode->ptmsg;
if (ptptr->pthead == ptptr->pttail) { /* delete last item */
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
ptptr->pthead = ptptr->pttail = NULL;
#else
ptptr->pthead = NULL;
ptptr->pttail = NULL;
#endif
} else ptptr->pthead = nxtnode->ptnext;
nxtnode->ptnext = ptfree; /* return to free list */
ptfree = nxtnode;
Kssignal(ERRNO, ptptr->ptssem);
enableps();
return msg;
}
#pragma toolparms 0
/*
* _ptclear - used by pdelete and preset to clear a port
*/
_ptclear(struct pt *ptptr, int newstate, int (*dispose)(long int))
{
struct ptnode *p;
/* put port in limbo until done freeing processes */
ptptr->ptstate = PTLIMBO;
ptptr->ptseq++;
if ((p=ptptr->pthead) != NULL) {
for (; p != NULL; p=p->ptnext)
/* only do this if they specified a disposition */
if (dispose != NULL) (*dispose)(p->ptmsg);
(ptptr->pttail)->ptnext = ptfree;
ptfree = ptptr->pthead;
}
if (newstate == PTALLOC) {
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
ptptr->pthead = ptptr->pttail = NULL;
#else
ptptr->pthead = NULL;
ptptr->pttail = NULL;
#endif
/* sreset(ptptr->ptssem, ptptr->ptmaxcnt);
sreset(ptptr->ptrsem, 0); */
} else {
enableps();
Ksdelete(&errno, ptptr->ptssem);
Ksdelete(&errno, ptptr->ptrsem);
disableps();
}
ptptr->ptstate = newstate;
}
#pragma toolparms 1
/*
* pdelete - delete a port, freeing waiting processes and messages
*/
pascal SYSCALL KERNpdelete(int portid, int (*dispose)(long int), int *ERRNO)
{
int ps;
struct pt *ptptr;
disableps();
if (isbadport(portid) ||
(ptptr = &ports[portid])->ptstate != PTALLOC) {
enableps();
return SYSERR;
}
_ptclear(ptptr,PTFREE,dispose);
/* dispose of the port's name */
if (ptptr->ptname != NULL) {
free(ptptr->ptname);
ptptr->ptname = NULL;
}
enableps();
return OK;
}
/*
* preset - reset a port, freeing waiting processes and messages
*/
pascal SYSCALL KERNpreset(int portid, int (*dispose)(long int), int *ERRNO)
{
int ps;
struct pt *ptptr;
disableps();
if (isbadport(portid) ||
(ptptr = &ports[portid])->ptstate != PTALLOC) {
enableps();
return SYSERR;
}
_ptclear(ptptr, PTALLOC, dispose);
enableps();
return OK;
}
/*
* pbind - binds a port to a name
*/
pascal SYSCALL KERNpbind(int portid, char *name, int *ERRNO)
{
struct pt *ptptr;
disableps();
if (isbadport(portid) ||
(ptptr = &ports[portid])->ptstate != PTALLOC) {
enableps();
return SYSERR;
}
if (ptptr->ptname != PTUNNAMED) {
enableps();
return SYSERR;
}
ptptr->ptname = malloc(33);
strncpy(ptptr->ptname,name,32);
enableps();
return OK;
}
pascal SYSCALL KERNpgetport(char *name, int *ERRNO)
{
struct pt *ptptr;
unsigned i;
disableps();
for (i = 0; i < NPORTS; i++)
if ((ports[i].ptstate == PTALLOC) && (ports[i].ptname != NULL)
&& (!strncmp(ports[i].ptname,name,32))) {
enableps();
return i;
}
enableps();
return SYSERR;
}
pascal SYSCALL KERNpgetcount(int portid, int *ERRNO)
{
struct pt *ptptr;
int c,d;
disableps();
if (isbadport(portid) ||
(ptptr = &ports[portid])->ptstate != PTALLOC) {
enableps();
return SYSERR;
}
c = Kscount(ERRNO, ptptr->ptssem);
d = (c == SYSERR) ? ptptr->ptmaxcnt : ptptr->ptmaxcnt - c;
enableps();
return d;
}

154
kern/gno/proc.h Normal file
View File

@ -0,0 +1,154 @@
/* $Id: proc.h,v 1.1 1998/02/02 08:18:43 taubert Exp $ */
/*
Kernel Process table structure
Copyright 1991-1998 Procyon, Inc.
*/
#ifndef PROC_KERN
#define PROC_KERN
#include <types.h>
#include <sys/types.h>
#include <sys/signal.h>
/* the various process states are defined here */
#define procUNUSED 0
#define procRUNNING 1
#define procREADY 2
#define procBLOCKED 3
#define procNEW 4
#define procSUSPENDED 5
#define procWAIT 6
#define procWAITSIGCH 7
#define procPAUSED 8
#define procSLEEP 9
#define BLOCKED_RECEIVE 2
#define BLOCKED_PRECEIVE 3
#define BLOCKED_SWAIT 4
#define SYSERR -1
#define SYSOK 0
#define rtGSOS 0
#define rtPIPE 1
#define rtTTY 2
#define rtSOCKET 3
#define rfPIPEREAD 1 /* read end of the pipe */
#define rfPIPEWRITE 2 /* write end of the pipe */
#define rfCLOSEEXEC 4 /* close this file on an exec() */
#define rfP16NEWL 8 /* special prodos-16 newline mode */
typedef struct fdentry {
word refNum; /* refNum, pipeNum, ttyID, or sockNum */
word refType; /* 0 = GS/OS refnum, 1 = pipe, 2 = tty, 3 = socket */
word refLevel; /* "file level" of the refnum */
word refFlags; /* see flags above */
word NLenableMask; /* these three fields are for newline handling */
word NLnumChars;
void *NLtable;
} fdentry, *fdentryPtr;
typedef struct fdtable {
word fdCount;
word fdLevel;
word fdLevelMode;
word fdTableSize;
fdentry fds[1];
} fdtable, *fdtablePtr;
#define FD_SIZE 32
typedef struct quitStack {
struct quitStack *next;
char data[1];
} quitStack;
/* these flags are set by execve() and fork() during process creation. */
#define FL_RESOURCE 1 /* does the process have and use a resource fork? */
#define FL_FORKED 2 /* was the process started with fork() ? */
#define FL_COMPLIANT 4 /* is the process fully GNO compliant? */
#define FL_NORMTERM 8 /* did the program terminate via exit()? 1=yes */
#define FL_RESTART 16 /* is the program restartable? (set by QuitGS) */
#define FL_NORESTART 32 /* don't allow this code to restart */
#define FL_QDSTARTUP 64 /* flag set if QDStartUp was called */
#define FL_MSGRECVD 128 /* flag set if there's a send() msg waiting */
#define FL_SELECTING 256 /* this process is 'selecting' */
struct pentry {
int parentpid; /* pid of this process' parent */
int processState;
int userID; /* a GS/OS UserID, used to keep track of memory */
int ttyID; /* driver (not GS/OS) number of i/o port */
word irq_A; /* context information for the process */
word irq_X;
word irq_Y;
word irq_S;
word irq_D;
byte irq_B;
byte irq_B1;
word irq_P;
word irq_state;
word irq_PC;
word irq_K;
int psem; /* semaphoreID process is blocked on */
char **prefix; /* cwd's (GS/OS prefixes 0,1, and 9 */
char *args; /* the command line that invoked the process program */
char **env; /* environment variables for the program */
struct sigrec *siginfo; /* global mask of which signals are blocked */
byte irq_SLTROM;
byte irq_STATEREG;
word lastTool;
longword ticks;
word flags;
fdtablePtr openFiles;
word pgrp;
word exitCode;
void *LInfo;
word stoppedState; /* process state before stoppage */
longword alarmCount;
void *executeHook; /* for a good time call... */
word queueLink;
#ifdef KERNEL
chldInfoPtr waitq; /* where waits wait to be processed */
#else
void *waitq;
#endif
int waitdone;
int flpid;
quitStack *returnStack;
word t2StackPtr;
word p_uid, p_gid;
word p_euid, p_egid;
word SANEwap;
longword msg;
longword childTicks;
unsigned long p_waitvec;
unsigned p_slink;
struct pentry *p_link,*p_rlink;
int p_prio;
/* no unused entries */
};
typedef struct pentry procState, *procStatePtr;
#ifdef KERNEL
struct kernelStruct {
procState procTable[32];
int curProcInd;
int userID;
int mutex;
int timeleft;
int numProcs;
word truepid;
word shutdown;
word gsosDebug;
int floatingPID;
};
typedef struct kernelStruct kernelStruct, *kernelStructPtr;
#endif /* KERNEL */
#endif /* PROC_KERN */

1337
kern/gno/pty.asm Normal file
View File

File diff suppressed because it is too large Load Diff

42
kern/gno/q.h Normal file
View File

@ -0,0 +1,42 @@
/* $Id: q.h,v 1.1 1998/02/02 08:18:46 taubert Exp $ */
/* q.h - firstid, firstkey, isempty, lastkey, nonempty */
#if 0
#ifndef NQNET
#define NQENT NPROC + NSEM + NSEM + 4 /* for ready & sleep */
#endif
struct qent { /* one for each process plust two for each list */
int qkey; /* key on which the queue is ordered */
int qnext; /* pointer to next process or tail */
int qdata; /* extra data to be stored with the key */
int qprev; /* pointer to previous process or head */
};
extern struct qent _q[];
/* list manipulation macros */
#define isempty(list) (_q[(list)].qnext >= NPROC)
#define nonempty(list) (_q[(list)].qnext < NPROC)
#define firstkey(list) (_q[_q[(list)].qnext].qkey)
#define lastkey(tail) (_q[_q[(tail)].qprev].qkey)
#define firstid(list) (_q[(list)].qnext)
#define EMPTY -1 /* equivalent of null pointer */
#else
struct qstruct { /* one for each process plust two for each list */
struct pentry *head; /* head of the q */
struct pentry *tail; /* tail of the q */
};
#define NQS NSEM+2 /* ready, sleep, and # of semaphores */
#define isbadqnum(__qn) (((__qn) < 0) || ((__qn) >= NQS))
extern struct qstruct *nq;
extern struct qstruct *q_free;
#define nonempty(q) (nq[(q)].head != NULL)
#endif

157
kern/gno/queue.c Normal file
View File

@ -0,0 +1,157 @@
/* $Id: queue.c,v 1.1 1998/02/02 08:18:48 taubert Exp $ */
#pragma optimize 79
#ifdef KERNEL
#include "proc.h"
#include "sys.h"
#include "conf.h"
#include "kernel.h"
#include "q.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
extern kernelStructPtr kp;
#else
#include "tests/testqueue.c"
#endif
void initQ(void)
{
int i;
for (i=0; i<NPROC; i++) {
kp->procTable[i].p_link = NULL;
kp->procTable[i].p_rlink = NULL;
}
if (!(nq = calloc(NQS,sizeof(struct qstruct))))
PANIC("Could not allocate Q entries");
for (i=0; i<NQS-1; i++)
nq[i].head = (struct pentry *) &nq[i+1];
nq[NQS-1].head = NULL;
q_free = nq;
}
int Qalloc(void)
{
struct qstruct *newfree,*newQ;
if (!q_free)
PANIC("Qalloc failed - ran out of free Q entries");
newQ = q_free;
q_free = (struct qstruct *) newQ->head;
newQ->head = NULL;
newQ->tail = NULL;
return (newQ - nq);
}
void Qdispose(int qnum)
{
struct qstruct *qn;
if (isbadqnum(qnum))
PANIC("Bogus qnum passed to Qdispose");
qn = &nq[qnum];
qn->head = (struct pentry *) q_free;
q_free = qn;
}
int _enqueue(int item, int qnum)
/* insert item at the tail of a list */
{
struct pentry *tptr; /* points to tail entry */
struct pentry *mptr; /* points to item entry */
if (isbadqnum(qnum))
PANIC("Bogus qnum passed to Qdispose");
mptr = &kp->procTable[item];
if (mptr->p_link || mptr->p_rlink) {
asm {brk 0xee};
PANIC("Attempt to _enqueue pentry on multiple queues");
}
tptr = nq[qnum].tail;
mptr->p_rlink = tptr;
mptr->p_link = NULL;
if (tptr)
tptr->p_link = mptr;
else
nq[qnum].head = mptr; /* if there was nothing in list... */
nq[qnum].tail = mptr;
return item;
}
int _getfirst(int qnum)
/* remove item from the front of a queue and return it */
{
struct pentry *mptr;
if (isbadqnum(qnum))
PANIC("Bogus qnum passed to _getfirst");
mptr = nq[qnum].head;
if (!mptr) return SYSERR;
nq[qnum].head = mptr->p_link;
if (!mptr->p_link) nq[qnum].tail = NULL;
else mptr->p_link->p_rlink = NULL;
mptr->p_link = NULL;
mptr->p_rlink = NULL;
return (mptr - kp);
}
/* we don't use _getlast anywhere */
int _dequeueitem(int item, int qnum)
/* remove an item from a list and return it */
{
struct pentry *mptr; /* pointer to q entry for item */
struct pentry *test;
if (isbadqnum(qnum))
PANIC("Bogus qnum passed to _dequeueitem");
mptr = &kp->procTable[item];
test = nq[qnum].head;
while (test != mptr) {
if (!test) return SYSERR; /* item not found */
test = test->p_link;
}
if (!mptr->p_link) nq[qnum].tail = mptr->p_rlink;
else mptr->p_link->p_rlink = mptr->p_rlink;
if (!mptr->p_rlink) nq[qnum].head = mptr->p_link;
else mptr->p_rlink->p_link = mptr->p_link;
mptr->p_link = NULL;
mptr->p_rlink = NULL;
return(item);
}
int _insert(int proc, int qnum, int key)
/* insert a process into a q list in key order */
/* int proc; process to insert */
/* int qnum; q index of head of list */
/* int key; key to use for this process */
{
struct pentry *mptr, *next, *prev;
if (isbadqnum(qnum))
PANIC("Bogus qnum passed to _insert");
mptr = &kp->procTable[proc];
if (mptr->p_link || mptr->p_rlink) {
asm {brk 0xee};
PANIC("Attempt to _insert pentry on multiple queues");
}
prev = NULL;
for (next=nq[qnum].head;next&&(next->p_prio<key);next=next->p_link)
prev = next;
if (mptr->p_rlink = prev) prev->p_link = mptr;
else nq[qnum].head = mptr;
if (mptr->p_link = next) next->p_rlink = mptr;
else nq[qnum].tail = mptr;
return OK;
}

303
kern/gno/regexp.asm Normal file
View File

@ -0,0 +1,303 @@
* $Id: regexp.asm,v 1.1 1998/02/02 08:19:42 taubert Exp $
**************************************************************************
*
* The GNO Shell Project
*
* Developed by:
* Jawaid Bazyar
* Tim Meekins
* Derek Taubert
*
**************************************************************************
*
* RegExp()
*
* Tim's Regular Expression Parser
* Written by Tim Meekins, 6/13/91
*
* Copyright 1991 by Tim Meekins
* This function is hereby donated to the public domain as long as I am
* given credit as the author.
*
* Version 1.0
* - First release, not very fancy or efficient, but I wrote the entire
* program in 2 hours and is has to be the world's shortest regular
* expression parser!
*
* "Look Ma, no non-deterministic finite state transition table!"
*
**************************************************************************
*
* INPUT:
* PH4 addr ;This is the address to a pattern for matching
* PH4 addr ;This is the text match against
* PH4 word ;This a flag. Bit 16 = 1 if case sensitive.
* jsl RegExp
*
* OUTPUT:
* On Exit A=0 if no match, else a match was found.
*
* EXAMPLE:
* while ((*p != 0) && (RegExp(pattern,*p))) p++;
*
* This example will search sequentially through a list until a match is found.
* Or at least I hope this works, never actually tried this example.
*
* PATTERNS are built the following way:
*
* pure text is matched directly to the text
* '*' matchs 0 or more characters
* '+' matches 1 or more characters
* '?' matches 0 or 1 characters
* '[..]' matches one of the characters contained in the brackets. If two
* characters are separated by '-' then matches if the character is
* within the range. If the first character in the list is a '^'
* then a match will occur if NONE of the characters in brackets macth.
* '\' exactly matches the following character. This lets you match the above
* characters and '\' itself. Otherwise known as character quoting.
*
**************************************************************************
*
* meekins@cis.ohio-state.edu
* timm@pro-tc.cts.com
*
**************************************************************************
mcopy m/regexp.mac
case on
RegExp START
result equ 0
ch equ result+2
negflag equ ch+2
space equ negflag+2
subroutine (4:pattern,4:text,2:flag),space
ld2 0,result
;=========================================================================
;
; PHASE 1. Match characters one by one
;
;=========================================================================
phase1 lda [pattern]
jsr ToLower
cmp #0
beq patt0
cmp #'\'
beq quote
cmp #'+'
beq plus
cmp #'*'
beq star
cmp #'?'
jeq quest
cmp #'['
jeq lbrak
phase1a sta ch
lda [text]
jsr ToLower
cmp ch
bne done
inc pattern
bne inc01
inc pattern+2
inc01 inc text
bne inc02
inc text+2
inc02 bra phase1
patt0 lda [text]
and #$FF
bne done
bra match
quote anop ;do character quoting
inc pattern
bne inc03
inc pattern+2
inc03 lda [pattern]
jsr ToLower
cmp #0
beq done
bra phase1a
;=========================================================================
;
; PHASE 2. non-deterministic matching
;
;=========================================================================
;
; Match one or more characters
;
plus anop
inc text
bne inc04
inc text+2
inc04 lda [text]
and #$FF
beq done
;
; Match 0 or more characters
;
star anop
inc pattern
bne inc05
inc pattern+2
inc05 lda [pattern]
and #$FF
beq match
starloop lda [text]
and #$FF
beq done
pei (pattern+2)
pei (pattern)
pei (text+2)
pei (text)
pei (flag)
jsl RegExp
cmp #0
bne match
inc text
bne starloop
inc text+2
bra starloop
;
; If a positive match is made, jump to match
; If no match is made, jump to done.
;
match ld2 1,result
done return 2:result
;
; Match 0 or 1 characters
;
quest anop
inc pattern
bne inc06
inc pattern+2
inc06 pei (pattern+2)
pei (pattern)
pei (text+2)
pei (text)
pei (flag)
jsl RegExp
cmp #0
bne match
inc text
bne inc07
inc text+2
inc07 pei (pattern+2)
pei (pattern)
pei (text+2)
pei (text)
pei (flag)
jsl RegExp
cmp #0
bne match
bra done
;
; Match one character contained in brackets
;
lbrak anop
stz negflag
lda [text]
jsr ToLower
cmp #0
beq done
sta ch
ldy #1
lda [pattern],y
and #$FF
cmp #'^'
bne lbrak3
inc negflag
lbrak2 iny
lda [pattern],y
and #$FF
lbrak3 cmp #']'
beq braknomatch
iny
lda [pattern],y
dey
and #$FF
cmp #'-'
beq range
lda [pattern],y ;match a single character
jsr ToLower
cmp #0
jeq done
cmp ch
bne lbrak2
brakmatch lda negflag
beq brakdone
jmp done
braknomatch lda negflag
bne brakdone2
jmp done
brakdone iny
brakdone2 lda [pattern],y
and #$FF
jeq done
cmp #']'
bne brakdone
iny
clc
tya
adc pattern
sta pattern
bne inc08
inc pattern+2
inc08 inc text
bne inc09
inc text+2
inc09 jmp phase1
range lda [pattern],y
iny2
and #$FF
jeq done
dec a
cmp ch
bcc range2
lda [pattern],y
and #$FF
jeq done
bra range3
range2 lda [pattern],y
and #$FF
jeq done
cmp ch
bcs brakmatch
range3 jmp lbrak2
;=========================================================================
;
; Takes a sixteen bit value, strips to 8 bit and converts to lower case.
;
;=========================================================================
ToLower anop
and #$FF
ldx flag
bmi lowered
if2 @a,cc,#'A',lowered
if2 @a,cs,#'Z'+1,lowered
add2 @a,#'a'-'A',@a
lowered rts
END

1071
kern/gno/resource.asm Normal file
View File

File diff suppressed because it is too large Load Diff

583
kern/gno/select.asm Normal file
View File

@ -0,0 +1,583 @@
* $Id: select.asm,v 1.1 1998/02/02 08:19:46 taubert Exp $
*
* select.asm
*
* modified socket stuff - Derek Taubert - 12/13/94
* added GS/OS file support and proper return value - DT - 2/6/96
* added timeout support - DT - 2/13/96
*
mcopy m/select.mac
case on
copy inc/tty.inc
copy inc/gsos.inc
copy inc/kern.inc
copy global.equates
IncBusyFlag gequ $E10064
DecBusyFlag gequ $E10068
DebugNames gequ 1
*
*
*
TIselect START KERN2
TIselect name
using pipeRecord
using KernelStruct
using SelTimStruct
* locals
mask equ 1 1 used?
pPtr equ mask+4 5
fdtptr equ pPtr+4 9
fdPtr equ fdtptr+4 13 used?
slept equ fdPtr+4 17
r_mask equ slept+2 19
w_mask equ r_mask+4 23
x_mask equ w_mask+4 27,28,29,30
space equ x_mask+4-1
* intermediates
bsp equ x_mask+4 31
dsp equ bsp+1 32
rtl2 equ dsp+2 34
rtl1 equ rtl2+3 37
* args
errnoptr equ rtl1+3 40
timeout equ errnoptr+4 44
exceptfds equ timeout+4 48
writefds equ exceptfds+4 52
readfds equ writefds+4 56
width equ readfds+4 60
retval equ width+2 62
phd
phb
phk
plb
tsc
sec
sbc #space
tcd
tcs
stz retval
lda >procPtr
sta pPtr
lda >procPtr+2
sta pPtr+2
ldy #openFiles-CKernData
lda [pPtr],y
sta fdtptr
ldy #(openFiles-CKernData+2)
lda [pPtr],y
sta fdtptr+2
lda readfds
ora readfds+2
beq checkwr1
pei (readfds+2)
pei (readfds)
pei (fdtptr+2)
pei (fdtptr)
jsl validate_mask
cmp #0
bne err_mask
checkwr1 lda writefds
ora writefds+2
beq checkex1
pei (writefds+2)
pei (writefds)
pei (fdtptr+2)
pei (fdtptr)
jsl validate_mask
cmp #0
bne err_mask
checkex1 lda exceptfds
ora exceptfds+2
beq enter_loop
pei (exceptfds+2)
pei (exceptfds)
pei (fdtptr+2)
pei (fdtptr)
jsl validate_mask
cmp #0
beq enter_loop
err_mask lda #EBADF
sta [errnoptr]
lda #-1
sta retval
jmp goaway
enter_loop anop
stz slept
jsr getSelTimIndex
lda #0
sta >SelTimExpired,x
lda >curProcInd
tax
lda #0
sta >p_waitvec,x ; just for kicks..
sta >p_waitvec+2,x
select_loop anop
* First, reset the local select masks we're using
lda #0
sta r_mask
sta r_mask+2
sta w_mask
sta w_mask+2
sta x_mask
sta x_mask+2
* Set Process' "selecting" flag
ldy #flags-KernelStruct
lda [pPtr],y
ora #FL_SELECTING
sta [pPtr],y
* For each FD, poll the device by calling its select routine
* If the descriptor can't do the operation, select must record that
* this process wants to do I/O.
lda readfds
ora readfds+2
beq checkwr2
pea SEL_READ
pei (readfds+2)
pei (readfds)
pei (fdtptr+2)
pei (fdtptr)
pea 0
tdc
clc
adc #retval
pha
jsl poll_mask
sta r_mask
stx r_mask+2
checkwr2 lda writefds
ora writefds+2
beq checkex2
pea SEL_WRITE
pei (writefds+2)
pei (writefds)
pei (fdtptr+2)
pei (fdtptr)
pea 0
tdc
clc
adc #retval
pha
jsl poll_mask
sta w_mask
stx w_mask+2
checkex2 lda exceptfds
ora exceptfds+2
beq endpoll
pea SEL_EXCEPT
pei (exceptfds+2)
pei (exceptfds)
pei (fdtptr+2)
pei (fdtptr)
pea 0
tdc
clc
adc #retval
pha
jsl poll_mask
sta x_mask
stx x_mask+2
endpoll php
sei
lda >curProcInd
tax
lda >flags,x
bit #FL_SELECTING
bne noloop
* Somebody cleared FL_SELECTING, we better check again
plp
jmp select_loop
noloop and #FL_SELECTING.EOR.$FFFF
sta >flags,x
; retval slept timeout SelTimExpired
; 0 0 0 X sleep
; 0 0 1 X set alarm, sleep
; 0 1 0 X return -1, EINTR
; 0 1 1 0 return -1, EINTR
; 0 1 1 1 return 0
; 1 X X X return retval
lda retval
bne done1 ; we have a fd, kaptain!
lda slept
beq tosleep
; check to see how k_sleep woke up
lda timeout
ora timeout+2
beq interup
jsr getSelTimIndex
lda >SelTimExpired,x
beq interup
lda #0
sta >SelTimExpired,x
done1 bra done ; we timed out!
interup plp
lda #EINTR
sta [errnoptr]
lda #-1
sta retval
jmp goaway
timeoutTMP dc i4'0'
; set up alarm here
tosleep lda timeout
ora timeout+2
beq noalrm
setalrm anop
MUL4 [timeout],#10,timeoutTMP
; FIXME: add microseconds to timeoutTMP too
jsr getSelTimIndex
lda timeoutTMP
bne nofudge
inc A ; so SelTimTimeout never starts at zero
nofudge sta >SelTimTimeout,x
lda timeoutTMP+2
sta >SelTimTimeout+2,x
lda >curProcInd
sta >SelTimPID,x
noalrm lda >truepid
pha
pea 0
ph4 #selwait
jsl k_sleep
inc slept
lda timeout
ora timeout+2
beq noalrm2
; remove alarm here
jsr getSelTimIndex
lda #0
sta >SelTimTimeout,x
sta >SelTimTimeout+2,x
noalrm2 plp
jmp select_loop
done plp
ldy #2
lda r_mask
sta [readfds]
lda r_mask+2
sta [readfds],y
lda w_mask
sta [writefds]
lda w_mask+2
sta [writefds],y
lda x_mask
sta [exceptfds]
lda x_mask+2
sta [exceptfds],y
goaway anop
tsc
clc
adc #space
tcs
plb
pld
ldx #0
ldy #22
jmp >tool_exit
END
poll_mask START KERN2
poll_mask name
using KernelStruct
words_left equ 0
cur_fd equ 2
bitcount equ 4
wordind equ 6
fdPtr equ 8
outmask equ 12
subroutine (2:which,4:mask,4:fdtptr,4:fdsrdyptr),16
stz outmask
stz outmask+2
ldy #FDTfdTableSize
lda [fdtptr],y ; table size, divide by 16
lsr a
lsr a
lsr a
lsr a
sta words_left
stz cur_fd
stz wordind
val_loop1 lda #16
sta bitcount
ldy wordind
lda [mask],y
val_loop2 ror a ; rotate into carry flag
bcc dontcheck1 ; do not check this fd
pha
pei (cur_fd)
jsl getFDptr
sta fdPtr
stx fdPtr+2
; dispatch to the driver's select routine, which will tell us whether there's
; data and do other sundry stuff
lda [fdPtr] ; get device number
dec a ; dec to get device index
pha
pei (which) ; tell the driver which I/O operation
; had to add this parm - DT
lda >curProcInd ; current pid
pha
;
ldy #FDrefType
lda [fdPtr],y
cmp #FDsocket
beq selsok1
cmp #FDgsos
beq selsok2
; otherwise, it is #FDtty
; need to load A with dev type here, not ref type - DT
lda [fdPtr] ; get device number
dec a ; dec to get device index
ldy #t_select
jsl LineDiscDispatch
bra donesel1
; we can always read and write #FDgsos, never except
selsok2 anop
pla ; current pid
pla ; which operation
plx ; device number
cmp #SEL_EXCEPT
beq gsos_nox
sec
bra donesel2
gsos_nox clc
bra donesel2
selsok1 anop
jsl SOCKselect
donesel1 cmp #1 ; set carry properly
donesel2 bcc notready
lda [fdsrdyptr]
adc #0
sta [fdsrdyptr]
sec
notready ldx wordind
ror <outmask,x
pla
dontcheck inc cur_fd
dec bitcount
bne val_loop2
inc wordind
inc wordind
dec words_left
bne val_loop1
goaway return 4:outmask
dontcheck1 anop
ldx wordind
ror <outmask,x
bra dontcheck
END
validate_mask START KERN2
validate_mask name
words_left equ 0
cur_fd equ 2
res equ 4
bitcount equ 6
wordind equ 8
fdPtr equ 10
subroutine (4:mask,4:fdtptr),14
stz res
ldy #FDTfdTableSize
lda [fdtptr],y ; table size, divide by 16
lsr a
lsr a
lsr a
lsr a
sta words_left
stz cur_fd
stz wordind
val_loop1 lda #16
sta bitcount
ldy wordind
lda [mask],y
val_loop2 ror a ; rotate into carry flag
bcc dontcheck ; do not check this fd
pha
lda cur_fd
beq badfd ; fd 0 does not exist
pha
jsl getFDptr
sta fdPtr
stx fdPtr+2
lda [fdPtr]
beq badfd
ldy #FDrefType
lda [fdPtr],y
cmp #FDgsos
beq dn1
cmp #FDsocket
beq dn1
cmp #FDtty
bne badfd ; we only select on ttys & sockets
dn1 pla
dontcheck inc cur_fd
dec bitcount
bne val_loop2
inc wordind
inc wordind
dec words_left
bne val_loop1
goaway return 2:res
badfd pla
lda #1
sta res
bra goaway
END
selwakeupdefer START KERN2
selwakeupdefer name
subroutine (2:runflag,2:pid),0
pei (runflag)
pei (pid)
ph4 #selwait
jsl k_remove
return
END
selwakeup START KERN2
selwakeup name
selwait ENTRY
using KernelStruct
subroutine (2:pid,2:collflag),0
lda collflag
beq nocollision
ph4 #selwait
jsl k_wakeup
nocollision ldx pid
lda >p_waitvec,x
cmp #selwait
bne ck_coll
lda >p_waitvec+2,x
cmp #^selwait
bne ck_coll
lda >ProcessState,x
cmp #PS_SLEEP
bne ck_coll
ph4 #selwakeupdefer
lda pid
lsr a
lsr a
lsr a
lsr a
lsr a
lsr a
lsr a
pha
pea 1
jsl defer
bra goaway
ck_coll lda >flags,x
and #FL_SELECTING.EOR.$FFFF
sta >flags,x
goaway return
END
SelTimStruct DATA
SelTimTimeout dc i4'0' ; timeout in tenths of seconds
SelTimPID dc i2'0' ; pid argument to call selwakeup with
SelTimExpired dc i2'0' ; set by the HB routine when she blows
ds 8*(NPROC-1) ; space for 31 more entries
END
getSelTimIndex START KERN2
getSelTimIndex name
using KernelStruct
lda >truepid
asl a
asl a
asl a
tax
rts
END
;KERNgetdtablesize START KERN2
; using KernelStruct
;
;pPtr equ 0
;fdPtr equ 4
;ret equ 8
;
; subroutine (4:errptr),10
;
; mv4 >procPtr,pPtr
; ldy #openFiles-CKernData
; lda [pPtr],y
; sta fdPtr
; ldy #(openFiles-CKernData-2)
; lda [pPtr],y
; sta fdPtr+2
;
; lda #0
; sta [errptr]
;
; ldy #FDTfdTableSize
; lda [fdPtr],y
; sta ret
; return 2:ret
; END
;
;STACK START ~_STACK
; KIND $12
; ds 1024
; END

228
kern/gno/sem.c Normal file
View File

@ -0,0 +1,228 @@
/* $Id: sem.c,v 1.1 1998/02/02 08:18:51 taubert Exp $ */
/* _sem.c - semaphore functions
SYSCALL swait() - make current process wait on a semaphore
SYSCALL ssignal() - signal a semaphore, releasing one waiting process
SYSCALL screate() - create and initialize a semaphore, returning its id
SYSCALL sdelete() - delete a semaphore by releasing its table entry
_seminit() - initialize semaphore system
newsem() - allocate an unused semaphore and return its index
*/
#pragma optimize 79
segment "KERN3 ";
#include "conf.h"
#if NSEM
#include "kernel.h"
#include "proc.h"
#include "sys.h"
#include "q.h"
#include "sem.h"
#include "gno.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include <sys/errno.h>
static int nextsem = NSEM-1;
extern kernelStructPtr kp;
extern void sleepbusy(void);
static int newsem()
{
int sem;
int i;
for (i=0;i<NSEM;i++) {
sem = nextsem--;
if (nextsem < 0) nextsem = NSEM-1;
if (_semaph[sem].sstate == SFREE) {
_semaph[sem].sstate = SUSED;
_semaph[sem].squeue = Qalloc();
return sem;
}
}
return SYSERR;
}
/* initialize semaphores */
void _seminit()
{
int i;
struct sentry *sptr;
initQ();
if (!(_semaph = calloc(NSEM,sizeof(struct sentry))))
PANIC("Could not allocate sempahore entries");
for ( i=0; i < NSEM; i++ ) /* initialize semaphores */
{
(sptr = &_semaph[i])->sstate = SFREE;
/* sptr->sqtail = 1 + ( sptr->sqhead = _newqueue() ); */
/* don't allocate queues until we need them, but init them
here */
}
}
/* make current process wait on a semaphore */
SYSCALL commonSwait(int *ERRNO, int sem, int blockas, int waitdone)
{
struct sentry *sptr;
struct pentry *pptr;
if (blockas != procBLOCKED)
PANIC("commonSwait() only supports procBLOCKED now");
disableps();
if (isbadsem(sem) || (sptr = &_semaph[sem])->sstate == SFREE) {
enableps();
*ERRNO = EINVAL;
return SYSERR;
}
if (--(sptr->semcnt) < 0) {
PROC->processState = blockas;
if (blockas == procBLOCKED) PROC->waitdone = waitdone;
PROC->psem = sem;
_enqueue(Kgetpid(),sptr->squeue);
sleepbusy();
if (blockas == procBLOCKED && PROC->waitdone == waitdone) goto gotit;
if (sptr->sstate != SFREE) {
if (_dequeueitem(Kgetpid(),sptr->squeue) != SYSERR)
PANIC("pentry still on queue in commonSwait()");
} /* else sem was deallocated */
enableps();
*ERRNO = EINTR;
return SYSERR;
}
gotit:
PROC->psem = 0;
enableps();
return OK;
}
/* Cleanup semaphore due to signal causing EINTR */
void semINTR(int sem, int mpid)
{
struct sentry *sptr;
if (isbadsem(sem) || (sptr = &_semaph[sem])->sstate == SFREE)
return;
_dequeueitem(mpid, sptr->squeue);
sptr->semcnt++;
PROC->psem = -1;
}
/* create and initialize a semaphore, returning its id */
/* initial count (>=0) */
SYSCALL Kscreate(int *ERRNO, int count)
{
int sem;
disableps();
if (count < 0 || (sem=newsem()) == SYSERR) {
enableps();
*ERRNO = ENOMEM;
return SYSERR;
}
_semaph[sem].semcnt = count;
enableps();
return sem;
}
SYSCALL Kscount(int *ERRNO, int sem)
{
struct sentry *sptr;
int c;
disableps();
if (isbadsem(sem) || (sptr = &_semaph[sem])->sstate == SFREE) {
enableps();
*ERRNO = EINVAL;
return SYSERR;
}
c = sptr->semcnt;
enableps();
return c; /* BAH! This could be == SYSERR */
}
#pragma databank 1
#pragma toolparms 1
SYSCALL KERNswait(int *ERRNO,int sem)
{
return commonSwait(ERRNO,sem,procBLOCKED,BLOCKED_SWAIT);
}
SYSCALL KERNscreate(int *ERRNO, int count)
{
return Kscreate(ERRNO, count);
}
SYSCALL KERNscount(int *ERRNO, int sem)
{
return Kscount(ERRNO, sem);
}
/* signal a semaphore, releasing one waiting process */
SYSCALL KERNssignal(int *ERRNO, int sem)
{
struct sentry *sptr;
int mpid;
disableps();
if (isbadsem(sem) || (sptr = &_semaph[sem])->sstate == SFREE) {
enableps();
*ERRNO = EINVAL;
return SYSERR;
}
if ((sptr->semcnt++) < 0) {
if ((mpid = _getfirst(sptr->squeue)) == SYSERR)
PANIC("ssignal: _getfirst FAILED!");
/* _ready(kp->procTable[mpid].flpid,RESCHNO); */
if (kp->procTable[mpid].processState != procUNUSED)
kp->procTable[mpid].processState = procREADY;
}
enableps();
return OK;
}
/* delete a semaphore by releasing its table entry */
SYSCALL KERNsdelete(int *ERRNO, int sem)
{
int mpid;
struct sentry *sptr; /* address of sem to free */
disableps();
if (isbadsem(sem) || (sptr = &_semaph[sem])->sstate == SFREE) {
enableps();
*ERRNO = EINVAL;
return SYSERR;
}
sptr->sstate = SFREE;
if (nonempty(sptr->squeue)) {
while ((mpid = _getfirst(sptr->squeue)) != SYSERR) {
/* _ready(kp->procTable[mpid].flpid,RESCHNO); */
if (kp->procTable[mpid].processState != procUNUSED)
kp->procTable[mpid].processState = procREADY;
}
Qdispose(sptr->squeue);
enableps();
_resched();
return OK;
}
Qdispose(sptr->squeue);
enableps();
return OK;
}
#pragma databank 0
#pragma toolparms 0
#endif

20
kern/gno/sem.h Normal file
View File

@ -0,0 +1,20 @@
/* $Id: sem.h,v 1.1 1998/02/02 08:18:54 taubert Exp $ */
/* sem.h - semaphore definitions */
#if NSEM
#define SFREE 1 /* free semaphore */
#define SUSED 2 /* semaphore in use */
struct sentry { /* semaphore table entry */
char sstate; /* SFREE or SUSED */
short semcnt; /* semaphore count, (i.e. value) */
unsigned squeue; /* process queue id */
};
extern struct sentry *_semaph;
/*extern struct sentry _semaph[];*/
#define isbadsem(s) (s<0 || s>=NSEM)
void semINTR(int sem, int mpid);
#endif

1897
kern/gno/shellcall.asm Normal file
View File

File diff suppressed because it is too large Load Diff

725
kern/gno/signal.c Normal file
View File

@ -0,0 +1,725 @@
/* $Id: signal.c,v 1.1 1998/02/02 08:18:56 taubert Exp $ */
/* Signals work like this.
The following paragraphs only describe calling a handler routine, as
ignore and default are trivial operations in all situations. kill(x,9)
supercedes all this and just blasts the process to hell.
Mutex should of course be in effect during any of this.
1) A process sends a signal to itself
Set the sigmasks appropriately, then pushes the context on the stack
and jsl's the handler routine. The handler RTLs to the context restore
routine, and another rtl occurs to resume execution right after the sig
call.
2) A process sends a signal to another process
a) if there are signals pending, just set the bits and what-not and
return (the context restore routine will run the next handler if
necessary)
b) get the process context from the process table, and build stuff
on the process' stack, so that the next time the proc is executed,
it will be executing the signal handler.
c) in either case, the restore context routine checks to see whether
there are any more signals pending, and if so, sets it up immediately.
The only difference between 1 and 2 is that 1 gets the 'current context'
by shoving registers on the stack, and 2 gets it from the target process'
Note that the signal code need not worry about the various machine states
(shadow, statereg, etc) because those would only be modified by routines
in emulation mode, which should by all accounts be mutexed.
*/
#pragma optimize 79
segment "KERN2 ";
#include "conf.h"
#include "kernel.h"
#include "proc.h"
#include "sys.h"
#include "gno.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include <memory.h>
#include <loader.h>
#include <gsos.h>
#include <misctool.h>
#include <sys/errno.h>
#include <sys/wait.h>
extern kernelStructPtr kp;
extern void selwakeup(int col_flag, int pid);
extern void selwait(void);
enqueueWait(int targetpid, int pid, union wait status)
{
chldInfoPtr walk;
chldInfoPtr nwait;
/* printf("enqueueWait: tpid %d pid %d status %04X\n",targetpid,pid,status);
*/
if (targetpid == 0) return; /* don't queue up for Null Process */
nwait = malloc(sizeof(chldInfo));
nwait->next = NULL;
nwait->pid = pid;
nwait->status = status;
walk = kp->procTable[targetpid].waitq;
if (walk == NULL) { kp->procTable[targetpid].waitq = nwait; return; }
while (walk->next != NULL) walk = walk->next;
walk->next = nwait;
}
word numInWaitQueue(int pid)
{
chldInfoPtr w;
word x;
w = kp->procTable[pid].waitq;
while (w != NULL) {
w = w->next;
x++;
}
return x;
}
int dequeueWait(chldInfoPtr status, int pid)
{
chldInfoPtr item;
/*printf("dequeueWait: %06lX, pid %d ",kp->procTable[pid].waitq,
pid); */
if ((item = kp->procTable[pid].waitq) == NULL) return -1;
if (status != NULL)
memcpy(status,item,sizeof(chldInfo));
kp->procTable[pid].waitq = item->next;
/* printf("status: %04X, tpid: %d\n",item->status,item->pid); */
nfree(item);
return 0;
}
#pragma databank 1
#pragma toolparms 1
extern void addsig(int, int);
/*
* This MUST be in a function by itself so the kp-> dereference will have
* an allocated DP to use.
*/
static void proc_free(struct pentry *tosig)
{
if (tosig->flags & FL_FORKED) {
DisposeAll(tosig->userID); /* process was fork()ed, don't USD */
DeleteID(tosig->userID);
} else {
UserShutDown(tosig->userID,
((tosig->flags & FL_RESTART) &&
!(tosig->flags & FL_NORESTART)) ? 0x4000 : 0);
}
kp->numProcs--;
if (kp->numProcs == 1) kp->shutdown = 1;
}
int KERNkill(int *ERRNO, int signum, int pid)
{
struct pentry *tosig;
struct sigrec *sig;
int i,j,mpid;
longword wait;
word ClosePB[2];
union wait status;
extern int OLDGSOSST(word callnum, void *pBlock);
extern void ctxtRestore(void);
extern void enableBuf(void);
extern pgrp pgrpInfo[];
extern void disposevar(int);
if (kp->gsosDebug & 8)
kern_printf("kill (-%d):pid %d\n\r",signum,pid);
/* $$$ if (pid == 0) pid = -(kp->procTable[Kgetpid()].pgrp); */
if (pid == 0) pid = -(PROC->pgrp);
if (pid < 0) {
pid = 0-pid;
for (i = 0; i < NPROC; i++) {
if ((kp->procTable[i].processState) &&
(kp->procTable[i].pgrp == pid))
addsig(i,signum);
}
_resched(); /* allow signals to be processed before we go on */
return 0;
}
mpid = mapPID(pid);
if (mpid == 0) return -1; /* can't signal the kernel null process */
if (mpid == -1) { *ERRNO = ESRCH; return -1; }
if (!signum) return 0;
if ((signum < 1) || (signum > 32)) { *ERRNO = EINVAL; return -1; }
tosig = &(kp->procTable[mpid]);
sig = tosig->siginfo;
disableps();
if (sig->signalmask & sigmask(signum)) {
sig->sigpending |= sigmask(signum);
enableps();
return 0;
}
/* if we were BLOCKED, then restart the operation */
if (tosig->processState == procBLOCKED) {
#if 1
/* if (sig interrupt bit is set) */
if ((sig->v_signal[signum] != SIG_DFL) &&
(sig->v_signal[signum] != SIG_IGN))
{ tosig->waitdone = -1; tosig->processState = procREADY; }
#else
{ tosig->waitdone = 1; tosig->processState = procREADY; }
#endif
/* Semaphore cleanup for preceive(), swait() */
if (tosig->psem && tosig->psem != -1)
semINTR(tosig->psem, mpid);
}
/* if we were waiting for a signal, restart the process after we
execute any signal handler (including killing the puppy if necessary) */
if (tosig->processState == procPAUSED)
tosig->processState = procREADY;
else if (tosig->processState == procWAITSIGCH) {
if (signum == SIGCHLD) tosig->waitdone = 1;
else {
if (sig->v_signal[signum] != SIG_DFL)
tosig->waitdone = -1;
}
tosig->processState = procREADY; /* restart the process, bloke! */
}
/* ignore the signal? */
if (sig->v_signal[signum] == SIG_IGN) { enableps(); return 0; }
else if (sig->v_signal[signum] == SIG_DFL) { /* default actions */
switch (signum) {
case SIGCONT:
if (tosig->processState != procSUSPENDED)
{ enableps(); return 0; }
if ((tosig->stoppedState == procRUNNING) ||
(tosig->stoppedState == procBLOCKED))
tosig->processState = procREADY;
else tosig->processState = tosig->stoppedState;
/* if (tosig->stoppedState == procBLOCKED)
tosig->irq_A = 0xFF; *//* restart I/O operation */
enableps();
return 0;
case SIGURG:
case SIGCHLD: enableps(); return 0;
case SIGSTOP:
case SIGTSTP:
case SIGTTIN:
case SIGTTOU:
/* if the process is already suspended, ignore these signals */
if (tosig->processState != procSUSPENDED) {
status.w_stopsig = signum;
status.w_stopval = WSTOPPED;
enqueueWait(tosig->parentpid,pid,status);
/* this seems to be a definite no-no; the parent will restart on receipt
of the SIGCHLD */
/* kp->procTable[tosig->parentpid].processState = procREADY; */
tosig->stoppedState = tosig->processState;
tosig->processState = procSUSPENDED;
addsig(tosig->parentpid,SIGCHLD);
}
enableps();
if (mpid == Kgetpid()) _resched();
return 0;
}
/* this is the old 'kill' code
This portion is repsponsible for terminating processes
*/
/*printf("kill (-%d):pid %d (userID %04X)",signum,pid,tosig->userID);*/
#if 0
if (kp->gsosDebug & 8) {
int i;
for (i=0;i<sizeof(struct pentry);i++)
fprintf(stderr, "%02x ", ((unsigned char *)tosig)[i]);
fprintf(stderr, "\n");
}
#endif
if (tosig->parentpid != 0) {
if (tosig->flags & FL_NORMTERM) {
status.w_termsig = 0;
status.w_coredump = 0;
status.w_retcode = tosig->exitCode;
} else {
status.w_termsig = signum;
status.w_coredump = 0;
status.w_retcode = 0;
}
enqueueWait(tosig->parentpid,pid,status);
addsig(tosig->parentpid,SIGCHLD);
/* update children time accounting stuff for times() */
if (tosig->parentpid)
kp->procTable[tosig->parentpid].childTicks +=
tosig->ticks + tosig->childTicks;
}
if (!(tosig->flags & FL_COMPLIANT)) {
int c = 5;
enableBuf();
}
/* If the process was in a sleep queue, remove it - do not ready */
if (tosig->p_waitvec) k_remove(tosig->p_waitvec, mpid, 0);
if (tosig->flags & FL_QDSTARTUP) *((byte *)0xE0C029l) &= 0x7F;
/* if the process has active children, have INIT (pid 0) inherit them */
/* printf("reassigning active children\n"); */
for (i = 1; i < NPROC; i++) {
if (kp->procTable[i].processState != procUNUSED)
if (kp->procTable[i].parentpid == mpid)
kp->procTable[i].parentpid = 0;
}
disposevar(mpid);
/*printf("dequeueing all wait info\n"); */
while (dequeueWait(NULL,mpid) != -1); /* unallocate all the wait info */
/*printf("freeing prefix recs\n");*/
for (i = 0; i < 33; i++)
if (tosig->prefix[i] != NULL)
nfree(tosig->prefix[i]);
/*printf("freeing prefix rec\n");*/
nfree(tosig->prefix);
/*printf("freeing args\n");*/
if (tosig->args) nfree(tosig->args);
/*printf("freeing sig\n");*/
nfree(sig); /* dealloc the signal record */
/*printf("deallocating pgrp\n"); */
if (tosig->pgrp != 0) pgrpInfo[tosig->pgrp-2].pgrpref--;
tosig->alarmCount = 0l;
switch (tosig->processState) {
case procRUNNING: /* suicide */
tosig->openFiles->fdLevel =
tosig->openFiles->fdLevelMode = 0;
ClosePB[0] = 1; ClosePB[1] = 0;
CloseGS(ClosePB);
nfree(tosig->openFiles); /* since we alloc'ed this- fix this later */
tosig->processState = procUNUSED;
/*
* Switch to the nullproc's stack so we won't be running on a
* deallocated stack.
*/
{
Word nullproc_S = kp->procTable[0].irq_S;
asm {
lda nullproc_S
tcs
}
}
/* STACK REPAIR MUST BE OFF TO CALL proc_free() */
proc_free(tosig);
/* DON'T USE ANY DP AFTER THIS until _resched() */
#if 1
/* do this in case program crashed in the kernel */
asm { lda #0
sta 0xE100FF
}
#else
enableps();
#endif
_resched();
PANIC("KILL OVERRUN #1");
/* not reached */
default:
{
fdtablePtr tmpof;
/* $$$ tmpof = kp->procTable[Kgetpid()].openFiles; */
tmpof = PROC->openFiles;
/* $$$ kp->procTable[Kgetpid()].openFiles = tosig->openFiles; */
PROC->openFiles = tosig->openFiles;
/* make sure we close _all_ files */
tosig->openFiles->fdLevel =
tosig->openFiles->fdLevelMode = 0;
ClosePB[0] = 1; ClosePB[1] = 0;
CloseGS(ClosePB);
/* $$$ kp->procTable[Kgetpid()].openFiles = tmpof; */
PROC->openFiles = tmpof;
tosig->processState = procUNUSED;
nfree(tosig->openFiles); /* since we alloc'ed this- fix this later */
break;
}
}
proc_free(tosig);
enableps();
return SYSOK;
}
if (mpid == Kgetpid()) {
int tmpwaitdone;
/* this is implemented as a function call- is there a reason not to? */
sig->signalmask |= sigmask(signum); /* block the signal */
tmpwaitdone = tosig->waitdone;
enableps();
(*sig->v_signal[signum])(signum,0);
tosig->waitdone = tmpwaitdone;
Ksigsetmask(ERRNO, sig->signalmask & ~sigmask(signum));
return 0;
} /* process signalling itself */
else { /* signalling another process */
sig->signalmask |= sigmask(signum); /* block the signal */
/* fake the RTL address of the 'jsl' to the signal handler */
*((longword *) (tosig->irq_S-30)) = (longword) (((byte *)ctxtRestore)-1);
/* fake the two parameters - first 'code', then 'signum' */
*((longword *) (tosig->irq_S-27)) = (longword) signum;
/* fake the parameter to cSignalHook */
*((word *) (tosig->irq_S-23)) = (word) signum;
/* store the waitdone flag */
*((word *) (tosig->irq_S-21)) = (word) tosig->waitdone;
/* copy the process' context record to the stack for restoration in
CTXTRESTORE */
memcpy((void *) ((tosig->irq_S-19)),((byte *) tosig)+8,20l);
/* use the stack pointer context field to store the old process state,
since the Stack is implicit */
/* Interrupt select() */
#if 0
/* selwakeup(1, mpid2KToff(mpid));
FIXME: why does this break init? */
#else
if (tosig->p_waitvec == (unsigned long)selwait)
k_remove(tosig->p_waitvec, mpid, 1);
#endif
switch(i = tosig->processState) {
/* case procRUNNING: */
case procBLOCKED: /* read(), preceive(), swait(), procreceive() */
/*
* We need to stay awake after the signal handler so
* the system call can return EINTR
*/
i = procREADY;
break;
}
*((word *) (tosig->irq_S-13)) = i;
/* we want the signal handler to run even if the process was not READY */
tosig->processState = procREADY;
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
tosig->irq_B = tosig->irq_B1 =
tosig->irq_K = (sig->v_signal[signum] >> 16);
#else
tosig->irq_K = (sig->v_signal[signum] >> 16);
tosig->irq_B1 = tosig->irq_K;
tosig->irq_B = tosig->irq_B1;
#endif
/* the PC field isn't used right now. fix it */
tosig->irq_PC = (word) sig->v_signal[signum];
tosig->irq_P = 0x04; /* leave interrupts off you idiot */
/* this RTI info simulation goes away at the next context switch,
and the other, actual interrupt info from the last context
switch out of the process gets RTId in ctxtRestore */
*((word *) (tosig->irq_S-33)) = (word) tosig->irq_PC;
*((byte *) (tosig->irq_S-34)) = 0; /*(byte) tosig->irq_P;*/ /* handler should run with interrupts on */
*((byte *) (tosig->irq_S-31)) = (byte) tosig->irq_K;
tosig->irq_S -= 35;
enableps();
return 0;
}
/* we won't actually get here ... */
PANIC("we shouldn't be here in signal");
enableps();
return 0;
}
void *KERNsignal(int *ERRNO, void (*func)(), int sig )
{
return Ksignal(ERRNO, func, sig);
}
longword KERNsigsetmask(int *ERRNO, longword mask)
{
return Ksigsetmask(ERRNO, mask);
}
longword KERNsigblock(int *ERRNO, longword mask)
{
return Ksigblock(ERRNO, mask);
}
/* wait() code- use with caution, this stuff is heinous! */
int KERNwait(int *ERRNO, union wait *stat)
{
/* $$$ struct pentry *p; */
unsigned i;
chldInfo waitinfo;
disableps();
for (i = 0; i < NPROC; i++) {
if (kp->procTable[i].processState) {
if (kp->procTable[i].parentpid == Kgetpid()) break;
}
}
if ((i == NPROC) && (PROC->waitq == NULL)) {
*ERRNO = ECHILD; enableps(); return -1;
}
/* $$$ p = &(kp->procTable[Kgetpid()]); */
while (dequeueWait(&waitinfo,Kgetpid()) == -1) {
PROC->waitdone = 0;
/* WAITSIGCH returns when a SIGCHLD or caught signal is sent
to the process */
/* $$$ kp->procTable[Kgetpid()].processState = procWAITSIGCH; */
PROC->processState = procWAITSIGCH;
enableps();
_resched();
if (PROC->waitdone == -1) { /* interrupted by a caught signal */
*ERRNO = EINTR; return -1;
}
disableps();
}
enableps();
if (stat != NULL)
*stat = waitinfo.status;
return (waitinfo.pid);
}
longword KERNalarm(int *ERRNO, longword seconds)
{
longword old;
asm {
php
sei
}
/* $$$ old = kp->procTable[Kgetpid()].alarmCount; */
old = PROC->alarmCount;
/* $$$ kp->procTable[Kgetpid()].alarmCount = seconds * 10; */
PROC->alarmCount = seconds * 10;
asm { plp }
return (old - (old % 10)) / 10;
}
longword KERNalarm10(int *ERRNO, longword seconds10)
{
longword old;
asm {
php
sei
}
/* $$$ old = kp->procTable[Kgetpid()].alarmCount; */
old = PROC->alarmCount;
/* $$$ kp->procTable[Kgetpid()].alarmCount = seconds * 10; */
PROC->alarmCount = seconds10;
asm { plp }
return old;
}
int KERNsigpause(int *ERRNO, longword mask)
{
longword oldmask;
disableps();
oldmask = Ksigsetmask(ERRNO, mask);
/* $$$ kp->procTable[Kgetpid()].processState = procPAUSED; */
PROC->processState = procPAUSED;
enableps();
_resched();
Ksigsetmask(ERRNO, oldmask);
return -1;
}
#pragma toolparms 0
#if 0
longword Kreceive(int *ERRNO)
{
longword tmp;
struct pentry *p;
extern void sleepbusy(void);
disableps();
p = PROC;
p->waitdone = BLOCKED_RECEIVE;
if (!(p->flags & FL_MSGRECVD)) {
p->processState = procBLOCKED;
sleepbusy();
}
if (p->waitdone == BLOCKED_RECEIVE) {
tmp = p->msg;
p->flags &= ~FL_MSGRECVD;
}
else tmp = -1l;
enableps();
return tmp; /* return the value of the message */
}
#else
extern longword Kreceive(int *);
#endif
void rcvttrap(int sig, int code)
{
/* foobar! */
}
#pragma toolparms 1
longword KERNreceive(int *ERRNO)
{
return Kreceive(ERRNO);
}
longword KERNrecvclr(int *ERRNO)
{
longword tmp;
struct pentry *p;
p = PROC;
disableps();
if (p->flags & FL_MSGRECVD) tmp = p->msg;
else tmp = -1l;
p->flags &= ~FL_MSGRECVD;
enableps();
return tmp;
}
longword KERNrecvtim(int *ERRNO, int timeout)
{
void *oldsig;
longword oldalrm, oldmask, tmp;
struct pentry *p;
oldmask = Ksigblock(ERRNO, SIGALRM);
oldsig = Ksignal(ERRNO, rcvttrap, SIGALRM);
/* $$$ p = &(kp->procTable[Kgetpid()]); */
p = PROC;
oldalrm = p->alarmCount;
p->alarmCount = timeout;
Ksigsetmask(ERRNO, oldmask & ~sigmask(SIGALRM));
tmp = Kreceive(ERRNO);
Ksigsetmask(ERRNO, oldmask);
p->alarmCount = oldalrm;
Ksignal(ERRNO, oldsig, SIGALRM);
return tmp;
}
int KERNsend(int *ERRNO, longword msg, int pid)
{
struct pentry *targetp;
int mpid;
mpid = mapPID(pid);
if ((mpid == 0) || (mpid == -1)) {
*ERRNO = ESRCH; return -1;
}
targetp = &(kp->procTable[mpid]);
disableps();
if (targetp->flags & FL_MSGRECVD) {
*ERRNO = EIO; enableps(); return -1;
}
targetp->msg = msg;
targetp->flags |= FL_MSGRECVD;
if ((targetp->waitdone == BLOCKED_RECEIVE) &&
(targetp->processState == procBLOCKED)) {
targetp->processState = procREADY;
}
enableps();
return 0;
}
#pragma toolparms 0
void cSignalHook(int signum)
{
struct sigrec *siginf;
disableps();
/* $$$ siginf = kp->procTable[Kgetpid()].siginfo; */
siginf = PROC->siginfo;
Ksigsetmask(&errno, siginf->signalmask &= ~sigmask(signum));
enableps();
}
#pragma databank 0
void *Ksignal(int *ERRNO, void (*func)(), int sig )
{
void (*old)();
struct sigrec *siginf;
if (kp->gsosDebug & 16)
kern_printf("signal(sig: %d, func:%06lX)\n\r",sig,func);
/* $$$ siginf = kp->procTable[Kgetpid()].siginfo; */
siginf = PROC->siginfo;
/* printf("siginf: %08lX\n",siginf); */
old = siginf->v_signal[sig];
/* silently enforce restriction on signal handling */
if ((sig != SIGKILL) && (sig != SIGSTOP)) {
if (func == SIG_IGN) siginf->sigpending &= ~sigmask(sig);
/* siginf->sigpending |= sigmask(sig); */
siginf->v_signal[sig] = func;
}
return old;
}
longword Ksigblock(int *ERRNO, longword mask)
{
struct sigrec *siginf;
longword oldmask;
/* $$$ siginf = kp->procTable[Kgetpid()].siginfo; */
siginf = PROC->siginfo;
oldmask = siginf->signalmask;
/* install new mask, but don't allow blocking of SIGKILL, SIGSTOP, or SIGCONT */
siginf->signalmask |= (mask & 0xFFFAFEFFl);
return oldmask;
}
longword Ksigsetmask(int *ERRNO, longword mask)
{
struct sigrec *siginf;
longword oldmask,ready;
int i;
disableps();
/* $$$ siginf = kp->procTable[Kgetpid()].siginfo; */
siginf = PROC->siginfo;
oldmask = siginf->signalmask;
mask &= 0xFFFAFEFFl;/* don't allow blocking of SIGKILL, SIGSTOP, or SIGCONT */
ready = siginf->sigpending & ~mask;
if (ready) {
for (i = 1; i < 32; i++)
if (ready & sigmask(i)) {
addsig(Kgetpid(), i);
siginf->sigpending &= ~sigmask(i);
}
}
siginf->signalmask = mask;
enableps();
return oldmask;
}

180
kern/gno/sleep.c Normal file
View File

@ -0,0 +1,180 @@
/* $Id: sleep.c,v 1.1 1998/02/02 08:19:00 taubert Exp $ */
/*
* sleep.c
*
* sleep/wakeup handling routines
*/
extern void sleepbusy(void);
#ifndef KERNEL
#include "tests/testsleep.c"
#else
/* Building it into the kernel */
#pragma databank 1
#pragma optimize 79
/*segment "KERN2 ";*/
#include "proc.h"
#include "sys.h"
#include "kernel.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
extern kernelStructPtr kp;
void dosleep(int pid)
{
kp->procTable[pid].processState = procSLEEP;
}
static void ready(int pid, int resch)
{
kp->procTable[pid].processState = procREADY;
if (resch) _resched();
}
#endif
typedef struct hash_entry {
unsigned pid; /* first pool entry on the wait list */
} hash_entry;
#define NUM_HVENTRIES 64
hash_entry hv_tab[NUM_HVENTRIES];
#if 0
void init_sleep_hash(void)
{
unsigned i;
for (i = 0; i < NUM_HVENTRIES; i++) {
hv_tab[i].vector = 0l;
hv_tab[i].pid = 0;
}
}
#endif
static unsigned hash_vector(unsigned long vec)
{
return (unsigned)(vec & 0x3F);
}
#define BUSY_FLAG ((byte *)0xE100FFl)
/* no longer used; this code is now in assembly language */
#if 0
int k_sleepold(unsigned long vec, int pri, int pid)
{
unsigned hv;
struct proc *p;
unsigned last;
unsigned cur;
byte oldBusy;
disableps();
hv = hash_vector(vec);
/*PROC->p_pri = pri;*/
/*PROC->p_waitvec = vec;*/
kp->procTable[pid].p_waitvec = vec;
/* Add this process to the END of this wait queue. This gives us a
FIFO action on the sleep queues */
last = hv_tab[hv].pid;
if (last == 0) {
hv_tab[hv].pid = pid;
} else {
while (kp->procTable[last].p_slink != 0) {
last = kp->procTable[last].p_slink;
}
kp->procTable[last].p_slink = pid;
}
kp->procTable[pid].p_slink = 0;
/*fprintf(stderr,"process %d going to sleep on vec %06lX\n",pid,vec);*/
dosleep(pid);
sleepbusy();
enableps();
}
#endif
/* Remove a single process from a sleep vector */
void k_remove(unsigned long vec, int pid, int readyq)
{
unsigned last = 0;
unsigned hv;
unsigned cur,link;
/*fprintf(stderr,"removing %d from %06lX\n",pid,vec);*/
disableps();
hv = hash_vector(vec);
cur = hv_tab[hv].pid;
while (cur != 0) {
link = kp->procTable[cur].p_slink;
if ((kp->procTable[cur].p_waitvec == vec) && (cur == pid)) {
/* Remove an item from the list. If the item is the first,
last == 0, and we set the hash vector to the follower
of the item */
if (last == 0) {
hv_tab[hv].pid = link;
}
/* Otherwise, the item is not the first; last != 0; we set
last's link to the current link, removing the curproc
from the list */
else {
kp->procTable[last].p_slink = kp->procTable[cur].p_slink;
last = cur;
}
if (readyq) ready(cur,0);
kp->procTable[cur].p_waitvec = 0l;
cur = link;
} else {
last = cur;
cur = link;
}
}
enableps();
/* if priority of a proc we awakened was higher than current priority
we need to _resched() */
}
/* Remove all processes from a sleep vector */
void k_wakeup(unsigned long vec)
{
unsigned last = 0;
unsigned hv;
unsigned cur,link;
/*fprintf(stderr,"waking up %06lX\n",vec);*/
disableps();
hv = hash_vector(vec);
cur = hv_tab[hv].pid;
while (cur != 0) {
link = kp->procTable[cur].p_slink;
if (kp->procTable[cur].p_waitvec == vec) {
/* Remove an item from the list. If the item is the first,
last == 0, and we set the hash vector to the follower
of the item */
if (last == 0) {
hv_tab[hv].pid = link;
}
/* Otherwise, the item is not the first; last != 0; we set
last's link to the current link, removing the curproc
from the list */
else {
kp->procTable[last].p_slink = kp->procTable[cur].p_slink;
last = cur;
}
ready(cur,0);
kp->procTable[cur].p_waitvec = 0l;
cur = link;
} else {
last = cur;
cur = link;
}
}
enableps();
/* if priority of a proc we awakened was higher than current priority
we need to _resched() */
}

250
kern/gno/stat.c Normal file
View File

@ -0,0 +1,250 @@
/* $Id: stat.c,v 1.1 1998/02/02 08:19:02 taubert Exp $ */
/*
stat.c
Copyright 1992-1998, Procyon Inc.
Many generations ago, Derek Taubert wrote the original version of
this code. There is still a family resemblance, but this great-great-
great-grandchild also bears a striking resemblance to Jawaid Bazyar.
I.e., this is a bastard piece of code.
The many changes were made to facilitate its merge into the GNO Kernel,
mostly dealing with reporting of pipes.
*/
segment "KERN2 ";
#pragma optimize 79
#include "proc.h"
#include "sys.h"
#include "kernel.h"
#include "/lang/orca/libraries/orcacdefs/stdio.h"
#include "/lang/orca/libraries/orcacdefs/string.h"
#include "/lang/orca/libraries/orcacdefs/stdlib.h"
#include <sys/stat.h>
#include <sys/errno.h>
#include <misctool.h>
#include <gsos.h>
#include <shell.h>
extern kernelStructPtr kp;
int inoPool = 1;
int
_mapErr (int err)
{
int ret;
if (!err) {
return 0;
}
if ((err & 0xff00) == 0x4300) {
/* GNO already mapped the error */
return (err & 0x00ff);
}
switch (err) {
case 0x43: ret = EBADF; break;
case 0x44:
case 0x45:
case 0x46: ret = ENOENT; break;
case 0x47:
case 0x50: ret = EEXIST; break;
case 0x48:
case 0x49: ret = ENOSPC; break;
case 0x4A: ret = ENOTDIR; break;
case 0x4B:
case 0x4F:
case 0x53: ret = EINVAL; break;
case 0x54: ret = ENOMEM; break;
case 0x4E: ret = EACCES; break;
case 0x58: ret = ENOTBLK; break;
default: ret = EIO; break;
}
return ret;
}
#pragma databank 1
int statCommon(const char *filename, struct stat *s_buf)
{
FileInfoRecGS fi;
DevNumRecGS getdev;
int e,entcount;
int dtype = 0;
GSString255Ptr fullpath,path;
extern void COPYC2GS(void*,void*);
extern GSString255Ptr gno_ExpandPath(GSString255Ptr, int, word);
unsigned long lsec;
disableps();
path = malloc(strlen(filename)+2);
COPYC2GS(path,filename);
fullpath = gno_ExpandPath(path,0,0);
fi.pCount = 10;
fi.optionList = NULL;
fi.pathname = fullpath;
GetFileInfoGS(&fi);
if (_toolErr) {
if (_toolErr == 0x58) dtype = 1;
else {
nfree(path);
enableps();
return _mapErr(_toolErr);
}
}
if (fullpath->text[0] == '.') {
getdev.devName = (GSString32Ptr) fullpath;
if (findDevice(fullpath)) {
memset(s_buf,0,sizeof(struct stat));
s_buf->st_mode = S_IFCHR;
nfree(path); return 0;
}
}
else {
fullpath->text[fullpath->length] = 0;
e = strpos(fullpath->text+1,':');
if (e != -1) {
if (e < fullpath->length) e++;
fullpath->length = e;
}
getdev.devName = (GSString32Ptr) fullpath;
}
getdev.pCount = 2;
GetDevNumberGS(&getdev);
if (_toolErr) {
enableps();
return _mapErr(_toolErr);
}
s_buf->st_dev = getdev.devNum;
/* this fakes an inode number. For applications like diff,
this will work since there are no file links under either
ProDOS or HFS */
s_buf->st_ino = inoPool++;
if (!dtype) {
s_buf->st_mode =
((fi.fileType == 0x0f) ? (S_IFDIR|S_IEXEC) : S_IFREG) |
((fi.access & 0x01) ? S_IREAD : 0) |
((fi.access & 0x02) ? S_IWRITE : 0) |
(((fi.fileType == 0xff) || (fi.fileType == 0xb5) ||
(fi.fileType == 0xb3)) ? S_IEXEC : 0);
s_buf->st_nlink = 0;
s_buf->st_uid = 0;
s_buf->st_gid = 0;
s_buf->st_rdev = 0; /* device type */
s_buf->st_size = fi.eof;
lsec = ConvSeconds(1,0l,(Pointer)&fi.modDateTime);
/* 2083363200. seconds difference */
/*s_buf->st_atime = s_buf->st_mtime = lsec - 2756021998ul;*/
/* a->i1 = a->i2 = b BROKEN in C 2.0.3 */
#if 0
s_buf->st_atime = s_buf->st_mtime = lsec - 2078611200ul;
#else
s_buf->st_mtime = lsec - 2078611200ul;
s_buf->st_atime = s_buf->st_mtime;
#endif
lsec = ConvSeconds(1,0l,(Pointer)&fi.createDateTime);
s_buf->st_ctime = lsec - 2078611200ul;
s_buf->st_blksize = STAT_BSIZE;
s_buf->st_blocks = fi.blocksUsed;
} else {
memset(s_buf,0,sizeof(struct stat));
s_buf->st_dev = getdev.devNum;
s_buf->st_mode = S_IFCHR;
}
enableps();
return(0);
}
#pragma databank 1
#pragma toolparms 1
int KERNfstat(int *ERRNO, struct stat *s_buf, int fd)
{
RefInfoRecGS refInfo;
ResultBuf255Ptr gstring;
fdentryPtr fp;
int rc;
extern fdentryPtr getFDptr(int);
disableps();
if (kp->gsosDebug & 16)
fprintf(stderr,"fstat: fd: %d s_buf: %06lX\n",fd,s_buf);
if ((fd == 0) || ((fp = getFDptr(fd)) == NULL) || (fp->refNum == 0)) {
*ERRNO = EBADF;
enableps();
return -1;
}
if (fp->refType == rtPIPE) {
memset(s_buf,0,sizeof(struct stat));
s_buf->st_mode = S_IFSOCK;
enableps(); return 0;
} else if (fp->refType == rtTTY) {
memset(s_buf,0,sizeof(struct stat));
s_buf->st_mode = S_IFCHR;
enableps(); return 0;
}
gstring = malloc(sizeof(ResultBuf255));
refInfo.pCount = 3;
refInfo.refNum = fd;
gstring->bufSize = 254;
refInfo.pathname = gstring;
tryGet:
GetRefInfoGS(&refInfo);
if (_toolErr == 0x4F) {
gstring = realloc(gstring,gstring->bufString.length+5);
gstring->bufSize = gstring->bufString.length;
goto tryGet;
}
if (_toolErr) {
*ERRNO = _mapErr(_toolErr);
enableps();
return(-1);
}
gstring->bufString.text[gstring->bufString.length]=0;
rc = statCommon(gstring->bufString.text,s_buf);
if (rc) *ERRNO = rc;
nfree(gstring);
enableps();
return (rc) ? -1 : 0;
}
int KERNlstat(int *ERRNO,struct stat *s_buf,const char *filename)
{
int rc;
if (kp->gsosDebug & 16)
fprintf(stderr,"stat: lpath: %s s_buf: %06lX\n",filename,s_buf);
rc = statCommon(filename,s_buf);
if (rc) *ERRNO = rc;
return (rc) ? -1 : 0;
}
int KERNstat(int *ERRNO,struct stat *s_buf,const char *filename)
{
int rc;
if (kp->gsosDebug & 16)
fprintf(stderr,"stat: path: %s s_buf: %06lX\n",filename,s_buf);
rc = statCommon(filename,s_buf);
if (rc) *ERRNO = rc;
return (rc) ? -1 : 0;
}
#pragma databank 0
#pragma toolparms 0

1249
kern/gno/sys.c Normal file
View File

File diff suppressed because it is too large Load Diff

20
kern/gno/sys.h Normal file
View File

@ -0,0 +1,20 @@
/* $Id: sys.h,v 1.1 1998/02/02 08:19:10 taubert Exp $ */
#if 0
int createProc(word stack, word dp, longword process);
int _ready(int pid, int resch);
int isbadpid( int pid );
/*void *mmemcpy(const void *dest, void *src, size_t len); */
#endif
#define Kgetpid() kp->truepid
typedef struct pgrp {
word pgrpref; /* number of references to this pgrp - tty and process */
} pgrp;
fdentryPtr allocFD(int *fdn);
void copygsstr(void *,void*);
void nfree(void *);
#define PROC procPtr
extern struct pentry *procPtr;

2428
kern/gno/texttool.asm Normal file
View File

File diff suppressed because it is too large Load Diff

1979
kern/gno/tty.asm Normal file
View File

File diff suppressed because it is too large Load Diff

50
kern/gno/tty.h Normal file
View File

@ -0,0 +1,50 @@
/* $Id: tty.h,v 1.1 1998/02/02 08:19:12 taubert Exp $ */
struct tty_s {
/*q outQ;
q inQ; */
char sg_ispeed; /* input speed */
char sg_ospeed; /* output speed */
char sg_erase; /* erase character */
char sg_kill; /* kill character */
unsigned sg_flags; /* mode flags */
unsigned local;
char t_intrc; /* interrupt */
char t_quitc; /* quit */
char t_startc; /* start output */
char t_stopc; /* stop output */
char t_eofc; /* end-of-file */
char t_brkc; /* input delimiter (like nl) */
char t_suspc; /* stop process signal */
char t_dsuspc; /* delayed stop process signal */
char t_rprntc; /* reprint line */
char t_flushc; /* flush output (toggles) */
char t_werasc; /* word erase */
char t_lnextc; /* literal next character */
unsigned short ws_row; /* rows, in characters */
unsigned short ws_col; /* columns, in characters */
unsigned short ws_xpixel; /* horizontal size, pixels */
unsigned short ws_ypixel; /* vertical size, pixels */
void (*t_open)(int devnum);
void (*t_close)(int devnum);
int (*t_ioctl)(int devNum, void *dataptr, unsigned long tioc);
int (*t_read)(int devNum, void *dataptr, unsigned count);
int (*t_write)(int devNum, void *dataptr, unsigned count);
void (*mutex)();
void (*demutex)();
void (*out_enq)(char c);
void (*in_enq)(char c);
int (*out_deq)();
int (*in_deq)();
int (*size_inq)();
int (*size_outq)();
unsigned editInd,editBegin;
unsigned st_flags;
char *editBuf;
};
typedef struct tty_s ttyb;

708
kern/gno/util.asm Normal file
View File

@ -0,0 +1,708 @@
* $Id: util.asm,v 1.1 1998/02/02 08:19:59 taubert Exp $
**************************************************************************
*
* The GNO Shell Project
*
* Developed by:
* Jawaid Bazyar
* Tim Meekins
* Derek Taubert
*
**************************************************************************
*
* UTIL.ASM
* By Tim Meekins
* By Jawaid Bazyar
*
* Utility functions used by the kernel. Mostly string manipulation
* routines, with a strong tilt towards coversion between different types
*
**************************************************************************
case on
mcopy m/util.mac
;=========================================================================
;
; Convert the accumulator to lower case.
;
;=========================================================================
TOLOWER START KERN2
if2 @,cc,#'A',done
if2 @,cs,#'Z'+1,done
add2 @,#'a'-'A',@
done rts
END
;=========================================================================
;
; Convert a c string to lower case
;
;=========================================================================
lowercstr START KERN2
space equ 0
subroutine (4:p),space
short a
ldy #0
loop lda [p],y
beq done
if2 @,cc,#'A',next
if2 @,cs,#'Z'+1,next
add2 @,#'a'-'A',@
sta [p],y
next iny
bra loop
done long a
return
END
;=========================================================================
;
; Get the length of a c string.
;
;=========================================================================
cstrlen START KERN2
space equ 0
subroutine (4:p),space
short a
ldy #0
loop lda [p],y
beq done
iny
bra loop
done long a
sty p
return 2:p
END
;=========================================================================
;
; Allocate memory for a c string the same length as another string.
;
;=========================================================================
alloccstr START KERN2
space equ 0
subroutine (4:p),space
ph4 p ;get length of string
jsl cstrlen
inc a ;for terminator
pea 0 ;allocate memory
pha
jsl ~NEW
sta p
stx p+2
return 4:p
END
;=========================================================================
;
; Copy a GS/OS string to a GS/OS result buffer. Assumes that the result
; address points to valid memory
;
;=========================================================================
copygs2res START KERN2
bufString equ 0
retval equ 4
subroutine (4:in,4:resultBuf),6
lda [in]
ldy #2
sta [resultBuf],y
clc
adc #4 ; string length, but add in buf size
cmp [resultBuf]
beq lenOkay
bcc lenOkay
lda #$004F ; bwa haha
bra goaway
lenOkay lda [in] ; we just want the length, bud
tay
iny ; copy the length word also
lda resultBuf
clc
adc #2
sta bufString
lda resultBuf+2
adc #0
sta bufString+2
short a
loop lda [in],y
sta [bufString],y
dey
bpl loop
long m
lda #0
goaway sta retval
return 2:retval
END
;=========================================================================
;
; appends one GS/OS string to another. assumes the destination is big
; enough to hold the result.
;
;=========================================================================
gsstrcat START KERN2
iind equ 0
oind equ iind+2
left equ oind+2
space equ left+2
subroutine (4:s,4:d),space
lda [d]
inc a
inc a
sta oind
lda #2
sta iind
lda [s]
sta left
clc
adc [d]
sta [d]
loop short m
ldy iind
lda [s],y
ldy oind
sta [d],y
long m
inc iind
inc oind
dec left
bne loop
return
END
;=========================================================================
;
; Copy one GS/OS string to another. Assumes an alloccstr has been
; performed on destination.
;
;=========================================================================
copygsstr START KERN2
space equ 0
subroutine (4:p,4:q),space
lda [p]
inc a
; clc
; adc #1
tay
short a
loop lda [p],y
sta [q],y
dey
bpl loop
done long a
return
END
;=========================================================================
;
; Copy one pascal string to another. Assumes an alloccstr has been
; performed on destination.
;
;=========================================================================
copypstr START KERN2
space equ 0
subroutine (4:p,4:q),space
lda [p]
and #$00FF
tay
short a
loop lda [p],y
sta [q],y
dey
bpl loop
done long a
return
END
;=========================================================================
;
; Copy one string to another. Assumes an alloccstr has been performed on
; destination.
;
;=========================================================================
copycstr START KERN2
space equ 0
subroutine (4:p,4:q),space
short a
ldy #0
loop lda [p],y
beq done
sta [q],y
iny
bra loop
done sta [q],y
long a
return
END
;=========================================================================
;
; Converts a pascal string to a c string. This allocates memory for the
; new c string.
;
;=========================================================================
p2cstr START KERN2
cstr equ 0
space equ cstr+4
subroutine (4:p),space
lda [p]
and #$FF
inc a
pea 0
pha
jsl ~NEW
sta cstr
stx cstr+2
lda [p]
and #$FF
tax
short a
ldy #0
loop cpx #0
beq done
iny
lda [p],y
dey
sta [cstr],y
iny
dex
bra loop
done lda #0
sta [cstr],y
long a
return 4:cstr
END
;=========================================================================
;
; Converts a GS/OS string to a c string. This allocates memory for the
; new c string.
;
;=========================================================================
gs2cstr START KERN2
cstr equ 0
space equ cstr+4
subroutine (4:gs),space
lda [gs]
inc a
pea 0
pha
jsl ~NEW
sta cstr
stx cstr+2
lda [gs]
tax
short a
ldy #0
loop cpx #0
beq done
iny
iny
lda [gs],y
dey
dey
sta [cstr],y
iny
dex
bra loop
done lda #0
sta [cstr],y
long a
return 4:cstr
END
;=========================================================================
;
; Converts a c string to a pascal string. Does not allocate memory.
;
;=========================================================================
c2pstr START KERN2
space equ 0
subroutine (4:cstr,4:p),space
short a
ldy #0
loop lda [cstr],y
beq endstr
iny
sta [p],y
bra loop
endstr tya
sta [p]
long a
return
END
;=========================================================================
;
; Compare two c strings. Return 0 if equal.
;
;=========================================================================
cmpcstr START KERN2
ch equ 0
result equ ch+2
space equ result+2
subroutine (4:p,4:q),space
ld2 1,result
ldy #0
strloop lda [p],y
and #$FF
beq strchk
sta ch
lda [q],y
and #$FF
cmp ch
bne done
iny
bra strloop
strchk lda [q],y
and #$FF
bne done
stz result
done return 2:result
END
writeacc START
phb
phk
plb
phy
phx
pha
sta tempacc
xba
lsr a
lsr a
lsr a
lsr a
and #$0F
jsr hexdig
lda tempacc
xba
and #$0F
jsr hexdig
lda tempacc
lsr a
lsr a
lsr a
lsr a
and #$0F
jsr hexdig
lda tempacc
and #$0F
jsr hexdig
pla ; preserve the accumulator
plx
ply
plb
rts
tempacc dc i2'0'
hexdig entry
cmp #$A
bcc add0
clc
adc #7
add0 anop
clc
adc #'0'
ErrWriteChar @a
rts
END
;=========================================================================
;
; Copy a Pascal string to a GS/OS string
;
;=========================================================================
copyp2gs START KERN2
slen equ 0
subroutine (4:p,4:gs),2
lda [p]
and #$00FF
sta [gs]
sta slen
ldy #0
short m
loop iny
lda [p],y
iny
sta [gs],y
dey
cpy slen
bcc loop
long m
return
END
;=========================================================================
;
; Copy a GS/OS string to a Pascal string
;
;=========================================================================
copygs2p START KERN2
slen equ 0
subroutine (4:gs,4:p),2
lda [gs]
and #$00FF
sta [p]
beq done ; 0 length- done!
inc a
sta slen
ldy #1
short m
loop iny
lda [gs],y
dey
sta [p],y
iny
cpy slen
bcc loop
long m
done return
END
;=========================================================================
;
; Copy a C string to a GS/OS result buffer
;
;=========================================================================
copyc2res START KERN2
bufString equ 0
clen equ 4
in equ 6
out equ 8
space equ out+2
subroutine (4:c,4:res),space
ph4 c
jsl cstrlen
ldy #2
sta [res],y
clc
adc #4
cmp [res]
beq lenokay
bcc lenokay
lda #$4F
bra goaway
lenokay anop
lda [res],y
sta clen
ldy #0
sty in
ldy #4
sty out
loop anop
short m
ldy in
lda [c],y
ldy out
sta [res],y
long m
inc in
inc out
ldy in
cpy clen
bcs done
bra loop
done anop
lda #0
goaway sta clen
return 2:clen
END
GScaseEqual START KERN2
retval equ 0
lowera equ 2
subroutine (4:a,4:b),4
lda [a]
cmp [b]
bne notequal
tay
iny
loop anop
cpy #1
beq isequal ; done with comparison
lda [a],y
and #$00FF
jsr TOLOWER
sta lowera
lda [b],y
and #$00FF
jsr TOLOWER
cmp lowera
bne notequal
dey
bra loop
isequal lda #1
sta retval
goaway return 2:retval
notequal stz retval
bra goaway
END
COPYC2GS START KERN2
subroutine (4:c,4:gs),0
ph4 c
jsl cstrlen
sta [gs]
tay
cpy #0
beq done
short m
lp lda [c],y
iny2
sta [gs],y
dey2
dey
bpl lp
done long m
return
END
~NDISPOSE START KERN2
~NDISPOSE name
subroutine (4:ptr),0
lda ptr+2
bit #$FF80
bne badptr
ora ptr
beq zptr
ph4 ptr
jsl ~DISPOSE
return
badptr anop
ph4 #bptrtxt
jsl PANIC
brk $00
bptrtxt dc c'Attempt to ~dispose bogus pointer',i1'0'
zptr anop
ph4 #zptrtxt
jsl PANIC
brk $00
zptrtxt dc c'Attempt to ~dispose null pointer',i1'0'
END
case on
nfree START KERN2
nfree name
subroutine (4:ptr),0
lda ptr+2
bit #$FF80
bne badptr
ora ptr
beq zptr
ph4 ptr
jsl free
return
badptr anop
ph4 #bptrtxt
jsl PANIC
brk $00
bptrtxt dc c'Attempt to free bogus pointer',i1'0'
zptr anop
ph4 #zptrtxt
jsl PANIC
brk $00
zptrtxt dc c'Attempt to free null pointer',i1'0'
END
gnoSetHandleID START KERN2
subroutine (4:hand,2:id),0
lda id
ldy #6
sta [hand],y
return
END

1293
kern/gno/var.asm Normal file
View File

File diff suppressed because it is too large Load Diff