This commit is contained in:
Kelvin Sherlock 2017-10-31 13:14:07 -04:00
parent 954c3a02b5
commit 578bda8439
28 changed files with 17666 additions and 28 deletions

49
assert.asm Executable file → Normal file
View File

@ -1 +1,48 @@
keep obj/assert mcopy assert.macros case on **************************************************************** * * Assert - Condition assertion macro * * This code implements the subroutines needed to support the * standard C library assert. * * October 1991 * Mike Westerfield * * Copyright 1991 * Byte Works, Inc. * **************************************************************** * Assert start dummy routine end **************************************************************** * * void __assert (char *f, int l) * * Inputs: * f - pointer to the file name * l - line number * **************************************************************** * __assert start csubroutine (4:f,2:l,4:s),0 ph4 s ph2 l ph4 f ph4 #msg ph4 >stderr jsl fprintf jsl abort creturn msg dc c'Assertion failed: file %s, line %d; assertion: %s',i1'10,0' end
keep obj/assert
mcopy assert.macros
case on
****************************************************************
*
* Assert - Condition assertion macro
*
* This code implements the subroutines needed to support the
* standard C library assert.
*
* October 1991
* Mike Westerfield
*
* Copyright 1991
* Byte Works, Inc.
*
****************************************************************
*
Assert start dummy routine
end
****************************************************************
*
* void __assert (char *f, int l)
*
* Inputs:
* f - pointer to the file name
* l - line number
*
****************************************************************
*
__assert start
csubroutine (4:f,2:l,4:s),0
ph4 s
ph2 l
ph4 f
ph4 #msg
ph4 >stderr
jsl fprintf
jsl abort
creturn
msg dc c'Assertion failed: file %s, line %d; assertion: %s',i1'10,0'
end

172
assert.macros Executable file → Normal file
View File

@ -1 +1,171 @@
MACRO &LAB PH2 &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 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G 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 csubroutine &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 1 .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<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &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+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
MACRO
&LAB PH2 &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
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
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 csubroutine &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 1
.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<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
MACRO
&lab creturn &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+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

32
backup Executable file → Normal file
View File

@ -1 +1,31 @@
if "{#}" != "1" echo Form: backup [day] exit 65535 end set dest /library/mike/{1}/ORCALib set list make backup smac equates.asm set list {list} assert.asm assert.macros set list {list} cc.asm cc.macros set list {list} ctype.asm set list {list} fcntl.asm fcntl.macros set list {list} orca.asm orca.macros set list {list} setjmp.asm set list {list} signal.asm signal.macros set list {list} ctype.asm set list {list} stdio.asm stdio.macros set list {list} stdlib.asm stdlib.macros set list {list} string.asm string.macros set list {list} time.asm time.macros set list {list} toolglue.asm toolglue.macros set list {list} vars.asm vars.macros unset exit create {dest} >.null >&.null for i in {list} newer {dest}/{i} {i} if {Status} != 0 copy -c {i} {dest}/{i} end end
if "{#}" != "1"
echo Form: backup [day]
exit 65535
end
set dest /library/mike/{1}/ORCALib
set list make backup smac equates.asm
set list {list} assert.asm assert.macros
set list {list} cc.asm cc.macros
set list {list} ctype.asm
set list {list} fcntl.asm fcntl.macros
set list {list} orca.asm orca.macros
set list {list} setjmp.asm
set list {list} signal.asm signal.macros
set list {list} ctype.asm
set list {list} stdio.asm stdio.macros
set list {list} stdlib.asm stdlib.macros
set list {list} string.asm string.macros
set list {list} time.asm time.macros
set list {list} toolglue.asm toolglue.macros
set list {list} vars.asm vars.macros
unset exit
create {dest} >.null >&.null
for i in {list}
newer {dest}/{i} {i}
if {Status} != 0
copy -c {i} {dest}/{i}
end
end

1021
cc.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

542
cc.macros Executable file → Normal file

File diff suppressed because one or more lines are too long

1091
ctype.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

114
equates.asm Executable file → Normal file
View File

