diff --git a/src/makefile b/src/makefile old mode 100644 new mode 100755 index 36ec4bb..acce732 --- a/src/makefile +++ b/src/makefile @@ -44,8 +44,8 @@ MEMMGR = MEMMGR\#FE1000 MEMTEST = MEMTEST\#FE1000 FIBER = FIBER\#FE1000 PLASM = plasm -INCS = toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h -OBJS = toolsrc/plasm.c toolsrc/parse.o toolsrc/lex.o toolsrc/codegen.o +INCS = toolsrc/plasm.h toolsrc/tokens.h toolsrc/symbols.h toolsrc/lex.h toolsrc/parse.h toolsrc/codegen.h +OBJS = toolsrc/plasm.c toolsrc/parse.c toolsrc/lex.c toolsrc/codegen.c # # Image filetypes for Virtual ][ # @@ -83,20 +83,20 @@ $(PLVM): vmsrc/plvm.c cc vmsrc/plvm.c -o $(PLVM) vmsrc/a1cmd.a: vmsrc/a1cmd.pla $(PLASM) - ./$(PLASM) -A < vmsrc/a1cmd.pla > vmsrc/a1cmd.a + ./$(PLASM) -AO < vmsrc/a1cmd.pla > vmsrc/a1cmd.a $(PLVM01): vmsrc/plvm01.s vmsrc/a1cmd.a acme -o $(PLVM01) -l vmsrc/plvm01.sym vmsrc/plvm01.s $(CMD): vmsrc/cmd.pla vmsrc/cmdstub.s $(PLVM02) $(PLASM) - ./$(PLASM) -A < vmsrc/cmd.pla > vmsrc/cmd.a + ./$(PLASM) -AO < vmsrc/cmd.pla > vmsrc/cmd.a acme --setpc 8192 -o $(CMD) vmsrc/cmdstub.s $(PLVM02): vmsrc/plvm02.s acme -o $(PLVM02) -l vmsrc/plvm02.sym vmsrc/plvm02.s vmsrc/soscmd.a: vmsrc/soscmd.pla $(PLASM) - ./$(PLASM) -A < vmsrc/soscmd.pla > vmsrc/soscmd.a + ./$(PLASM) -AO < vmsrc/soscmd.pla > vmsrc/soscmd.a $(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a acme -o $(PLVM03) -l vmsrc/plvm03.sym vmsrc/plvm03.s @@ -105,143 +105,143 @@ $(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a # Sample code # test: samplesrc/test.pla samplesrc/testlib.pla $(PLVM) $(PLASM) - ./$(PLASM) -AM < samplesrc/test.pla > samplesrc/test.a + ./$(PLASM) -AMO < samplesrc/test.pla > samplesrc/test.a acme --setpc 4094 -o $(TEST) samplesrc/test.a - ./$(PLASM) -AM < samplesrc/testlib.pla > samplesrc/testlib.a + ./$(PLASM) -AMO < samplesrc/testlib.pla > samplesrc/testlib.a acme --setpc 4094 -o $(TESTLIB) samplesrc/testlib.a ./$(PLVM) TEST $(ED): toolsrc/ed.pla $(PLVM02) $(PLASM) toolsrc/ed.pla - ./$(PLASM) -A < toolsrc/ed.pla > toolsrc/ed.a + ./$(PLASM) -AO < toolsrc/ed.pla > toolsrc/ed.a acme --setpc 8192 -o $(ED) toolsrc/ed.a $(SB): toolsrc/sb.pla $(PLVM02) $(PLASM) toolsrc/sb.pla - ./$(PLASM) -A < toolsrc/sb.pla > toolsrc/sb.a + ./$(PLASM) -AO < toolsrc/sb.pla > toolsrc/sb.a acme --setpc 8192 -o $(SB) toolsrc/sb.a $(ARGS): libsrc/args.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/args.pla > libsrc/args.a + ./$(PLASM) -AMO < libsrc/args.pla > libsrc/args.a acme --setpc 4094 -o $(ARGS) libsrc/args.a $(MEMMGR): libsrc/memmgr.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/memmgr.pla > libsrc/memmgr.a + ./$(PLASM) -AMO < libsrc/memmgr.pla > libsrc/memmgr.a acme --setpc 4094 -o $(MEMMGR) libsrc/memmgr.a $(MEMTEST): samplesrc/memtest.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/memtest.pla > samplesrc/memtest.a + ./$(PLASM) -AMO < samplesrc/memtest.pla > samplesrc/memtest.a acme --setpc 4094 -o $(MEMTEST) samplesrc/memtest.a $(FIBER): libsrc/fiber.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/fiber.pla > libsrc/fiber.a + ./$(PLASM) -AMO < libsrc/fiber.pla > libsrc/fiber.a acme --setpc 4094 -o $(FIBER) libsrc/fiber.a $(MON): samplesrc/mon.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/mon.pla > samplesrc/mon.a + ./$(PLASM) -AMO < samplesrc/mon.pla > samplesrc/mon.a acme --setpc 4094 -o $(MON) samplesrc/mon.a $(ROD): samplesrc/rod.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/rod.pla > samplesrc/rod.a + ./$(PLASM) -AMO < samplesrc/rod.pla > samplesrc/rod.a acme --setpc 4094 -o $(ROD) samplesrc/rod.a $(SIEVE): samplesrc/sieve.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/sieve.pla > samplesrc/sieve.a + ./$(PLASM) -AMO < samplesrc/sieve.pla > samplesrc/sieve.a acme --setpc 4094 -o $(SIEVE) samplesrc/sieve.a $(UTHERNET): libsrc/uthernet.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/uthernet.pla > libsrc/uthernet.a + ./$(PLASM) -AMO < libsrc/uthernet.pla > libsrc/uthernet.a acme --setpc 4094 -o $(UTHERNET) libsrc/uthernet.a $(UTHERNET2): libsrc/uthernet2.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/uthernet2.pla > libsrc/uthernet2.a + ./$(PLASM) -AMO < libsrc/uthernet2.pla > libsrc/uthernet2.a acme --setpc 4094 -o $(UTHERNET2) libsrc/uthernet2.a $(ETHERIP): libsrc/etherip.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/etherip.pla > libsrc/etherip.a + ./$(PLASM) -AMO < libsrc/etherip.pla > libsrc/etherip.a acme --setpc 4094 -o $(ETHERIP) libsrc/etherip.a $(INET): libsrc/inet.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/inet.pla > libsrc/inet.a + ./$(PLASM) -AMO < libsrc/inet.pla > libsrc/inet.a acme --setpc 4094 -o $(INET) libsrc/inet.a $(DHCP): libsrc/dhcp.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/dhcp.pla > libsrc/dhcp.a + ./$(PLASM) -AMO < libsrc/dhcp.pla > libsrc/dhcp.a acme --setpc 4094 -o $(DHCP) libsrc/dhcp.a $(HTTPD): samplesrc/httpd.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/httpd.pla > samplesrc/httpd.a + ./$(PLASM) -AMO < samplesrc/httpd.pla > samplesrc/httpd.a acme --setpc 4094 -o $(HTTPD) samplesrc/httpd.a $(FILEIO): libsrc/fileio.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/fileio.pla > libsrc/fileio.a + ./$(PLASM) -AMO < libsrc/fileio.pla > libsrc/fileio.a acme --setpc 4094 -o $(FILEIO) libsrc/fileio.a $(TONE): libsrc/tone.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/tone.pla > libsrc/tone.a + ./$(PLASM) -AMO < libsrc/tone.pla > libsrc/tone.a acme --setpc 4094 -o $(TONE) libsrc/tone.a $(FATCAT): samplesrc/fatcat.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/fatcat.pla > samplesrc/fatcat.a + ./$(PLASM) -AMO < samplesrc/fatcat.pla > samplesrc/fatcat.a acme --setpc 4094 -o $(FATCAT) samplesrc/fatcat.a $(FATGET): samplesrc/fatget.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/fatget.pla > samplesrc/fatget.a + ./$(PLASM) -AMO < samplesrc/fatget.pla > samplesrc/fatget.a acme --setpc 4094 -o $(FATGET) samplesrc/fatget.a $(FATPUT): samplesrc/fatput.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/fatput.pla > samplesrc/fatput.a + ./$(PLASM) -AMO < samplesrc/fatput.pla > samplesrc/fatput.a acme --setpc 4094 -o $(FATPUT) samplesrc/fatput.a $(FATWDSK): samplesrc/fatwritedsk.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/fatwritedsk.pla > samplesrc/fatwritedsk.a + ./$(PLASM) -AMO < samplesrc/fatwritedsk.pla > samplesrc/fatwritedsk.a acme --setpc 4094 -o $(FATWDSK) samplesrc/fatwritedsk.a $(FATRDSK): samplesrc/fatreaddsk.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a + ./$(PLASM) -AMO < samplesrc/fatreaddsk.pla > samplesrc/fatreaddsk.a acme --setpc 4094 -o $(FATRDSK) samplesrc/fatreaddsk.a $(SDFAT): libsrc/sdfat.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/sdfat.pla > libsrc/sdfat.a + ./$(PLASM) -AMO < libsrc/sdfat.pla > libsrc/sdfat.a acme --setpc 4094 -o $(SDFAT) libsrc/sdfat.a $(SPIPORT): libsrc/spiport.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/spiport.pla > libsrc/spiport.a + ./$(PLASM) -AMO < libsrc/spiport.pla > libsrc/spiport.a acme --setpc 4094 -o $(SPIPORT) libsrc/spiport.a $(PORTIO): libsrc/portio.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/portio.pla > libsrc/portio.a + ./$(PLASM) -AMO < libsrc/portio.pla > libsrc/portio.a acme --setpc 4094 -o $(PORTIO) libsrc/portio.a $(DGR): libsrc/dgr.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < libsrc/dgr.pla > libsrc/dgr.a + ./$(PLASM) -AMO < libsrc/dgr.pla > libsrc/dgr.a acme --setpc 4094 -o $(DGR) libsrc/dgr.a $(DGRTEST): samplesrc/dgrtest.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/dgrtest.pla > samplesrc/dgrtest.a + ./$(PLASM) -AMO < samplesrc/dgrtest.pla > samplesrc/dgrtest.a acme --setpc 4094 -o $(DGRTEST) samplesrc/dgrtest.a $(ROGUE): samplesrc/rogue.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/rogue.pla > samplesrc/rogue.a + ./$(PLASM) -AMO < samplesrc/rogue.pla > samplesrc/rogue.a acme --setpc 4094 -o $(ROGUE) samplesrc/rogue.a $(ROGUEIO): samplesrc/rogue.io.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/rogue.io.pla > samplesrc/rogue.io.a + ./$(PLASM) -AMO < samplesrc/rogue.io.pla > samplesrc/rogue.io.a acme --setpc 4094 -o $(ROGUEIO) samplesrc/rogue.io.a $(ROGUECOMBAT): samplesrc/rogue.combat.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a + ./$(PLASM) -AMO < samplesrc/rogue.combat.pla > samplesrc/rogue.combat.a acme --setpc 4094 -o $(ROGUECOMBAT) samplesrc/rogue.combat.a $(ROGUEMAP): samplesrc/rogue.map.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/rogue.map.pla > samplesrc/rogue.map.a + ./$(PLASM) -AMO < samplesrc/rogue.map.pla > samplesrc/rogue.map.a acme --setpc 4094 -o $(ROGUEMAP) samplesrc/rogue.map.a $(HGR1): samplesrc/hgr1.pla samplesrc/hgr1test.pla $(PLVM02) $(PLASM) - ./$(PLASM) -AM < samplesrc/hgr1test.pla > samplesrc/hgr1test.a + ./$(PLASM) -AMO < samplesrc/hgr1test.pla > samplesrc/hgr1test.a acme --setpc 4094 -o $(HGR1TEST) samplesrc/hgr1test.a - ./$(PLASM) -AM < samplesrc/hgr1.pla > samplesrc/hgr1.a + ./$(PLASM) -AMO < samplesrc/hgr1.pla > samplesrc/hgr1.a acme --setpc 4094 -o $(HGR1) samplesrc/hgr1.a hello: samplesrc/hello.pla $(PLVM) $(PLASM) - ./$(PLASM) -AM < samplesrc/hello.pla > samplesrc/hello.a + ./$(PLASM) -AMO < samplesrc/hello.pla > samplesrc/hello.a acme --setpc 4094 -o $(HELLO) samplesrc/hello.a ./$(PLVM) HELLO diff --git a/src/toolsrc/codegen.c b/src/toolsrc/codegen.c index 0c1e299..9d0cfb8 100755 --- a/src/toolsrc/codegen.c +++ b/src/toolsrc/codegen.c @@ -1,10 +1,7 @@ #include #include #include -#include "tokens.h" -#include "lex.h" -#include "symbols.h" -#include "codegen.h" +#include "plasm.h" /* * Symbol table and fixup information. */ @@ -30,6 +27,8 @@ static int idlocal_offset[128]; static char fixup_size[2048]; static int fixup_type[2048]; static int fixup_tag[2048]; +static t_opseq optbl[256]; +static t_opseq *freeop_lst = &optbl[0]; #define FIXUP_BYTE 0x00 #define FIXUP_WORD 0x80 int id_match(char *name, int len, char *id) @@ -162,6 +161,11 @@ int id_add(char *name, int len, int type, int size) { return ((type & LOCAL_TYPE) ? idlocal_add(name, len, type, size) : idglobal_add(name, len, type, size)); } +void idlocal_reset(void) +{ + locals = 0; + localsize = 0; +} int idfunc_add(char *name, int len, int type, int tag) { if (globals > 1024) @@ -255,10 +259,6 @@ int fixup_new(int tag, int type, int size) /* * Emit assembly code. */ -#define BYTECODE_SEG 8 -#define INIT 16 -#define SYSFLAGS 32 -static int outflags = 0; static const char *DB = ".BYTE"; static const char *DW = ".WORD"; static const char *DS = ".RES"; @@ -305,8 +305,7 @@ void emit_dci(char *str, int len) } void emit_flags(int flags) { - outflags = flags; - if (outflags & ACME) + if (flags & ACME) { DB = "!BYTE"; DW = "!WORD"; @@ -316,6 +315,8 @@ void emit_flags(int flags) } void emit_header(void) { + int i; + if (outflags & ACME) printf("; ACME COMPATIBLE OUTPUT\n"); else @@ -324,7 +325,7 @@ void emit_header(void) { printf("\t%s\t_SEGEND-_SEGBEGIN\t; LENGTH OF HEADER + CODE/DATA + BYTECODE SEGMENT\n", DW); printf("_SEGBEGIN%c\n", LBL); - printf("\t%s\t$DA7E\t\t\t; MAGIC #\n", DW); + printf("\t%s\t$DA7F\t\t\t; MAGIC #\n", DW); printf("\t%s\t_SYSFLAGS\t\t\t; SYSTEM FLAGS\n", DW); printf("\t%s\t_SUBSEG\t\t\t; BYTECODE SUB-SEGMENT\n", DW); printf("\t%s\t_DEFCNT\t\t\t; BYTECODE DEF COUNT\n", DW); @@ -334,6 +335,12 @@ void emit_header(void) { printf("\tJMP\t_INIT\t\t\t; MODULE INITIALIZATION ROUTINE\n"); } + /* + * Init free op sequence table + */ + for (i = 0; i < sizeof(optbl)/sizeof(t_opseq)-1; i++) + optbl[i].nextop = &optbl[i+1]; + optbl[i].nextop = NULL; } void emit_rld(void) { @@ -448,9 +455,16 @@ void emit_idglobal(int tag, int size, char *name) else printf("_D%03d%c\t%s\t%d\t\t\t; %s\n", tag, LBL, DS, size, name); } -void emit_idfunc(int tag, int type, char *name) +void emit_idfunc(int tag, int type, char *name, int is_bytecode) { - printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name); + if (name) + printf("%s%c\t\t\t\t\t; %s()\n", tag_string(tag, type), LBL, name); + if (!(outflags & MODULE)) + { + //printf("%s%c\n", name, LBL); + if (is_bytecode) + printf("\tJSR\tINTERP\n"); + } } void emit_idconst(char *name, int value) { @@ -519,17 +533,6 @@ int emit_data(int vartype, int consttype, long constval, int constsize) } return (datasize); } -void emit_def(const char *name, int is_bytecode) -{ - if (!(outflags & MODULE)) - { - //printf("%s%c\n", name, LBL); - if (is_bytecode) - printf("\tJSR\tINTERP\n"); - } - locals = 0; - localsize = 0; -} void emit_codetag(int tag) { printf("_B%03d%c\n", tag, LBL); @@ -566,17 +569,31 @@ void emit_llw(int index) } void emit_lab(int tag, int offset, int type) { - int fixup = fixup_new(tag, type, FIXUP_WORD); - char *taglbl = tag_string(tag, type); - printf("\t%s\t$68\t\t\t; LAB\t%s+%d\n", DB, taglbl, offset); - printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$68\t\t\t; LAB\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$68,$%02X,$%02X\t\t; LAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } } void emit_law(int tag, int offset, int type) { - int fixup = fixup_new(tag, type, FIXUP_WORD); - char *taglbl = tag_string(tag, type); - printf("\t%s\t$6A\t\t\t; LAW\t%s+%d\n", DB, taglbl, offset); - printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$6A\t\t\t; LAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$6A,$%02X,$%02X\t\t; LAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } } void emit_sb(void) { @@ -604,31 +621,45 @@ void emit_dlw(int index) } void emit_sab(int tag, int offset, int type) { - int fixup = fixup_new(tag, type, FIXUP_WORD); - char *taglbl = tag_string(tag, type); - printf("\t%s\t$78\t\t\t; SAB\t%s+%d\n", DB, taglbl, offset); - printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$78\t\t\t; SAB\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$78,$%02X,$%02X\t\t; SAB\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } } void emit_saw(int tag, int offset, int type) +{ + if (type) + { + int fixup = fixup_new(tag, type, FIXUP_WORD); + char *taglbl = tag_string(tag, type); + printf("\t%s\t$7A\t\t\t; SAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); + } + else + { + printf("\t%s\t$7A,$%02X,$%02X\t\t; SAW\t%d\n", DB, offset&0xFF,(offset>>8)&0xFF, offset); + } +} +void emit_dab(int tag, int offset, int type) { int fixup = fixup_new(tag, type, FIXUP_WORD); char *taglbl = tag_string(tag, type); - printf("\t%s\t$7A\t\t\t; SAW\t%s+%d\n", DB, taglbl, offset); + printf("\t%s\t$7C\t\t\t; DAB\t%s+%d\n", DB, taglbl, offset); printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); } -void emit_dab(int tag, int type) +void emit_daw(int tag, int offset, int type) { int fixup = fixup_new(tag, type, FIXUP_WORD); char *taglbl = tag_string(tag, type); - printf("\t%s\t$7C\t\t\t; DAB\t%s\n", DB, taglbl); - printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl); -} -void emit_daw(int tag, int type) -{ - int fixup = fixup_new(tag, type, FIXUP_WORD); - char *taglbl = tag_string(tag, type); - printf("\t%s\t$7E\t\t\t; DAW\t%s\n", DB, taglbl); - printf("_F%03d%c\t%s\t%s\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl); + printf("\t%s\t$7E\t\t\t; DAW\t%s+%d\n", DB, taglbl, offset); + printf("_F%03d%c\t%s\t%s+%d\t\t\n", fixup, LBL, DW, type & EXTERN_TYPE ? "0" : taglbl, offset); } void emit_localaddr(int index) { @@ -725,27 +756,23 @@ void emit_start(void) outflags |= INIT; defs++; } -void emit_dup(void) +void emit_push_exp(void) { - printf("\t%s\t$32\t\t\t; DUP\n", DB); + printf("\t%s\t$34\t\t\t; PUSH EXP\n", DB); } -void emit_push(void) +void emit_pull_exp(void) { - printf("\t%s\t$34\t\t\t; PUSH\n", DB); -} -void emit_pull(void) -{ - printf("\t%s\t$36\t\t\t; PULL\n", DB); -} -void emit_swap(void) -{ - printf("\t%s\t$2E\t\t\t; SWAP\n", DB); + printf("\t%s\t$36\t\t\t; PULL EXP\n", DB); } void emit_drop(void) { printf("\t%s\t$30\t\t\t; DROP\n", DB); } -int emit_unaryop(int op) +void emit_dup(void) +{ + printf("\t%s\t$32\t\t\t; DUP\n", DB); +} +int emit_unaryop(t_token op) { switch (op) { @@ -841,3 +868,459 @@ int emit_op(t_token op) } return (1); } +/* + * New/release sequence ops + */ +t_opseq *new_op(void) +{ + t_opseq* op = freeop_lst; + if (!op) + { + fprintf(stderr, "Compiler out of sequence ops!\n"); + return (NULL); + } + freeop_lst = freeop_lst->nextop; + op->nextop = NULL; + return (op); +} +void release_op(t_opseq *op) +{ + if (op) + { + op->nextop = freeop_lst; + freeop_lst = op; + } +} +void release_seq(t_opseq *seq) +{ + t_opseq *op; + while (seq) + { + op = seq; + seq = seq->nextop; + /* + * Free this op + */ + op->nextop = freeop_lst; + freeop_lst = op; + } +} +/* + * Crunch sequence (peephole optimize) + */ +int crunch_seq(t_opseq *seq) +{ + t_opseq *opnext, *opnextnext; + t_opseq *op = seq; + int crunched = 0; + int freeops = 0; + while (op && (opnext = op->nextop)) + { + switch (op->code) + { + case CONST_CODE: + //fprintf(stderr, "CONST -> $%04X", opnext->code); + if (op->val == 1) + { + if (opnext->code == BINARY_CODE(ADD_TOKEN)) + { + op->code = INC_CODE; + freeops = 1; + break; + } + if (opnext->code == BINARY_CODE(SUB_TOKEN)) + { + op->code = DEC_CODE; + freeops = 1; + break; + } + } + switch (opnext->code) + { + case NEG_CODE: + op->val = -(op->val); + freeops = 1; + break; + case COMP_CODE: + op->val = ~(op->val); + freeops = 1; + break; + case LOGIC_NOT_CODE: + op->val = op->val ? 0 : 1; + freeops = 1; + break; + case UNARY_CODE(BPTR_TOKEN): + case LB_CODE: + op->offsz = op->val; + op->code = LAB_CODE; + freeops = 1; + break; + case UNARY_CODE(WPTR_TOKEN): + case LW_CODE: + op->offsz = op->val; + op->code = LAW_CODE; + freeops = 1; + break; + case SB_CODE: + op->offsz = op->val; + op->code = SAB_CODE; + freeops = 1; + break; + case SW_CODE: + op->offsz = op->val; + op->code = SAW_CODE; + freeops = 1; + break; + case CONST_CODE: // Collapse constant operation + if ((opnextnext = opnext->nextop)) + switch (opnextnext->code) + { + case BINARY_CODE(MUL_TOKEN): + op->val *= opnext->val; + freeops = 2; + break; + case BINARY_CODE(DIV_TOKEN): + op->val /= opnext->val; + freeops = 2; + break; + case BINARY_CODE(MOD_TOKEN): + op->val %= opnext->val; + freeops = 2; + break; + case BINARY_CODE(ADD_TOKEN): + op->val += opnext->val; + freeops = 2; + break; + case BINARY_CODE(SUB_TOKEN): + op->val -= opnext->val; + freeops = 2; + break; + case BINARY_CODE(SHL_TOKEN): + op->val <<= opnext->val; + freeops = 2; + break; + case BINARY_CODE(SHR_TOKEN): + op->val >>= opnext->val; + freeops = 2; + break; + case BINARY_CODE(AND_TOKEN): + op->val &= opnext->val; + freeops = 2; + break; + case BINARY_CODE(OR_TOKEN): + op->val |= opnext->val; + freeops = 2; + break; + case BINARY_CODE(EOR_TOKEN): + op->val ^= opnext->val; + freeops = 2; + break; + case BINARY_CODE(EQ_TOKEN): + op->val = op->val == opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(NE_TOKEN): + op->val = op->val != opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(GE_TOKEN): + op->val = op->val >= opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(LT_TOKEN): + op->val = op->val < opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(GT_TOKEN): + op->val = op->val > opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(LE_TOKEN): + op->val = op->val <= opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(LOGIC_OR_TOKEN): + op->val = op->val || opnext->val ? 1 : 0; + freeops = 2; + break; + case BINARY_CODE(LOGIC_AND_TOKEN): + op->val = op->val && opnext->val ? 1 : 0; + freeops = 2; + break; + } + break; // CONST_CODE + } + break; // CONST_CODE + case LADDR_CODE: + switch (opnext->code) + { + case CONST_CODE: + if ((opnextnext = opnext->nextop)) + switch (opnextnext->code) + { + case ADD_CODE: + case INDEXB_CODE: + op->offsz += opnext->val; + freeops = 2; + break; + case INDEXW_CODE: + op->offsz += opnext->val * 2; + freeops = 2; + break; + } + break; + case LB_CODE: + op->code = LLB_CODE; + freeops = 1; + break; + case LW_CODE: + op->code = LLW_CODE; + freeops = 1; + break; + case SB_CODE: + op->code = SLB_CODE; + freeops = 1; + break; + case SW_CODE: + op->code = SLW_CODE; + freeops = 1; + break; + } + break; // LADDR_CODE + case GADDR_CODE: + switch (opnext->code) + { + case CONST_CODE: + if ((opnextnext = opnext->nextop)) + switch (opnextnext->code) + { + case ADD_CODE: + case INDEXB_CODE: + op->offsz += opnext->val; + freeops = 2; + break; + case INDEXW_CODE: + op->offsz += opnext->val * 2; + freeops = 2; + break; + } + break; + case LB_CODE: + op->code = LAB_CODE; + freeops = 1; + break; + case LW_CODE: + op->code = LAW_CODE; + freeops = 1; + break; + case SB_CODE: + op->code = SAB_CODE; + freeops = 1; + break; + case SW_CODE: + op->code = SAW_CODE; + freeops = 1; + break; + case ICAL_CODE: + op->code = CALL_CODE; + freeops = 1; + break; + } + break; // GADDR_CODE + } + // + // Free up crunched ops + // + while (freeops) + { + op->nextop = opnext->nextop; + opnext->nextop = freeop_lst; + freeop_lst = opnext; + opnext = op->nextop; + crunched = 1; + freeops--; + } + op = opnext; + } + return (crunched); +} +/* + * Generate a sequence of code + */ +t_opseq *gen_seq(t_opseq *seq, int opcode, long cval, int tag, int offsz, int type) +{ + t_opseq *op; + + if (!seq) + { + op = seq = new_op(); + } + else + { + op = seq; + while (op->nextop) + op = op->nextop; + op->nextop = new_op(); + op = op->nextop; + } + op->code = opcode; + op->val = cval; + op->tag = tag; + op->offsz = offsz; + op->type = type; + return (seq); +} +/* + * Append one sequence to the end of another + */ +t_opseq *cat_seq(t_opseq *seq1, t_opseq *seq2) +{ + t_opseq *op; + + if (!seq1) + return (seq2); + for (op = seq1; op->nextop; op = op->nextop); + op->nextop = seq2; + return (seq1); +} +/* + * Emit a sequence of ops + */ +int emit_seq(t_opseq *seq) +{ + t_opseq *op; + + if (!seq) + return (0); + if (outflags & OPTIMIZE) + while (crunch_seq(seq)); + while (seq) + { + op = seq; + switch (op->code) + { + case NEG_CODE: + case COMP_CODE: + case LOGIC_NOT_CODE: + case INC_CODE: + case DEC_CODE: + case BPTR_CODE: + case WPTR_CODE: + emit_unaryop(op->code); + break; + case MUL_CODE: + case DIV_CODE: + case MOD_CODE: + case ADD_CODE: + case SUB_CODE: + case SHL_CODE: + case SHR_CODE: + case AND_CODE: + case OR_CODE: + case EOR_CODE: + case EQ_CODE: + case NE_CODE: + case GE_CODE: + case LT_CODE: + case GT_CODE: + case LE_CODE: + case LOGIC_OR_CODE: + case LOGIC_AND_CODE: + emit_op(op->code); + break; + case CONST_CODE: + emit_const(op->val); + break; + case STR_CODE: + emit_conststr(op->val, op->offsz); + break; + case LB_CODE: + emit_lb(); + break; + case LW_CODE: + emit_lw(); + break; + case LLB_CODE: + emit_llb(op->offsz); + break; + case LLW_CODE: + emit_llw(op->offsz); + break; + case LAB_CODE: + emit_lab(op->tag, op->offsz, op->type); + break; + case LAW_CODE: + emit_law(op->tag, op->offsz, op->type); + break; + case SB_CODE: + emit_sb(); + break; + case SW_CODE: + emit_sw(); + break; + case SLB_CODE: + emit_slb(op->offsz); + break; + case SLW_CODE: + emit_slw(op->offsz); + break; + case DLB_CODE: + emit_dlb(op->offsz); + break; + case DLW_CODE: + emit_dlw(op->offsz); + break; + case SAB_CODE: + emit_sab(op->tag, op->offsz, op->type); + break; + case SAW_CODE: + emit_saw(op->tag, op->offsz, op->type); + break; + case DAB_CODE: + emit_dab(op->tag, op->offsz, op->type); + break; + case DAW_CODE: + emit_daw(op->tag, op->offsz, op->type); + break; + case CALL_CODE: + emit_call(op->tag, op->type); + break; + case ICAL_CODE: + emit_ical(); + break; + case LADDR_CODE: + emit_localaddr(op->offsz); + break; + case GADDR_CODE: + emit_globaladdr(op->tag, op->offsz, op->type); + break; + case INDEXB_CODE: + emit_indexbyte(); + break; + case INDEXW_CODE: + emit_indexword(); + break; + case DROP_CODE: + emit_drop(); + break; + case DUP_CODE: + emit_dup(); + break; + case PUSH_EXP_CODE: + emit_push_exp(); + break; + case PULL_EXP_CODE: + emit_pull_exp(); + break; + default: + return (0); + } + seq = seq->nextop; + /* + * Free this op + */ + op->nextop = freeop_lst; + freeop_lst = op; + } + return (1); +} diff --git a/src/toolsrc/codegen.h b/src/toolsrc/codegen.h index d05d11c..f69c96b 100755 --- a/src/toolsrc/codegen.h +++ b/src/toolsrc/codegen.h @@ -1,5 +1,84 @@ -#define ACME 1 -#define MODULE 2 +typedef struct _opseq { + int code; + long val; + int tag; + int offsz; + int type; + struct _opseq *nextop; +} t_opseq; +#define UNARY_CODE(tkn) ((tkn)|0x0100) +#define BINARY_CODE(tkn) ((tkn)|0x0200) +#define NEG_CODE 0x0100|NEG_TOKEN +#define COMP_CODE 0x0100|COMP_TOKEN +#define LOGIC_NOT_CODE 0x0100|LOGIC_NOT_TOKEN +#define INC_CODE 0x0100|INC_TOKEN +#define DEC_CODE 0x0100|DEC_TOKEN +#define BPTR_CODE 0x0100|BPTR_TOKEN +#define WPTR_CODE 0x0100|WPTR_TOKEN +#define MUL_CODE 0x0200|MUL_TOKEN +#define DIV_CODE 0x0200|DIV_TOKEN +#define MOD_CODE 0x0200|MOD_TOKEN +#define ADD_CODE 0x0200|ADD_TOKEN +#define SUB_CODE 0x0200|SUB_TOKEN +#define SHL_CODE 0x0200|SHL_TOKEN +#define SHR_CODE 0x0200|SHR_TOKEN +#define AND_CODE 0x0200|AND_TOKEN +#define OR_CODE 0x0200|OR_TOKEN +#define EOR_CODE 0x0200|EOR_TOKEN +#define EQ_CODE 0x0200|EQ_TOKEN +#define NE_CODE 0x0200|NE_TOKEN +#define GE_CODE 0x0200|GE_TOKEN +#define LT_CODE 0x0200|LT_TOKEN +#define GT_CODE 0x0200|GT_TOKEN +#define LE_CODE 0x0200|LE_TOKEN +#define LOGIC_OR_CODE 0x0200|LOGIC_OR_TOKEN +#define LOGIC_AND_CODE 0x0200|LOGIC_AND_TOKEN +#define CONST_CODE 0x0300 +#define STR_CODE 0x0301 +#define LB_CODE 0x0302 +#define LW_CODE 0x0303 +#define LLB_CODE 0x0304 +#define LLW_CODE 0x0305 +#define LAB_CODE 0x0306 +#define LAW_CODE 0x0307 +#define SB_CODE 0x0308 +#define SW_CODE 0x0309 +#define SLB_CODE 0x030A +#define SLW_CODE 0x030B +#define DLB_CODE 0x030C +#define DLW_CODE 0x030D +#define SAB_CODE 0x030E +#define SAW_CODE 0x030F +#define DAB_CODE 0x0310 +#define DAW_CODE 0x0311 +#define CALL_CODE 0x0312 +#define ICAL_CODE 0x0313 +#define LADDR_CODE 0x0314 +#define GADDR_CODE 0x0315 +#define INDEXB_CODE 0x0316 +#define INDEXW_CODE 0x0317 +#define DROP_CODE 0x0318 +#define DUP_CODE 0x0319 +#define PUSH_EXP_CODE 0x031A +#define PULL_EXP_CODE 0x031B + +#define gen_uop(seq,op) gen_seq(seq,UNARY_CODE(op),0,0,0,0) +#define gen_op(seq,op) gen_seq(seq,BINARY_CODE(op),0,0,0,0) +#define gen_const(seq,val) gen_seq(seq,CONST_CODE,val,0,0,0) +#define gen_str(seq,str,len) gen_seq(seq,STR_CODE,str,0,len,0) +#define gen_lcladr(seq,idx) gen_seq(seq,LADDR_CODE,0,0,idx,0) +#define gen_gbladr(seq,tag,typ) gen_seq(seq,GADDR_CODE,0,tag,0,typ) +#define gen_idxb(seq) gen_seq(seq,ADD_CODE,0,0,0,0) +#define gen_idxw(seq) gen_seq(seq,INDEXW_CODE,0,0,0,0) +#define gen_lb(seq) gen_seq(seq,LB_CODE,0,0,0,0) +#define gen_lw(seq) gen_seq(seq,LW_CODE,0,0,0,0) +#define gen_sb(seq) gen_seq(seq,SB_CODE,0,0,0,0) +#define gen_sw(seq) gen_seq(seq,SW_CODE,0,0,0,0) +#define gen_icall(seq) gen_seq(seq,ICAL_CODE,0,0,0,0) +#define gen_pushexp(seq) gen_seq(seq,PUSH_EXP_CODE,0,0,0,0) +#define gen_pullexp(seq) gen_seq(seq,PULL_EXP_CODE,0,0,0,0) +#define gen_drop(seq) gen_seq(seq,DROP_CODE,0,0,0,0) + void emit_flags(int flags); void emit_header(void); void emit_trailer(void); @@ -10,9 +89,8 @@ void emit_comment(char *s); void emit_asm(char *s); void emit_idlocal(char *name, int value); void emit_idglobal(int value, int size, char *name); -void emit_idfunc(int tag, int type, char *name); +void emit_idfunc(int tag, int type, char *name, int is_bytecode); void emit_idconst(char *name, int value); -void emit_def(const char *name, int is_bytecode); int emit_data(int vartype, int consttype, long constval, int constsize); void emit_codetag(int tag); void emit_const(int cval); @@ -30,16 +108,16 @@ void emit_slw(int index); void emit_dlb(int index); void emit_dlw(int index); void emit_sab(int tag, int offset, int type); -void emit_saw(int tag, int ofset, int type); -void emit_dab(int tag, int type); -void emit_daw(int tag, int type); +void emit_saw(int tag, int offset, int type); +void emit_dab(int tag, int offset, int type); +void emit_daw(int tag, int offset, int type); void emit_call(int tag, int type); void emit_ical(void); void emit_localaddr(int index); void emit_globaladdr(int tag, int offset, int type); void emit_indexbyte(void); void emit_indexword(void); -int emit_unaryop(int op); +int emit_unaryop(t_token op); int emit_op(t_token op); void emit_brtru(int tag); void emit_brfls(int tag); @@ -47,14 +125,19 @@ void emit_brgt(int tag); void emit_brlt(int tag); void emit_brne(int tag); void emit_brnch(int tag); -void emit_swap(void); -void emit_dup(void); -void emit_push(void); -void emit_pull(void); +void emit_empty(void); +void emit_push_exp(void); +void emit_pull_exp(void); void emit_drop(void); +void emit_dup(void); void emit_leave(void); void emit_ret(void); void emit_enter(int cparams); void emit_start(void); void emit_rld(void); void emit_esd(void); +void release_seq(t_opseq *seq); +int crunch_seq(t_opseq *seq); +t_opseq *gen_seq(t_opseq *seq, int opcode, long cval, int tag, int offsz, int type); +t_opseq *cat_seq(t_opseq *seq1, t_opseq *seq2); +int emit_seq(t_opseq *seq); diff --git a/src/toolsrc/lex.c b/src/toolsrc/lex.c index f2294cb..77ae0ca 100755 --- a/src/toolsrc/lex.c +++ b/src/toolsrc/lex.c @@ -13,8 +13,7 @@ #include #include #include -#include "tokens.h" -#include "symbols.h" +#include "plasm.h" char *statement, *tokenstr, *scanpos = (char*) ""; t_token scantoken, prevtoken; @@ -66,6 +65,8 @@ t_token keywords[] = { EOL_TOKEN }; +extern int outflags; + void parse_error(const char *errormsg) { char *error_carrot = statement; @@ -76,7 +77,18 @@ void parse_error(const char *errormsg) fprintf(stderr, "^\nError: %s\n", errormsg); exit(1); } +void parse_warn(const char *warnmsg) +{ + if (outflags & WARNINGS) + { + char *error_carrot = statement; + fprintf(stderr, "\n%s %4d: %s\n%*s ", filename, lineno, statement, (int)strlen(filename), ""); + for (error_carrot = statement; error_carrot != tokenstr; error_carrot++) + putc(*error_carrot == '\t' ? '\t' : ' ', stderr); + fprintf(stderr, "^\nWarning: %s\n", warnmsg); + } +} int hexdigit(char ch) { ch = toupper(ch); diff --git a/src/toolsrc/lex.h b/src/toolsrc/lex.h index cf12a95..07033b5 100755 --- a/src/toolsrc/lex.h +++ b/src/toolsrc/lex.h @@ -4,6 +4,7 @@ extern int tokenlen; extern long constval; extern char inputline[]; void parse_error(const char *errormsg); +void parse_warn(const char *warnmsg); int next_line(void); void scan_rewind(char *backptr); int scan_lookahead(void); diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index a04986a..a9aeb2f 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -1,11 +1,9 @@ #include -#include "tokens.h" -#include "symbols.h" -#include "lex.h" -#include "codegen.h" -#include "parse.h" - +#include "plasm.h" +#define LVALUE 0 +#define RVALUE 1 int infunc = 0, break_tag = 0, cont_tag = 0, stack_loop = 0; +long infuncvals = 0; t_token prevstmnt; t_token binary_ops_table[] = { @@ -221,7 +219,7 @@ int parse_constval(void) { case CLOSE_PAREN_TOKEN: break; - case STRING_TOKEN: + case STRING_TOKEN: size = tokenlen - 1; value = constval; type = STRING_TYPE; @@ -340,406 +338,347 @@ int parse_const(long *value) /* * Normal expression parsing */ -int parse_expr(void); -int parse_term(void) +t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth); +t_opseq *parse_list(t_opseq *codeseq, int *stackdepth) { - /* - * Parse terminal tokens. - */ - switch (scan()) + int parmdepth; + t_opseq *parmseq; + if (stackdepth) + *stackdepth = 0; + while ((parmseq = parse_expr(codeseq, &parmdepth))) { - case CHAR_TOKEN: - case INT_TOKEN: - case ID_TOKEN: - case STRING_TOKEN: + codeseq = parmseq; + if (stackdepth) + *stackdepth += parmdepth; + if (scantoken != COMMA_TOKEN) break; - case OPEN_PAREN_TOKEN: - if (!parse_expr()) - { - parse_error("Bad expression in parenthesis"); - return (0); - } - if (scantoken != CLOSE_PAREN_TOKEN) - { - parse_error("Missing closing parenthesis"); - return (0); - } - break; - default: - /* - * Non-terminal token. - */ - return (0); } - return (1); + return (codeseq); } -int parse_value(int rvalue) +t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth) { - int cparams; int deref = rvalue; - int optos = opsptr; - int type = 0, value = 0, emit_value = 0; - int ref_type, const_size; - long ref_offset, const_offset; + int type = 0, value = 0; + int cfnparms = 0; + long cfnvals = 1; + long const_offset; + t_opseq *uopseq = NULL; + t_opseq *valseq = NULL; + t_opseq *idxseq = NULL; + + if (stackdepth) + *stackdepth = 1; /* - * Parse pre operand operators. + * Parse pre operators. */ - while (!parse_term()) + while (scan()) { - switch (scantoken) + if (scantoken == ADD_TOKEN) { - case ADD_TOKEN: - /* - * Just ignore unary plus, it is a no-op. - */ - break; - case BPTR_TOKEN: - if (deref) - push_op(scantoken, 0); - else - { - deref++; - type |= BPTR_TYPE; - } - break; - case WPTR_TOKEN: - if (deref) - push_op(scantoken, 0); - else - { - deref++; - type |= WPTR_TYPE; - } - break; - case AT_TOKEN: - deref--; - break; - case NEG_TOKEN: - case COMP_TOKEN: - case LOGIC_NOT_TOKEN: - push_op(scantoken, 0); - break; - default: - return (0); + /* + * Just ignore unary plus, it is a no-op. + */ + } + else if (scantoken == AT_TOKEN) + { + if (deref-- == 0) + { + parse_error("Invalid ADDRESS-OF op"); + return (NULL); + } + } + else if (scantoken == BPTR_TOKEN || scantoken == WPTR_TOKEN) + { + deref++; + type |= scantoken == BPTR_TOKEN ? BPTR_TYPE : WPTR_TYPE; + } + else if (scantoken == NEG_TOKEN || scantoken == COMP_TOKEN || scantoken == LOGIC_NOT_TOKEN) + { + if (!rvalue) + { + parse_error("Invalid op for LVALUE"); + return (NULL); + } + uopseq = gen_uop(uopseq, scantoken); } - } - /* - * Determine which terminal type. - */ - if (scantoken == INT_TOKEN || scantoken == CHAR_TOKEN) - { - value = constval; - type |= CONST_TYPE; - } - else if (scantoken == ID_TOKEN) - { - if ((type |= id_type(tokenstr, tokenlen)) & CONST_TYPE) - value = id_const(tokenstr, tokenlen); - else if (type & VAR_TYPE) - value = id_tag(tokenstr, tokenlen); - else if (type & FUNC_TYPE) - value = id_tag(tokenstr, tokenlen); else - { - printf("Bad ID type\n"); - return (0); - } + break; } - else if (scantoken == CLOSE_PAREN_TOKEN) - { - // type |= WORD_TYPE; - emit_value = 1; - } - else if (scantoken == STRING_TOKEN) + /* + * Determine which value type. + */ + if (scantoken == STRING_TOKEN) { /* * This is a special case. Just emit the string and return */ - emit_conststr(constval, tokenlen - 1); + codeseq = gen_str(codeseq, constval, tokenlen - 1); scan(); - return WORD_TYPE; + return (codeseq); } - else - return (0); - if (type & CONST_TYPE) + if (scantoken == INT_TOKEN || scantoken == CHAR_TOKEN) { - /* - * Quick optimizations - */ - while ((optos < opsptr) - && ((tos_op() == NEG_TOKEN) || (tos_op() == COMP_TOKEN) || (tos_op() == LOGIC_NOT_TOKEN))) + value = constval; + type |= CONST_TYPE; + valseq = gen_const(NULL, value); + } + else if (scantoken == ID_TOKEN) + { + if ((type |= id_type(tokenstr, tokenlen)) & CONST_TYPE) { - switch (pop_op()) - { - case NEG_TOKEN: - value = -value; - break; - case COMP_TOKEN: - value = ~value; - break; - case LOGIC_NOT_TOKEN: - value = value ? 0 : -1; - break; - } + value = id_const(tokenstr, tokenlen); + valseq = gen_const(NULL, value); + } + else //if (type & (VAR_TYPE | FUNC_TYPE)) + { + value = id_tag(tokenstr, tokenlen); + if (type & LOCAL_TYPE) + valseq = gen_lcladr(NULL, value); + else + valseq = gen_gbladr(NULL, value, type); + } + if (type & FUNC_TYPE) + { + cfnparms = funcparms_cnt(type); + cfnvals = funcvals_cnt(type); } } - /* - * Parse post operand operators. - */ - ref_type = type & ~PTR_TYPE; - ref_offset = 0; - while (scan() == OPEN_PAREN_TOKEN - || scantoken == OPEN_BRACKET_TOKEN - || scantoken == PTRB_TOKEN - || scantoken == PTRW_TOKEN - || scantoken == DOT_TOKEN - || scantoken == COLON_TOKEN) + else if (scantoken == OPEN_PAREN_TOKEN) { - switch (scantoken) + if (!(valseq = parse_expr(NULL, stackdepth))) { - case OPEN_PAREN_TOKEN: + parse_error("Bad expression in parenthesis"); + return (NULL); + } + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Missing closing parenthesis"); + return (NULL); + } + } + else + return (NULL); + /* + * Parse post operators. + */ + while (scan()) + { + if (scantoken == OPEN_PAREN_TOKEN) + { + /* + * Function call - parameters generate before call address + */ + valseq = cat_seq(parse_list(NULL, &value), valseq); + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Missing closing parenthesis"); + return (NULL); + } + if (scan() == POUND_TOKEN) + { /* - * Function call + * Override return vals count */ - if (emit_value) + if (!parse_const(&cfnvals)) { - if (ref_offset != 0) - { - emit_const(ref_offset); - emit_op(ADD_TOKEN); - ref_offset = 0; - } - if (ref_type & PTR_TYPE) - (ref_type & BPTR_TYPE) ? emit_lb() : emit_lw(); - if (scan_lookahead() != CLOSE_PAREN_TOKEN) - emit_push(); - } - cparams = 0; - while (parse_expr()) - { - cparams++; - if (scantoken != COMMA_TOKEN) - break; - } - if (scantoken != CLOSE_PAREN_TOKEN) - { - parse_error("Missing closing parenthesis"); + parse_error("Invalid def return value count"); return (0); } - if (ref_type & (FUNC_TYPE | CONST_TYPE)) - emit_call(value, ref_type); - else - { - if (!emit_value) - { - if (type & CONST_TYPE) - emit_const(value); - else if (type & VAR_TYPE) - { - if (type & LOCAL_TYPE) - emit_llw(value + ref_offset); - else - emit_law(value, ref_offset, type); - ref_offset = 0; - } - } - else - if (cparams) - emit_pull(); - emit_ical(); - } - emit_value = 1; - ref_type = 0; - break; - case OPEN_BRACKET_TOKEN: + } + else + scan_rewind(tokenstr); + if (cfnparms && (cfnparms != value)) + parse_warn("Parameter count mismatch"); + if (stackdepth) + *stackdepth = cfnvals + cfnparms - value; + if (type & (VAR_TYPE | PTR_TYPE)) //!(type & (FUNC_TYPE | CONST_TYPE))) + { + valseq = gen_lw(valseq); + if (deref) + deref--; + } + valseq = gen_icall(valseq); + if (stackdepth) + *stackdepth = cfnvals; + cfnvals = 1; + type &= ~FUNC_TYPE; + } + else if (scantoken == OPEN_BRACKET_TOKEN) + { + /* + * Array of arrays + */ + if (type & FUNC_TYPE) + { /* - * Array of arrays + * Function call dereference */ - if (!emit_value) - { - if (type & CONST_TYPE) - emit_const(value); - else if (type & ADDR_TYPE) - { - if (type & LOCAL_TYPE) - emit_localaddr(value + ref_offset); - else - emit_globaladdr(value, ref_offset, type); - ref_offset = 0; - } - else - { - parse_error("Bad index reference"); - return (0); - } - emit_value = 1; - } - else - { - if (ref_offset != 0) - { - emit_const(ref_offset); - emit_op(ADD_TOKEN); - ref_offset = 0; - } - } - while (parse_expr()) - { - if (scantoken != COMMA_TOKEN) - break; - emit_indexword(); - emit_lw(); - } - if (scantoken != CLOSE_BRACKET_TOKEN) - { - parse_error("Missing closing bracket"); - return (0); - } - if (ref_type & (WPTR_TYPE | WORD_TYPE)) - { - emit_indexword(); - ref_type = WPTR_TYPE; - } - else - { - emit_indexbyte(); - ref_type = BPTR_TYPE; - } - break; - case PTRB_TOKEN: - case PTRW_TOKEN: + valseq = gen_icall(valseq); + if (stackdepth) + *stackdepth = cfnvals; + } + while ((idxseq = parse_expr(NULL, stackdepth))) + { + valseq = cat_seq(valseq, idxseq); + if (scantoken != COMMA_TOKEN) + break; + valseq = gen_idxw(valseq); + valseq = gen_lw(valseq); + } + if (scantoken != CLOSE_BRACKET_TOKEN) + { + parse_error("Missing closing bracket"); + return (NULL); + } + if (type & (WPTR_TYPE | WORD_TYPE)) + { + valseq = gen_idxw(valseq); + type = WPTR_TYPE; + } + else + { + valseq = gen_idxb(valseq); + type = BPTR_TYPE; + } + } + else if (scantoken == PTRB_TOKEN || scantoken == PTRW_TOKEN) + { + /* + * Pointer to structure/array + */ + if (type & FUNC_TYPE) + { + /* + * Function call dereference + */ + valseq = gen_icall(valseq); + if (stackdepth) + *stackdepth = cfnvals; + type &= ~FUNC_TYPE; + } + else if (type & VAR_TYPE) + { + /* + * Pointer dereference + */ + valseq = gen_lw(valseq); + } + type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE; + if (!parse_const(&const_offset)) + { + /* + * Setting type override for following operations + */ + scan_rewind(tokenstr); + } + else if (const_offset != 0) + { /* * Structure member pointer */ - if (!emit_value) - { - if (type & CONST_TYPE) - emit_const(value); - else if (type & ADDR_TYPE) - { - if (type & LOCAL_TYPE) - (ref_type & BYTE_TYPE) ? emit_llb(value + ref_offset) : emit_llw(value + ref_offset); - else - (ref_type & BYTE_TYPE) ? emit_lab(value, ref_offset, type) : emit_law(value, ref_offset, type); - } - emit_value = 1; - } - else - { - if (ref_offset != 0) - { - emit_const(ref_offset); - emit_op(ADD_TOKEN); - } - if (ref_type & PTR_TYPE) - (ref_type & BPTR_TYPE) ? emit_lb() : emit_lw(); - } - ref_offset = 0; - ref_type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE; - if (!parse_const(&ref_offset)) - scan_rewind(tokenstr); - if (ref_offset != 0) - { - emit_const(ref_offset); - emit_op(ADD_TOKEN); - ref_offset = 0; - } - break; - case DOT_TOKEN: - case COLON_TOKEN: + valseq = gen_const(valseq, const_offset); + valseq = gen_op(valseq, ADD_TOKEN); + } + } + else if (scantoken == DOT_TOKEN || scantoken == COLON_TOKEN) + { + /* + * Structure/array offset + */ + if (type & FUNC_TYPE) + { + /* + * Function call dereference + */ + valseq = gen_icall(valseq); + if (stackdepth) + *stackdepth = cfnvals; + type &= ~FUNC_TYPE; + } + type = (type & (VAR_TYPE | CONST_TYPE)) + ? ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE) + : ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE); + if (!parse_const(&const_offset)) + { + /* + * Setting type override for following operations + */ + scan_rewind(tokenstr); + } + else if (const_offset != 0) + { /* * Structure member offset */ - ref_type = (ref_type & (VAR_TYPE | CONST_TYPE)) - ? ((scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE) - : ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE); - if (parse_const(&const_offset)) - ref_offset += const_offset; - else - scan_rewind(tokenstr); - if (!emit_value) - { - if (type & CONST_TYPE) - { - value += ref_offset; - ref_offset = 0; - } - else if (type & FUNC_TYPE) - { - emit_globaladdr(value, ref_offset, type); - ref_offset = 0; - emit_value = 1; - } - } - break; - } - } - if (emit_value) - { - if (ref_offset != 0) - { - emit_const(ref_offset); - emit_op(ADD_TOKEN); - ref_offset = 0; - } - if (deref) - { - if (ref_type & BPTR_TYPE) emit_lb(); - else if (ref_type & WPTR_TYPE) emit_lw(); - } - } - else - { - if (deref) - { - if (type & CONST_TYPE) - { - emit_const(value); - if (ref_type & VAR_TYPE) - (ref_type & BYTE_TYPE) ? emit_lb() : emit_lw(); - } - else if (type & FUNC_TYPE) - emit_call(value, ref_type); - else if (type & VAR_TYPE) - { - if (type & LOCAL_TYPE) - (ref_type & BYTE_TYPE) ? emit_llb(value + ref_offset) : emit_llw(value + ref_offset); - else - (ref_type & BYTE_TYPE) ? emit_lab(value, ref_offset, ref_type) : emit_law(value, ref_offset, ref_type); + valseq = gen_const(valseq, const_offset); + valseq = gen_op(valseq, ADD_TOKEN); } } else - { - if (type & CONST_TYPE) - emit_const(value); - else if (type & ADDR_TYPE) - { - if (type & LOCAL_TYPE) - emit_localaddr(value + ref_offset); - else - emit_globaladdr(value, ref_offset, ref_type); - } - } + break; } - while (optos < opsptr) + /* + * Resolve outstanding dereference pointer loads + */ + while (deref > rvalue) { - if (!emit_unaryop(pop_op())) + deref--; + if (type & FUNC_TYPE) { - parse_error(": Invalid unary operation"); - return (0); + valseq = gen_icall(valseq); + if (stackdepth) + *stackdepth = cfnvals; + type &= ~FUNC_TYPE; + } + else if (type & VAR_TYPE) + valseq = gen_lw(valseq); + } + if (deref) + { + if (type & FUNC_TYPE) + { + valseq = gen_icall(valseq); + if (stackdepth) + *stackdepth = cfnvals; + type &= ~FUNC_TYPE; + } + else if (type & (BYTE_TYPE | BPTR_TYPE)) + valseq = gen_lb(valseq); + else if (type & (WORD_TYPE | WPTR_TYPE)) + valseq = gen_lw(valseq); + } + /* + * Output pre-operations + */ + valseq = cat_seq(valseq, uopseq); + /* + * Wrap up LVALUE store + */ + if (!rvalue) + { + if (type & (BYTE_TYPE | BPTR_TYPE)) + valseq = gen_sb(valseq); + else if (type & (WORD_TYPE | WPTR_TYPE)) + valseq = gen_sw(valseq); + else + { + release_seq(valseq); + return (NULL); // Function or const cannot be LVALUE, must be RVALUE } } - if (type & PTR_TYPE) - ref_type = type; - return (ref_type ? ref_type : WORD_TYPE); + return (cat_seq(codeseq, valseq)); } -int parse_expr() +t_opseq *parse_expr(t_opseq *codeseq, int *stackdepth) { int prevmatch; int matchop = 0; int optos = opsptr; - int i; + int i, valdepth; int prevtype, type = 0; + t_opseq *valseq; + + if (stackdepth) + *stackdepth = 0; do { /* @@ -747,42 +686,85 @@ int parse_expr() */ prevmatch = matchop; matchop = 0; - if (parse_value(1)) + if ((valseq = parse_value(NULL, RVALUE, &valdepth))) { + codeseq = cat_seq(codeseq, valseq); matchop = 1; + if (stackdepth) + *stackdepth += valdepth; for (i = 0; i < sizeof(binary_ops_table); i++) if (scantoken == binary_ops_table[i]) { matchop = 2; if (binary_ops_precedence[i] >= tos_op_prec(optos)) - if (!emit_op(pop_op())) - { - parse_error(": Invalid binary operation"); - return (0); - } + { + codeseq = gen_op(codeseq, pop_op()); + if (stackdepth) + (*stackdepth)--; + } push_op(scantoken, binary_ops_precedence[i]); break; } } - } - while (matchop == 2); + } while (matchop == 2); if (matchop == 0 && prevmatch == 2) { parse_error("Missing operand"); - return (0); + return (NULL); } while (optos < opsptr) - if (!emit_op(pop_op())) - { - parse_error(": Invalid binary operation"); - return (0); - } - return (matchop || prevmatch); + { + codeseq = gen_op(codeseq, pop_op()); + if (stackdepth) + (*stackdepth)--; + } + return (codeseq); +} +t_opseq *parse_set(t_opseq *codeseq) +{ + char *setptr = tokenstr; + int lparms = 0, rparms = 0; + int i; + t_opseq *setseq[16], *rseq = NULL; + + while ((setseq[lparms] = parse_value(NULL, LVALUE, NULL))) + { + lparms++; + if (scantoken != COMMA_TOKEN) + break; + } + if (lparms == 0 || scantoken != SET_TOKEN) + { + tokenstr = setptr; + scan_rewind(tokenstr); + while (lparms--) + release_seq(setseq[lparms]); + return (NULL); + } + rseq = parse_list(NULL, &rparms); + if (lparms > rparms) + { + parse_error("Set value list underflow"); + return (NULL); + } + if ((lparms != rparms) && (rparms - lparms != 1)) + codeseq = gen_pushexp(codeseq); + codeseq = cat_seq(codeseq, rseq); + for (i = lparms - 1; i >= 0; i--) + codeseq = cat_seq(codeseq, setseq[i]); + if (lparms != rparms) + { + if (rparms - lparms == 1) + codeseq = gen_drop(codeseq); + else + codeseq = gen_pullexp(codeseq); + } + return (codeseq); } int parse_stmnt(void) { int tag_prevbrk, tag_prevcnt, tag_else, tag_endif, tag_while, tag_wend, tag_repeat, tag_for, tag_choice, tag_of; - int type, addr, step; + int type, addr, step, cfnvals; char *idptr; /* @@ -793,7 +775,7 @@ int parse_stmnt(void) switch (scantoken) { case IF_TOKEN: - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad expression"); return (0); @@ -802,21 +784,21 @@ int parse_stmnt(void) tag_endif = tag_new(BRANCH_TYPE); emit_brfls(tag_else); scan(); - do { + do + { while (parse_stmnt()) next_line(); if (scantoken != ELSEIF_TOKEN) break; emit_brnch(tag_endif); emit_codetag(tag_else); - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad expression"); return (0); } tag_else = tag_new(BRANCH_TYPE); emit_brfls(tag_else); - } - while (1); + } while (1); if (scantoken == ELSE_TOKEN) { emit_brnch(tag_endif); @@ -844,7 +826,7 @@ int parse_stmnt(void) tag_prevbrk = break_tag; break_tag = tag_wend; emit_codetag(tag_while); - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad expression"); return (0); @@ -877,7 +859,7 @@ int parse_stmnt(void) } emit_codetag(cont_tag); cont_tag = tag_prevcnt; - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad expression"); return (0); @@ -905,7 +887,7 @@ int parse_stmnt(void) parse_error("Missing FOR ="); return (0); } - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad FOR expression"); return (0); @@ -914,7 +896,7 @@ int parse_stmnt(void) if (type & LOCAL_TYPE) type & BYTE_TYPE ? emit_dlb(addr) : emit_dlw(addr); else - type & BYTE_TYPE ? emit_dab(addr, type) : emit_daw(addr, type); + type & BYTE_TYPE ? emit_dab(addr, 0, type) : emit_daw(addr, 0, type); if (scantoken == TO_TOKEN) step = 1; else if (scantoken == DOWNTO_TOKEN) @@ -924,7 +906,7 @@ int parse_stmnt(void) parse_error("Missing FOR TO"); return (0); } - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad FOR TO expression"); return (0); @@ -932,7 +914,7 @@ int parse_stmnt(void) step > 0 ? emit_brgt(break_tag) : emit_brlt(break_tag); if (scantoken == STEP_TOKEN) { - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad FOR STEP expression"); return (0); @@ -960,7 +942,7 @@ int parse_stmnt(void) break_tag = tag_new(BRANCH_TYPE); tag_choice = tag_new(BRANCH_TYPE); tag_of = tag_new(BRANCH_TYPE); - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad CASE expression"); return (0); @@ -970,7 +952,7 @@ int parse_stmnt(void) { if (scantoken == OF_TOKEN) { - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) { parse_error("Bad CASE OF expression"); return (0); @@ -1037,13 +1019,17 @@ int parse_stmnt(void) int i; for (i = 0; i < stack_loop; i++) emit_drop(); - if (!parse_expr()) + cfnvals = 0; + emit_seq(parse_list(NULL, &cfnvals)); + if (cfnvals != infuncvals) + parse_warn("Inconsistent return value count"); + while (cfnvals++ < infuncvals) emit_const(0); emit_leave(); } else { - if (!parse_expr()) + if (!emit_seq(parse_expr(NULL, NULL))) emit_const(0); emit_ret(); } @@ -1064,123 +1050,46 @@ int parse_stmnt(void) case DONE_TOKEN: case DEF_TOKEN: return (0); - case ID_TOKEN: - idptr = tokenstr; - type = id_type(tokenstr, tokenlen); - addr = id_tag(tokenstr, tokenlen); - if (type & VAR_TYPE) - { - int elem_type = type; - long elem_offset = 0; - if (scan() == DOT_TOKEN || scantoken == COLON_TOKEN) - { - /* - * Structure member offset - */ - int elem_size; - elem_type = (scantoken == DOT_TOKEN) ? BYTE_TYPE : WORD_TYPE; - if (!parse_const(&elem_offset)) - scantoken = ID_TOKEN; - else - scan(); - } - if (scantoken == SET_TOKEN) - { - if (!parse_expr()) - { - parse_error("Bad expression"); - return (0); - } - if (type & LOCAL_TYPE) - (elem_type & BYTE_TYPE) ? emit_slb(addr + elem_offset) : emit_slw(addr + elem_offset); - else - (elem_type & BYTE_TYPE) ? emit_sab(addr, elem_offset, type) : emit_saw(addr, elem_offset, type); - break; - } - else if (scantoken == INC_TOKEN || scantoken == DEC_TOKEN) - { - if (type & LOCAL_TYPE) - { - if (elem_type & BYTE_TYPE) - { - emit_llb(addr + elem_offset); emit_unaryop(scantoken); emit_slb(addr + elem_offset); - } - else - { - emit_llw(addr + elem_offset); emit_unaryop(scantoken); emit_slw(addr + elem_offset); - } - } - else - { - if (elem_type & BYTE_TYPE) - { - emit_lab(addr, elem_offset, type); emit_unaryop(scantoken); emit_sab(addr, elem_offset, type); - } - else - { - emit_law(addr, elem_offset, type); emit_unaryop(scantoken); emit_saw(addr, elem_offset, type); - } - } - break; - } - } - else if (type & FUNC_TYPE) - { - if (scan() == EOL_TOKEN) - { - emit_call(addr, type); - emit_drop(); - break; - } - } - tokenstr = idptr; default: scan_rewind(tokenstr); - if ((type = parse_value(0)) != 0) + if (!emit_seq(parse_set(NULL))) { - if (scantoken == SET_TOKEN) + t_opseq *rseq; + int stackdepth = 0; + idptr = tokenstr; + if ((rseq = parse_value(NULL, RVALUE, &stackdepth))) { - if (!parse_expr()) + if (scantoken == INC_TOKEN || scantoken == DEC_TOKEN) { - parse_error("Bad expression"); + emit_seq(rseq); + emit_unaryop(scantoken); + tokenstr = idptr; + scan_rewind(tokenstr); + emit_seq(parse_value(NULL, LVALUE, NULL)); + } + else if (scantoken != SET_TOKEN) + { + if (stackdepth > 1) + { + rseq = cat_seq(gen_pushexp(NULL), rseq); + rseq = cat_seq(rseq, gen_pullexp(NULL)); + } + else if (stackdepth == 1) + rseq = cat_seq(rseq, gen_drop(NULL)); + emit_seq(rseq); + } + else + { + parse_error("Invalid LVALUE"); return (0); } - if (type & LOCAL_TYPE) - (type & (BYTE_TYPE | BPTR_TYPE)) ? emit_sb() : emit_sw(); - else - (type & (BYTE_TYPE | BPTR_TYPE)) ? emit_sb() : emit_sw(); - } - else if (scantoken == INC_TOKEN || scantoken == DEC_TOKEN) - { - if (type & (BYTE_TYPE | BPTR_TYPE)) - { - emit_dup(); - emit_lb(); - emit_unaryop(scantoken); - emit_sb(); - } - else - { - emit_dup(); - emit_lw(); - emit_unaryop(scantoken); - emit_sw(); - } } else { - if (type & BPTR_TYPE) - emit_lb(); - else if (type & WPTR_TYPE) - emit_lw(); - emit_drop(); + parse_error("Syntax error"); + return (0); } } - else - { - parse_error("Syntax error"); - return (0); - } } if (scan() != EOL_TOKEN && scantoken != COMMENT_TOKEN) { @@ -1327,7 +1236,8 @@ int parse_struc(void) int parse_vars(int type) { long value; - int idlen, size; + int idlen, size, cfnparms; + long cfnvals; char *idstr; switch (scantoken) @@ -1412,20 +1322,77 @@ int parse_vars(int type) type |= PREDEF_TYPE; idstr = tokenstr; idlen = tokenlen; - idfunc_add(tokenstr, tokenlen, type, tag_new(type)); - while (scan() == COMMA_TOKEN) + cfnparms = 0; + cfnvals = 1; // Default to one return value for compatibility + if (scan() == OPEN_PAREN_TOKEN) + { + do + { + if (scan() == ID_TOKEN) + { + cfnparms++; + scan(); + } + } while (scantoken == COMMA_TOKEN); + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Bad function parameter list"); + return (0); + } + scan(); + } + if (scantoken == POUND_TOKEN) + { + if (!parse_const(&cfnvals)) + { + parse_error("Invalid def return value count"); + return (0); + } + } + type |= funcparms_type(cfnparms) | funcvals_type(cfnvals); + idfunc_add(idstr, idlen, type, tag_new(type)); + while (scantoken == COMMA_TOKEN) { if (scan() == ID_TOKEN) { idstr = tokenstr; idlen = tokenlen; - idfunc_add(tokenstr, tokenlen, type, tag_new(type)); + cfnparms = 0; + cfnvals = 1; // Default to one return value for compatibility + if (scan() == OPEN_PAREN_TOKEN) + { + do + { + if (scan() == ID_TOKEN) + { + cfnparms++; + scan(); + } + } while (scantoken == COMMA_TOKEN); + if (scantoken != CLOSE_PAREN_TOKEN) + { + parse_error("Bad function parameter list"); + return (0); + } + scan(); + } + if (scantoken == POUND_TOKEN) + { + if (!parse_const(&cfnvals)) + { + parse_error("Invalid def return value count"); + return (0); + } + } + type |= funcparms_type(cfnparms) | funcvals_type(cfnvals); + idfunc_add(idstr, idlen, type, tag_new(type)); } else { parse_error("Bad function pre-declaration"); return (0); } + //scan(); } } else @@ -1471,8 +1438,8 @@ int parse_mods(void) } int parse_defs(void) { - char c; - int func_tag, cfnparms, type = GLOBAL_TYPE; + char c, *idstr; + int idlen, func_tag, cfnparms, cfnvals, type = GLOBAL_TYPE, pretype; static char bytecode = 0; if (scantoken == EXPORT_TOKEN) { @@ -1493,29 +1460,15 @@ int parse_defs(void) emit_bytecode_seg(); bytecode = 1; cfnparms = 0; + infuncvals = 1; // Defaut to one return value for compatibility infunc = 1; type |= DEF_TYPE; - if (idglobal_lookup(tokenstr, tokenlen) >= 0) - { - if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE)) - { - parse_error("Mismatch function type"); - return (0); - } - emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr); - func_tag = tag_new(type); - idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag - } - else - { - func_tag = tag_new(type); - idfunc_add(tokenstr, tokenlen, type, func_tag); - } - c = tokenstr[tokenlen]; - tokenstr[tokenlen] = '\0'; - emit_idfunc(func_tag, type, tokenstr); - emit_def(tokenstr, 1); - tokenstr[tokenlen] = c; + idstr = tokenstr; + idlen = tokenlen; + idlocal_reset(); + /* + * Parse parameters and return value count + */ if (scan() == OPEN_PAREN_TOKEN) { do @@ -1534,6 +1487,42 @@ int parse_defs(void) } scan(); } + if (scantoken == POUND_TOKEN) + { + if (!parse_const(&infuncvals)) + { + parse_error("Invalid def return value count"); + return (0); + } + scan(); + } + type |= funcparms_type(cfnparms) | funcvals_type(infuncvals); + if (idglobal_lookup(idstr, idlen) >= 0) + { + pretype = id_type(idstr, idlen); + if (!(pretype & PREDEF_TYPE)) + { + parse_error("Mismatch function type"); + return (0); + } + if ((pretype & FUNC_PARMVALS) != (type & FUNC_PARMVALS)) + parse_warn("Mismatch function params/return values"); + emit_idfunc(id_tag(idstr, idlen), PREDEF_TYPE, idstr, 0); + func_tag = tag_new(type); + idfunc_set(idstr, idlen, type, func_tag); // Override any predef type & tag + } + else + { + func_tag = tag_new(type); + idfunc_add(idstr, idlen, type, func_tag); + } + c = idstr[idlen]; + idstr[idlen] = '\0'; + emit_idfunc(func_tag, type, idstr, 1); + idstr[idlen] = c; + /* + * Parse local vars + */ while (parse_vars(LOCAL_TYPE)) next_line(); emit_enter(cfnparms); prevstmnt = 0; @@ -1551,7 +1540,10 @@ int parse_defs(void) } if (prevstmnt != RETURN_TOKEN) { - emit_const(0); + if (infuncvals) + parse_warn("Inconsistent return value count"); + for (cfnvals = 0; cfnvals < infuncvals; cfnvals++) + emit_const(0); emit_leave(); } return (1); @@ -1569,29 +1561,12 @@ int parse_defs(void) return (0); } cfnparms = 0; + infuncvals = 1; // Defaut to one return value for compatibility infunc = 1; type |= ASM_TYPE; - if (idglobal_lookup(tokenstr, tokenlen) >= 0) - { - if (!(id_type(tokenstr, tokenlen) & PREDEF_TYPE)) - { - parse_error("Mismatch function type"); - return (0); - } - emit_idfunc(id_tag(tokenstr, tokenlen), PREDEF_TYPE, tokenstr); - func_tag = tag_new(type); - idfunc_set(tokenstr, tokenlen, type, func_tag); // Override any predef type & tag - } - else - { - func_tag = tag_new(type); - idfunc_add(tokenstr, tokenlen, type, func_tag); - } - c = tokenstr[tokenlen]; - tokenstr[tokenlen] = '\0'; - emit_idfunc(func_tag, type, tokenstr); - emit_def(tokenstr, 0); - tokenstr[tokenlen] = c; + idstr = tokenstr; + idlen = tokenlen; + idlocal_reset(); if (scan() == OPEN_PAREN_TOKEN) { do @@ -1599,7 +1574,6 @@ int parse_defs(void) if (scan() == ID_TOKEN) { cfnparms++; - idlocal_add(tokenstr, tokenlen, WORD_TYPE, 2); scan(); } } @@ -1611,6 +1585,38 @@ int parse_defs(void) } scan(); } + if (scantoken == POUND_TOKEN) + { + if (!parse_const(&infuncvals)) + { + parse_error("Invalid def return value count"); + return (0); + } + } + type |= funcparms_type(cfnparms) | funcvals_type(infuncvals); + if (idglobal_lookup(idstr, idlen) >= 0) + { + pretype = id_type(idstr, idlen); + if (!(pretype & PREDEF_TYPE)) + { + parse_error("Mismatch function type"); + return (0); + } + if ((pretype & FUNC_PARMVALS) != (type & FUNC_PARMVALS)) + parse_warn("Mismatch function params/return values"); + emit_idfunc(id_tag(idstr, idlen), PREDEF_TYPE, idstr, 0); + func_tag = tag_new(type); + idfunc_set(idstr, idlen, type, func_tag); // Override any predef type & tag + } + else + { + func_tag = tag_new(type); + idfunc_add(idstr, idlen, type, func_tag); + } + c = tokenstr[idlen]; + tokenstr[idlen] = '\0'; + emit_idfunc(func_tag, type, idstr, 0); + idstr[idlen] = c; do { if (scantoken == EOL_TOKEN || scantoken == COMMENT_TOKEN) @@ -1640,7 +1646,8 @@ int parse_module(void) { emit_bytecode_seg(); emit_start(); - emit_def("_INIT", 1); + idlocal_reset(); + emit_idfunc(0, 0, NULL, 1); prevstmnt = 0; while (parse_stmnt()) next_line(); if (scantoken != DONE_TOKEN) diff --git a/src/toolsrc/plasm.c b/src/toolsrc/plasm.c index 2416456..d111694 100755 --- a/src/toolsrc/plasm.c +++ b/src/toolsrc/plasm.c @@ -1,8 +1,7 @@ #include -#include "tokens.h" -#include "lex.h" -#include "codegen.h" -#include "parse.h" +#include "plasm.h" + +int outflags = 0; int main(int argc, char **argv) { @@ -10,23 +9,28 @@ int main(int argc, char **argv) for (i = 1; i < argc; i++) { if (argv[i][0] == '-') - { + { j = 1; while (argv[i][j]) { switch(argv[i][j++]) { case 'A': - flags |= ACME; + outflags |= ACME; break; case 'M': - flags |= MODULE; + outflags |= MODULE; break; + case 'O': + outflags |= OPTIMIZE; + break; + case 'W': + outflags |= WARNINGS; } } } } - emit_flags(flags); + emit_flags(outflags); if (parse_module()) { fprintf(stderr, "Compilation complete.\n"); diff --git a/src/toolsrc/plasm.h b/src/toolsrc/plasm.h new file mode 100755 index 0000000..f3c4432 --- /dev/null +++ b/src/toolsrc/plasm.h @@ -0,0 +1,16 @@ +/* + * Global flags. + */ +#define ACME (1<<0) +#define MODULE (1<<1) +#define OPTIMIZE (1<<2) +#define BYTECODE_SEG (1<<3) +#define INIT (1<<4) +#define SYSFLAGS (1<<5) +#define WARNINGS (1<<6) +extern int outflags; +#include "tokens.h" +#include "lex.h" +#include "symbols.h" +#include "parse.h" +#include "codegen.h" diff --git a/src/toolsrc/symbols.h b/src/toolsrc/symbols.h index 4fd5251..5828901 100755 --- a/src/toolsrc/symbols.h +++ b/src/toolsrc/symbols.h @@ -10,7 +10,7 @@ #define DEF_TYPE (1 << 4) #define BRANCH_TYPE (1 << 5) #define LOCAL_TYPE (1 << 6) -#define EXTERN_TYPE (1 << 7) +#define EXTERN_TYPE (1 << 7) #define ADDR_TYPE (VAR_TYPE | FUNC_TYPE | EXTERN_TYPE) #define WPTR_TYPE (1 << 8) #define BPTR_TYPE (1 << 9) @@ -18,8 +18,16 @@ #define STRING_TYPE (1 << 10) #define TAG_TYPE (1 << 11) #define EXPORT_TYPE (1 << 12) -#define PREDEF_TYPE (1 << 13) +#define PREDEF_TYPE (1 << 13) #define FUNC_TYPE (ASM_TYPE | DEF_TYPE | PREDEF_TYPE) +#define FUNC_PARMS (0x0F << 16) +#define FUNC_VALS (0x0F << 20) +#define FUNC_PARMVALS (FUNC_PARMS|FUNC_VALS) +#define funcparms_type(p) (((p)&0x0F)<<16) +#define funcparms_cnt(t) (((t)>>16)&0x0F) +#define funcvals_type(v) (((v)&0x0F)<<20) +#define funcvals_cnt(t) (((t)>>20)&0x0F) + int id_match(char *name, int len, char *id); int idlocal_lookup(char *name, int len); int idglobal_lookup(char *name, int len); @@ -27,6 +35,7 @@ int idconst_lookup(char *name, int len); int idlocal_add(char *name, int len, int type, int size); int idglobal_add(char *name, int len, int type, int size); int id_add(char *name, int len, int type, int size); +void idlocal_reset(void); int idfunc_set(char *name, int len, int type, int tag); int idfunc_add(char *name, int len, int type, int tag); int idconst_add(char *name, int len, int value); diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla old mode 100644 new mode 100755 index b2ce603..ed61cb1 --- a/src/vmsrc/a1cmd.pla +++ b/src/vmsrc/a1cmd.pla @@ -39,7 +39,7 @@ predef loadmod, execmod, lookupstrmod // // System variables. // -word version = $0094 // 00.94 +word version = $0099 // 00.99 word systemflags = 0 word heap word symtbl, lastsym @@ -90,18 +90,18 @@ byte execstr[] = "MODEXEC" byte modadrstr[] = "MODADDR" byte argstr[] = "ARGS" word exports[] = @sysstr, @syscall -word = @callstr, @call -word = @putcstr, @cout +word = @callstr, @call +word = @putcstr, @cout word = @putlnstr, @crout -word = @putsstr, @prstr -word = @getcstr, @cin -word = @getsstr, @rdstr -word = @hpmarkstr, @markheap -word = @hpallocstr,@allocheap -word = @hpalignstr,@allocalignheap -word = @hprelstr, @releaseheap -word = @memsetstr, @memset -word = @memcpystr, @memcpy +word = @putsstr, @prstr +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy word = @uisgtstr, @uword_isgt word = @uisgestr, @uword_isge word = @uisltstr, @uword_islt @@ -112,21 +112,21 @@ word = @modadrstr, @lookupstrmod word = @machidstr, @machid word = @argstr, @cmdptr word = 0 -word syslibsym = @exports +word syslibsym = @exports // // CALL CFFA1 API ENTRYPOINT // SYSCALL(CMD) // asm syscall - LDA ESTKL,X - STX ESP - TAX - JSR $900C - LDX ESP - LDY #$00 - STA ESTKL,X - STY ESTKH,X - RTS + LDA ESTKL,X + STX ESP + TAX + JSR $900C + LDX ESP + LDY #$00 + STA ESTKL,X + STY ESTKH,X + RTS end // // CALL 6502 ROUTINE @@ -351,7 +351,7 @@ asm interp STA ESTKH,X RTS end -// +// // A DCI string is one that has the high bit set for every character except the last. // More efficient than C or Pascal strings. // @@ -650,7 +650,7 @@ end def finddirentry(filename) *CFFAFileName = filename perr = syscall($14) - return *CFFAEntryPtr + return *CFFAEntryPtr end def readfile(filename, buffer) *CFFADest = buffer @@ -783,12 +783,12 @@ def loadmod(mod) fin if rdlen > 0 readfile(@filename, heap) - memcpy(@header, heap, 128) - modsize = header:0 - moddep = @header.1 - defofst = modsize + memcpy(@header, heap, 128) + modsize = header:0 + moddep = @header.1 + defofst = modsize init = 0 - if rdlen > 4 and heap=>2 == $DA7E // DAVE = magic number :-) + if rdlen > 4 and heap=>2 == $DA7F // DAVE+1 = magic number :-) // // This is an EXTended RELocatable (data+bytecode) module. // @@ -796,44 +796,46 @@ def loadmod(mod) defcnt = header:8 init = header:10 moddep = @header.12 - // - // Load module dependencies. - // + // + // Load module dependencies. + // while ^moddep if !lookupmod(moddep) if loadmod(moddep) < 0 - return -perr - fin + return -perr + fin fin moddep = moddep + dcitos(moddep, @str) loop - // - // Init def table. - // - deftbl = allocheap(defcnt * 5 + 1) - deflast = deftbl - ^deflast = 0 - // - // Re-read file - // - readfile(@filename, heap) + // + // Init def table. + // + deftbl = allocheap(defcnt * 5 + 1) + deflast = deftbl + ^deflast = 0 + // + // Re-read file + // + readfile(@filename, heap) + else + return -69 fin - // - // Alloc heap space for relocated module (data + bytecode). - // - moddep = moddep + 1 - @header + heap - modfix = moddep - (heap + 2) // Adjust to skip header - modsize = modsize - modfix - rdlen = rdlen - modfix - 2 - modaddr = allocheap(modsize) - memcpy(modaddr, moddep, rdlen) - // - // Add module to symbol table. - // - addmod(mod, modaddr) - // - // Apply all fixups and symbol import/export. - // + // + // Alloc heap space for relocated module (data + bytecode). + // + moddep = moddep + 1 - @header + heap + modfix = moddep - (heap + 2) // Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + // + // Add module to symbol table. + // + addmod(mod, modaddr) + // + // Apply all fixups and symbol import/export. + // modfix = modaddr - modfix bytecode = defofst + modfix - MODADDR modend = modaddr + modsize @@ -841,16 +843,16 @@ def loadmod(mod) esd = rld // Extern+Entry Symbol Directory while ^esd // Scan to end of ESD esd = esd + 4 - loop + loop esd = esd + 1 // // Run through the Re-Location Dictionary. // while ^rld if ^rld == $02 - // - // This is a bytcode def entry - add it to the def directory. - // + // + // This is a bytcode def entry - add it to the def directory. + // adddef(rld=>1 - defofst + bytecode, @deflast) else addr = rld=>1 + modfix @@ -880,21 +882,21 @@ def loadmod(mod) fin rld = rld + 4 loop - // + // // Run through the External/Entry Symbol Directory. - // + // while ^esd sym = esd esd = esd + dcitos(esd, @str) if ^esd & $08 - // + // // EXPORT symbol - add it to the global symbol table. - // + // addr = esd=>1 + modfix - MODADDR if uword_isge(addr, bytecode) - // - // Use the def directory address for bytecode. - // + // + // Use the def directory address for bytecode. + // addr = lookupdef(addr - bytecode + bytecode, deftbl) fin addsym(sym, addr) @@ -910,13 +912,13 @@ def loadmod(mod) // fixup = 0 if init - fixup = adddef(init - defofst + bytecode, @deflast)() - if fixup < 0 - perr = -fixup - fin - if !(systemflags & modinitkeep) + fixup = adddef(init - defofst + bytecode, @deflast)() + if fixup < 0 + perr = -fixup + fin + if !(systemflags & modinitkeep) modend = init - defofst + bytecode - fin + fin fin // // Free up the end-of-module in main memory. diff --git a/src/vmsrc/cmd.pla b/src/vmsrc/cmd.pla old mode 100644 new mode 100755 index 8ed47a6..14c9201 --- a/src/vmsrc/cmd.pla +++ b/src/vmsrc/cmd.pla @@ -33,7 +33,7 @@ predef loadmod, execmod, lookupstrmod // // System variable. // -word version = $0094 // 00.94 +word version = $0099 // 00.99 word systemflags = 0 word heap word xheap = $0800 @@ -68,19 +68,19 @@ byte modadrstr = "MODADDR" byte argstr = "ARGS" byte autorun = "AUTORUN" byte prefix[] // overlay with exported symbols table -word exports = @sysstr, @syscall -word = @callstr, @call -word = @putcstr, @cout +word exports = @sysstr, @syscall +word = @callstr, @call +word = @putcstr, @cout word = @putlnstr, @crout -word = @putsstr, @prstr -word = @getcstr, @cin -word = @getsstr, @rdstr -word = @hpmarkstr, @markheap -word = @hpallocstr,@allocheap -word = @hpalignstr,@allocalignheap -word = @hprelstr, @releaseheap -word = @memsetstr, @memset -word = @memcpystr, @memcpy +word = @putsstr, @prstr +word = @getcstr, @cin +word = @getsstr, @rdstr +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +word = @hprelstr, @releaseheap +word = @memsetstr, @memset +word = @memcpystr, @memcpy word = @uisgtstr, @uword_isgt word = @uisgestr, @uword_isge word = @uisltstr, @uword_islt @@ -101,27 +101,27 @@ word syslibsym = @exports // SYSCALL(CMD, PARAMS) // asm syscall - LDA ESTKL,X - LDY ESTKH,X - STA PARAMS - STY PARAMS+1 - INX - LDA ESTKL,X - STA CMD - JSR $BF00 -CMD: !BYTE 00 -PARAMS: !WORD 0000 - LDY #$00 - STA ESTKL,X - STY ESTKH,X - RTS + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + JSR $BF00 +CMD: !BYTE 00 +PARAMS: !WORD 0000 + LDY #$00 + STA ESTKL,X + STY ESTKH,X + RTS end // // CALL 6502 ROUTINE // CALL(ADDR, AREG, XREG, YREG, STATUS) // asm call -REGVALS = SRC +REGVALS = SRC PHP LDA ESTKL+4,X STA TMPL @@ -137,7 +137,7 @@ REGVALS = SRC INX INX INX - INX + INX STX ESP TAX PLA @@ -158,29 +158,29 @@ REGVALS = SRC STY ESTKH,X PLP RTS -JMPTMP JMP (TMP) +JMPTMP JMP (TMP) end // // CALL LOADED SYSTEM PROGRAM // asm exec - LDX #$00 - STX IFPL - LDA #$BF - STA IFPH - LDX #$FE - TXS - LDX #ESTKSZ/2 - BIT ROMEN - JMP $2000 + LDX #$00 + STX IFPL + LDA #$BF + STA IFPH + LDX #$FE + TXS + LDX #ESTKSZ/2 + BIT ROMEN + JMP $2000 end // // EXIT // asm reboot - BIT ROMEN - DEC $03F4 ; INVALIDATE POWER-UP BYTE - JMP ($FFFC) ; RESET + BIT ROMEN + DEC $03F4 ; INVALIDATE POWER-UP BYTE + JMP ($FFFC) ; RESET end // // SET MEMORY TO VALUE @@ -188,111 +188,111 @@ end // With optimizations from Peter Ferrie // asm memset - LDA ESTKL+2,X - STA DSTL - LDA ESTKH+2,X - STA DSTH - LDY ESTKL,X - BEQ + - INC ESTKH,X - LDY #$00 -+ LDA ESTKH,X - BEQ SETMEX -SETMLPL CLC - LDA ESTKL+1,X -SETMLPH STA (DST),Y - DEC ESTKL,X - BEQ ++ -- INY - BEQ + --- BCS SETMLPL - SEC - LDA ESTKH+1,X - BCS SETMLPH -+ INC DSTH - BNE -- -++ DEC ESTKH,X - BNE - -SETMEX INX - INX - RTS + LDA ESTKL+2,X + STA DSTL + LDA ESTKH+2,X + STA DSTH + LDY ESTKL,X + BEQ + + INC ESTKH,X + LDY #$00 ++ LDA ESTKH,X + BEQ SETMEX +SETMLPL CLC + LDA ESTKL+1,X +SETMLPH STA (DST),Y + DEC ESTKL,X + BEQ ++ +- INY + BEQ + +-- BCS SETMLPL + SEC + LDA ESTKH+1,X + BCS SETMLPH ++ INC DSTH + BNE -- +++ DEC ESTKH,X + BNE - +SETMEX INX + INX + RTS end // // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // asm memcpy - INX - INX - LDA ESTKL-2,X - ORA ESTKH-2,X - BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X - BCC REVCPY + INX + INX + LDA ESTKL-2,X + ORA ESTKH-2,X + BEQ CPYMEX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL-1,X - STA SRCL - LDA ESTKH-1,X - STA SRCH - LDY ESTKL-2,X - BEQ FORCPYLP - INC ESTKH-2,X - LDY #$00 -FORCPYLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL-2,X - BNE FORCPYLP - DEC ESTKH-2,X - BNE FORCPYLP - RTS + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL-1,X + STA SRCL + LDA ESTKH-1,X + STA SRCH + LDY ESTKL-2,X + BEQ FORCPYLP + INC ESTKH-2,X + LDY #$00 +FORCPYLP LDA (SRC),Y + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-2,X + BNE FORCPYLP + DEC ESTKH-2,X + BNE FORCPYLP + RTS ; ; REVERSE COPY ; -REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X - STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X - STA DSTH - CLC - LDA ESTKL-2,X - ADC ESTKL-1,X - STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X - STA SRCH - DEC DSTH - DEC SRCH - LDY #$FF - LDA ESTKL-2,X - BEQ REVCPYLP - INC ESTKH-2,X -REVCPYLP LDA (SRC),Y - STA (DST),Y - DEY - CPY #$FF - BNE + - DEC DSTH - DEC SRCH -+ DEC ESTKL-2,X - BNE REVCPYLP - DEC ESTKH-2,X - BNE REVCPYLP -CPYMEX RTS +REVCPY ;CLC + LDA ESTKL-2,X + ADC ESTKL,X + STA DSTL + LDA ESTKH-2,X + ADC ESTKH,X + STA DSTH + CLC + LDA ESTKL-2,X + ADC ESTKL-1,X + STA SRCL + LDA ESTKH-2,X + ADC ESTKH-1,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-2,X + BEQ REVCPYLP + INC ESTKH-2,X +REVCPYLP LDA (SRC),Y + STA (DST),Y + DEY + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-2,X + BNE REVCPYLP + DEC ESTKH-2,X + BNE REVCPYLP +CPYMEX RTS end // // COPY FROM MAIN MEM TO AUX MEM. @@ -300,191 +300,191 @@ end // MEMXCPY(DST, SRC, SIZE) // asm memxcpy - LDA ESTKL+1,X - STA $3C - CLC - ADC ESTKL,X - STA $3E - LDA ESTKH+1,X - STA $3D - ADC ESTKH,X - STA $3F - LDA ESTKL+2,X - STA $42 - LDA ESTKH+2,X - STA $43 - STX ESP - BIT ROMEN - SEC - JSR $C311 - BIT LCRDEN+LCBNK2 - LDX ESP - INX - INX - RTS + LDA ESTKL+1,X + STA $3C + CLC + ADC ESTKL,X + STA $3E + LDA ESTKH+1,X + STA $3D + ADC ESTKH,X + STA $3F + LDA ESTKL+2,X + STA $42 + LDA ESTKH+2,X + STA $43 + STX ESP + BIT ROMEN + SEC + JSR $C311 + BIT LCRDEN+LCBNK2 + LDX ESP + INX + INX + RTS end asm crout - DEX - LDA #$0D - BNE + - ; FALL THROUGH TO COUT + DEX + LDA #$0D + BNE + + ; FALL THROUGH TO COUT end // // CHAR OUT // COUT(CHAR) // asm cout - LDA ESTKL,X - BIT $BF98 - BMI + - JSR TOUPR -+ ORA #$80 - BIT ROMEN - JSR $FDED - BIT LCRDEN+LCBNK2 - RTS + LDA ESTKL,X + BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + BIT ROMEN + JSR $FDED + BIT LCRDEN+LCBNK2 + RTS end // // CHAR IN // RDKEY() // asm cin - BIT ROMEN - JSR $FD0C - BIT LCRDEN+LCBNK2 - DEX - LDY #$00 - AND #$7F - STA ESTKL,X - STY ESTKH,X - RTS + BIT ROMEN + JSR $FD0C + BIT LCRDEN+LCBNK2 + DEX + LDY #$00 + AND #$7F + STA ESTKL,X + STY ESTKH,X + RTS end // // PRINT STRING // PRSTR(STR) // asm prstr - LDY #$00 - LDA ESTKL,X - STA SRCL - LDA ESTKH,X - STA SRCH - LDA (SRC),Y - BEQ ++ - STA TMP - BIT ROMEN -- INY - LDA (SRC),Y - BIT $BF98 - BMI + - JSR TOUPR -+ ORA #$80 - JSR $FDED - CPY TMP - BNE - - BIT LCRDEN+LCBNK2 -++ RTS + LDY #$00 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDA (SRC),Y + BEQ ++ + STA TMP + BIT ROMEN +- INY + LDA (SRC),Y + BIT $BF98 + BMI + + JSR TOUPR ++ ORA #$80 + JSR $FDED + CPY TMP + BNE - + BIT LCRDEN+LCBNK2 +++ RTS end // // PRINT BYTE // asm prbyte - LDA ESTKL,X - STX ESP - BIT ROMEN - JSR $FDDA - LDX ESP - BIT LCRDEN+LCBNK2 - RTS + LDA ESTKL,X + STX ESP + BIT ROMEN + JSR $FDDA + LDX ESP + BIT LCRDEN+LCBNK2 + RTS end // // PRINT WORD // asm prword - STX ESP - TXA - TAY - LDA ESTKH,Y - LDX ESTKL,Y - BIT ROMEN - JSR $F941 - LDX ESP - BIT LCRDEN+LCBNK2 - RTS + STX ESP + TXA + TAY + LDA ESTKH,Y + LDX ESTKL,Y + BIT ROMEN + JSR $F941 + LDX ESP + BIT LCRDEN+LCBNK2 + RTS end // // READ STRING // STR = RDSTR(PROMPTCHAR) // asm rdstr - LDA ESTKL,X - STA $33 - STX ESP - BIT ROMEN - JSR $FD6A - STX $01FF -- LDA $01FF,X - AND #$7F - STA $01FF,X - DEX - BPL - - TXA - LDX ESP - STA ESTKL,X - LDA #$01 - STA ESTKH,X - BIT LCRDEN+LCBNK2 - RTS + LDA ESTKL,X + STA $33 + STX ESP + BIT ROMEN + JSR $FD6A + STX $01FF +- LDA $01FF,X + AND #$7F + STA $01FF,X + DEX + BPL - + TXA + LDX ESP + STA ESTKL,X + LDA #$01 + STA ESTKH,X + BIT LCRDEN+LCBNK2 + RTS end asm uword_isge - LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - LDA #$FF - ADC #$00 - EOR #$FF - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end asm uword_isle - LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - LDA #$FF - ADC #$00 - EOR #$FF - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + EOR #$FF + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end asm uword_isgt - LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - LDA #$FF - ADC #$00 - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end asm uword_islt - LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - LDA #$FF - ADC #$00 - STA ESTKL+1,X - STA ESTKH+1,X - INX - RTS + LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + LDA #$FF + ADC #$00 + STA ESTKL+1,X + STA ESTKH+1,X + INX + RTS end // // Utility routines. @@ -504,28 +504,28 @@ end // return len //end asm dcitos - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH - LDY #$00 -- LDA (SRC),Y - CMP #$80 - AND #$7F - INY - STA (DST),Y - BCS - - TYA - LDY #$00 - STA (DST),Y - INX - STA ESTKL,X - STY ESTKH,X - RTS + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + CMP #$80 + AND #$7F + INY + STA (DST),Y + BCS - + TYA + LDY #$00 + STA (DST),Y + INX + STA ESTKL,X + STY ESTKH,X + RTS end //def stodci(str, dci) // byte len, c @@ -537,50 +537,50 @@ end // len = len - 1 // (dci).[len] = c // while len -// c = toupper((str).[len]) | $80 -// len = len - 1 -// (dci).[len] = c +// c = toupper((str).[len]) | $80 +// len = len - 1 +// (dci).[len] = c // loop // return ^str //end asm stodci - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH - INX - LDY #$00 - LDA (SRC),Y - BEQ ++ - TAY - LDA (SRC),Y - JSR TOUPR - BNE + -- LDA (SRC),Y - JSR TOUPR - ORA #$80 -+ DEY - STA (DST),Y - BNE - - LDA (SRC),Y -++ STA ESTKL,X - STY ESTKH,X - RTS + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INX + LDY #$00 + LDA (SRC),Y + BEQ ++ + TAY + LDA (SRC),Y + JSR TOUPR + BNE + +- LDA (SRC),Y + JSR TOUPR + ORA #$80 ++ DEY + STA (DST),Y + BNE - + LDA (SRC),Y +++ STA ESTKL,X + STY ESTKH,X + RTS end asm toupper - LDA ESTKL,X -TOUPR AND #$7F - CMP #'a' - BCC + - CMP #'z'+1 - BCS + - SBC #$1F -+ STA ESTKL,X - RTS + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS end // // Module symbols are entered into the symbol table @@ -599,25 +599,25 @@ end // return dci //end asm modtosym - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH - LDA ESTKL,X - STA ESTKL+1,X - STA DSTL - LDA ESTKH,X - STA ESTKH+1,X - STA DSTH - INX - LDY #$00 - LDA #'#'+$80 -- STA (DST),Y - ASL - LDA (SRC),Y - INY - BCS - - RTS + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDA ESTKL,X + STA ESTKL+1,X + STA DSTL + LDA ESTKH,X + STA ESTKH+1,X + STA DSTH + INX + LDY #$00 + LDA #'#'+$80 +- STA (DST),Y + ASL + LDA (SRC),Y + INY + BCS - + RTS end // // Lookup routines. @@ -640,46 +640,46 @@ end // loop // return 0 asm lookuptbl - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH - LDY #$00 -- LDA (DST),Y - BEQ + - CMP (SRC),Y - BNE ++ - INY - ASL - BCS - - LDA (DST),Y - PHA - INY - LDA (DST),Y - TAY - PLA -+ INX - STA ESTKL,X - STY ESTKH,X - RTS -++ LDY #$00 --- LDA (DST),Y - INC DSTL - BEQ + ---- ASL - BCS -- - LDA #$02 - ADC DSTL - STA DSTL - BCC - - INC DSTH - BCS - -+ INC DSTH - BNE --- + LDA ESTKL,X + STA DSTL + LDA ESTKH,X + STA DSTH + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + LDY #$00 +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + ASL + BCS - + LDA (DST),Y + PHA + INY + LDA (DST),Y + TAY + PLA ++ INX + STA ESTKL,X + STY ESTKH,X + RTS +++ LDY #$00 +-- LDA (DST),Y + INC DSTL + BEQ + +--- ASL + BCS -- + LDA #$02 + ADC DSTL + STA DSTL + BCC - + INC DSTH + BCS - ++ INC DSTH + BNE --- end // // ProDOS routines @@ -743,15 +743,15 @@ def allocheap(size) heap = heap + size if systemflags & reshgr1 if uword_islt(addr, $4000) and uword_isgt(heap, $2000) - addr = $4000 - heap = addr + size - fin + addr = $4000 + heap = addr + size + fin fin if systemflags & reshgr2 if uword_islt(addr, $6000) and uword_isgt(heap, $4000) - addr = $6000 - heap = addr + size - fin + addr = $6000 + heap = addr + size + fin fin if uword_isge(heap, @addr) return 0 @@ -784,27 +784,27 @@ def allocxheap(size) xheap = xheap + size if systemflags & restxt1 if uword_isle(xaddr, $0800) and uword_isgt(xheap, $0400) - xaddr = $0800 - xheap = xaddr + size - fin + xaddr = $0800 + xheap = xaddr + size + fin fin if systemflags & restxt2 if uword_isle(xaddr, $0C00) and uword_isgt(xheap, $0800) - xaddr = $0C00 - xheap = xaddr + size - fin + xaddr = $0C00 + xheap = xaddr + size + fin fin if systemflags & resxhgr1 if uword_isle(xaddr, $4000) and uword_isgt(xheap, $2000) - xaddr = $4000 - xheap = xaddr + size - fin + xaddr = $4000 + xheap = xaddr + size + fin fin if systemflags & resxhgr2 if uword_isle(xaddr, $6000) and uword_isgt(xheap, $4000) - xaddr = $6000 - xheap = xaddr + size - fin + xaddr = $6000 + xheap = xaddr + size + fin fin if uword_isge(xheap, $BF00) return 0 @@ -852,12 +852,12 @@ def lookupextern(esd, index) esd = esd + dcitos(esd, @str) if esd->0 & $10 and esd->1 == index addr = lookupsym(sym) - if !addr + if !addr perr = $81 - cout('?') - prstr(@str) - crout - fin + cout('?') + prstr(@str) + crout + fin return addr fin esd = esd + 3 @@ -901,71 +901,73 @@ def loadmod(mod) refnum = open(@filename, iobuffer) if refnum > 0 rdlen = read(refnum, @header, 128) - modsize = header:0 - moddep = @header.1 - defofst = modsize + modsize = header:0 + moddep = @header.1 + defofst = modsize init = 0 - if rdlen > 4 and header:2 == $DA7E // DAVE = magic number :-) + if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-) // // This is an EXTended RELocatable (data+bytecode) module. // - systemflags = header:4 | systemflags + systemflags = header:4 | systemflags defofst = header:6 defcnt = header:8 init = header:10 moddep = @header.12 - // - // Load module dependencies. - // + // + // Load module dependencies. + // while ^moddep if !lookupmod(moddep) - close(refnum) - refnum = 0 + close(refnum) + refnum = 0 if loadmod(moddep) < 0 - return -perr - fin + return -perr + fin fin moddep = moddep + dcitos(moddep, @str) loop - // - // Init def table. - // - deftbl = allocheap(defcnt * 5 + 1) - deflast = deftbl - ^deflast = 0 - if !refnum - // - // Reset read pointer. - // - refnum = open(@filename, iobuffer) - rdlen = read(refnum, @header, 128) - fin + // + // Init def table. + // + deftbl = allocheap(defcnt * 5 + 1) + deflast = deftbl + ^deflast = 0 + if !refnum + // + // Reset read pointer. + // + refnum = open(@filename, iobuffer) + rdlen = read(refnum, @header, 128) + fin + else + return -69 fin - // - // Alloc heap space for relocated module (data + bytecode). - // - moddep = moddep + 1 - modfix = moddep - @header.2 // Adjust to skip header - modsize = modsize - modfix - rdlen = rdlen - modfix - 2 - modaddr = allocheap(modsize) - memcpy(modaddr, moddep, rdlen) - // - // Read in remainder of module into memory for fixups. - // - addr = modaddr// + // + // Alloc heap space for relocated module (data + bytecode). + // + moddep = moddep + 1 + modfix = moddep - @header.2 // Adjust to skip header + modsize = modsize - modfix + rdlen = rdlen - modfix - 2 + modaddr = allocheap(modsize) + memcpy(modaddr, moddep, rdlen) + // + // Read in remainder of module into memory for fixups. + // + addr = modaddr// repeat addr = addr + rdlen rdlen = read(refnum, addr, 4096) until rdlen <= 0 close(refnum) - // - // Add module to symbol table. - // - addmod(mod, modaddr) - // - // Apply all fixups and symbol import/export. - // + // + // Add module to symbol table. + // + addmod(mod, modaddr) + // + // Apply all fixups and symbol import/export. + // modfix = modaddr - modfix bytecode = defofst + modfix - MODADDR modend = modaddr + modsize @@ -973,39 +975,39 @@ def loadmod(mod) esd = rld // Extern+Entry Symbol Directory while ^esd // Scan to end of ESD esd = esd + 4 - loop + loop esd = esd + 1 - // - // Locate bytecode defs in appropriate bank. - // - if ^MACHID & $30 == $30 - defbank = 1 - defaddr = allocxheap(rld - bytecode) - modend = bytecode - else - defbank = 0 - defaddr = bytecode - fin + // + // Locate bytecode defs in appropriate bank. + // + if ^MACHID & $30 == $30 + defbank = 1 + defaddr = allocxheap(rld - bytecode) + modend = bytecode + else + defbank = 0 + defaddr = bytecode + fin // // Run through the Re-Location Dictionary. // while ^rld if ^rld == $02 - // - // This is a bytcode def entry - add it to the def directory. - // - adddef(defbank, rld=>1 - defofst + defaddr, @deflast) + // + // This is a bytcode def entry - add it to the def directory. + // + adddef(defbank, rld=>1 - defofst + defaddr, @deflast) else addr = rld=>1 + modfix if uword_isge(addr, modaddr) // Skip fixups to header if ^rld & $80 // WORD sized fixup. fixup = *addr - else // BYTE sized fixup. + else // BYTE sized fixup. fixup = ^addr fin if ^rld & $10 // EXTERN reference. fixup = fixup + lookupextern(esd, rld->3) - else // INTERN fixup. + else // INTERN fixup. fixup = fixup + modfix - MODADDR if uword_isge(fixup, bytecode) // @@ -1016,40 +1018,40 @@ def loadmod(mod) fin if ^rld & $80 // WORD sized fixup. *addr = fixup - else // BYTE sized fixup. + else // BYTE sized fixup. ^addr = fixup fin fin fin rld = rld + 4 loop - // + // // Run through the External/Entry Symbol Directory. - // + // while ^esd sym = esd esd = esd + dcitos(esd, @str) if ^esd & $08 - // + // // EXPORT symbol - add it to the global symbol table. - // + // addr = esd=>1 + modfix - MODADDR if uword_isge(addr, bytecode) - // - // Use the def directory address for bytecode. - // + // + // Use the def directory address for bytecode. + // addr = lookupdef(addr - bytecode + defaddr, deftbl) fin addsym(sym, addr) fin esd = esd + 3 loop - if defbank - // - // Move bytecode to AUX bank. - // - memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr)) - fin + if defbank + // + // Move bytecode to AUX bank. + // + memxcpy(defaddr, bytecode, modsize - (bytecode - modaddr)) + fin fin if perr return -perr @@ -1060,21 +1062,21 @@ def loadmod(mod) fixup = 0 // This is repurposed for the return code if init fixup = adddef(defbank, init - defofst + defaddr, @deflast)() - if fixup < modinitkeep - // - // Free init routine unless initkeep - // - if defbank - xheap = init - defofst + defaddr - else - modend = init - defofst + defaddr - fin - if fixup < 0 + if fixup < modinitkeep + // + // Free init routine unless initkeep + // + if defbank + xheap = init - defofst + defaddr + else + modend = init - defofst + defaddr + fin + if fixup < 0 perr = -fixup - fin - else - fixup = fixup & ~modinitkeep - fin + fin + else + fixup = fixup & ~modinitkeep + fin fin // // Free up the end-of-module in main memory. @@ -1097,12 +1099,12 @@ def volumes strbuf = databuff for i = 0 to 15 ^strbuf = ^strbuf & $0F - if ^strbuf - cout('/') - prstr(strbuf) - crout() - fin - strbuf = strbuf + 16 + if ^strbuf + cout('/') + prstr(strbuf) + crout() + fin + strbuf = strbuf + 16 next end def catalog(optpath) @@ -1143,12 +1145,12 @@ def catalog(optpath) if type & $F0 == $D0 // Is it a directory? cout('/') len = len + 1 - elsif entry->$10 == $FF - cout('-') - len = len + 1 - elsif entry->$10 == $FE - cout('+') - len = len + 1 + elsif entry->$10 == $FF + cout('-') + len = len + 1 + elsif entry->$10 == $FE + cout('+') + len = len + 1 fin for len = 19 - len downto 0 cout(' ') @@ -1187,9 +1189,9 @@ def striptrail(strptr) for i = 1 to ^strptr if ^(strptr + i) <= ' ' - ^strptr = i - 1 - return strptr - fin + ^strptr = i - 1 + return strptr + fin next return strptr end @@ -1225,23 +1227,23 @@ def execsys(sysfile) if ^sysfile memcpy($280, sysfile, ^sysfile + 1) - striptrail(sysfile) - refnum = open(sysfile, iobuffer) - if refnum - len = read(refnum, databuff, $FFFF) - resetmemfiles() - if len - memcpy(sysfile, $280, ^$280 + 1) - if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE - stripspaces(sysfile) - if ^$2005 >= ^sysfile + 1 - memcpy($2006, sysfile, ^sysfile + 1) - fin - fin - striptrail($280) - exec() - fin - fin + striptrail(sysfile) + refnum = open(sysfile, iobuffer) + if refnum + len = read(refnum, databuff, $FFFF) + resetmemfiles() + if len + memcpy(sysfile, $280, ^$280 + 1) + if stripchars(sysfile) and ^$2000 == $4C and *$2003 == $EEEE + stripspaces(sysfile) + if ^$2005 >= ^sysfile + 1 + memcpy($2006, sysfile, ^sysfile + 1) + fin + fin + striptrail($280) + exec() + fin + fin fin end def execmod(modfile) @@ -1251,16 +1253,16 @@ def execmod(modfile) perr = 1 if stodci(modfile, @moddci) saveheap = heap - savexheap = xheap - savesym = lastsym - saveflags = systemflags - if loadmod(@moddci) < modkeep - lastsym = savesym - xheap = savexheap - heap = saveheap - fin - ^lastsym = 0 - systemflags = saveflags + savexheap = xheap + savesym = lastsym + saveflags = systemflags + if loadmod(@moddci) < modkeep + lastsym = savesym + xheap = savexheap + heap = saveheap + fin + ^lastsym = 0 + systemflags = saveflags fin return -perr end @@ -1303,34 +1305,34 @@ while 1 if cmdln when toupper(parsecmd(@cmdln)) is 'Q' - reboot() - break - is 'C' - catalog(@cmdln) - break - is 'P' - setpfx(@cmdln) - break - is 'V' - volumes() - break - is '-' - execsys(@cmdln) - break - is '+' - execmod(striptrail(@cmdln)) - break - otherwise - cout('?') + reboot() + break + is 'C' + catalog(@cmdln) + break + is 'P' + setpfx(@cmdln) + break + is 'V' + volumes() + break + is '-' + execsys(@cmdln) + break + is '+' + execmod(striptrail(@cmdln)) + break + otherwise + cout('?') wend if perr prstr("ERR:$") - prbyte(perr) - perr = 0 + prbyte(perr) + perr = 0 else prstr("OK") fin - crout() + crout() fin prstr(getpfx(@prefix)) memcpy(@cmdln, rdstr($BA), 128) diff --git a/src/vmsrc/plvm.c b/src/vmsrc/plvm.c index fbeb538..f05e305 100755 --- a/src/vmsrc/plvm.c +++ b/src/vmsrc/plvm.c @@ -17,32 +17,32 @@ int show_state = 0; /* * Bytecode memory */ -#define BYTE_PTR(bp) ((byte)((bp)[0])) -#define WORD_PTR(bp) ((word)((bp)[0] | ((bp)[1] << 8))) -#define UWORD_PTR(bp) ((uword)((bp)[0] | ((bp)[1] << 8))) -#define TO_UWORD(w) ((uword)((w))) -#define MOD_ADDR 0x1000 -#define DEF_CALL 0x0800 -#define DEF_CALLSZ 0x0800 -#define DEF_ENTRYSZ 6 -#define MEM_SIZE 65536 +#define BYTE_PTR(bp) ((byte)((bp)[0])) +#define WORD_PTR(bp) ((word)((bp)[0] | ((bp)[1] << 8))) +#define UWORD_PTR(bp) ((uword)((bp)[0] | ((bp)[1] << 8))) +#define TO_UWORD(w) ((uword)((w))) +#define MOD_ADDR 0x1000 +#define DEF_CALL 0x0800 +#define DEF_CALLSZ 0x0800 +#define DEF_ENTRYSZ 6 +#define MEM_SIZE 65536 byte mem_data[MEM_SIZE]; uword sp = 0x01FE, fp = 0xFFFF, heap = 0x0200, deftbl = DEF_CALL, lastdef = DEF_CALL; -#define PHA(b) (mem_data[sp--]=(b)) -#define PLA() (mem_data[++sp]) -#define EVAL_STACKSZ 16 -#define PUSH(v) (*(--esp))=(v) -#define POP ((word)(*(esp++))) -#define UPOP ((uword)(*(esp++))) -#define TOS (esp[0]) +#define PHA(b) (mem_data[sp--]=(b)) +#define PLA (mem_data[++sp]) +#define EVAL_STACKSZ 16 +#define PUSH(v) (*(--esp))=(v) +#define POP ((word)(*(esp++))) +#define UPOP ((uword)(*(esp++))) +#define TOS (esp[0]) word eval_stack[EVAL_STACKSZ]; word *esp = eval_stack + EVAL_STACKSZ; -#define SYMTBLSZ 1024 -#define SYMSZ 16 -#define MODTBLSZ 128 -#define MODSZ 16 -#define MODLSTSZ 32 +#define SYMTBLSZ 1024 +#define SYMSZ 16 +#define MODTBLSZ 128 +#define MODSZ 16 +#define MODLSTSZ 32 byte symtbl[SYMTBLSZ]; byte *lastsym = symtbl; byte modtbl[MODTBLSZ]; @@ -53,7 +53,7 @@ byte *lastmod = modtbl; void interp(code *ip); /* * Utility routines. - * + * * A DCI string is one that has the high bit set for every character except the last. * More efficient than C or Pascal strings. */ @@ -126,7 +126,7 @@ void dump_tbl(byte *tbl) putchar(':'); while (len++ < 15) putchar(' '); - printf("$%04X\n", tbl[0] | (tbl[1] << 8)); + printf("$%04X\n", tbl[0] | (tbl[1] << 8)); tbl += 2; } } @@ -248,7 +248,7 @@ int load_mod(byte *mod) moddep = header + 1; modsize = header[0] | (header[1] << 8); magic = header[2] | (header[3] << 8); - if (magic == 0xDA7E) + if (magic == 0xDA7F) { /* * This is a relocatable bytecode module. @@ -282,7 +282,7 @@ int load_mod(byte *mod) } /* * Alloc heap space for relocated module (data + bytecode). - */ + */ moddep += 1; hdrlen = moddep - header; len -= hdrlen; @@ -381,7 +381,7 @@ int load_mod(byte *mod) { if (show_state) printf("BYTE"); mem_data[addr] = fixup; - } + } } else { @@ -502,18 +502,18 @@ void call(uword pc) exit(1); } } - + /* * OPCODE TABLE * -OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - DW NOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,??? ; 50 52 54 56 58 5A 5C 5E - DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E +OPTBL: DW ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E + DW NEG,COMP,AND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E + DW NOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + DW DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + DW ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + DW BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,??? ; 50 52 54 56 58 5A 5C 5E + DW LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + DW SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E */ void interp(code *ip) { @@ -533,9 +533,9 @@ void interp(code *ip) } switch (*ip++) { - /* - * 0x00-0x0F - */ + /* + * 0x00-0x0F + */ case 0x00: // ZERO : TOS = 0 PUSH(0); break; @@ -656,13 +656,11 @@ void interp(code *ip) PUSH(val); break; case 0x34: // PUSH : TOSP = TOS - val = POP; - PHA(val >> 8); + val = esp - eval_stack; PHA(val); break; case 0x36: // PULL : TOS = TOSP - PUSH(mem_data[sp] | (mem_data[sp + 1] << 8)); - sp += 2; + esp = eval_stack + PLA; break; case 0x38: // BRGT : TOS-1 > TOS ? IP += (IP) val = POP; @@ -775,7 +773,7 @@ void interp(code *ip) printf("\n"); break; case 0x5A: // LEAVE : DEL FRAME, IP = TOFP - fp += PLA(); + fp += PLA; case 0x5C: // RET : IP = TOFP return; case 0x5E: // ??? @@ -822,14 +820,14 @@ void interp(code *ip) /* * 0x70-0x7F */ - case 0x70: // SB : BYTE (TOS) = TOS-1 - val = POP; + case 0x70: // SB : BYTE (TOS-1) = TOS ea = UPOP; + val = POP; mem_data[ea] = val; break; - case 0x72: // SW : WORD (TOS) = TOS-1 - val = POP; + case 0x72: // SW : WORD (TOS-1) = TOS ea = UPOP; + val = POP; mem_data[ea] = val; mem_data[ea + 1] = val >> 8; break; @@ -889,7 +887,7 @@ int main(int argc, char **argv) { byte dci[32]; int i; - + if (--argc) { argv++; diff --git a/src/vmsrc/plvm01.s b/src/vmsrc/plvm01.s index dcd4f12..787c59c 100644 --- a/src/vmsrc/plvm01.s +++ b/src/vmsrc/plvm01.s @@ -8,928 +8,921 @@ ;* ;* VM ZERO PAGE LOCATIONS ;* - !SOURCE "vmsrc/plvmzp.inc" + !SOURCE "vmsrc/plvmzp.inc" ;* ;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO ;* - !MACRO INC_IP { - INY - BNE *+4 - INC IPH - } + !MACRO INC_IP { + INY + BNE *+4 + INC IPH + } ;* ;* INTERPRETER HEADER+INITIALIZATION ;* - *= $0280 -SEGBEGIN JMP VMINIT + *= $0280 +SEGBEGIN JMP VMINIT ;* ;* SYSTEM INTERPRETER ENTRYPOINT ;* -INTERP PLA - CLC - ADC #$01 +INTERP PLA + CLC + ADC #$01 STA IPL PLA - ADC #$00 + ADC #$00 STA IPH - LDY #$00 - JMP FETCHOP + LDY #$00 + JMP FETCHOP ;* ;* ENTER INTO USER BYTECODE INTERPRETER ;* -IINTERP PLA +IINTERP PLA STA TMPL PLA STA TMPH - LDY #$02 - LDA (TMP),Y - STA IPH - DEY - LDA (TMP),Y - STA IPL + LDY #$02 + LDA (TMP),Y + STA IPH + DEY + LDA (TMP),Y + STA IPL DEY - JMP FETCHOP + JMP FETCHOP ;* ;* MUL TOS-1 BY TOS ;* -MUL STY IPY - LDY #$10 - LDA ESTKL+1,X - EOR #$FF - STA TMPL - LDA ESTKH+1,X - EOR #$FF - STA TMPH - LDA #$00 - STA ESTKL+1,X ; PRODL -; STA ESTKH+1,X ; PRODH -MULLP LSR TMPH ; MULTPLRH - ROR TMPL ; MULTPLRL - BCS + - STA ESTKH+1,X ; PRODH - LDA ESTKL,X ; MULTPLNDL - ADC ESTKL+1,X ; PRODL - STA ESTKL+1,X - LDA ESTKH,X ; MULTPLNDH - ADC ESTKH+1,X ; PRODH -+ ASL ESTKL,X ; MULTPLNDL - ROL ESTKH,X ; MULTPLNDH - DEY - BNE MULLP - STA ESTKH+1,X ; PRODH - LDY IPY -; INX -; JMP NEXTOP - JMP DROP +MUL STY IPY + LDY #$10 + LDA ESTKL+1,X + EOR #$FF + STA TMPL + LDA ESTKH+1,X + EOR #$FF + STA TMPH + LDA #$00 + STA ESTKL+1,X ; PRODL +; STA ESTKH+1,X ; PRODH +MULLP LSR TMPH ; MULTPLRH + ROR TMPL ; MULTPLRL + BCS + + STA ESTKH+1,X ; PRODH + LDA ESTKL,X ; MULTPLNDL + ADC ESTKL+1,X ; PRODL + STA ESTKL+1,X + LDA ESTKH,X ; MULTPLNDH + ADC ESTKH+1,X ; PRODH ++ ASL ESTKL,X ; MULTPLNDL + ROL ESTKH,X ; MULTPLNDH + DEY + BNE MULLP + STA ESTKH+1,X ; PRODH + LDY IPY +; INX +; JMP NEXTOP + JMP DROP ;* ;* INCREMENT TOS ;* -INCR INC ESTKL,X - BNE INCR1 - INC ESTKH,X -INCR1 JMP NEXTOP +INCR INC ESTKL,X + BNE INCR1 + INC ESTKH,X +INCR1 JMP NEXTOP ;* ;* DECREMENT TOS ;* -DECR LDA ESTKL,X - BNE DECR1 - DEC ESTKH,X -DECR1 DEC ESTKL,X - JMP NEXTOP +DECR LDA ESTKL,X + BNE DECR1 + DEC ESTKH,X +DECR1 DEC ESTKL,X + JMP NEXTOP ;* ;* BITWISE COMPLIMENT TOS ;* -COMP LDA #$FF - EOR ESTKL,X - STA ESTKL,X - LDA #$FF - EOR ESTKH,X - STA ESTKH,X - JMP NEXTOP +COMP LDA #$FF + EOR ESTKL,X + STA ESTKL,X + LDA #$FF + EOR ESTKH,X + STA ESTKH,X + JMP NEXTOP ;* ;* OPCODE TABLE ;* - !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E - !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E - !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E - !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E - !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E + !ALIGN 255,0 +OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E + !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E + !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E + !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E + !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E + !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E ;* ;* DIV TOS-1 BY TOS ;* -DIV JSR _DIV - LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 - BCS NEG - JMP NEXTOP +DIV JSR _DIV + LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 + BCS NEG + JMP NEXTOP ;* ;* MOD TOS-1 BY TOS ;* -MOD JSR _DIV - LDA TMPL ; REMNDRL - STA ESTKL,X - LDA TMPH ; REMNDRH - STA ESTKH,X - LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND - BMI NEG - JMP NEXTOP +MOD JSR _DIV + LDA TMPL ; REMNDRL + STA ESTKL,X + LDA TMPH ; REMNDRH + STA ESTKH,X + LDA DVSIGN ; REMAINDER IS SIGN OF DIVIDEND + BMI NEG + JMP NEXTOP ;* ;* NEGATE TOS ;* -NEG LDA #$00 - SEC - SBC ESTKL,X - STA ESTKL,X - LDA #$00 - SBC ESTKH,X - STA ESTKH,X - JMP NEXTOP +NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + JMP NEXTOP ;* ;* INTERNAL DIVIDE ALGORITHM ;* -_NEG LDA #$00 - SEC - SBC ESTKL,X - STA ESTKL,X - LDA #$00 - SBC ESTKH,X - STA ESTKH,X - RTS -_DIV STY IPY - LDY #$11 ; #BITS+1 - LDA #$00 - STA TMPL ; REMNDRL - STA TMPH ; REMNDRH - LDA ESTKH,X - AND #$80 - STA DVSIGN - BPL + - JSR _NEG - INC DVSIGN -+ LDA ESTKH+1,X - BPL + - INX - JSR _NEG - DEX - INC DVSIGN - BNE _DIV1 -+ ORA ESTKL+1,X ; DVDNDL - BEQ _DIVEX -_DIV1 ASL ESTKL+1,X ; DVDNDL - ROL ESTKH+1,X ; DVDNDH - DEY - BCC _DIV1 -_DIVLP ROL TMPL ; REMNDRL - ROL TMPH ; REMNDRH - LDA TMPL ; REMNDRL - CMP ESTKL,X ; DVSRL - LDA TMPH ; REMNDRH - SBC ESTKH,X ; DVSRH - BCC + - STA TMPH ; REMNDRH - LDA TMPL ; REMNDRL - SBC ESTKL,X ; DVSRL - STA TMPL ; REMNDRL - SEC -+ ROL ESTKL+1,X ; DVDNDL - ROL ESTKH+1,X ; DVDNDH - DEY - BNE _DIVLP -_DIVEX INX - LDY IPY - RTS +_NEG LDA #$00 + SEC + SBC ESTKL,X + STA ESTKL,X + LDA #$00 + SBC ESTKH,X + STA ESTKH,X + RTS +_DIV STY IPY + LDY #$11 ; #BITS+1 + LDA #$00 + STA TMPL ; REMNDRL + STA TMPH ; REMNDRH + LDA ESTKH,X + AND #$80 + STA DVSIGN + BPL + + JSR _NEG + INC DVSIGN ++ LDA ESTKH+1,X + BPL + + INX + JSR _NEG + DEX + INC DVSIGN + BNE _DIV1 ++ ORA ESTKL+1,X ; DVDNDL + BEQ _DIVEX +_DIV1 ASL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BCC _DIV1 +_DIVLP ROL TMPL ; REMNDRL + ROL TMPH ; REMNDRH + LDA TMPL ; REMNDRL + CMP ESTKL,X ; DVSRL + LDA TMPH ; REMNDRH + SBC ESTKH,X ; DVSRH + BCC + + STA TMPH ; REMNDRH + LDA TMPL ; REMNDRL + SBC ESTKL,X ; DVSRL + STA TMPL ; REMNDRL + SEC ++ ROL ESTKL+1,X ; DVDNDL + ROL ESTKH+1,X ; DVDNDH + DEY + BNE _DIVLP +_DIVEX INX + LDY IPY + RTS ;* ;* ADD TOS TO TOS-1 ;* -ADD LDA ESTKL,X - CLC - ADC ESTKL+1,X - STA ESTKL+1,X - LDA ESTKH,X - ADC ESTKH+1,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +ADD LDA ESTKL,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ;* ;* SUB TOS FROM TOS-1 ;* -SUB LDA ESTKL+1,X - SEC - SBC ESTKL,X - STA ESTKL+1,X - LDA ESTKH+1,X - SBC ESTKH,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +SUB LDA ESTKL+1,X + SEC + SBC ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + SBC ESTKH,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ; ;* ;* SHIFT TOS LEFT BY 1, ADD TO TOS-1 ;* -IDXW LDA ESTKL,X - ASL - ROL ESTKH,X - CLC - ADC ESTKL+1,X - STA ESTKL+1,X - LDA ESTKH,X - ADC ESTKH+1,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +IDXW LDA ESTKL,X + ASL + ROL ESTKH,X + CLC + ADC ESTKL+1,X + STA ESTKL+1,X + LDA ESTKH,X + ADC ESTKH+1,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ;* ;* BITWISE AND TOS TO TOS-1 ;* -BAND LDA ESTKL+1,X - AND ESTKL,X - STA ESTKL+1,X - LDA ESTKH+1,X - AND ESTKH,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +BAND LDA ESTKL+1,X + AND ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + AND ESTKH,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ;* ;* INCLUSIVE OR TOS TO TOS-1 ;* -IOR LDA ESTKL+1,X - ORA ESTKL,X - STA ESTKL+1,X - LDA ESTKH+1,X - ORA ESTKH,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +IOR LDA ESTKL+1,X + ORA ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + ORA ESTKH,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ;* ;* EXLUSIVE OR TOS TO TOS-1 ;* -XOR LDA ESTKL+1,X - EOR ESTKL,X - STA ESTKL+1,X - LDA ESTKH+1,X - EOR ESTKH,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +XOR LDA ESTKL+1,X + EOR ESTKL,X + STA ESTKL+1,X + LDA ESTKH+1,X + EOR ESTKH,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ;* ;* SHIFT TOS-1 LEFT BY TOS ;* -SHL STY IPY - LDA ESTKL,X - CMP #$08 - BCC SHL1 - LDY ESTKL+1,X - STY ESTKH+1,X - LDY #$00 - STY ESTKL+1,X - SBC #$08 -SHL1 TAY - BEQ SHL3 -SHL2 ASL ESTKL+1,X - ROL ESTKH+1,X - DEY - BNE SHL2 -SHL3 LDY IPY -; INX -; JMP NEXTOP - JMP DROP +SHL STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHL1 + LDY ESTKL+1,X + STY ESTKH+1,X + LDY #$00 + STY ESTKL+1,X + SBC #$08 +SHL1 TAY + BEQ SHL3 +SHL2 ASL ESTKL+1,X + ROL ESTKH+1,X + DEY + BNE SHL2 +SHL3 LDY IPY +; INX +; JMP NEXTOP + JMP DROP ;* ;* SHIFT TOS-1 RIGHT BY TOS ;* -SHR STY IPY - LDA ESTKL,X - CMP #$08 - BCC SHR2 - LDY ESTKH+1,X - STY ESTKL+1,X - CPY #$80 - LDY #$00 - BCC SHR1 - DEY -SHR1 STY ESTKH+1,X - SEC - SBC #$08 -SHR2 TAY - BEQ SHR4 - LDA ESTKH+1,X -SHR3 CMP #$80 - ROR - ROR ESTKL+1,X - DEY - BNE SHR3 - STA ESTKH+1,X -SHR4 LDY IPY -; INX -; JMP NEXTOP - JMP DROP +SHR STY IPY + LDA ESTKL,X + CMP #$08 + BCC SHR2 + LDY ESTKH+1,X + STY ESTKL+1,X + CPY #$80 + LDY #$00 + BCC SHR1 + DEY +SHR1 STY ESTKH+1,X + SEC + SBC #$08 +SHR2 TAY + BEQ SHR4 + LDA ESTKH+1,X +SHR3 CMP #$80 + ROR + ROR ESTKL+1,X + DEY + BNE SHR3 + STA ESTKH+1,X +SHR4 LDY IPY +; INX +; JMP NEXTOP + JMP DROP ;* ;* LOGICAL NOT ;* -LNOT LDA ESTKL,X - ORA ESTKH,X - BEQ LNOT1 - LDA #$FF -LNOT1 EOR #$FF - STA ESTKL,X - STA ESTKH,X - JMP NEXTOP +LNOT LDA ESTKL,X + ORA ESTKH,X + BEQ LNOT1 + LDA #$FF +LNOT1 EOR #$FF + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP ;* ;* LOGICAL AND ;* -LAND LDA ESTKL+1,X - ORA ESTKH+1,X - BEQ LAND2 - LDA ESTKL,X - ORA ESTKH,X - BEQ LAND1 - LDA #$FF -LAND1 STA ESTKL+1,X - STA ESTKH+1,X -;LAND2 INX -; JMP NEXTOP -LAND2 JMP DROP +LAND LDA ESTKL+1,X + ORA ESTKH+1,X + BEQ LAND2 + LDA ESTKL,X + ORA ESTKH,X + BEQ LAND1 + LDA #$FF +LAND1 STA ESTKL+1,X + STA ESTKH+1,X +;LAND2 INX +; JMP NEXTOP +LAND2 JMP DROP ;* ;* LOGICAL OR ;* -LOR LDA ESTKL,X - ORA ESTKH,X - ORA ESTKL+1,X - ORA ESTKH+1,X - BEQ LOR1 - LDA #$FF - STA ESTKL+1,X - STA ESTKH+1,X -;LOR1 INX -; JMP NEXTOP -LOR1 JMP DROP +LOR LDA ESTKL,X + ORA ESTKH,X + ORA ESTKL+1,X + ORA ESTKH+1,X + BEQ LOR1 + LDA #$FF + STA ESTKL+1,X + STA ESTKH+1,X +;LOR1 INX +; JMP NEXTOP +LOR1 JMP DROP ;* ;* DUPLICATE TOS ;* -DUP DEX - LDA ESTKL+1,X - STA ESTKL,X - LDA ESTKH+1,X - STA ESTKH,X - JMP NEXTOP +DUP DEX + LDA ESTKL+1,X + STA ESTKL,X + LDA ESTKH+1,X + STA ESTKH,X + JMP NEXTOP ;* -;* PUSH FROM EVAL STACK TO CALL STACK +;* PUSH EVAL STACK POINTER TO CALL STACK ;* -PUSH LDA ESTKL,X - PHA - LDA ESTKH,X - PHA -; INX -; JMP NEXTOP - JMP DROP +PUSHEP TXA + PHA + JMP NEXTOP ;* -;* PULL FROM CALL STACK TO EVAL STACK +;* PULL EVAL STACK POINTER FROM CALL STACK ;* -PULL DEX - PLA - STA ESTKH,X - PLA - STA ESTKL,X - JMP NEXTOP +PULLEP PLA + TAX + JMP NEXTOP ;* ;* CONSTANT ;* -ZERO DEX - LDA #$00 - STA ESTKL,X - STA ESTKH,X - JMP NEXTOP -CB DEX - +INC_IP - LDA (IP),Y - STA ESTKL,X - LDA #$00 - STA ESTKH,X - JMP NEXTOP +ZERO DEX + LDA #$00 + STA ESTKL,X + STA ESTKH,X + JMP NEXTOP +CB DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP ;* ;* LOAD ADDRESS & LOAD CONSTANT WORD (SAME THING, WITH OR WITHOUT FIXUP) ;* -LA = * -CW DEX - +INC_IP - LDA (IP),Y - STA ESTKL,X - +INC_IP - LDA (IP),Y - STA ESTKH,X - JMP NEXTOP +LA = * +CW DEX + +INC_IP + LDA (IP),Y + STA ESTKL,X + +INC_IP + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP ;* ;* CONSTANT STRING ;* -CS DEX - +INC_IP - TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK - CLC - ADC IPL - STA IPL - STA ESTKL,X - LDA #$00 - TAY - ADC IPH - STA IPH - STA ESTKH,X - LDA (IP),Y - TAY - JMP NEXTOP +CS DEX + +INC_IP + TYA ; NORMALIZE IP AND SAVE STRING ADDR ON ESTK + CLC + ADC IPL + STA IPL + STA ESTKL,X + LDA #$00 + TAY + ADC IPH + STA IPH + STA ESTKH,X + LDA (IP),Y + TAY + JMP NEXTOP ;* ;* LOAD VALUE FROM ADDRESS TAG ;* -LB LDA ESTKL,X - STA TMPL - LDA ESTKH,X - STA TMPH - STY IPY - LDY #$00 - LDA (TMP),Y - STA ESTKL,X - STY ESTKH,X - LDY IPY - JMP NEXTOP -LW LDA ESTKL,X - STA TMPL - LDA ESTKH,X - STA TMPH - STY IPY - LDY #$00 - LDA (TMP),Y - STA ESTKL,X - INY - LDA (TMP),Y - STA ESTKH,X - LDY IPY - JMP NEXTOP +LB LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +LW LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* LOAD ADDRESS OF LOCAL FRAME OFFSET ;* -LLA +INC_IP - LDA (IP),Y - DEX - CLC - ADC IFPL - STA ESTKL,X - LDA #$00 - ADC IFPH - STA ESTKH,X - JMP NEXTOP +LLA +INC_IP + LDA (IP),Y + DEX + CLC + ADC IFPL + STA ESTKL,X + LDA #$00 + ADC IFPH + STA ESTKH,X + JMP NEXTOP ;* ;* LOAD VALUE FROM LOCAL FRAME OFFSET ;* -LLB +INC_IP - LDA (IP),Y - STY IPY - TAY - DEX - LDA (IFP),Y - STA ESTKL,X - LDA #$00 - STA ESTKH,X - LDY IPY - JMP NEXTOP -LLW +INC_IP - LDA (IP),Y - STY IPY - TAY - DEX - LDA (IFP),Y - STA ESTKL,X - INY - LDA (IFP),Y - STA ESTKH,X - LDY IPY - JMP NEXTOP +LLB +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + LDA #$00 + STA ESTKH,X + LDY IPY + JMP NEXTOP +LLW +INC_IP + LDA (IP),Y + STY IPY + TAY + DEX + LDA (IFP),Y + STA ESTKL,X + INY + LDA (IFP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* -LAB +INC_IP - LDA (IP),Y - STA TMPL - +INC_IP - LDA (IP),Y - STA TMPH - STY IPY - LDY #$00 - LDA (TMP),Y - DEX - STA ESTKL,X - STY ESTKH,X - LDY IPY - JMP NEXTOP -LAW +INC_IP - LDA (IP),Y - STA TMPL - +INC_IP - LDA (IP),Y - STA TMPH - STY IPY - LDY #$00 - LDA (TMP),Y - DEX - STA ESTKL,X - INY - LDA (TMP),Y - STA ESTKH,X - LDY IPY - JMP NEXTOP +LAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + STY ESTKH,X + LDY IPY + JMP NEXTOP +LAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA (TMP),Y + DEX + STA ESTKL,X + INY + LDA (TMP),Y + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* STORE VALUE TO ADDRESS ;* -SB LDA ESTKL+1,X - STA TMPL - LDA ESTKH+1,X - STA TMPH - LDA ESTKL,X - STY IPY - LDY #$00 - STA (TMP),Y - LDY IPY - INX -; INX -; JMP NEXTOP - JMP DROP -SW LDA ESTKL+1,X - STA TMPL - LDA ESTKH+1,X - STA TMPH - STY IPY - LDY #$00 - LDA ESTKL,X - STA (TMP),Y - INY - LDA ESTKH,X - STA (TMP),Y - LDY IPY - INX -; INX -; JMP NEXTOP - JMP DROP +SB LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + LDA ESTKL+1,X + STY IPY + LDY #$00 + STA (TMP),Y + LDY IPY + INX +; INX +; JMP NEXTOP + JMP DROP +SW LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL+1,X + STA (TMP),Y + INY + LDA ESTKH+1,X + STA (TMP),Y + LDY IPY + INX +; INX +; JMP NEXTOP + JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET ;* -SLB +INC_IP - LDA (IP),Y - STY IPY - TAY - LDA ESTKL,X - STA (IFP),Y - LDY IPY -; INX -; JMP NEXTOP - JMP DROP -SLW +INC_IP - LDA (IP),Y - STY IPY - TAY - LDA ESTKL,X - STA (IFP),Y - INY - LDA ESTKH,X - STA (IFP),Y - LDY IPY -; INX -; JMP NEXTOP - JMP DROP +SLB +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY +; INX +; JMP NEXTOP + JMP DROP +SLW +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY +; INX +; JMP NEXTOP + JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK ;* -DLB +INC_IP - LDA (IP),Y - STY IPY - TAY - LDA ESTKL,X - STA (IFP),Y - LDY IPY - JMP NEXTOP -DLW +INC_IP - LDA (IP),Y - STY IPY - TAY - LDA ESTKL,X - STA (IFP),Y - INY - LDA ESTKH,X - STA (IFP),Y - LDY IPY - JMP NEXTOP +DLB +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + LDY IPY + JMP NEXTOP +DLW +INC_IP + LDA (IP),Y + STY IPY + TAY + LDA ESTKL,X + STA (IFP),Y + INY + LDA ESTKH,X + STA (IFP),Y + LDY IPY + JMP NEXTOP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS ;* -SAB +INC_IP - LDA (IP),Y - STA TMPL - +INC_IP - LDA (IP),Y - STA TMPH - LDA ESTKL,X - STY IPY - LDY #$00 - STA (TMP),Y - LDY IPY -; INX -; JMP NEXTOP - JMP DROP -SAW +INC_IP - LDA (IP),Y - STA TMPL - +INC_IP - LDA (IP),Y - STA TMPH - STY IPY - LDY #$00 - LDA ESTKL,X - STA (TMP),Y - INY - LDA ESTKH,X - STA (TMP),Y - LDY IPY -; INX -; JMP NEXTOP - JMP DROP +SAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + LDA ESTKL,X + STY IPY + LDY #$00 + STA (TMP),Y + LDY IPY +; INX +; JMP NEXTOP + JMP DROP +SAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY +; INX +; JMP NEXTOP + JMP DROP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK ;* -DAB +INC_IP - LDA (IP),Y - STA TMPL - +INC_IP - LDA (IP),Y - STA TMPH - STY IPY - LDY #$00 - LDA ESTKL,X - STA (TMP),Y - LDY IPY - JMP NEXTOP -DAW +INC_IP - LDA (IP),Y - STA TMPL - +INC_IP - LDA (IP),Y - STA TMPH - STY IPY - LDY #$00 - LDA ESTKL,X - STA (TMP),Y - INY - LDA ESTKH,X - STA (TMP),Y - LDY IPY - JMP NEXTOP +DAB +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + LDY IPY + JMP NEXTOP +DAW +INC_IP + LDA (IP),Y + STA TMPL + +INC_IP + LDA (IP),Y + STA TMPH + STY IPY + LDY #$00 + LDA ESTKL,X + STA (TMP),Y + INY + LDA ESTKH,X + STA (TMP),Y + LDY IPY + JMP NEXTOP ;* ;* COMPARES ;* -ISEQ LDA ESTKL,X - CMP ESTKL+1,X - BNE ISFLS - LDA ESTKH,X - CMP ESTKH+1,X - BNE ISFLS -ISTRU LDA #$FF - STA ESTKL+1,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +ISEQ LDA ESTKL,X + CMP ESTKL+1,X + BNE ISFLS + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISFLS +ISTRU LDA #$FF + STA ESTKL+1,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ; -ISNE LDA ESTKL,X - CMP ESTKL+1,X - BNE ISTRU - LDA ESTKH,X - CMP ESTKH+1,X - BNE ISTRU -ISFLS LDA #$00 - STA ESTKL+1,X - STA ESTKH+1,X -; INX -; JMP NEXTOP - JMP DROP +ISNE LDA ESTKL,X + CMP ESTKL+1,X + BNE ISTRU + LDA ESTKH,X + CMP ESTKH+1,X + BNE ISTRU +ISFLS LDA #$00 + STA ESTKL+1,X + STA ESTKH+1,X +; INX +; JMP NEXTOP + JMP DROP ; -ISGE LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - BVC ISGE1 - EOR #$80 -ISGE1 BPL ISTRU - BMI ISFLS +ISGE LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISGE1 + EOR #$80 +ISGE1 BPL ISTRU + BMI ISFLS ; -ISGT LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - BVC ISGT1 - EOR #$80 -ISGT1 BMI ISTRU - BPL ISFLS +ISGT LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISGT1 + EOR #$80 +ISGT1 BMI ISTRU + BPL ISFLS ; -ISLE LDA ESTKL,X - CMP ESTKL+1,X - LDA ESTKH,X - SBC ESTKH+1,X - BVC ISLE1 - EOR #$80 -ISLE1 BPL ISTRU - BMI ISFLS +ISLE LDA ESTKL,X + CMP ESTKL+1,X + LDA ESTKH,X + SBC ESTKH+1,X + BVC ISLE1 + EOR #$80 +ISLE1 BPL ISTRU + BMI ISFLS ; -ISLT LDA ESTKL+1,X - CMP ESTKL,X - LDA ESTKH+1,X - SBC ESTKH,X - BVC ISLT1 - EOR #$80 -ISLT1 BMI ISTRU - BPL ISFLS +ISLT LDA ESTKL+1,X + CMP ESTKL,X + LDA ESTKH+1,X + SBC ESTKH,X + BVC ISLT1 + EOR #$80 +ISLT1 BMI ISTRU + BPL ISFLS ;* ;* BRANCHES ;* -BRTRU INX - LDA ESTKH-1,X - ORA ESTKL-1,X - BNE BRNCH -NOBRNCH +INC_IP - +INC_IP - JMP NEXTOP -BRFLS INX - LDA ESTKH-1,X - ORA ESTKL-1,X - BNE NOBRNCH -BRNCH LDA IPH - STA TMPH - LDA IPL - +INC_IP - CLC - ADC (IP),Y - STA TMPL - LDA TMPH - +INC_IP - ADC (IP),Y - STA IPH - LDA TMPL - STA IPL - DEY - DEY - JMP NEXTOP -BREQ INX - LDA ESTKL-1,X - CMP ESTKL,X - BNE NOBRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ BRNCH - BNE NOBRNCH -BRNE INX - LDA ESTKL-1,X - CMP ESTKL,X - BNE BRNCH - LDA ESTKH-1,X - CMP ESTKH,X - BEQ NOBRNCH - BNE BRNCH -BRGT INX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X - BMI BRNCH - BPL NOBRNCH -BRLT INX - LDA ESTKL,X - CMP ESTKL-1,X - LDA ESTKH,X - SBC ESTKH-1,X - BMI BRNCH - BPL NOBRNCH -IBRNCH LDA IPL - CLC - ADC ESTKL,X - STA IPL - LDA IPH - ADC ESTKH,X - STA IPH -; INX -; JMP NEXTOP - JMP DROP +BRTRU INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE BRNCH +NOBRNCH +INC_IP + +INC_IP + JMP NEXTOP +BRFLS INX + LDA ESTKH-1,X + ORA ESTKL-1,X + BNE NOBRNCH +BRNCH LDA IPH + STA TMPH + LDA IPL + +INC_IP + CLC + ADC (IP),Y + STA TMPL + LDA TMPH + +INC_IP + ADC (IP),Y + STA IPH + LDA TMPL + STA IPL + DEY + DEY + JMP NEXTOP +BREQ INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE NOBRNCH + LDA ESTKH-1,X + CMP ESTKH,X + BEQ BRNCH + BNE NOBRNCH +BRNE INX + LDA ESTKL-1,X + CMP ESTKL,X + BNE BRNCH + LDA ESTKH-1,X + CMP ESTKH,X + BEQ NOBRNCH + BNE BRNCH +BRGT INX + LDA ESTKL-1,X + CMP ESTKL,X + LDA ESTKH-1,X + SBC ESTKH,X + BMI BRNCH + BPL NOBRNCH +BRLT INX + LDA ESTKL,X + CMP ESTKL-1,X + LDA ESTKH,X + SBC ESTKH-1,X + BMI BRNCH + BPL NOBRNCH +IBRNCH LDA IPL + CLC + ADC ESTKL,X + STA IPL + LDA IPH + ADC ESTKH,X + STA IPH +; INX +; JMP NEXTOP + JMP DROP ;* ;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) ;* -CALL +INC_IP - LDA (IP),Y - STA CALLADR+1 - +INC_IP - LDA (IP),Y - STA CALLADR+2 - LDA IPH - PHA - LDA IPL - PHA - TYA - PHA -CALLADR JSR $FFFF - PLA - TAY - PLA - STA IPL - PLA - STA IPH - JMP NEXTOP +CALL +INC_IP + LDA (IP),Y + STA CALLADR+1 + +INC_IP + LDA (IP),Y + STA CALLADR+2 + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA +CALLADR JSR $FFFF + PLA + TAY + PLA + STA IPL + PLA + STA IPH + JMP NEXTOP ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* -ICAL LDA ESTKL,X - STA ICALADR+1 - LDA ESTKH,X - STA ICALADR+2 - INX - LDA IPH - PHA - LDA IPL - PHA - TYA - PHA -ICALADR JSR $FFFF - PLA - TAY - PLA - STA IPL - PLA - STA IPH - JMP NEXTOP +ICAL LDA ESTKL,X + STA ICALADR+1 + LDA ESTKH,X + STA ICALADR+2 + INX + LDA IPH + PHA + LDA IPL + PHA + TYA + PHA +ICALADR JSR $FFFF + PLA + TAY + PLA + STA IPL + PLA + STA IPH + JMP NEXTOP ;* ;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT ;* -ENTER INY - LDA (IP),Y - PHA ; SAVE ON STACK FOR LEAVE - EOR #$FF - SEC - ADC IFPL - STA IFPL - BCS + - DEC IFPH -+ INY - LDA (IP),Y - ASL - TAY - BEQ + -- LDA ESTKH,X - DEY - STA (IFP),Y - LDA ESTKL,X - INX - DEY - STA (IFP),Y - BNE - -+ LDY #$02 - JMP NEXTOP +ENTER INY + LDA (IP),Y + PHA ; SAVE ON STACK FOR LEAVE + EOR #$FF + SEC + ADC IFPL + STA IFPL + BCS + + DEC IFPH ++ INY + LDA (IP),Y + ASL + TAY + BEQ + +- LDA ESTKH,X + DEY + STA (IFP),Y + LDA ESTKL,X + INX + DEY + STA (IFP),Y + BNE - ++ LDY #$02 + JMP NEXTOP ;* ;* LEAVE FUNCTION ;* -LEAVE PLA - CLC - ADC IFPL - STA IFPL - BCS LIFPH - RTS -LIFPH INC IFPH -RET RTS -A1CMD !SOURCE "vmsrc/a1cmd.a" -SEGEND = * -VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE -- LDA PAGE0-1,Y - STA DROP-1,Y - DEY - BNE - - STY IFPL ; INIT FRAME POINTER - LDA #$80 - STA IFPH - LDA #SEGEND - STA SRCH - LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX - JMP A1CMD -PAGE0 = * - !PSEUDOPC $00EF { +LEAVE PLA + CLC + ADC IFPL + STA IFPL + BCS LIFPH + RTS +LIFPH INC IFPH +RET RTS +A1CMD !SOURCE "vmsrc/a1cmd.a" +SEGEND = * +VMINIT LDY #$10 ; INSTALL PAGE 0 FETCHOP ROUTINE +- LDA PAGE0-1,Y + STA DROP-1,Y + DEY + BNE - + STY IFPL ; INIT FRAME POINTER + LDA #$80 + STA IFPH + LDA #SEGEND + STA SRCH + LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX + JMP A1CMD +PAGE0 = * + !PSEUDOPC $00EF { ;* ;* INTERP BYTECODE INNER LOOP ;* - INX ; DROP - INY ; NEXTOP - BEQ NEXTOPH - LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 - STA OPIDX - JMP (OPTBL) -NEXTOPH INC IPH - BNE FETCHOP + INX ; DROP + INY ; NEXTOP + BEQ NEXTOPH + LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 + STA OPIDX + JMP (OPTBL) +NEXTOPH INC IPH + BNE FETCHOP } diff --git a/src/vmsrc/plvm02.s b/src/vmsrc/plvm02.s old mode 100644 new mode 100755 index d1b3243..7aeb36a --- a/src/vmsrc/plvm02.s +++ b/src/vmsrc/plvm02.s @@ -1,64 +1,64 @@ ;********************************************************** ;* -;* APPLE ][ 64K/128K PLASMA INTERPETER +;* APPLE ][ 64K/128K PLASMA INTERPRETER ;* -;* SYSTEM ROUTINES AND LOCATIONS +;* SYSTEM ROUTINES AND LOCATIONS ;* ;********************************************************** ;* ;* MONITOR SPECIAL LOCATIONS ;* -CSWL = $36 -CSWH = $37 -PROMPT = $33 +CSWL = $36 +CSWH = $37 +PROMPT = $33 ;* ;* PRODOS ;* -PRODOS = $BF00 -DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT -DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST -MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE -RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR -NODEV = $BF10 +PRODOS = $BF00 +DEVCNT = $BF31 ; GLOBAL PAGE DEVICE COUNT +DEVLST = $BF32 ; GLOBAL PAGE DEVICE LIST +MACHID = $BF98 ; GLOBAL PAGE MACHINE ID BYTE +RAMSLOT = $BF26 ; SLOT 3, DRIVE 2 IS /RAM'S DRIVER VECTOR +NODEV = $BF10 ;* ;* HARDWARE ADDRESSES ;* -KEYBD = $C000 -CLRKBD = $C010 -SPKR = $C030 -LCRDEN = $C080 -LCWTEN = $C081 -ROMEN = $C082 -LCRWEN = $C083 -LCBNK2 = $00 -LCBNK1 = $08 -ALTZPOFF= $C008 -ALTZPON = $C009 -ALTRDOFF= $C002 -ALTRDON = $C003 -ALTWROFF= $C004 -ALTWRON = $C005 - !SOURCE "vmsrc/plvmzp.inc" -STRBUF = $0280 -INTERP = $03D0 +KEYBD = $C000 +CLRKBD = $C010 +SPKR = $C030 +LCRDEN = $C080 +LCWTEN = $C081 +ROMEN = $C082 +LCRWEN = $C083 +LCBNK2 = $00 +LCBNK1 = $08 +ALTZPOFF= $C008 +ALTZPON = $C009 +ALTRDOFF= $C002 +ALTRDON = $C003 +ALTWROFF= $C004 +ALTWRON = $C005 + !SOURCE "vmsrc/plvmzp.inc" +STRBUF = $0280 +INTERP = $03D0 ;* ;* INTERPRETER INSTRUCTION POINTER INCREMENT MACRO ;* !MACRO INC_IP { INY - BNE * + 4 - INC IPH + BNE * + 4 + INC IPH } ;****************************** ;* * ;* INTERPRETER INITIALIZATION * ;* * ;****************************** -* = $2000 - LDX #$FE +* = $2000 + LDX #$FE TXS - LDX #$00 - STX $01FF + LDX #$00 + STX $01FF ;* ;* DISCONNECT /RAM ;* @@ -73,25 +73,25 @@ INTERP = $03D0 LDA RAMSLOT+1 CMP NODEV+1 BEQ RAMDONE -RAMCONT LDY DEVCNT -RAMLOOP LDA DEVLST,Y +RAMCONT LDY DEVCNT +RAMLOOP LDA DEVLST,Y AND #$F3 CMP #$B3 BEQ GETLOOP DEY BPL RAMLOOP BMI RAMDONE -GETLOOP LDA DEVLST+1,Y +GETLOOP LDA DEVLST+1,Y STA DEVLST,Y BEQ RAMEXIT INY BNE GETLOOP -RAMEXIT LDA NODEV +RAMEXIT LDA NODEV STA RAMSLOT LDA NODEV+1 STA RAMSLOT+1 DEC DEVCNT -RAMDONE CLI +RAMDONE CLI ;* ;* MOVE VM INTO LANGUAGE CARD ;* @@ -105,7 +105,7 @@ RAMDONE CLI STY DSTL LDA #$D0 STA DSTH -- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD +- LDA (SRC),Y ; COPY VM+CMD INTO LANGUAGE CARD STA (DST),Y INY BNE - @@ -117,7 +117,7 @@ RAMDONE CLI ;* ;* MOVE FIRST PAGE OF 'BYE' INTO PLACE ;* - STY SRCL + STY SRCL LDA #$D1 STA SRCH - LDA (SRC),Y @@ -127,7 +127,7 @@ RAMDONE CLI ;* ;* SAVE DEFAULT COMMAND INTERPRETER PATH IN LC ;* - JSR PRODOS ; GET PREFIX + JSR PRODOS ; GET PREFIX !BYTE $C7 !WORD GETPFXPARMS LDY STRBUF ; APPEND "CMD" @@ -146,13 +146,13 @@ RAMDONE CLI INY STA STRBUF,Y STY STRBUF - BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE + BIT LCRWEN+LCBNK2 ; COPY TO LC FOR BYE BIT LCRWEN+LCBNK2 - LDA STRBUF,Y STA LCDEFCMD,Y DEY BPL - - JMP CMDENTRY + JMP CMDENTRY GETPFXPARMS !BYTE 1 !WORD STRBUF ; PATH STRING GOES HERE ;************************************************ @@ -160,7 +160,7 @@ GETPFXPARMS !BYTE 1 ;* LANGUAGE CARD RESIDENT PLASMA VM STARTS HERE * ;* * ;************************************************ -VMCORE = * +VMCORE = * !PSEUDOPC $D000 { ;**************** ;* * @@ -168,12 +168,12 @@ VMCORE = * ;* * ;**************** !ALIGN 255,0 -OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E +OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E - !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E + !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E !WORD SB,SW,SLB,SLW,SAB,SAW,DAB,DAW ; 70 72 74 76 78 7A 7C 7E ;* @@ -182,10 +182,10 @@ OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E DINTRP PLA CLC ADC #$01 - STA IPL - PLA + STA IPL + PLA ADC #$00 - STA IPH + STA IPH LDA IFPH PHA ; SAVE ON STACK FOR LEAVE/RET LDA IFPL @@ -199,16 +199,16 @@ DINTRP PLA STA OPPAGE JMP FETCHOP IINTRP PLA - STA TMPL - PLA - STA TMPH + STA TMPL + PLA + STA TMPH LDY #$02 - LDA (TMP),Y - STA IPH + LDA (TMP),Y + STA IPH DEY - LDA (TMP),Y + LDA (TMP),Y STA IPL - DEY + DEY LDA IFPH PHA ; SAVE ON STACK FOR LEAVE/RET LDA IFPL @@ -219,18 +219,18 @@ IINTRP PLA STA IFPH LDA #>OPTBL STA OPPAGE - JMP FETCHOP -IINTRPX PLA - STA TMPL - PLA - STA TMPH + JMP FETCHOP +IINTRPX PLA + STA TMPL + PLA + STA TMPH LDY #$02 - LDA (TMP),Y - STA IPH + LDA (TMP),Y + STA IPH DEY - LDA (TMP),Y + LDA (TMP),Y STA IPL - DEY + DEY LDA IFPH PHA ; SAVE ON STACK FOR LEAVE/RET LDA IFPL @@ -277,7 +277,7 @@ CMDENTRY = * ; INSTALL PAGE 0 FETCHOP ROUTINE ; LDY #$0F -- LDA PAGE0,Y +- LDA PAGE0,Y STA DROP,Y DEY BPL - @@ -285,35 +285,35 @@ CMDENTRY = * ; INSTALL PAGE 3 VECTORS ; LDY #$12 -- LDA PAGE3,Y +- LDA PAGE3,Y STA INTERP,Y DEY BPL - ; ; READ CMD INTO MEMORY ; - JSR PRODOS ; CLOSE EVERYTHING + JSR PRODOS ; CLOSE EVERYTHING !BYTE $CC !WORD CLOSEPARMS - BNE FAIL - JSR PRODOS ; OPEN CMD + BNE FAIL + JSR PRODOS ; OPEN CMD !BYTE $C8 !WORD OPENPARMS BNE FAIL - LDA REFNUM - STA READPARMS+1 - JSR PRODOS + LDA REFNUM + STA READPARMS+1 + JSR PRODOS !BYTE $CA !WORD READPARMS - BNE FAIL - JSR PRODOS + BNE FAIL + JSR PRODOS !BYTE $CC !WORD CLOSEPARMS - BNE FAIL + BNE FAIL ; ; INIT VM ENVIRONMENT STACK POINTERS ; -; LDA #$00 ; INIT FRAME POINTER +; LDA #$00 ; INIT FRAME POINTER STA PPL STA IFPL LDA #$BF @@ -321,8 +321,8 @@ CMDENTRY = * STA IFPH LDX #$FE ; INIT STACK POINTER (YES, $FE. SEE GETS) TXS - LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX - JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND + LDX #ESTKSZ/2 ; INIT EVAL STACK INDEX + JMP $2000 ; JUMP TO LOADED SYSTEM COMMAND ; ; PRINT FAIL MESSAGE, WAIT FOR KEYPRESS, AND REBOOT ; @@ -335,33 +335,33 @@ FAIL INC $3F4 ; INVALIDATE POWER-UP BYTE BPL - JSR $FD0C ; WAIT FOR KEYPRESS JMP ($FFFC) ; RESET -OPENPARMS !BYTE 3 +OPENPARMS !BYTE 3 !WORD STRBUF !WORD $0800 REFNUM !BYTE 0 -READPARMS !BYTE 4 +READPARMS !BYTE 4 !BYTE 0 !WORD $2000 !WORD $9F00 !WORD 0 CLOSEPARMS !BYTE 1 !BYTE 0 -DISABLE80 !BYTE 21, 13, '1', 26, 13 +DISABLE80 !BYTE 21, 13, '1', 26, 13 FAILMSG !TEXT "...TESER OT YEK YNA .DMC GNISSIM" -PAGE0 = * +PAGE0 = * ;****************************** ;* * ;* INTERP BYTECODE INNER LOOP * ;* * ;****************************** - !PSEUDOPC $00EF { + !PSEUDOPC $00EF { INX ; DROP @ $EF - INY ; NEXTOP @ $F0 + INY ; NEXTOP @ $F0 BEQ NEXTOPH LDA $FFFF,Y ; FETCHOP @ $F3, IP MAPS OVER $FFFF @ $F4 STA OPIDX JMP (OPTBL) ; OPIDX AND OPPAGE MAP OVER OPTBL -NEXTOPH INC IPH +NEXTOPH INC IPH BNE FETCHOP } PAGE3 = * @@ -386,10 +386,10 @@ LCDEFCMD = *-28 ; DEFCMD IN LC MEMORY ;* * ;***************** !ALIGN 255,0 -OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E - !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E +OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E + !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CSX ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E !WORD BRNCH,IBRNCH,CALLX,ICALX,ENTER,LEAVEX,RETX,NEXTOP; 50 52 54 56 58 5A 5C 5E !WORD LBX,LWX,LLBX,LLWX,LABX,LAWX,DLB,DLW ; 60 62 64 66 68 6A 6C 6E @@ -397,7 +397,7 @@ OPXTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E ;* ;* ADD TOS TO TOS-1 ;* -ADD LDA ESTKL,X +ADD LDA ESTKL,X CLC ADC ESTKL+1,X STA ESTKL+1,X @@ -410,7 +410,7 @@ ADD LDA ESTKL,X ;* ;* SUB TOS FROM TOS-1 ;* -SUB LDA ESTKL+1,X +SUB LDA ESTKL+1,X SEC SBC ESTKL,X STA ESTKL+1,X @@ -423,7 +423,7 @@ SUB LDA ESTKL+1,X ;* ;* SHIFT TOS LEFT BY 1, ADD TO TOS-1 ;* -IDXW LDA ESTKL,X +IDXW LDA ESTKL,X ASL ROL ESTKH,X CLC @@ -447,18 +447,18 @@ MUL STY IPY EOR #$FF STA TMPH LDA #$00 - STA ESTKL+1,X ; PRODL -; STA ESTKH+1,X ; PRODH -MULLP LSR TMPH ; MULTPLRH + STA ESTKL+1,X ; PRODL +; STA ESTKH+1,X ; PRODH +MULLP LSR TMPH ; MULTPLRH ROR TMPL ; MULTPLRL BCS + - STA ESTKH+1,X ; PRODH + STA ESTKH+1,X ; PRODH LDA ESTKL,X ; MULTPLNDL - ADC ESTKL+1,X ; PRODL + ADC ESTKL+1,X ; PRODL STA ESTKL+1,X - LDA ESTKH,X ; MULTPLNDH - ADC ESTKH+1,X ; PRODH -+ ASL ESTKL,X ; MULTPLNDL + LDA ESTKH,X ; MULTPLNDH + ADC ESTKH+1,X ; PRODH ++ ASL ESTKL,X ; MULTPLNDL ROL ESTKH,X ; MULTPLNDH DEY BNE MULLP @@ -470,7 +470,7 @@ MULLP LSR TMPH ; MULTPLRH ;* ;* INTERNAL DIVIDE ALGORITHM ;* -_NEG LDA #$00 +_NEG LDA #$00 SEC SBC ESTKL,X STA ESTKL,X @@ -479,7 +479,7 @@ _NEG LDA #$00 STA ESTKH,X RTS _DIV STY IPY - LDY #$11 ; #BITS+1 + LDY #$11 ; #BITS+1 LDA #$00 STA TMPL ; REMNDRL STA TMPH ; REMNDRH @@ -489,29 +489,29 @@ _DIV STY IPY BPL + JSR _NEG INC DVSIGN -+ LDA ESTKH+1,X ++ LDA ESTKH+1,X BPL + INX JSR _NEG DEX INC DVSIGN BNE _DIV1 -+ ORA ESTKL+1,X ; DVDNDL ++ ORA ESTKL+1,X ; DVDNDL BEQ _DIVEX -_DIV1 ASL ESTKL+1,X ; DVDNDL +_DIV1 ASL ESTKL+1,X ; DVDNDL ROL ESTKH+1,X ; DVDNDH DEY BCC _DIV1 -_DIVLP ROL TMPL ; REMNDRL +_DIVLP ROL TMPL ; REMNDRL ROL TMPH ; REMNDRH LDA TMPL ; REMNDRL - CMP ESTKL,X ; DVSRL + CMP ESTKL,X ; DVSRL LDA TMPH ; REMNDRH - SBC ESTKH,X ; DVSRH + SBC ESTKH,X ; DVSRH BCC + STA TMPH ; REMNDRH LDA TMPL ; REMNDRL - SBC ESTKL,X ; DVSRL + SBC ESTKL,X ; DVSRL STA TMPL ; REMNDRL SEC + ROL ESTKL+1,X ; DVDNDL @@ -524,7 +524,7 @@ _DIVEX INX ;* ;* NEGATE TOS ;* -NEG LDA #$00 +NEG LDA #$00 SEC SBC ESTKL,X STA ESTKL,X @@ -535,7 +535,7 @@ NEG LDA #$00 ;* ;* DIV TOS-1 BY TOS ;* -DIV JSR _DIV +DIV JSR _DIV LSR DVSIGN ; SIGN(RESULT) = (SIGN(DIVIDEND) + SIGN(DIVISOR)) & 1 BCS NEG JMP NEXTOP @@ -553,22 +553,22 @@ MOD JSR _DIV ;* ;* INCREMENT TOS ;* -INCR INC ESTKL,X +INCR INC ESTKL,X BNE INCR1 INC ESTKH,X -INCR1 JMP NEXTOP +INCR1 JMP NEXTOP ;* ;* DECREMENT TOS ;* -DECR LDA ESTKL,X +DECR LDA ESTKL,X BNE DECR1 DEC ESTKH,X -DECR1 DEC ESTKL,X +DECR1 DEC ESTKL,X JMP NEXTOP ;* ;* BITWISE COMPLIMENT TOS ;* -COMP LDA #$FF +COMP LDA #$FF EOR ESTKL,X STA ESTKL,X LDA #$FF @@ -578,11 +578,11 @@ COMP LDA #$FF ;* ;* BITWISE AND TOS TO TOS-1 ;* -BAND LDA ESTKL+1,X +BAND LDA ESTKL+1,X AND ESTKL,X STA ESTKL+1,X LDA ESTKH+1,X - AND ESTKH,X + AND ESTKH,X STA ESTKH+1,X ; INX ; JMP NEXTOP @@ -590,7 +590,7 @@ BAND LDA ESTKL+1,X ;* ;* INCLUSIVE OR TOS TO TOS-1 ;* -IOR LDA ESTKL+1,X +IOR LDA ESTKL+1,X ORA ESTKL,X STA ESTKL+1,X LDA ESTKH+1,X @@ -602,7 +602,7 @@ IOR LDA ESTKL+1,X ;* ;* EXLUSIVE OR TOS TO TOS-1 ;* -XOR LDA ESTKL+1,X +XOR LDA ESTKL+1,X EOR ESTKL,X STA ESTKL+1,X LDA ESTKH+1,X @@ -623,13 +623,13 @@ SHL STY IPY LDY #$00 STY ESTKL+1,X SBC #$08 -SHL1 TAY +SHL1 TAY BEQ SHL3 -SHL2 ASL ESTKL+1,X +SHL2 ASL ESTKL+1,X ROL ESTKH+1,X DEY BNE SHL2 -SHL3 LDY IPY +SHL3 LDY IPY ; INX ; JMP NEXTOP JMP DROP @@ -646,19 +646,19 @@ SHR STY IPY LDY #$00 BCC SHR1 DEY -SHR1 STY ESTKH+1,X +SHR1 STY ESTKH+1,X SEC SBC #$08 -SHR2 TAY +SHR2 TAY BEQ SHR4 LDA ESTKH+1,X -SHR3 CMP #$80 +SHR3 CMP #$80 ROR ROR ESTKL+1,X DEY BNE SHR3 STA ESTKH+1,X -SHR4 LDY IPY +SHR4 LDY IPY ; INX ; JMP NEXTOP JMP DROP @@ -676,14 +676,14 @@ LNOT1 EOR #$FF ;* ;* LOGICAL AND ;* -LAND LDA ESTKL+1,X +LAND LDA ESTKL+1,X ORA ESTKH+1,X BEQ LAND2 LDA ESTKL,X ORA ESTKH,X BEQ LAND1 LDA #$FF -LAND1 STA ESTKL+1,X +LAND1 STA ESTKL+1,X STA ESTKH+1,X ;LAND2 INX ; JMP NEXTOP @@ -691,13 +691,13 @@ LAND2 JMP DROP ;* ;* LOGICAL OR ;* -LOR LDA ESTKL,X +LOR LDA ESTKL,X ORA ESTKH,X ORA ESTKL+1,X ORA ESTKH+1,X BEQ LOR1 LDA #$FF - STA ESTKL+1,X + STA ESTKL+1,X STA ESTKH+1,X ;LOR1 INX ; JMP NEXTOP @@ -705,40 +705,33 @@ LOR1 JMP DROP ;* ;* DUPLICATE TOS ;* -DUP DEX +DUP DEX LDA ESTKL+1,X STA ESTKL,X LDA ESTKH+1,X STA ESTKH,X JMP NEXTOP ;* -;* PUSH FROM EVAL STACK TO CALL STACK +;* PUSH EVAL STACK POINTER TO CALL STACK ;* -PUSH LDA ESTKL,X +PUSHEP TXA PHA - LDA ESTKH,X - PHA -; INX -; JMP NEXTOP - JMP DROP + JMP NEXTOP ;* -;* PULL FROM CALL STACK TO EVAL STACK +;* PULL EVAL STACK POINTER FROM CALL STACK ;* -PULL DEX - PLA - STA ESTKH,X - PLA - STA ESTKL,X +PULLEP PLA + TAX JMP NEXTOP ;* ;* CONSTANT ;* -ZERO DEX +ZERO DEX LDA #$00 STA ESTKL,X STA ESTKH,X JMP NEXTOP -CB DEX +CB DEX +INC_IP LDA (IP),Y STA ESTKL,X @@ -751,10 +744,10 @@ CB DEX LA = * CW DEX +INC_IP - LDA (IP),Y + LDA (IP),Y STA ESTKL,X +INC_IP - LDA (IP),Y + LDA (IP),Y STA ESTKH,X JMP NEXTOP ;* @@ -776,21 +769,21 @@ CS DEX TAY JMP NEXTOP ; -CSX DEX +CSX DEX +INC_IP TYA ; NORMALIZE IP CLC - ADC IPL + ADC IPL STA IPL - LDA #$00 + LDA #$00 TAY - ADC IPH - STA IPH - LDA PPL ; SCAN POOL FOR STRING ALREADY THERE - STA TMPL + ADC IPH + STA IPH + LDA PPL ; SCAN POOL FOR STRING ALREADY THERE + STA TMPL LDA PPH STA TMPH -_CMPPSX ;LDA TMPH ; CHECK FOR END OF POOL +_CMPPSX ;LDA TMPH ; CHECK FOR END OF POOL CMP IFPH BCC _CMPSX ; CHECK FOR MATCHING STRING BNE _CPYSX ; BEYOND END OF POOL, COPY STRING OVER @@ -803,8 +796,8 @@ _CMPSX STA ALTRDOFF CMP (IP),Y ; COMPARE STRING LENGTHS BNE _CNXTSX1 TAY -_CMPCSX STA ALTRDOFF - LDA (TMP),Y ; COMPARE STRING CHARS FROM END +_CMPCSX STA ALTRDOFF + LDA (TMP),Y ; COMPARE STRING CHARS FROM END STA ALTRDON CMP (IP),Y BNE _CNXTSX @@ -815,7 +808,7 @@ _CMPCSX STA ALTRDOFF LDA TMPH STA ESTKH,X BNE _CEXSX -_CNXTSX LDY #$00 +_CNXTSX LDY #$00 STA ALTRDOFF LDA (TMP),Y STA ALTRDON @@ -837,7 +830,7 @@ _CPYSX LDA (IP),Y ; COPY STRING FROM AUX TO MAIN MEM POOL ADC PPH STA PPH STA ESTKH,X ; COPY STRING FROM AUX MEM BYTECODE TO MAIN MEM POOL -_CPYSX1 LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE +_CPYSX1 LDA (IP),Y ; ALTRD IS ON, NO NEED TO CHANGE IT HERE STA (PP),Y ; ALTWR IS OFF, NO NEED TO CHANGE IT HERE DEY CPY #$FF @@ -849,7 +842,7 @@ _CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING ;* ;* LOAD VALUE FROM ADDRESS TAG ;* -LB LDA ESTKL,X +LB LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH @@ -859,12 +852,12 @@ LB LDA ESTKL,X STA ESTKL,X STY ESTKH,X LDY IPY - JMP NEXTOP -LW LDA ESTKL,X + JMP NEXTOP +LW LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH - STY IPY + STY IPY LDY #$00 LDA (TMP),Y STA ESTKL,X @@ -891,9 +884,9 @@ LWX LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH - STY IPY + STY IPY STA ALTRDOFF - LDY #$00 + LDY #$00 LDA (TMP),Y STA ESTKL,X INY @@ -905,8 +898,8 @@ LWX LDA ESTKL,X ;* ;* LOAD ADDRESS OF LOCAL FRAME OFFSET ;* -LLA +INC_IP - LDA (IP),Y +LLA +INC_IP + LDA (IP),Y DEX CLC ADC IFPL @@ -918,8 +911,8 @@ LLA +INC_IP ;* ;* LOAD VALUE FROM LOCAL FRAME OFFSET ;* -LLB +INC_IP - LDA (IP),Y +LLB +INC_IP + LDA (IP),Y STY IPY TAY DEX @@ -929,8 +922,8 @@ LLB +INC_IP STA ESTKH,X LDY IPY JMP NEXTOP -LLW +INC_IP - LDA (IP),Y +LLW +INC_IP + LDA (IP),Y STY IPY TAY DEX @@ -943,7 +936,7 @@ LLW +INC_IP JMP NEXTOP ; LLBX +INC_IP - LDA (IP),Y + LDA (IP),Y STY IPY TAY DEX @@ -956,7 +949,7 @@ LLBX +INC_IP LDY IPY JMP NEXTOP LLWX +INC_IP - LDA (IP),Y + LDA (IP),Y STY IPY TAY DEX @@ -972,7 +965,7 @@ LLWX +INC_IP ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* -LAB +INC_IP +LAB +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -986,7 +979,7 @@ LAB +INC_IP STY ESTKH,X LDY IPY JMP NEXTOP -LAW +INC_IP +LAW +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1003,7 +996,7 @@ LAW +INC_IP LDY IPY JMP NEXTOP ; -LABX +INC_IP +LABX +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1019,7 +1012,7 @@ LABX +INC_IP STA ALTRDON LDY IPY JMP NEXTOP -LAWX +INC_IP +LAWX +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1040,11 +1033,11 @@ LAWX +INC_IP ;* ;* STORE VALUE TO ADDRESS ;* -SB LDA ESTKL+1,X +SB LDA ESTKL,X STA TMPL - LDA ESTKH+1,X + LDA ESTKH,X STA TMPH - LDA ESTKL,X + LDA ESTKL+1,X STY IPY LDY #$00 STA (TMP),Y @@ -1053,16 +1046,16 @@ SB LDA ESTKL+1,X ; INX ; JMP NEXTOP JMP DROP -SW LDA ESTKL+1,X +SW LDA ESTKL,X STA TMPL - LDA ESTKH+1,X + LDA ESTKH,X STA TMPH STY IPY LDY #$00 - LDA ESTKL,X + LDA ESTKL+1,X STA (TMP),Y INY - LDA ESTKH,X + LDA ESTKH+1,X STA (TMP),Y LDY IPY INX @@ -1072,8 +1065,8 @@ SW LDA ESTKL+1,X ;* ;* STORE VALUE TO LOCAL FRAME OFFSET ;* -SLB +INC_IP - LDA (IP),Y +SLB +INC_IP + LDA (IP),Y STY IPY TAY LDA ESTKL,X @@ -1082,8 +1075,8 @@ SLB +INC_IP ; INX ; JMP NEXTOP JMP DROP -SLW +INC_IP - LDA (IP),Y +SLW +INC_IP + LDA (IP),Y STY IPY TAY LDA ESTKL,X @@ -1092,13 +1085,13 @@ SLW +INC_IP LDA ESTKH,X STA (IFP),Y LDY IPY -; INX +; INX ; JMP NEXTOP JMP DROP ;* ;* STORE VALUE TO LOCAL FRAME OFFSET WITHOUT POPPING STACK ;* -DLB +INC_IP +DLB +INC_IP LDA (IP),Y STY IPY TAY @@ -1106,7 +1099,7 @@ DLB +INC_IP STA (IFP),Y LDY IPY JMP NEXTOP -DLW +INC_IP +DLW +INC_IP LDA (IP),Y STY IPY TAY @@ -1120,7 +1113,7 @@ DLW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS ;* -SAB +INC_IP +SAB +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1134,7 +1127,7 @@ SAB +INC_IP ; INX ; JMP NEXTOP JMP DROP -SAW +INC_IP +SAW +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1154,7 +1147,7 @@ SAW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK ;* -DAB +INC_IP +DAB +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1166,7 +1159,7 @@ DAB +INC_IP STA (TMP),Y LDY IPY JMP NEXTOP -DAW +INC_IP +DAW +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1203,7 +1196,7 @@ ISNE LDA ESTKL,X LDA ESTKH,X CMP ESTKH+1,X BNE ISTRU -ISFLS LDA #$00 +ISFLS LDA #$00 STA ESTKL+1,X STA ESTKH+1,X ; INX @@ -1216,7 +1209,7 @@ ISGE LDA ESTKL+1,X SBC ESTKH,X BVC ISGE1 EOR #$80 -ISGE1 BPL ISTRU +ISGE1 BPL ISTRU BMI ISFLS ; ISGT LDA ESTKL,X @@ -1225,7 +1218,7 @@ ISGT LDA ESTKL,X SBC ESTKH+1,X BVC ISGT1 EOR #$80 -ISGT1 BMI ISTRU +ISGT1 BMI ISTRU BPL ISFLS ; ISLE LDA ESTKL,X @@ -1234,7 +1227,7 @@ ISLE LDA ESTKL,X SBC ESTKH+1,X BVC ISLE1 EOR #$80 -ISLE1 BPL ISTRU +ISLE1 BPL ISTRU BMI ISFLS ; ISLT LDA ESTKL+1,X @@ -1243,19 +1236,19 @@ ISLT LDA ESTKL+1,X SBC ESTKH,X BVC ISLT1 EOR #$80 -ISLT1 BMI ISTRU +ISLT1 BMI ISTRU BPL ISFLS ;* ;* BRANCHES ;* -BRTRU INX +BRTRU INX LDA ESTKH-1,X ORA ESTKL-1,X BNE BRNCH -NOBRNCH +INC_IP +NOBRNCH +INC_IP +INC_IP JMP NEXTOP -BRFLS INX +BRFLS INX LDA ESTKH-1,X ORA ESTKL-1,X BNE NOBRNCH @@ -1275,7 +1268,7 @@ BRNCH LDA IPH DEY DEY JMP NEXTOP -BREQ INX +BREQ INX LDA ESTKL-1,X CMP ESTKL,X BNE NOBRNCH @@ -1283,7 +1276,7 @@ BREQ INX CMP ESTKH,X BEQ BRNCH BNE NOBRNCH -BRNE INX +BRNE INX LDA ESTKL-1,X CMP ESTKL,X BNE BRNCH @@ -1291,14 +1284,14 @@ BRNE INX CMP ESTKH,X BEQ NOBRNCH BNE BRNCH -BRGT INX +BRGT INX LDA ESTKL-1,X CMP ESTKL,X LDA ESTKH-1,X SBC ESTKH,X BMI BRNCH BPL NOBRNCH -BRLT INX +BRLT INX LDA ESTKL,X CMP ESTKL-1,X LDA ESTKH,X @@ -1318,7 +1311,7 @@ IBRNCH LDA IPL ;* ;* CALL INTO ABSOLUTE ADDRESS (NATIVE CODE) ;* -CALL +INC_IP +CALL +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1341,7 +1334,7 @@ CALL +INC_IP STA OPPAGE JMP NEXTOP ; -CALLX +INC_IP +CALLX +INC_IP LDA (IP),Y STA TMPL +INC_IP @@ -1355,7 +1348,7 @@ CALLX +INC_IP PHA STA ALTRDOFF CLI - JSR JMPTMP + JSR JMPTMP SEI STA ALTRDON PLA @@ -1370,7 +1363,7 @@ CALLX +INC_IP ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) ;* -ICAL LDA ESTKL,X +ICAL LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH @@ -1392,7 +1385,7 @@ ICAL LDA ESTKL,X STA OPPAGE JMP NEXTOP ; -ICALX LDA ESTKL,X +ICALX LDA ESTKL,X STA TMPL LDA ESTKH,X STA TMPH @@ -1424,7 +1417,7 @@ JMPTMP JMP (TMP) ;* ;* ENTER FUNCTION WITH FRAME SIZE AND PARAM COUNT ;* -ENTER INY +ENTER INY LDA (IP),Y PHA ; SAVE ON STACK FOR LEAVE EOR #$FF ; ALLOCATE FRAME @@ -1448,22 +1441,22 @@ ENTER INY INX DEY STA (IFP),Y - BNE - + BNE - + LDY #$02 JMP NEXTOP ;* ;* LEAVE FUNCTION ;* -LEAVEX STA ALTRDOFF +LEAVEX STA ALTRDOFF CLI -LEAVE PLA ; DEALLOCATE POOL + FRAME +LEAVE PLA ; DEALLOCATE POOL + FRAME CLC ADC IFPL STA PPL LDA #$00 ADC IFPH STA PPH - PLA ; RESTORE PREVIOUS FRAME + PLA ; RESTORE PREVIOUS FRAME STA IFPL PLA STA IFPH @@ -1475,7 +1468,7 @@ RET LDA IFPL ; DEALLOCATE POOL STA PPL LDA IFPH STA PPH - PLA ; RESTORE PREVIOUS FRAME + PLA ; RESTORE PREVIOUS FRAME STA IFPL PLA STA IFPH diff --git a/src/vmsrc/plvm03.s b/src/vmsrc/plvm03.s index bc82707..4d8f59a 100644 --- a/src/vmsrc/plvm03.s +++ b/src/vmsrc/plvm03.s @@ -218,7 +218,7 @@ _DIVEX INX OPTBL !WORD ZERO,ADD,SUB,MUL,DIV,MOD,INCR,DECR ; 00 02 04 06 08 0A 0C 0E !WORD NEG,COMP,BAND,IOR,XOR,SHL,SHR,IDXW ; 10 12 14 16 18 1A 1C 1E !WORD LNOT,LOR,LAND,LA,LLA,CB,CW,CS ; 20 22 24 26 28 2A 2C 2E - !WORD DROP,DUP,PUSH,PULL,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E + !WORD DROP,DUP,PUSHEP,PULLEP,BRGT,BRLT,BREQ,BRNE ; 30 32 34 36 38 3A 3C 3E !WORD ISEQ,ISNE,ISGT,ISLT,ISGE,ISLE,BRFLS,BRTRU ; 40 42 44 46 48 4A 4C 4E !WORD BRNCH,IBRNCH,CALL,ICAL,ENTER,LEAVE,RET,NEXTOP ; 50 52 54 56 58 5A 5C 5E !WORD LB,LW,LLB,LLW,LAB,LAW,DLB,DLW ; 60 62 64 66 68 6A 6C 6E @@ -488,23 +488,16 @@ DUP DEX STA ESTKH,X JMP NEXTOP ;* -;* PUSH FROM EVAL STACK TO CALL STACK +;* PUSH EVAL STACK POINTER TO CALL STACK ;* -PUSH LDA ESTKL,X +PUSHEP TXA PHA - LDA ESTKH,X - PHA -; INX -; JMP NEXTOP - JMP DROP + JMP NEXTOP ;* ;* PULL FROM CALL STACK TO EVAL STACK ;* -PULL DEX - PLA - STA ESTKH,X - PLA - STA ESTKL,X +PULLEP PLA + TAX JMP NEXTOP ;* ;* CONSTANT @@ -702,11 +695,11 @@ LAW +INC_IP ;* ;* STORE VALUE TO ADDRESS ;* -SB LDA ESTKL+1,X +SB LDA ESTKL,X STA TMPL - LDA ESTKH+1,X + LDA ESTKH,X STA TMPH - LDA ESTKL,X + LDA ESTKL+1,X STY IPY LDY #$00 STA (TMP),Y @@ -715,16 +708,16 @@ SB LDA ESTKL+1,X ; INX ; JMP NEXTOP JMP DROP -SW LDA ESTKL+1,X +SW LDA ESTKL,X STA TMPL - LDA ESTKH+1,X + LDA ESTKH,X STA TMPH STY IPY LDY #$00 - LDA ESTKL,X + LDA ESTKL+1,X STA (TMP),Y INY - LDA ESTKH,X + LDA ESTKH+1,X STA (TMP),Y LDY IPY INX diff --git a/src/vmsrc/plvmzp.inc b/src/vmsrc/plvmzp.inc old mode 100644 new mode 100755 index 2e6aebb..fd9bb75 --- a/src/vmsrc/plvmzp.inc +++ b/src/vmsrc/plvmzp.inc @@ -10,9 +10,9 @@ DST = SRC+2 DSTL = DST DSTH = DST+1 ESTKSZ = $20 -XSTK = $A0 -XSTKL = XSTK -XSTKH = XSTK+ESTKSZ/2 +XSTK = $A0 +XSTKL = XSTK +XSTKH = XSTK+ESTKSZ/2 ESTK = $C0 ESTKL = ESTK ESTKH = ESTK+ESTKSZ/2 diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla old mode 100644 new mode 100755 index 6abe962..0767d88 --- a/src/vmsrc/soscmd.pla +++ b/src/vmsrc/soscmd.pla @@ -34,13 +34,13 @@ predef loadmod, execmod, lookupstrmod // // System variables. // -word version = $0094 // 00.94 +word version = $0099 // 00.99 word systemflags = 0 byte refcons = 0 byte devcons = 0 word heap = $2000 byte modid = 0 -byte modseg[15] +byte modseg[15] word symtbl, lastsym byte perr, terr, lerr // @@ -108,7 +108,7 @@ word = @modadrstr, @lookupstrmod word = @machidstr, @machid word = @argstr, @cmdptr word = 0 -word syslibsym = @exports +word syslibsym = @exports // // CALL SOS // SYSCALL(CMD, PARAMS) @@ -411,7 +411,7 @@ asm interp STA ESTKH,X RTS end -// +// // A DCI string is one that has the high bit set for every character except the last. // More efficient than C or Pascal strings. // @@ -691,7 +691,7 @@ end // def dev_control(devnum, code, list) byte params[5] - + params.0 = 3 params.1 = devnum params.2 = code @@ -701,7 +701,7 @@ def dev_control(devnum, code, list) end def dev_getnum(name) byte params[4] - + params.0 = 2 params:1 = name params.3 = 0 @@ -710,7 +710,7 @@ def dev_getnum(name) end def dev_info(devnum, name, list, listlen) byte params[7] - + params.0 = 4 params.1 = devnum params:2 = name @@ -724,7 +724,7 @@ end // def seg_request(base, limit, id) byte params[7] - + params.0 = 4 params:1 = base params:3 = limit @@ -735,7 +735,7 @@ def seg_request(base, limit, id) end def seg_find(search, base, limit, pages, id) byte params[10] - + params.0 = 6 params.1 = search params.2 = id @@ -750,7 +750,7 @@ def seg_find(search, base, limit, pages, id) end def seg_release(segnum) byte params[2] - + params.0 = 1 params.1 = segnum perr = syscall($45, @params) @@ -948,7 +948,7 @@ def loadmod(mod) moddep = @header.1 defofst = modsize init = 0 - if rdlen > 4 and header:2 == $DA7E // DAVE = magic number :-) + if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-) // // This is an EXTended RELocatable (data+bytecode) module. // @@ -985,6 +985,8 @@ def loadmod(mod) refnum = open(@filename, O_READ) rdlen = read(refnum, @header, 128) fin + else + return -69 fin // // Alloc heap space for relocated module (data + bytecode).