@ -1 +1,113 @@
**************************************************************** * * This file contains constant values defined in the C interfaces * that are also used in the assembly language portion of the * libraries. * **************************************************************** ; ; error numbers ; EDOM gequ 1 domain error ERANGE gequ 2 # too large, too small, or illegal ENOMEM gequ 3 Not enough memory ENOENT gequ 4 No such file or directory EIO gequ 5 I/O error EINVAL gequ 6 Invalid argument EBADF gequ 7 bad file descriptor EMFILE gequ 8 too many files are open EACCES gequ 9 access bits prevent the operation EEXIST gequ 10 the file exists ENOSPC gequ 11 the file is too large ; ; masks for the __ctype array ; _digit gequ $01 ['0'..'9'] _upper gequ $02 ['A'..'Z'] _lower gequ $04 ['a'..'z'] _control gequ $08 [chr(0)..chr(31),chr(127)] _punctuation gequ $10 [' ','!'..'/',':'..'@','['..'`','{'..'~'] _space gequ $20 [chr(9)..chr(13),' '] _hex gequ $40 ['0'..'9','a'..'f','A'..'F'] _print gequ $80 [' '..'~'] ; ; masks for the __ctype2 array ; _csym gequ $01 ['0'..'9','A'..'Z','a'..'z','_'] _csymf gequ $02 ['A'..'Z','a'..'z'.'_'] _octal gequ $04 ['0'..'7'] ; ; signal numbers ; SIGABRT gequ 1 SIGFPE gequ 2 SIGILL gequ 3 SIGINT gequ 4 SIGSEGV gequ 5 SIGTERM gequ 6 ; ; The FILE record ; ! flags ! ----- _IOFBF gequ $0001 full buffering _IONBF gequ $0002 no buffering _IOLBF gequ $0004 flush when a \n is written _IOREAD gequ $0008 currently reading _IOWRT gequ $0010 currently writing _IORW gequ $0020 read/write enabled _IOMYBUF gequ $0040 buffer was allocated by stdio _IOEOF gequ $0080 has an EOF been found? _IOERR gequ $0100 has an error occurred? _IOTEXT gequ $0200 is this file a text file? _IOTEMPFILE gequ $0400 was this file created by tmpfile()? ! record structure ! ---------------- FILE_next gequ 0 disp to next pointer (must stay 0!) FILE_ptr gequ FILE_next+4 next location to write to FILE_base gequ FILE_ptr+4 first byte of the buffer FILE_end gequ FILE_base+4 end of the file buffer FILE_size gequ FILE_end+4 size of the file buffer FILE_cnt gequ FILE_size+4 # chars that can be read/writen to buffer FILE_pbk gequ FILE_cnt+4 put back character FILE_flag gequ FILE_pbk+4 buffer flags FILE_file gequ FILE_flag+2 GS/OS file ID sizeofFILE gequ FILE_file+2 size of the record BUFSIZ gequ 1024 default file buffer size _LBUFSIZ gequ 255 line buffer size L_tmpnam gequ 9 size of a temp name TMP_MAX gequ 10000 # of uniq temp names ; ; Seek codes for fseek ; SEEK_SET gequ 0 seek from start of file SEEK_CUR gequ 1 seek from current position SEEK_END gequ 2 seek from end of file ; ; Values for fcntl.h ; OPEN_MAX gequ 30 files in the file array F_DUPFD gequ 1 dup file flag (fcntl) O_RDONLY gequ $0001 file is read only O_WRONLY gequ $0002 file is write only O_RDWR gequ $0004 file is read/write O_NDELAY gequ $0008 not used O_APPEND gequ $0010 append to file on all writes O_CREAT gequ $0020 create a new file if needed O_TRUNC gequ $0040 erase old file O_EXCL gequ $0080 don't create a new file O_BINARY gequ $0100 file is binary ; ; Misc. ; EOF gequ -1 end of file character stdinID gequ -1 standard in file ID stdoutID gequ -2 standard out file ID stderrID gequ -3 error out file ID
****************************************************************
*
* This file contains constant values defined in the C interfaces
* that are also used in the assembly language portion of the
* libraries.
*
****************************************************************
;
; error numbers
;
EDOM gequ 1 domain error
ERANGE gequ 2 # too large, too small, or illegal
ENOMEM gequ 3 Not enough memory
ENOENT gequ 4 No such file or directory
EIO gequ 5 I/O error
EINVAL gequ 6 Invalid argument
EBADF gequ 7 bad file descriptor
EMFILE gequ 8 too many files are open
EACCES gequ 9 access bits prevent the operation
EEXIST gequ 10 the file exists
ENOSPC gequ 11 the file is too large
;
; masks for the __ctype array
;
_digit gequ $01 ['0'..'9']
_upper gequ $02 ['A'..'Z']
_lower gequ $04 ['a'..'z']
_control gequ $08 [chr(0)..chr(31),chr(127)]
_punctuation gequ $10 [' ','!'..'/',':'..'@','['..'`','{'..'~']
_space gequ $20 [chr(9)..chr(13),' ']
_hex gequ $40 ['0'..'9','a'..'f','A'..'F']
_print gequ $80 [' '..'~']
;
; masks for the __ctype2 array
;
_csym gequ $01 ['0'..'9','A'..'Z','a'..'z','_']
_csymf gequ $02 ['A'..'Z','a'..'z'.'_']
_octal gequ $04 ['0'..'7']
;
; signal numbers
;
SIGABRT gequ 1
SIGFPE gequ 2
SIGILL gequ 3
SIGINT gequ 4
SIGSEGV gequ 5
SIGTERM gequ 6
;
; The FILE record
;
! flags
! -----
_IOFBF gequ $0001 full buffering
_IONBF gequ $0002 no buffering
_IOLBF gequ $0004 flush when a \n is written
_IOREAD gequ $0008 currently reading
_IOWRT gequ $0010 currently writing
_IORW gequ $0020 read/write enabled
_IOMYBUF gequ $0040 buffer was allocated by stdio
_IOEOF gequ $0080 has an EOF been found?
_IOERR gequ $0100 has an error occurred?
_IOTEXT gequ $0200 is this file a text file?
_IOTEMPFILE gequ $0400 was this file created by tmpfile()?
! record structure
! ----------------
FILE_next gequ 0 disp to next pointer (must stay 0!)
FILE_ptr gequ FILE_next+4 next location to write to
FILE_base gequ FILE_ptr+4 first byte of the buffer
FILE_end gequ FILE_base+4 end of the file buffer
FILE_size gequ FILE_end+4 size of the file buffer
FILE_cnt gequ FILE_size+4 # chars that can be read/writen to buffer
FILE_pbk gequ FILE_cnt+4 put back character
FILE_flag gequ FILE_pbk+4 buffer flags
FILE_file gequ FILE_flag+2 GS/OS file ID
sizeofFILE gequ FILE_file+2 size of the record
BUFSIZ gequ 1024 default file buffer size
_LBUFSIZ gequ 255 line buffer size
L_tmpnam gequ 9 size of a temp name
TMP_MAX gequ 10000 # of uniq temp names
;
; Seek codes for fseek
;
SEEK_SET gequ 0 seek from start of file
SEEK_CUR gequ 1 seek from current position
SEEK_END gequ 2 seek from end of file
;
; Values for fcntl.h
;
OPEN_MAX gequ 30 files in the file array
F_DUPFD gequ 1 dup file flag (fcntl)
O_RDONLY gequ $0001 file is read only
O_WRONLY gequ $0002 file is write only
O_RDWR gequ $0004 file is read/write
O_NDELAY gequ $0008 not used
O_APPEND gequ $0010 append to file on all writes
O_CREAT gequ $0020 create a new file if needed
O_TRUNC gequ $0040 erase old file
O_EXCL gequ $0080 don't create a new file
O_BINARY gequ $0100 file is binary
;
; Misc.
;
EOF gequ -1 end of file character
stdinID gequ -1 standard in file ID
stdoutID gequ -2 standard out file ID
stderrID gequ -3 error out file ID

885
fcntl.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

509
fcntl.macros Executable file → Normal file

File diff suppressed because one or more lines are too long

49
make Executable file → Normal file
View File

@ -1 +1,48 @@
unset exit unset cc >&/work unset cg >&/work if {#} == 0 Newer obj/stdio.a stdio.asm equates.asm if {Status} != 0 set exit on echo assemble +e +t stdio.asm assemble +e +t stdio.asm unset exit end Newer obj/assert.a assert.asm if {Status} != 0 set exit on echo assemble +e +t assert.asm assemble +e +t assert.asm unset exit end for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal Newer obj/{i}.a {i}.asm if {Status} != 0 set exit on echo assemble +e +t {i}.asm assemble +e +t {i}.asm unset exit end end else set exit on for i assemble +e +t {i}.asm end end echo delete orcalib delete orcalib set list vars.a assert.a cc.a setjmp.a ctype.a string.a stdlib.a set list {list} time.a signal.a toolglue.a orca.a fcntl.a stdio.a for i in {list} echo makelib orcalib +obj/{i} makelib orcalib +obj/{i} end set echo on
unset exit
unset cc >&/work
unset cg >&/work
if {#} == 0
Newer obj/stdio.a stdio.asm equates.asm
if {Status} != 0
set exit on
echo assemble +e +t stdio.asm
assemble +e +t stdio.asm
unset exit
end
Newer obj/assert.a assert.asm
if {Status} != 0
set exit on
echo assemble +e +t assert.asm
assemble +e +t assert.asm
unset exit
end
for i in cc ctype string stdlib time setjmp orca fcntl vars toolglue signal
Newer obj/{i}.a {i}.asm
if {Status} != 0
set exit on
echo assemble +e +t {i}.asm
assemble +e +t {i}.asm
unset exit
end
end
else
set exit on
for i
assemble +e +t {i}.asm
end
end
echo delete orcalib
delete orcalib
set list vars.a assert.a cc.a setjmp.a ctype.a string.a stdlib.a
set list {list} time.a signal.a toolglue.a orca.a fcntl.a stdio.a
for i in {list}
echo makelib orcalib +obj/{i}
makelib orcalib +obj/{i}
end
set echo on

159
orca.asm Executable file → Normal file
View File

@ -1 +1,158 @@
keep obj/orca mcopy orca.macros case on **************************************************************** * * ORCA - ORCA/C specific libraries * * This code implements the tables and subroutines needed to * support the ORCA/C library ORCA. * * March 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * **************************************************************** * ORCA start dummy segment end **************************************************************** * * char *commandline(void) * * Inputs: * ~CommandLine - address of the command line * **************************************************************** * commandline start ldx #0 lda ~COMMANDLINE ora ~COMMANDLINE+2 beq lb1 lda ~COMMANDLINE ldx ~COMMANDLINE+2 clc adc #8 bcc lb1 inx lb1 rtl end **************************************************************** * * void enddesk(void) * **************************************************************** * enddesk start jmp ~ENDDESK end **************************************************************** * * void endgraph(void) * **************************************************************** * endgraph start jmp ~ENDGRAPH end **************************************************************** * * char *shellid(void) * * Inputs: * ~CommandLine - address of the command line * **************************************************************** * shellid start ldx #0 return NULL if there is no command line lda >~COMMANDLINE ora >~COMMANDLINE+2 bne lb1 rtl lb1 lda >~COMMANDLINE+2 pha lda >~COMMANDLINE pha phd tsc tcd phb phk plb ldy #6 lb2 lda [3],Y sta id,Y dey dey bpl lb2 plb pld pla pla lda #id ldx #^id rtl id dc 8c' ',i1'0' end **************************************************************** * * void startdesk(int width) * **************************************************************** * startdesk start jmp ~STARTDESK end **************************************************************** * * void startgraph(int width) * **************************************************************** * startgraph start jmp ~STARTGRAPH end **************************************************************** * * int toolerror(void) * **************************************************************** * toolerror start lda >~TOOLERROR rtl end **************************************************************** * * int userid(void) * **************************************************************** * userid start lda >~USER_ID rtl end
keep obj/orca
mcopy orca.macros
case on
****************************************************************
*
* ORCA - ORCA/C specific libraries
*
* This code implements the tables and subroutines needed to
* support the ORCA/C library ORCA.
*
* March 1989
* Mike Westerfield
*
* Copyright 1989
* Byte Works, Inc.
*
****************************************************************
*
ORCA start dummy segment
end
****************************************************************
*
* char *commandline(void)
*
* Inputs:
* ~CommandLine - address of the command line
*
****************************************************************
*
commandline start
ldx #0
lda ~COMMANDLINE
ora ~COMMANDLINE+2
beq lb1
lda ~COMMANDLINE
ldx ~COMMANDLINE+2
clc
adc #8
bcc lb1
inx
lb1 rtl
end
****************************************************************
*
* void enddesk(void)
*
****************************************************************
*
enddesk start
jmp ~ENDDESK
end
****************************************************************
*
* void endgraph(void)
*
****************************************************************
*
endgraph start
jmp ~ENDGRAPH
end
****************************************************************
*
* char *shellid(void)
*
* Inputs:
* ~CommandLine - address of the command line
*
****************************************************************
*
shellid start
ldx #0 return NULL if there is no command line
lda >~COMMANDLINE
ora >~COMMANDLINE+2
bne lb1
rtl
lb1 lda >~COMMANDLINE+2
pha
lda >~COMMANDLINE
pha
phd
tsc
tcd
phb
phk
plb
ldy #6
lb2 lda [3],Y
sta id,Y
dey
dey
bpl lb2
plb
pld
pla
pla
lda #id
ldx #^id
rtl
id dc 8c' ',i1'0'
end
****************************************************************
*
* void startdesk(int width)
*
****************************************************************
*
startdesk start
jmp ~STARTDESK
end
****************************************************************
*
* void startgraph(int width)
*
****************************************************************
*
startgraph start
jmp ~STARTGRAPH
end
****************************************************************
*
* int toolerror(void)
*
****************************************************************
*
toolerror start
lda >~TOOLERROR
rtl
end
****************************************************************
*
* int userid(void)
*
****************************************************************
*
userid start
lda >~USER_ID
rtl
end

47
orca.macros Executable file → Normal file
View File

@ -1 +1,46 @@
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 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

116
setjmp.asm Executable file → Normal file
View File

@ -1 +1,115 @@
keep obj/setjmp case on **************************************************************** * * SetJmp - Set jump library * * This code implements the subroutines needed to support the * standard C library SETJMP. * * January 1989 * Mike Westerfield * * Copyright 1989 * Byte Works, Inc. * **************************************************************** * SetJmp start dummy segment end **************************************************************** * * int setjmp(env) * jmp_buf env; * * Inputs: * env - pointer to the environment array * * Outputs: * Returns 0. * **************************************************************** * setjmp start env equ 4 pointer to array ret equ 1 return address tsc set up addressing phd tcd clc save the correct stack pointer adc #4 sta [env] ldy #2 save D lda 1,S sta [env],Y ldy #4 save the return address lda ret-1 sta [env],Y iny iny lda ret+1 sta [env],Y pld repair the stack phb plx ply pla pla phy phx plb lda #0 return 0 rtl end **************************************************************** * * void longjmp(env,status) * jmp_buf env; * int status; * * Inputs: * env - pointer to the environment array * status - status to return * **************************************************************** * longjmp start env equ 4 environment pointer status equ 8 status to return tsc set up the local stack frame tcd phb phk plb ldx status get the status bne lb1 inx lb1 ldy #6 get the env record lb2 lda [env],Y sta lenv,Y dey dey bpl lb2 plb lda >stackPtr reset the stack pointer tcs lda >ret+2 reset the return address sta 2,S lda >ret sta 0,S lda >dp reset the dp tcd txa return the status rtl lenv anop local copy of *env stackPtr ds 2 dp ds 2 ret ds 4 end
keep obj/setjmp
case on
****************************************************************
*
* SetJmp - Set jump library
*
* This code implements the subroutines needed to support the
* standard C library SETJMP.
*
* January 1989
* Mike Westerfield
*
* Copyright 1989
* Byte Works, Inc.
*
****************************************************************
*
SetJmp start dummy segment
end
****************************************************************
*
* int setjmp(env)
* jmp_buf env;
*
* Inputs:
* env - pointer to the environment array
*
* Outputs:
* Returns 0.
*
****************************************************************
*
setjmp start
env equ 4 pointer to array
ret equ 1 return address
tsc set up addressing
phd
tcd
clc save the correct stack pointer
adc #4
sta [env]
ldy #2 save D
lda 1,S
sta [env],Y
ldy #4 save the return address
lda ret-1
sta [env],Y
iny
iny
lda ret+1
sta [env],Y
pld repair the stack
phb
plx
ply
pla
pla
phy
phx
plb
lda #0 return 0
rtl
end
****************************************************************
*
* void longjmp(env,status)
* jmp_buf env;
* int status;
*
* Inputs:
* env - pointer to the environment array
* status - status to return
*
****************************************************************
*
longjmp start
env equ 4 environment pointer
status equ 8 status to return
tsc set up the local stack frame
tcd
phb
phk
plb
ldx status get the status
bne lb1
inx
lb1 ldy #6 get the env record
lb2 lda [env],Y
sta lenv,Y
dey
dey
bpl lb2
plb
lda >stackPtr reset the stack pointer
tcs
lda >ret+2 reset the return address
sta 2,S
lda >ret
sta 0,S
lda >dp reset the dp
tcd
txa return the status
rtl
lenv anop local copy of *env
stackPtr ds 2
dp ds 2
ret ds 4
end

136
signal.asm Executable file → Normal file
View File

@ -1 +1,135 @@
keep obj/signal mcopy signal.macros case on **************************************************************** * * signal - Asyncronous event signal handler * * April 1990 * Mike Westerfield * * Copyright 1990 * Byte Works, Inc. * **************************************************************** * SIGNAL start dummy segment copy equates.asm SIG_DFL gequ -3 SIG_IGN gequ -2 SIG_ERR gequ -1 SIGMAX gequ 6 maximum number of signals end **************************************************************** * * void (*signal(int sig, void (*func) (int)))(int); * * Set the interupt handler * * Inputs: * sig - signal number * func - signal handler * * Returns: * Pointer to the last signal handler; SIG_ERR if sig * is out of range. * **************************************************************** * signal start using signalCommon ptr equ 1 old sugnal handler csubroutine (2:sig,4:func),4 lla ptr,SIG_ERR assume we will find an error lda sig if (!sig in [1..6]) beq lb1 cmp #SIGMAX+1 blt lb2 lb1 lda #ERANGE errno = ERANGE sta >errno bra lb3 lb2 asl A get the old signal handler address asl A tax lda >subABRT-4,X sta ptr lda >subABRT-2,X sta ptr+2 lda func set the new signal handler address sta >subABRT-4,X lda func+2 sta >subABRT-2,X lb3 creturn 4:ptr end **************************************************************** * * int raise(int sig); * * Raise a signal. * * Inputs: * sig - signal number * * Returns: * 0 if successful, -1 if sig is out of range * **************************************************************** * raise start using signalCommon val equ 1 value to return csubroutine (2:sig),2 stz val no error lda sig if (!sig in [1..6]) beq lb1 cmp #SIGMAX+1 blt lb2 lb1 lda #-1 val = -1 sta val lda #ERANGE errno = ERANGE sta >errno bra lb3 lb2 asl A get the signal handler address asl A tax lda >subABRT-4,X tay lda >subABRT-2,X bmi lb3 skip if it is SIG_DFL or SIG_IGN short M set up the call address sta >jsl+3 long M tya sta >jsl+1 ph2 sig call the user signal handler jsl jsl jsl lb3 creturn 2:val end **************************************************************** * * signalCommon - data area for the signal unit * **************************************************************** * signalCommon privdata subABRT dc a4'SIG_DFL' subFPE dc a4'SIG_DFL' subILL dc a4'SIG_DFL' subINT dc a4'SIG_DFL' subSEGV dc a4'SIG_DFL' subTERM dc a4'SIG_DFL' end
keep obj/signal
mcopy signal.macros
case on
****************************************************************
*
* signal - Asyncronous event signal handler
*
* April 1990
* Mike Westerfield
*
* Copyright 1990
* Byte Works, Inc.
*
****************************************************************
*
SIGNAL start dummy segment
copy equates.asm
SIG_DFL gequ -3
SIG_IGN gequ -2
SIG_ERR gequ -1
SIGMAX gequ 6 maximum number of signals
end
****************************************************************
*
* void (*signal(int sig, void (*func) (int)))(int);
*
* Set the interupt handler
*
* Inputs:
* sig - signal number
* func - signal handler
*
* Returns:
* Pointer to the last signal handler; SIG_ERR if sig
* is out of range.
*
****************************************************************
*
signal start
using signalCommon
ptr equ 1 old sugnal handler
csubroutine (2:sig,4:func),4
lla ptr,SIG_ERR assume we will find an error
lda sig if (!sig in [1..6])
beq lb1
cmp #SIGMAX+1
blt lb2
lb1 lda #ERANGE errno = ERANGE
sta >errno
bra lb3
lb2 asl A get the old signal handler address
asl A
tax
lda >subABRT-4,X
sta ptr
lda >subABRT-2,X
sta ptr+2
lda func set the new signal handler address
sta >subABRT-4,X
lda func+2
sta >subABRT-2,X
lb3 creturn 4:ptr
end
****************************************************************
*
* int raise(int sig);
*
* Raise a signal.
*
* Inputs:
* sig - signal number
*
* Returns:
* 0 if successful, -1 if sig is out of range
*
****************************************************************
*
raise start
using signalCommon
val equ 1 value to return
csubroutine (2:sig),2
stz val no error
lda sig if (!sig in [1..6])
beq lb1
cmp #SIGMAX+1
blt lb2
lb1 lda #-1 val = -1
sta val
lda #ERANGE errno = ERANGE
sta >errno
bra lb3
lb2 asl A get the signal handler address
asl A
tax
lda >subABRT-4,X
tay
lda >subABRT-2,X
bmi lb3 skip if it is SIG_DFL or SIG_IGN
short M set up the call address
sta >jsl+3
long M
tya
sta >jsl+1
ph2 sig call the user signal handler
jsl jsl jsl
lb3 creturn 2:val
end
****************************************************************
*
* signalCommon - data area for the signal unit
*
****************************************************************
*
signalCommon privdata
subABRT dc a4'SIG_DFL'
subFPE dc a4'SIG_DFL'
subILL dc a4'SIG_DFL'
subINT dc a4'SIG_DFL'
subSEGV dc a4'SIG_DFL'
subTERM dc a4'SIG_DFL'
end

193
signal.macros Executable file → Normal file
View File

@ -1 +1,192 @@
MACRO &lab csubroutine &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 1 .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<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &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+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 MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB LONG &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB REP #&M*32+&I*16 AIF .NOT.&M,.B LONGA ON .B AIF .NOT.&I,.C LONGI ON .C MEND MACRO &LAB PH2 &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 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB SHORT &A,&B LCLB &I LCLB &M &A AMID &A,1,1 &M SETB ("&A"="M").OR.("&A"="m") &I SETB ("&A"="I").OR.("&A"="i") AIF C:&B=0,.A &B AMID &B,1,1 &M SETB ("&B"="M").OR.("&B"="m").OR.&M &I SETB ("&B"="I").OR.("&B"="i").OR.&I .A &LAB SEP #&M*32+&I*16 AIF .NOT.&M,.B LONGA OFF .B AIF .NOT.&I,.C LONGI OFF .C MEND
MACRO
&lab csubroutine &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 1
.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<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
MACRO
&lab creturn &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+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
MACRO
&LAB LLA &AD1,&AD2
&LAB ANOP
LCLA &L
LCLB &LA
AIF S:LONGA,.A
REP #%00100000
LONGA ON
&LA SETB 1
.A
LDA #&AD2
&L SETA C:&AD1
.B
STA &AD1(&L)
&L SETA &L-1
AIF &L,^B
LDA #^&AD2
&L SETA C:&AD1
.C
STA 2+&AD1(&L)
&L SETA &L-1
AIF &L,^C
AIF &LA=0,.D
SEP #%00100000
LONGA OFF
.D
MEND
MACRO
&LAB LONG &A,&B
LCLB &I
LCLB &M
&A AMID &A,1,1
&M SETB ("&A"="M").OR.("&A"="m")
&I SETB ("&A"="I").OR.("&A"="i")
AIF C:&B=0,.A
&B AMID &B,1,1
&M SETB ("&B"="M").OR.("&B"="m").OR.&M
&I SETB ("&B"="I").OR.("&B"="i").OR.&I
.A
&LAB REP #&M*32+&I*16
AIF .NOT.&M,.B
LONGA ON
.B
AIF .NOT.&I,.C
LONGI ON
.C
MEND
MACRO
&LAB PH2 &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
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB SHORT &A,&B
LCLB &I
LCLB &M
&A AMID &A,1,1
&M SETB ("&A"="M").OR.("&A"="m")
&I SETB ("&A"="I").OR.("&A"="i")
AIF C:&B=0,.A
&B AMID &B,1,1
&M SETB ("&B"="M").OR.("&B"="m").OR.&M
&I SETB ("&B"="I").OR.("&B"="i").OR.&I
.A
&LAB SEP #&M*32+&I*16
AIF .NOT.&M,.B
LONGA OFF
.B
AIF .NOT.&I,.C
LONGI OFF
.C
MEND

111
smac Executable file → Normal file
View File

@ -1 +1,110 @@
macro &lab cstr &s &lab dc c"&s",i1'0' mend MACRO &LAB MOVE4 &F,&T &LAB ~SETM LDA 2+&F STA 2+&T LDA &F STA &T ~RESTM MEND macro &lab csubroutine &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 1 .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<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend macro &lab creturn &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+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
macro
&lab cstr &s
&lab dc c"&s",i1'0'
mend
MACRO
&LAB MOVE4 &F,&T
&LAB ~SETM
LDA 2+&F
STA 2+&T
LDA &F
STA &T
~RESTM
MEND
macro
&lab csubroutine &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 1
.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<=c:&parms,^b
.e
tsc
aif &work=0,.f
sec
sbc #&work
tcs
.f
phd
tcd
mend
macro
&lab creturn &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+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

5238
stdio.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

778
stdio.macros Executable file → Normal file

File diff suppressed because one or more lines are too long

1050
stdlib.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

588
stdlib.macros Executable file → Normal file

File diff suppressed because one or more lines are too long

1788
string.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

558
string.macros Executable file → Normal file

File diff suppressed because one or more lines are too long

500
time.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

563
time.macros Executable file → Normal file

File diff suppressed because one or more lines are too long

850
toolglue.asm Executable file → Normal file

File diff suppressed because one or more lines are too long

374
toolglue.macros Executable file → Normal file
View File

@ -1 +1,373 @@
MACRO &LAB LLA &AD1,&AD2 &LAB ANOP LCLA &L LCLB &LA AIF S:LONGA,.A REP #%00100000 LONGA ON &LA SETB 1 .A LDA #&AD2 &L SETA C:&AD1 .B STA &AD1(&L) &L SETA &L-1 AIF &L,^B LDA #^&AD2 &L SETA C:&AD1 .C STA 2+&AD1(&L) &L SETA &L-1 AIF &L,^C AIF &LA=0,.D SEP #%00100000 LONGA OFF .D MEND MACRO &LAB PH2 &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 LDA (&N1) PHA AGO .E .B LDA &N1 PHA AGO .E .D &N1 AMID &N1,2,L:&N1-1 PEA &N1 AGO .F .E AIF S:LONGA=1,.F SEP #%00100000 .F MEXIT .G MNOTE "Missing closing '}'",16 MEND MACRO &LAB PL2 &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) AGO .D .B PLA STA &N1 .D AIF S:LONGA=1,.E SEP #%00100000 .E MEXIT .F MNOTE "Missing closing '}'",16 MEND MACRO &LAB _READTIMEHEX &LAB LDX #$0D03 JSL $E10000 MEND MACRO &LAB _FWENTRY &LAB LDX #$2403 JSL $E10000 MEND MACRO &LAB _GETMOUSECLAMP &LAB LDX #$1D03 JSL $E10000 MEND MACRO &LAB _READMOUSE &LAB LDX #$1703 JSL $E10000 MEND MACRO &LAB _GETABSCLAMP &LAB LDX #$2B03 JSL $E10000 MEND MACRO &lab csubroutine &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 1 .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<=c:&parms,^b .e tsc aif &work=0,.f sec sbc #&work tcs .f phd tcd mend MACRO &lab creturn &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+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 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 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 _LONGDIVIDE &LAB LDX #$0D0B JSL $E10000 MEND MACRO &LAB _LONGMUL &LAB LDX #$0C0B JSL $E10000 MEND MACRO &LAB _SDIVIDE &LAB LDX #$0A0B JSL $E10000 MEND MACRO &LAB _UDIVIDE &LAB LDX #$0B0B JSL $E10000 MEND MACRO &LAB _INITIALLOAD &LAB LDX #$0911 JSL $E10000 MEND MACRO &LAB _RESTART &LAB LDX #$0A11 JSL $E10000 MEND MACRO &LAB _LOADSEGNAME &LAB LDX #$0D11 JSL $E10000 MEND MACRO &LAB _UNLOADSEG &LAB LDX #$0E11 JSL $E10000 MEND MACRO &LAB _GETLOC &LAB LDX #$0C1A JSL $E10000 MEND MACRO &LAB _GETERRGLOBALS &LAB LDX #$0E0C JSL $E10000 MEND MACRO &LAB _GETINGLOBALS &LAB LDX #$0C0C JSL $E10000 MEND MACRO &LAB _GETINPUTDEVICE &LAB LDX #$120C JSL $E10000 MEND MACRO &LAB _GETOUTGLOBALS &LAB LDX #$0D0C JSL $E10000 MEND MACRO &LAB _GETOUTPUTDEVICE &LAB LDX #$130C JSL $E10000 MEND MACRO &LAB _GETERRORDEVICE &LAB LDX #$140C JSL $E10000 MEND MACRO &LAB _INITIALLOAD2 &LAB LDX #$2011 JSL $E10000 MEND MACRO &lab _GetMSData &lab ldx #$1F23 jsl $E10000 MEND
MACRO
&LAB LLA &AD1,&AD2
&LAB ANOP
LCLA &L
LCLB &LA
AIF S:LONGA,.A
REP #%00100000
LONGA ON
&LA SETB 1
.A
LDA #&AD2
&L SETA C:&AD1
.B
STA &AD1(&L)
&L SETA &L-1
AIF &L,^B
LDA #^&AD2
&L SETA C:&AD1
.C
STA 2+&AD1(&L)
&L SETA &L-1
AIF &L,^C
AIF &LA=0,.D
SEP #%00100000
LONGA OFF
.D
MEND
MACRO
&LAB PH2 &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
LDA (&N1)
PHA
AGO .E
.B
LDA &N1
PHA
AGO .E
.D
&N1 AMID &N1,2,L:&N1-1
PEA &N1
AGO .F
.E
AIF S:LONGA=1,.F
SEP #%00100000
.F
MEXIT
.G
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB PL2 &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)
AGO .D
.B
PLA
STA &N1
.D
AIF S:LONGA=1,.E
SEP #%00100000
.E
MEXIT
.F
MNOTE "Missing closing '}'",16
MEND
MACRO
&LAB _READTIMEHEX
&LAB LDX #$0D03
JSL $E10000
MEND
MACRO
&LAB _FWENTRY
&LAB LDX #$2403
JSL $E10000
MEND
MACRO
&LAB _GETMOUSECLAMP
&LAB LDX #$1D03
JSL $E10000
MEND
MACRO
&LAB _READMOUSE
&LAB LDX #$1703
JSL $E10000
MEND
MACRO
&LAB _GETABSCLAMP
&LAB LDX #$2B03
JSL $E10000
MEND
MACRO
&lab csubroutine &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 1
.b
&p setc &parms(&i)