From 50f066e527b7fc7491e84f6b8bb3d9db1ab0b832 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Mon, 7 Aug 2017 07:34:56 -0700 Subject: [PATCH 1/6] Fix DEFCNT for lambda functions --- src/samplesrc/test.pla | 5 +++++ src/toolsrc/parse.c | 11 ++++++++--- 2 files changed, 13 insertions(+), 3 deletions(-) diff --git a/src/samplesrc/test.pla b/src/samplesrc/test.pla index e35a03d..0de4a05 100755 --- a/src/samplesrc/test.pla +++ b/src/samplesrc/test.pla @@ -121,6 +121,11 @@ export def main(range) lambda = &(x,y) x * y puti(lambda(2,3));putln end + +def dummy(zz)#0 + puts("dummy func"); putln +end + puti(array[0]);putc(' ') puti(array[1]);putc(' ') puti(array[2]);putc(' ') diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index 781af06..548e5f2 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -1485,7 +1485,6 @@ int parse_lambda(void) * Parse parameters and return value count */ cfnparms = 0; - func_tag = tag_new(DEF_TYPE); if (scan() == OPEN_PAREN_TOKEN) { do @@ -1527,13 +1526,19 @@ int parse_lambda(void) lambda_seq[lambda_cnt] = parse_expr(NULL, NULL); scan_rewind(tokenstr); } - lambda_cparams[lambda_cnt] = cfnparms; - lambda_tag[lambda_cnt] = func_tag; sprintf(lambda_id[lambda_cnt], "_LAMBDA%04d", lambda_num++); if (idglobal_lookup(lambda_id[lambda_cnt], strlen(lambda_id[lambda_cnt])) >= 0) + { + func_tag = lambda_tag[lambda_cnt]; idfunc_set(lambda_id[lambda_cnt], strlen(lambda_id[lambda_cnt]), DEF_TYPE | funcparms_type(cfnparms), func_tag); // Override any predef type & tag + } else + { + func_tag = tag_new(DEF_TYPE); + lambda_tag[lambda_cnt] = func_tag; + lambda_cparams[lambda_cnt] = cfnparms; idfunc_add(lambda_id[lambda_cnt], strlen(lambda_id[lambda_cnt]), DEF_TYPE | funcparms_type(cfnparms), func_tag); + } lambda_cnt++; idlocal_restore(); return (func_tag); From 45913348967710d9afbf9576678c285691679e1f Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sat, 12 Aug 2017 15:50:36 -0700 Subject: [PATCH 2/6] Add optional self-modifying opcode implementation. --- src/vmsrc/plvm01.s | 67 ++++++++++++++++++++++ src/vmsrc/plvm02.s | 128 ++++++++++++++++++++++++++++++++++++++++++- src/vmsrc/plvm03.s | 67 ++++++++++++++++++++++ src/vmsrc/plvmzp.inc | 70 +++++++++++------------ 4 files changed, 296 insertions(+), 36 deletions(-) diff --git a/src/vmsrc/plvm01.s b/src/vmsrc/plvm01.s index 956677a..cf1d8fb 100644 --- a/src/vmsrc/plvm01.s +++ b/src/vmsrc/plvm01.s @@ -5,6 +5,7 @@ ;* SYSTEM ROUTINES AND LOCATIONS ;* ;********************************************************** +SELFMODIFY = 1 ;* ;* VM ZERO PAGE LOCATIONS ;* @@ -441,6 +442,17 @@ CS DEX ;* ;* LOAD VALUE FROM ADDRESS TAG ;* +!IF SELFMODIFY { +LB LDA ESTKL,X + STA LBLDA+1 + LDA ESTKH,X + STA LBLDA+2 +LBLDA LDA $FFFF + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +} ELSE { LB LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -452,6 +464,7 @@ LB LDA ESTKL,X STY ESTKH,X LDY IPY JMP NEXTOP +} LW LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -507,6 +520,20 @@ LLW +INC_IP ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* +!IF SELFMODIFY { +LAB +INC_IP + LDA (IP),Y + STA LABLDA+1 + +INC_IP + LDA (IP),Y + STA LABLDA+2 +LABLDA LDA $FFFF + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +} ELSE { LAB +INC_IP LDA (IP),Y STA TMPL @@ -521,6 +548,7 @@ LAB +INC_IP STY ESTKH,X LDY IPY JMP NEXTOP +} LAW +INC_IP LDA (IP),Y STA TMPL @@ -540,6 +568,18 @@ LAW +INC_IP ;* ;* STORE VALUE TO ADDRESS ;* +!IF SELFMODIFY { +SB LDA ESTKL,X + STA SBSTA+1 + LDA ESTKH,X + STA SBSTA+2 + LDA ESTKL+1,X +SBSTA STA $FFFF + INX +; INX +; JMP NEXTOP + JMP DROP +} ELSE { SB LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -553,6 +593,7 @@ SB LDA ESTKL,X ; INX ; JMP NEXTOP JMP DROP +} SW LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -620,6 +661,19 @@ DLW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS ;* +!IF SELFMODIFY { +SAB +INC_IP + LDA (IP),Y + STA SABSTA+1 + +INC_IP + LDA (IP),Y + STA SABSTA+2 + LDA ESTKL,X +SABSTA STA $FFFF +; INX +; JMP NEXTOP + JMP DROP +} ELSE { SAB +INC_IP LDA (IP),Y STA TMPL @@ -634,6 +688,7 @@ SAB +INC_IP ; INX ; JMP NEXTOP JMP DROP +} SAW +INC_IP LDA (IP),Y STA TMPL @@ -654,6 +709,17 @@ SAW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK ;* +!IF SELFMODIFY { +DAB +INC_IP + LDA (IP),Y + STA DABSTA+1 + +INC_IP + LDA (IP),Y + STA DABSTA+2 + LDA ESTKL,X +DABSTA STA $FFFF + JMP NEXTOP +} ELSE { DAB +INC_IP LDA (IP),Y STA TMPL @@ -666,6 +732,7 @@ DAB +INC_IP STA (TMP),Y LDY IPY JMP NEXTOP +} DAW +INC_IP LDA (IP),Y STA TMPL diff --git a/src/vmsrc/plvm02.s b/src/vmsrc/plvm02.s index 175958c..94c1569 100755 --- a/src/vmsrc/plvm02.s +++ b/src/vmsrc/plvm02.s @@ -5,6 +5,7 @@ ;* SYSTEM ROUTINES AND LOCATIONS ;* ;********************************************************** +SELFMODIFY = 0 ;* ;* MONITOR SPECIAL LOCATIONS ;* @@ -195,9 +196,13 @@ DINTRP PLA LDA PPH STA IFPH LDY #$00 +!IF SELFMODIFY { + BEQ + +} ELSE { LDA #>OPTBL STA OPPAGE JMP FETCHOP +} IINTRP PLA STA TMPL PLA @@ -217,8 +222,12 @@ IINTRP PLA STA IFPL LDA PPH STA IFPH - LDA #>OPTBL ++ LDA #>OPTBL STA OPPAGE +!IF SELFMODIFY { + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 +} JMP FETCHOP IINTRPX PLA STA TMPL @@ -243,6 +252,10 @@ IINTRPX PLA STA OPPAGE SEI STA ALTRDON +!IF SELFMODIFY { + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 +} JMP FETCHOP ;************************************************************ ;* * @@ -844,6 +857,17 @@ _CEXSX LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING ;* ;* LOAD VALUE FROM ADDRESS TAG ;* +!IF SELFMODIFY { +LB LDA ESTKL,X + STA LBLDA+1 + LDA ESTKH,X + STA LBLDA+2 +LBLDA LDA $FFFF + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +} ELSE { LB LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -855,6 +879,7 @@ LB LDA ESTKL,X STY ESTKH,X LDY IPY JMP NEXTOP +} LW LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -869,6 +894,19 @@ LW LDA ESTKL,X LDY IPY JMP NEXTOP ; +!IF SELFMODIFY { +LBX LDA ESTKL,X + STA LBXLDA+1 + LDA ESTKH,X + STA LBXLDA+2 + STA ALTRDOFF +LBXLDA LDA $FFFF + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +} ELSE { LBX LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -882,6 +920,7 @@ LBX LDA ESTKL,X LDY IPY STA ALTRDON JMP NEXTOP +} LWX LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -967,6 +1006,20 @@ LLWX +INC_IP ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* +!IF SELFMODIFY { +LAB +INC_IP + LDA (IP),Y + STA LABLDA+1 + +INC_IP + LDA (IP),Y + STA LABLDA+2 +LABLDA LDA $FFFF + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +} ELSE { LAB +INC_IP LDA (IP),Y STA TMPL @@ -981,6 +1034,7 @@ LAB +INC_IP STY ESTKH,X LDY IPY JMP NEXTOP +} LAW +INC_IP LDA (IP),Y STA TMPL @@ -998,6 +1052,22 @@ LAW +INC_IP LDY IPY JMP NEXTOP ; +!IF SELFMODIFY { +LABX +INC_IP + LDA (IP),Y + STA LABXLDA+1 + +INC_IP + LDA (IP),Y + STA LABXLDA+2 + STA ALTRDOFF +LABXLDA LDA $FFFF + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + STA ALTRDON + JMP NEXTOP +} ELSE { LABX +INC_IP LDA (IP),Y STA TMPL @@ -1014,6 +1084,7 @@ LABX +INC_IP STA ALTRDON LDY IPY JMP NEXTOP +} LAWX +INC_IP LDA (IP),Y STA TMPL @@ -1035,6 +1106,18 @@ LAWX +INC_IP ;* ;* STORE VALUE TO ADDRESS ;* +!IF SELFMODIFY { +SB LDA ESTKL,X + STA SBSTA+1 + LDA ESTKH,X + STA SBSTA+2 + LDA ESTKL+1,X +SBSTA STA $FFFF + INX +; INX +; JMP NEXTOP + JMP DROP +} ELSE { SB LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -1048,6 +1131,7 @@ SB LDA ESTKL,X ; INX ; JMP NEXTOP JMP DROP +} SW LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -1115,6 +1199,19 @@ DLW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS ;* +!IF SELFMODIFY { +SAB +INC_IP + LDA (IP),Y + STA SABSTA+1 + +INC_IP + LDA (IP),Y + STA SABSTA+2 + LDA ESTKL,X +SABSTA STA $FFFF +; INX +; JMP NEXTOP + JMP DROP +} ELSE { SAB +INC_IP LDA (IP),Y STA TMPL @@ -1129,6 +1226,7 @@ SAB +INC_IP ; INX ; JMP NEXTOP JMP DROP +} SAW +INC_IP LDA (IP),Y STA TMPL @@ -1149,6 +1247,17 @@ SAW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK ;* +!IF SELFMODIFY { +DAB +INC_IP + LDA (IP),Y + STA DABSTA+1 + +INC_IP + LDA (IP),Y + STA DABSTA+2 + LDA ESTKL,X +DABSTA STA $FFFF + JMP NEXTOP +} ELSE { DAB +INC_IP LDA (IP),Y STA TMPL @@ -1161,6 +1270,7 @@ DAB +INC_IP STA (TMP),Y LDY IPY JMP NEXTOP +} DAW +INC_IP LDA (IP),Y STA TMPL @@ -1334,6 +1444,10 @@ CALL +INC_IP STA IPH LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE +!IF SELFMODIFY { + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 +} JMP NEXTOP ; CALLX +INC_IP @@ -1361,6 +1475,10 @@ CALLX +INC_IP STA IPH LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE +!IF SELFMODIFY { + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 +} JMP NEXTOP ;* ;* INDIRECT CALL TO ADDRESS (NATIVE CODE) @@ -1385,6 +1503,10 @@ ICAL LDA ESTKL,X STA IPH LDA #>OPTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE +!IF SELFMODIFY { + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 +} JMP NEXTOP ; ICALX LDA ESTKL,X @@ -1411,6 +1533,10 @@ ICALX LDA ESTKL,X STA IPH LDA #>OPXTBL ; MAKE SURE WE'RE INDEXING THE RIGHT TABLE STA OPPAGE +!IF SELFMODIFY { + BIT LCRWEN+LCBNK2 + BIT LCRWEN+LCBNK2 +} JMP NEXTOP ;* ;* JUMP INDIRECT TRHOUGH TMP diff --git a/src/vmsrc/plvm03.s b/src/vmsrc/plvm03.s index 89dec04..ee2e9f0 100644 --- a/src/vmsrc/plvm03.s +++ b/src/vmsrc/plvm03.s @@ -5,6 +5,7 @@ ;* SYSTEM ROUTINES AND LOCATIONS ;* ;********************************************************** +SELFMODIFY = 1 ; ; HARDWARE REGISTERS ; @@ -598,6 +599,17 @@ _CEXS LDA (IP),Y ; SKIP TO NEXT OP ADDR AFTER STRING ;* ;* LOAD VALUE FROM ADDRESS TAG ;* +!IF SELFMODIFY { +LB LDA ESTKL,X + STA LBLDA+1 + LDA ESTKH,X + STA LBLDA+2 +LBLDA LDA $FFFF + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +} ELSE { LB LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -609,6 +621,7 @@ LB LDA ESTKL,X STY ESTKH,X LDY IPY JMP NEXTOP +} LW LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -664,6 +677,20 @@ LLW +INC_IP ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* +!IF SELFMODIFY { +LAB +INC_IP + LDA (IP),Y + STA LABLDA+1 + +INC_IP + LDA (IP),Y + STA LABLDA+2 +LABLDA LDA $FFFF + DEX + STA ESTKL,X + LDA #$00 + STA ESTKH,X + JMP NEXTOP +} ELSE { LAB +INC_IP LDA (IP),Y STA TMPL @@ -678,6 +705,7 @@ LAB +INC_IP STY ESTKH,X LDY IPY JMP NEXTOP +} LAW +INC_IP LDA (IP),Y STA TMPL @@ -697,6 +725,18 @@ LAW +INC_IP ;* ;* STORE VALUE TO ADDRESS ;* +!IF SELFMODIFY { +SB LDA ESTKL,X + STA SBSTA+1 + LDA ESTKH,X + STA SBSTA+2 + LDA ESTKL+1,X +SBSTA STA $FFFF + INX +; INX +; JMP NEXTOP + JMP DROP +} ELSE { SB LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -710,6 +750,7 @@ SB LDA ESTKL,X ; INX ; JMP NEXTOP JMP DROP +} SW LDA ESTKL,X STA TMPL LDA ESTKH,X @@ -777,6 +818,19 @@ DLW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS ;* +!IF SELFMODIFY { +SAB +INC_IP + LDA (IP),Y + STA SABSTA+1 + +INC_IP + LDA (IP),Y + STA SABSTA+2 + LDA ESTKL,X +SABSTA STA $FFFF +; INX +; JMP NEXTOP + JMP DROP +} ELSE { SAB +INC_IP LDA (IP),Y STA TMPL @@ -791,6 +845,7 @@ SAB +INC_IP ; INX ; JMP NEXTOP JMP DROP +} SAW +INC_IP LDA (IP),Y STA TMPL @@ -811,6 +866,17 @@ SAW +INC_IP ;* ;* STORE VALUE TO ABSOLUTE ADDRESS WITHOUT POPPING STACK ;* +!IF SELFMODIFY { +DAB +INC_IP + LDA (IP),Y + STA DABSTA+1 + +INC_IP + LDA (IP),Y + STA DABSTA+2 + LDA ESTKL,X +DABSTA STA $FFFF + JMP NEXTOP +} ELSE { DAB +INC_IP LDA (IP),Y STA TMPL @@ -823,6 +889,7 @@ DAB +INC_IP STA (TMP),Y LDY IPY JMP NEXTOP +} DAW +INC_IP LDA (IP),Y STA TMPL diff --git a/src/vmsrc/plvmzp.inc b/src/vmsrc/plvmzp.inc index fd9bb75..e955f19 100755 --- a/src/vmsrc/plvmzp.inc +++ b/src/vmsrc/plvmzp.inc @@ -1,41 +1,41 @@ ;********************************************************** ;* -;* VM ZERO PAGE LOCATIONS +;* VM ZERO PAGE LOCATIONS ;* ;********************************************************** -SRC = $06 -SRCL = SRC -SRCH = SRC+1 -DST = SRC+2 -DSTL = DST -DSTH = DST+1 -ESTKSZ = $20 -XSTK = $A0 -XSTKL = XSTK -XSTKH = XSTK+ESTKSZ/2 -ESTK = $C0 -ESTKL = ESTK -ESTKH = ESTK+ESTKSZ/2 -VMZP = ESTK+ESTKSZ -ESP = VMZP -DVSIGN = VMZP -IFP = ESP+1 -IFPL = IFP -IFPH = IFP+1 +SRC = $06 +SRCL = SRC +SRCH = SRC+1 +DST = SRC+2 +DSTL = DST +DSTH = DST+1 +ESTKSZ = $20 +XSTK = $A0 +XSTKL = XSTK +XSTKH = XSTK+ESTKSZ/2 +ESTK = $C0 +ESTKL = ESTK +ESTKH = ESTK+ESTKSZ/2 +VMZP = ESTK+ESTKSZ +ESP = VMZP +DVSIGN = VMZP +IFP = ESP+1 +IFPL = IFP +IFPH = IFP+1 PP = IFP+2 -PPL = PP -PPH = PP+1 -IPY = PP+2 -TMP = IPY+1 -TMPL = TMP -TMPH = TMP+1 -NPARMS = TMPL -FRMSZ = TMPH -DROP = $EF -NEXTOP = $F0 +PPL = PP +PPH = PP+1 +IPY = PP+2 +TMP = IPY+1 +TMPL = TMP +TMPH = TMP+1 +NPARMS = TMPL +FRMSZ = TMPH +DROP = $EF +NEXTOP = $F0 FETCHOP = NEXTOP+3 -IP = FETCHOP+1 -IPL = IP -IPH = IPL+1 -OPIDX = FETCHOP+6 -OPPAGE = OPIDX+1 +IP = FETCHOP+1 +IPL = IP +IPH = IPL+1 +OPIDX = FETCHOP+6 +OPPAGE = OPIDX+1 From b5cac6dc3d2a7129dacbdaf27097657b62ad4ca6 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sat, 12 Aug 2017 16:28:29 -0700 Subject: [PATCH 3/6] Quick hack to flag var: and var=> without follow-on value as error --- src/toolsrc/parse.c | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/toolsrc/parse.c b/src/toolsrc/parse.c index 548e5f2..b9ac3ca 100755 --- a/src/toolsrc/parse.c +++ b/src/toolsrc/parse.c @@ -584,6 +584,11 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth) type = (scantoken == PTRB_TOKEN) ? BPTR_TYPE : WPTR_TYPE; if (!parse_const(&const_offset)) { + if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN) + { + parse_error("Syntax"); + return (NULL); + } /* * Setting type override for following operations */ @@ -618,6 +623,11 @@ t_opseq *parse_value(t_opseq *codeseq, int rvalue, int *stackdepth) : ((scantoken == DOT_TOKEN) ? BPTR_TYPE : WPTR_TYPE); if (!parse_const(&const_offset)) { + if (scantoken == EOL_TOKEN || scantoken == CLOSE_PAREN_TOKEN) + { + parse_error("Syntax"); + return (NULL); + } /* * Setting type override for following operations */ From 326482a2a04ca690c0e3a9b01945d4802a873d00 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sun, 27 Aug 2017 13:29:50 -0700 Subject: [PATCH 4/6] Add parameter/return values for predefs --- src/inc/cmdsys.plh | 12 +-- src/inc/testlib.plh | 4 +- src/makefile | 10 +-- src/samplesrc/test.pla | 13 +-- src/samplesrc/testlib.pla | 6 +- src/vmsrc/cmd.pla | 181 ++++++++++++++++++++------------------ src/vmsrc/plvm.c | 4 - 7 files changed, 117 insertions(+), 113 deletions(-) diff --git a/src/inc/cmdsys.plh b/src/inc/cmdsys.plh index 59ad45d..e8d6599 100644 --- a/src/inc/cmdsys.plh +++ b/src/inc/cmdsys.plh @@ -36,10 +36,10 @@ import cmdsys // // CMD exported functions // - predef putc, putln, puts, getc, gets - predef call, syscall - predef heapmark, heapallocalign, heapalloc, heaprelease, heapavail - predef memset, memcpy - predef isugt, isuge, isult, isule - predef modload, modexec, modaddr + predef putc(c)#0, putln()#0, puts(s)#0, getc()#1, gets(p)#1 + predef call(addr,areg,xreg,yreg,status)#1, syscall(cmd,params)#1 + predef heapmark()#1, heapallocalign(size, pow2, freeaddr), heapalloc(size)#1, heaprelease(newheap)#1, heapavail()#1 + predef memset(addr,value,size)#0, memcpy(dst,src,size)#0 + predef isugt(a,b)#1, isuge(a,b)#1, isult(a,b)#1, isule(a,b)#1 + predef modload(mod)#1, modexec(modfile)#1, modaddr(str)#1 end diff --git a/src/inc/testlib.plh b/src/inc/testlib.plh index 66710fa..11f5abd 100644 --- a/src/inc/testlib.plh +++ b/src/inc/testlib.plh @@ -1,6 +1,6 @@ import testlib - predef puti - word print + predef puti(i)#0 + word print(s)#0 const dec = 0 const hex = 2 const newln = 4 diff --git a/src/makefile b/src/makefile index e82e8be..d1f53bb 100755 --- a/src/makefile +++ b/src/makefile @@ -83,20 +83,20 @@ $(PLVM): vmsrc/plvm.c cc vmsrc/plvm.c -o $(PLVM) vmsrc/a1cmd.a: vmsrc/a1cmd.pla $(PLASM) - ./$(PLASM) -AO < vmsrc/a1cmd.pla > vmsrc/a1cmd.a + ./$(PLASM) -AOW < 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) -AO < vmsrc/cmd.pla > vmsrc/cmd.a + ./$(PLASM) -AOW < 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) -AO < vmsrc/soscmd.pla > vmsrc/soscmd.a + ./$(PLASM) -AOW < vmsrc/soscmd.pla > vmsrc/soscmd.a $(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a acme -o $(PLVM03) -l vmsrc/plvm03.sym vmsrc/plvm03.s @@ -105,9 +105,9 @@ $(PLVM03): vmsrc/plvm03.s vmsrc/soscmd.a # Sample code # test: samplesrc/test.pla samplesrc/testlib.pla $(PLVM) $(PLASM) - ./$(PLASM) -AMO < samplesrc/test.pla > samplesrc/test.a + ./$(PLASM) -AMOW < samplesrc/test.pla > samplesrc/test.a acme --setpc 4094 -o $(TEST) samplesrc/test.a - ./$(PLASM) -AMO < samplesrc/testlib.pla > samplesrc/testlib.a + ./$(PLASM) -AMOW < samplesrc/testlib.pla > samplesrc/testlib.a acme --setpc 4094 -o $(TESTLIB) samplesrc/testlib.a ./$(PLVM) TEST diff --git a/src/samplesrc/test.pla b/src/samplesrc/test.pla index 0de4a05..f07cab7 100755 --- a/src/samplesrc/test.pla +++ b/src/samplesrc/test.pla @@ -35,20 +35,20 @@ word ptr // // Define functions. // -def tens(start) +def tens(start)#0 word i, pptr i = start pptr = @print repeat - print:hex(i) + print:hex(i)#0 print:str(" ") - pptr=>dec(i) + pptr=>dec(i)#0 print:newln() i = i / 10 until i == 0 end -def ascii +def ascii#0 byte i i = 32 while i < 128 @@ -56,7 +56,7 @@ def ascii i = i + 1 loop end -def nums(range) +def nums(range)#0 word i byte j for i = range downto -range step range/10 @@ -81,7 +81,7 @@ def printfunc(a, b, lambda)#0 puti(lambda(a,b)) putln end -export def main(range) +export def main(range)#0 byte a word lambda @@ -124,6 +124,7 @@ end def dummy(zz)#0 puts("dummy func"); putln + return 0 end puti(array[0]);putc(' ') diff --git a/src/samplesrc/testlib.pla b/src/samplesrc/testlib.pla index ebaca9f..2a50e73 100755 --- a/src/samplesrc/testlib.pla +++ b/src/samplesrc/testlib.pla @@ -5,21 +5,21 @@ include "inc/cmdsys.plh" // // Module data. // -predef puti, puth +predef puti(i)#0, puth(h)#0 export word print[] = @puti, @puth, @putln, @puts, @putc byte valstr[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' byte loadstr[] = "testlib loaded!" // // Define functions. // -def puth(h) +def puth(h)#0 putc('$') putc(valstr[(h >> 12) & $0F]) putc(valstr[(h >> 8) & $0F]) putc(valstr[(h >> 4) & $0F]) putc(valstr[ h & $0F]) end -export def puti(i) +export def puti(i)#0 if i < 0; putc('-'); i = -i; fin if i < 10 putc(i + '0') diff --git a/src/vmsrc/cmd.pla b/src/vmsrc/cmd.pla index 14c9201..efbc46a 100755 --- a/src/vmsrc/cmd.pla +++ b/src/vmsrc/cmd.pla @@ -24,12 +24,12 @@ const modinitkeep = $4000 // // Pedefined functions. // -predef syscall, call -predef crout, cout, prstr, cin, rdstr -predef markheap, allocheap, allocalignheap, releaseheap, availheap -predef memset, memcpy -predef uword_isgt, uword_isge, uword_islt, uword_isle -predef loadmod, execmod, lookupstrmod +predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, cin()#1, rdstr(p)#1 +predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1 +predef memset(addr,value,size)#0, memcpy(dst,src,size)#0 +predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1 +predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1 // // System variable. // @@ -100,7 +100,7 @@ word syslibsym = @exports // CALL PRODOS // SYSCALL(CMD, PARAMS) // -asm syscall +asm syscall(cmd,params)#1 LDA ESTKL,X LDY ESTKH,X STA PARAMS @@ -120,7 +120,7 @@ end // CALL 6502 ROUTINE // CALL(ADDR, AREG, XREG, YREG, STATUS) // -asm call +asm call(addr,areg,xreg,yreg,sstatus)#1 REGVALS = SRC PHP LDA ESTKL+4,X @@ -137,7 +137,7 @@ REGVALS = SRC INX INX INX - INX + INX STX ESP TAX PLA @@ -163,7 +163,7 @@ end // // CALL LOADED SYSTEM PROGRAM // -asm exec +asm exec()#0 LDX #$00 STX IFPL LDA #$BF @@ -177,7 +177,7 @@ end // // EXIT // -asm reboot +asm reboot()#0 BIT ROMEN DEC $03F4 ; INVALIDATE POWER-UP BYTE JMP ($FFFC) ; RESET @@ -187,7 +187,7 @@ end // MEMSET(ADDR, VALUE, SIZE) // With optimizations from Peter Ferrie // -asm memset +asm memset(addr,value,size)#0 LDA ESTKL+2,X STA DSTL LDA ESTKH+2,X @@ -214,6 +214,7 @@ SETMLPH STA (DST),Y ++ DEC ESTKH,X BNE - SETMEX INX + INX INX RTS end @@ -221,31 +222,32 @@ end // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // -asm memcpy +asm memcpy(dst,src,size)#0 INX INX - LDA ESTKL-2,X - ORA ESTKH-2,X + INX + LDA ESTKL-3,X + ORA ESTKH-3,X BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH LDA ESTKL-1,X - STA SRCL + STA DSTL LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X STA SRCH - LDY ESTKL-2,X + LDY ESTKL-3,X BEQ FORCPYLP - INC ESTKH-2,X + INC ESTKH-3,X LDY #$00 FORCPYLP LDA (SRC),Y STA (DST),Y @@ -253,34 +255,34 @@ FORCPYLP LDA (SRC),Y BNE + INC DSTH INC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE FORCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE FORCPYLP RTS ; ; REVERSE COPY ; REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X + LDA ESTKL-3,X + ADC ESTKL-1,X STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X + LDA ESTKH-3,X + ADC ESTKH-1,X STA DSTH CLC - LDA ESTKL-2,X - ADC ESTKL-1,X + LDA ESTKL-3,X + ADC ESTKL-2,X STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X + LDA ESTKH-3,X + ADC ESTKH-2,X STA SRCH DEC DSTH DEC SRCH LDY #$FF - LDA ESTKL-2,X + LDA ESTKL-3,X BEQ REVCPYLP - INC ESTKH-2,X + INC ESTKH-3,X REVCPYLP LDA (SRC),Y STA (DST),Y DEY @@ -288,9 +290,9 @@ REVCPYLP LDA (SRC),Y BNE + DEC DSTH DEC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE REVCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE REVCPYLP CPYMEX RTS end @@ -299,7 +301,7 @@ end // // MEMXCPY(DST, SRC, SIZE) // -asm memxcpy +asm memxcpy(dst,src,size)#0 LDA ESTKL+1,X STA $3C CLC @@ -321,9 +323,10 @@ asm memxcpy LDX ESP INX INX + INX RTS end -asm crout +asm crout()#0 DEX LDA #$0D BNE + @@ -333,7 +336,7 @@ end // CHAR OUT // COUT(CHAR) // -asm cout +asm cout(c)#0 LDA ESTKL,X BIT $BF98 BMI + @@ -342,13 +345,14 @@ asm cout BIT ROMEN JSR $FDED BIT LCRDEN+LCBNK2 + INX RTS end // // CHAR IN // RDKEY() // -asm cin +asm cin()#1 BIT ROMEN JSR $FD0C BIT LCRDEN+LCBNK2 @@ -363,7 +367,7 @@ end // PRINT STRING // PRSTR(STR) // -asm prstr +asm prstr(s)#0 LDY #$00 LDA ESTKL,X STA SRCL @@ -383,24 +387,26 @@ asm prstr CPY TMP BNE - BIT LCRDEN+LCBNK2 -++ RTS +++ INX + RTS end // // PRINT BYTE // -asm prbyte +asm prbyte(b)#0 LDA ESTKL,X STX ESP BIT ROMEN JSR $FDDA LDX ESP BIT LCRDEN+LCBNK2 + INX RTS end // // PRINT WORD // -asm prword +asm prword(w)#0 STX ESP TXA TAY @@ -410,13 +416,14 @@ asm prword JSR $F941 LDX ESP BIT LCRDEN+LCBNK2 + INX RTS end // // READ STRING // STR = RDSTR(PROMPTCHAR) // -asm rdstr +asm rdstr(p)#1 LDA ESTKL,X STA $33 STX ESP @@ -436,7 +443,7 @@ asm rdstr BIT LCRDEN+LCBNK2 RTS end -asm uword_isge +asm uword_isge(a,b)#1 LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -449,7 +456,7 @@ asm uword_isge INX RTS end -asm uword_isle +asm uword_isle(a,b)#1 LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -462,7 +469,7 @@ asm uword_isle INX RTS end -asm uword_isgt +asm uword_isgt(a,b)#1 LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -474,7 +481,7 @@ asm uword_isgt INX RTS end -asm uword_islt +asm uword_islt(a,b)#1 LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -503,7 +510,7 @@ end // ^str = len // return len //end -asm dcitos +asm dcitos(dci, str)#1 LDA ESTKL,X STA DSTL LDA ESTKH,X @@ -543,7 +550,7 @@ end // loop // return ^str //end -asm stodci +asm stodci(str,dci)#1 LDA ESTKL,X STA DSTL LDA ESTKH,X @@ -571,7 +578,7 @@ asm stodci STY ESTKH,X RTS end -asm toupper +asm toupper(c)#1 LDA ESTKL,X TOUPR AND #$7F CMP #'a' @@ -598,7 +605,7 @@ end // until !(c & $80) // return dci //end -asm modtosym +asm modtosym(mod,dci)#1 LDA ESTKL+1,X STA SRCL LDA ESTKH+1,X @@ -639,7 +646,7 @@ end // tbl = tbl + 3 // loop // return 0 -asm lookuptbl +asm lookuptbl(dci, tbl)#1 LDA ESTKL,X STA DSTL LDA ESTKH,X @@ -684,7 +691,7 @@ end // // ProDOS routines // -def getpfx(path) +def getpfx(path)#1 byte params[3] ^path = 0 @@ -693,7 +700,7 @@ def getpfx(path) perr = syscall($C7, @params) return path end -def setpfx(path) +def setpfx(path)#1 byte params[3] params.0 = 1 @@ -701,7 +708,7 @@ def setpfx(path) perr = syscall($C6, @params) return path end -def open(path, buff) +def open(path, buff)#1 byte params[6] params.0 = 3 @@ -711,7 +718,7 @@ def open(path, buff) perr = syscall($C8, @params) return params.5 end -def close(refnum) +def close(refnum)#1 byte params[2] params.0 = 1 @@ -719,7 +726,7 @@ def close(refnum) perr = syscall($CC, @params) return perr end -def read(refnum, buff, len) +def read(refnum, buff, len)#1 byte params[8] params.0 = 4 @@ -733,11 +740,11 @@ end // // Heap routines. // -def availheap +def availheap()#1 byte fp return @fp - heap end -def allocheap(size) +def allocheap(size)#1 word addr addr = heap heap = heap + size @@ -771,14 +778,14 @@ def allocalignheap(size, pow2, freeaddr) fin return addr end -def markheap +def markheap()#1 return heap end -def releaseheap(newheap) +def releaseheap(newheap)#1 heap = newheap return @newheap - heap end -def allocxheap(size) +def allocxheap(size)#1 word xaddr xaddr = xheap xheap = xheap + size @@ -814,10 +821,10 @@ end // // Symbol table routines. // -def lookupsym(sym) +def lookupsym(sym)#1 return lookuptbl(sym, symtbl) end -def addsym(sym, addr) +def addsym(sym, addr)#0 while ^sym & $80 ^lastsym = ^sym lastsym = lastsym + 1 @@ -831,20 +838,20 @@ end // // Module routines. // -def lookupmod(mod) +def lookupmod(mod)#1 byte dci[17] return lookuptbl(modtosym(mod, @dci), symtbl) end -def lookupstrmod(str) +def lookupstrmod(str)#1 byte mod[17] stodci(str, @mod) return lookupmod(@mod) end -def addmod(mod, addr) +def addmod(mod, addr)#0 byte dci[17] - return addsym(modtosym(mod, @dci), addr) + addsym(modtosym(mod, @dci), addr) end -def lookupextern(esd, index) +def lookupextern(esd, index)#1 word sym, addr byte str[16] while ^esd @@ -864,7 +871,7 @@ def lookupextern(esd, index) loop return 0 end -def adddef(bank, addr, deflast) +def adddef(bank, addr, deflast)#1 word defentry defentry = *deflast *deflast = defentry + 5 @@ -878,7 +885,7 @@ def adddef(bank, addr, deflast) defentry->5 = 0 // NULL out next entry return defentry end -def lookupdef(addr, deftbl) +def lookupdef(addr, deftbl)#1 while deftbl->0 == $20 if deftbl=>3 == addr return deftbl @@ -887,7 +894,7 @@ def lookupdef(addr, deftbl) loop return 0 end -def loadmod(mod) +def loadmod(mod)#1 word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup word addr, defaddr, modaddr, modfix, modend word deftbl, deflast @@ -1087,7 +1094,7 @@ end // // Command mode // -def volumes +def volumes()#0 byte params[4] word strbuf byte i @@ -1107,7 +1114,7 @@ def volumes strbuf = strbuf + 16 next end -def catalog(optpath) +def catalog(optpath)#1 byte path[64] byte refnum byte firstblk @@ -1168,14 +1175,14 @@ def catalog(optpath) crout() return 0 end -def stripchars(strptr) +def stripchars(strptr)#1 while ^strptr and ^(strptr + 1) > ' ' memcpy(strptr + 1, strptr + 2, ^strptr) ^strptr = ^strptr - 1 loop return ^strptr end -def stripspaces(strptr) +def stripspaces(strptr)#0 while ^strptr and ^(strptr + ^strptr) <= ' ' ^strptr = ^strptr - 1 loop @@ -1184,7 +1191,7 @@ def stripspaces(strptr) ^strptr = ^strptr - 1 loop end -def striptrail(strptr) +def striptrail(strptr)#1 byte i for i = 1 to ^strptr @@ -1195,7 +1202,7 @@ def striptrail(strptr) next return strptr end -def parsecmd(strptr) +def parsecmd(strptr)#1 byte cmd cmd = 0 @@ -1208,7 +1215,7 @@ def parsecmd(strptr) stripspaces(strptr) return cmd end -def resetmemfiles +def resetmemfiles()#0 // // Close all files // @@ -1221,7 +1228,7 @@ def resetmemfiles ^$BF58 = $CF ^$BF6F = $01 end -def execsys(sysfile) +def execsys(sysfile)#0 byte refnum word len @@ -1246,7 +1253,7 @@ def execsys(sysfile) fin fin end -def execmod(modfile) +def execmod(modfile)#1 byte moddci[17] word saveheap, savexheap, savesym, saveflags diff --git a/src/vmsrc/plvm.c b/src/vmsrc/plvm.c index 62356d6..d009266 100755 --- a/src/vmsrc/plvm.c +++ b/src/vmsrc/plvm.c @@ -457,12 +457,10 @@ void call(uword pc) if (c == 0x0D) c = '\n'; putchar(c); - PUSH(0); break; case 4: // LIBRARY STDLIB::PUTS s = POP; i = mem_data[s++]; - PUSH(i); while (i--) { c = mem_data[s++]; @@ -479,7 +477,6 @@ void call(uword pc) c = '\n'; putchar(c); } - PUSH(0); break; case 6: // LIBRARY STDLIB::GETC PUSH(getchar()); @@ -495,7 +492,6 @@ void call(uword pc) case 8: // LIBRARY STDLIB::PUTNL putchar('\n'); fflush(stdout); - PUSH(0); break; default: printf("\nBad call code:$%02X\n", mem_data[pc - 1]); From 255061f75a27ca0101cfe5f2a0dd8debac94814a Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sun, 27 Aug 2017 20:38:26 -0700 Subject: [PATCH 5/6] Add def prototypes for cmdsys library functions --- src/vmsrc/a1cmd.pla | 158 ++++++++++++++++++----------------- src/vmsrc/soscmd.pla | 194 ++++++++++++++++++++++--------------------- 2 files changed, 179 insertions(+), 173 deletions(-) diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla index ed61cb1..c096631 100755 --- a/src/vmsrc/a1cmd.pla +++ b/src/vmsrc/a1cmd.pla @@ -30,12 +30,12 @@ const CFFAEntryPtr = $0B // // Pedefined functions. // -predef crout, cout, prstr, cin, rdstr -predef syscall, call -predef markheap, allocheap, allocalignheap, releaseheap, availheap -predef memset, memcpy -predef uword_isgt, uword_isge, uword_islt, uword_isle -predef loadmod, execmod, lookupstrmod +predef syscall(cmd)#1, call(addr,areg,xreg,yreg,status)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, cin()#1, rdstr(p)#1 +predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1 +predef memset(addr,value,size)#0, memcpy(dst,src,size)#0 +predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1 +predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1 // // System variables. // @@ -117,7 +117,7 @@ word syslibsym = @exports // CALL CFFA1 API ENTRYPOINT // SYSCALL(CMD) // -asm syscall +asm syscall(cmd)#1 LDA ESTKL,X STX ESP TAX @@ -132,7 +132,7 @@ end // CALL 6502 ROUTINE // CALL(ADDR, AREG, XREG, YREG, STATUS) // -asm call +asm call(addr,areg,xreg,yreg,sstatus)#1 PHP LDA ESTKL+4,X STA CALL6502+1 @@ -172,7 +172,7 @@ end // // QUIT TO MONITOR // -asm quit +asm quit()#0 JMP $9000 end // @@ -180,7 +180,7 @@ end // MEMSET(ADDR, VALUE, SIZE) // With optimizations from Peter Ferrie // -asm memset +asm memset(addr,value,size)#0 LDA ESTKL+2,X STA DSTL LDA ESTKH+2,X @@ -207,6 +207,7 @@ SETMLPH STA (DST),Y ++ DEC ESTKH,X BNE - SETMEX INX + INX INX RTS end @@ -214,31 +215,32 @@ end // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // -asm memcpy +asm memcpy(dst,src,size)#0 INX INX - LDA ESTKL-2,X - ORA ESTKH-2,X + INX + LDA ESTKL-3,X + ORA ESTKH-3,X BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X - STA DSTL - LDA ESTKH,X - STA DSTH LDA ESTKL-1,X - STA SRCL + STA DSTL LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X STA SRCH - LDY ESTKL-2,X + LDY ESTKL-3,X BEQ FORCPYLP - INC ESTKH-2,X + INC ESTKH-3,X LDY #$00 FORCPYLP LDA (SRC),Y STA (DST),Y @@ -246,34 +248,34 @@ FORCPYLP LDA (SRC),Y BNE + INC DSTH INC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE FORCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE FORCPYLP RTS ; ; REVERSE COPY ; REVCPY ;CLC - LDA ESTKL-2,X + LDA ESTKL-3,X ADC ESTKL,X STA DSTL - LDA ESTKH-2,X + LDA ESTKH-3,X ADC ESTKH,X STA DSTH CLC - LDA ESTKL-2,X - ADC ESTKL-1,X + LDA ESTKL-3,X + ADC ESTKL-2,X STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X + LDA ESTKH-3,X + ADC ESTKH-2,X STA SRCH DEC DSTH DEC SRCH LDY #$FF - LDA ESTKL-2,X + LDA ESTKL-3,X BEQ REVCPYLP - INC ESTKH-2,X + INC ESTKH-3,X REVCPYLP LDA (SRC),Y STA (DST),Y DEY @@ -281,16 +283,16 @@ REVCPYLP LDA (SRC),Y BNE + DEC DSTH DEC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE REVCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE REVCPYLP CPYMEX RTS end // // Unsigned word comparisons. // -asm uword_isge +asm uword_isge(a,b)#1 LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -303,7 +305,7 @@ asm uword_isge INX RTS end -asm uword_isle +asm uword_isle(a,b)#1 LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -316,7 +318,7 @@ asm uword_isle INX RTS end -asm uword_isgt +asm uword_isgt(a,b)#1 LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -328,7 +330,7 @@ asm uword_isgt INX RTS end -asm uword_islt +asm uword_islt(a,b)#1 LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -343,7 +345,7 @@ end // // Addresses of internal routines. // -asm interp +asm interp()#1 DEX LDA #> 4) & $0F]) - return cout(hexchar[v & $0F]) + cout(hexchar[v & $0F]) end -def prword(v) +def prword(v)#0 prbyte(v >> 8) - return prbyte(v) + prbyte(v) end // // CFFA1 routines @@ -647,12 +649,12 @@ end // perr = syscall($12) // return *CFFAEntryPtr //end -def finddirentry(filename) +def finddirentry(filename)#1 *CFFAFileName = filename perr = syscall($14) return *CFFAEntryPtr end -def readfile(filename, buffer) +def readfile(filename, buffer)#1 *CFFADest = buffer *CFFAFileName = filename perr = syscall($22) @@ -661,11 +663,11 @@ end // // Heap routines. // -def availheap +def availheap()#1 byte fp return @fp - heap end -def allocheap(size) +def allocheap(size)#1 word addr addr = heap heap = heap + size @@ -674,7 +676,7 @@ def allocheap(size) fin return addr end -def allocalignheap(size, pow2, freeaddr) +def allocalignheap(size, pow2, freeaddr)#1 word align, addr if freeaddr *freeaddr = heap @@ -687,20 +689,20 @@ def allocalignheap(size, pow2, freeaddr) fin return addr end -def markheap +def markheap()#1 return heap end -def releaseheap(newheap) +def releaseheap(newheap)#1 heap = newheap return @newheap - heap end // // Symbol table routines. // -def lookupsym(sym) +def lookupsym(sym)#1 return lookuptbl(sym, symtbl) end -def addsym(sym, addr) +def addsym(sym, addr)#0 while ^sym & $80 ^lastsym = ^sym lastsym = lastsym + 1 @@ -714,20 +716,20 @@ end // // Module routines. // -def lookupmod(mod) +def lookupmod(mod)#1 byte dci[17] return lookuptbl(modtosym(mod, @dci), symtbl) end -def lookupstrmod(str) +def lookupstrmod(str)#1 byte mod[17] stodci(str, @mod) return lookupmod(@mod) end -def addmod(mod, addr) +def addmod(mod, addr)#0 byte dci[17] - return addsym(modtosym(mod, @dci), addr) + addsym(modtosym(mod, @dci), addr) end -def lookupextern(esd, index) +def lookupextern(esd, index)#1 word sym, addr byte str[16] while ^esd @@ -747,7 +749,7 @@ def lookupextern(esd, index) loop return 0 end -def adddef(addr, deflast) +def adddef(addr, deflast)#1 word defentry defentry = *deflast *deflast = defentry + 5 @@ -757,7 +759,7 @@ def adddef(addr, deflast) defentry->5 = 0 // null out next entry return defentry end -def lookupdef(addr, deftbl) +def lookupdef(addr, deftbl)#1 while deftbl->0 == $20 if deftbl=>3 == addr return deftbl @@ -766,7 +768,7 @@ def lookupdef(addr, deftbl) loop return 0 end -def loadmod(mod) +def loadmod(mod)#1 word rdlen, modsize, bytecode, defofst, defcnt, init, fixup word addr, modaddr, modfix, modend word deftbl, deflast @@ -929,14 +931,14 @@ end // // Command mode // -def stripchars(strptr) +def stripchars(strptr)#1 while ^strptr and ^(strptr + 1) <> ' ' memcpy(strptr + 1, strptr + 2, ^strptr) ^strptr = ^strptr - 1 loop return ^strptr end -def stripspaces(strptr) +def stripspaces(strptr)#0 while ^strptr and ^(strptr + ^strptr) <= ' ' ^strptr = ^strptr - 1 loop @@ -945,7 +947,7 @@ def stripspaces(strptr) ^strptr = ^strptr - 1 loop end -def striptrail(strptr) +def striptrail(strptr)#0 byte i for i = 1 to ^strptr @@ -955,7 +957,7 @@ def striptrail(strptr) fin next end -def parsecmd(strptr) +def parsecmd(strptr)#1 byte cmd cmd = 0 @@ -968,7 +970,7 @@ def parsecmd(strptr) stripspaces(strptr) return cmd end -def execmod(modfile) +def execmod(modfile)#1 byte moddci[17] word saveheap, savesym, saveflags diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla index 0767d88..007d218 100755 --- a/src/vmsrc/soscmd.pla +++ b/src/vmsrc/soscmd.pla @@ -25,12 +25,12 @@ const O_READ_WRITE = 3 // // Pedefined functions. // -predef crout, cout, prstr, cin, rdstr -predef syscall, call -predef markheap, allocheap, allocalignheap, releaseheap, availheap -predef memset, memcpy -predef uword_isgt, uword_isge, uword_islt, uword_isle -predef loadmod, execmod, lookupstrmod +predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, cin()#1, rdstr(p)#1 +predef markheap()#1, allocheap(size)#1, allocalignheap(size, pow2, freeaddr), releaseheap(newheap)#1, availheap()#1 +predef memset(addr,value,size)#0, memcpy(dst,src,size)#0 +predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1 +predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1 // // System variables. // @@ -113,7 +113,7 @@ word syslibsym = @exports // CALL SOS // SYSCALL(CMD, PARAMS) // -asm syscall +asm syscall(cmd,params)#1 LDA ESTKL,X LDY ESTKH,X STA PARAMS @@ -133,7 +133,7 @@ end // CALL 6502 ROUTINE // CALL(AREG, XREG, YREG, STATUS, ADDR) // -asm call +asm call(addr,areg,xreg,yreg,sstatus)#1 REGVALS = SRC PHP LDA ESTKL,X @@ -176,7 +176,7 @@ end // MEMSET(ADDR, VALUE, SIZE) // With optimizations from Peter Ferrie // -asm memset +asm memset(addr,value,size)#0 LDA ESTKL+2,X STA DSTL LDA ESTKH+2,X @@ -203,6 +203,7 @@ SETMLPH STA (DST),Y ++ DEC ESTKH,X BNE - SETMEX INX + INX INX RTS end @@ -210,31 +211,32 @@ end // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // -asm memcpy +asm memcpy(dst,src,size)#0 INX INX - LDA ESTKL-2,X - ORA ESTKH-2,X + INX + LDA ESTKL-3,X + ORA ESTKH-3,X BEQ CPYMEX - LDA ESTKL-1,X - CMP ESTKL,X - LDA ESTKH-1,X - SBC ESTKH,X + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL,X + LDA ESTKL-2,X STA DSTL - LDA ESTKH,X + LDA ESTKH-2,X STA DSTH - LDA ESTKL-1,X + LDA ESTKL-2,X STA SRCL - LDA ESTKH-1,X + LDA ESTKH-2,X STA SRCH - LDY ESTKL-2,X + LDY ESTKL-3,X BEQ FORCPYLP - INC ESTKH-2,X + INC ESTKH-3,X LDY #$00 FORCPYLP LDA (SRC),Y STA (DST),Y @@ -242,34 +244,34 @@ FORCPYLP LDA (SRC),Y BNE + INC DSTH INC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE FORCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE FORCPYLP RTS ; ; REVERSE COPY ; REVCPY ;CLC - LDA ESTKL-2,X - ADC ESTKL,X + LDA ESTKL-3,X + ADC ESTKL-1,X STA DSTL - LDA ESTKH-2,X - ADC ESTKH,X + LDA ESTKH-3,X + ADC ESTKH-1,X STA DSTH CLC - LDA ESTKL-2,X - ADC ESTKL-1,X + LDA ESTKL-3,X + ADC ESTKL-2,X STA SRCL - LDA ESTKH-2,X - ADC ESTKH-1,X + LDA ESTKH-3,X + ADC ESTKH-2,X STA SRCH DEC DSTH DEC SRCH LDY #$FF - LDA ESTKL-2,X + LDA ESTKL-3,X BEQ REVCPYLP - INC ESTKH-2,X + INC ESTKH-3,X REVCPYLP LDA (SRC),Y STA (DST),Y DEY @@ -277,9 +279,9 @@ REVCPYLP LDA (SRC),Y BNE + DEC DSTH DEC SRCH -+ DEC ESTKL-2,X ++ DEC ESTKL-3,X BNE REVCPYLP - DEC ESTKH-2,X + DEC ESTKH-3,X BNE REVCPYLP CPYMEX RTS end @@ -288,7 +290,7 @@ end // // MEMXCPY(DSTSEG, SRC, SIZE) // -asm memxcpy +asm memxcpy(dst,src,size)#0 LDA ESTKL,X ORA ESTKH,X BEQ CPYXMEX @@ -320,6 +322,7 @@ CPYXLP LDA (SRC),Y LDA #$00 STA DSTX CPYXMEX INX + INX INX RTS end @@ -328,7 +331,7 @@ end // // XPOKEB(SEG, DST, BYTEVAL) // -asm xpokeb +asm xpokeb(seg, dst, byteval)#0 LDA ESTKL+1,X STA DSTL LDA ESTKH+1,X @@ -345,12 +348,13 @@ asm xpokeb STY DSTX INX INX + INX RTS end // // Unsigned word comparisons. // -asm uword_isge +asm uword_isge(a,b)#1 LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -363,7 +367,7 @@ asm uword_isge INX RTS end -asm uword_isle +asm uword_isle(a,b)#1 LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -376,7 +380,7 @@ asm uword_isle INX RTS end -asm uword_isgt +asm uword_isgt(a,b)#1 LDA ESTKL,X CMP ESTKL+1,X LDA ESTKH,X @@ -388,7 +392,7 @@ asm uword_isgt INX RTS end -asm uword_islt +asm uword_islt(a,b)#1 LDA ESTKL+1,X CMP ESTKL,X LDA ESTKH+1,X @@ -403,7 +407,7 @@ end // // Addresses of internal routines. // -asm interp +asm interp()#1 DEX LDA #[^str] == $0D cout($0A) fin end -def rdstr(prompt) +def rdstr(prompt)#1 cout(prompt) ^heap = read(refcons, heap + 1, 128) if heap->[^heap] == $0D @@ -809,25 +813,25 @@ def rdstr(prompt) cout($0D) return heap end -def crout - return cout($0D) +def crout()#0 + cout($0D) end -def prbyte(v) +def prbyte(v)#0 cout(hexchar[(v >> 4) & $0F]) - return cout(hexchar[v & $0F]) + cout(hexchar[v & $0F]) end -def prword(v) +def prword(v)#0 prbyte(v >> 8) - return prbyte(v) + prbyte(v) end // // Heap routines. // -def availheap +def availheap()#1 byte fp return @fp - heap end -def allocheap(size) +def allocheap(size)#1 word addr addr = heap heap = heap + size @@ -836,7 +840,7 @@ def allocheap(size) fin return addr end -def allocalignheap(size, pow2, freeaddr) +def allocalignheap(size, pow2, freeaddr)#1 word align, addr if freeaddr *freeaddr = heap @@ -849,20 +853,20 @@ def allocalignheap(size, pow2, freeaddr) fin return addr end -def markheap +def markheap()#1 return heap end -def releaseheap(newheap) +def releaseheap(newheap)#1 heap = newheap return @newheap - heap end // // Symbol table routines. // -def lookupsym(sym) +def lookupsym(sym)#1 return lookuptbl(sym, symtbl) end -def addsym(sym, addr) +def addsym(sym, addr)#0 while ^sym & $80 xpokeb(symtbl.0, lastsym, ^sym) lastsym = lastsym + 1 @@ -877,20 +881,20 @@ end // // Module routines. // -def lookupmod(mod) +def lookupmod(mod)#1 byte dci[17] return lookuptbl(modtosym(mod, @dci), symtbl) end -def lookupstrmod(str) +def lookupstrmod(str)#1 byte mod[17] stodci(str, @mod) return lookupmod(@mod) end -def addmod(mod, addr) +def addmod(mod, addr)#0 byte dci[17] - return addsym(modtosym(mod, @dci), addr) + addsym(modtosym(mod, @dci), addr) end -def lookupextern(esd, index) +def lookupextern(esd, index)#1 word sym, addr byte str[16] while ^esd @@ -910,7 +914,7 @@ def lookupextern(esd, index) loop return 0 end -def adddef(ext, addr, deflast) +def adddef(ext, addr, deflast)#1 word defentry defentry = *deflast *deflast = defentry + 6 @@ -920,7 +924,7 @@ def adddef(ext, addr, deflast) defentry=>5 = ext // ext is byte, so this nulls out next entry return defentry end -def lookupdef(addr, deftbl) +def lookupdef(addr, deftbl)#1 while deftbl->0 == $20 if deftbl=>3 == addr return deftbl @@ -929,7 +933,7 @@ def lookupdef(addr, deftbl) loop return 0 end -def loadmod(mod) +def loadmod(mod)#1 word refnum, rdlen, modsize, bytecode, defofst, defcnt, init, fixup word addr, defaddr, modaddr, modfix, modend word deftbl, deflast, codeseg @@ -1121,7 +1125,7 @@ end // // Command mode // -def volumes +def volumes()#0 byte info[11] byte devname[17] byte volname[17] @@ -1141,7 +1145,7 @@ def volumes next perr = 0 end -def catalog(optpath) +def catalog(optpath)#1 byte path[64] byte refnum byte firstblk @@ -1202,14 +1206,14 @@ def catalog(optpath) crout() return 0 end -def stripchars(strptr) +def stripchars(strptr)#1 while ^strptr and ^(strptr + 1) <> ' ' memcpy(strptr + 1, strptr + 2, ^strptr) ^strptr = ^strptr - 1 loop return ^strptr end -def stripspaces(strptr) +def stripspaces(strptr)#0 while ^strptr and ^(strptr + ^strptr) <= ' ' ^strptr = ^strptr - 1 loop @@ -1218,7 +1222,7 @@ def stripspaces(strptr) ^strptr = ^strptr - 1 loop end -def striptrail(strptr) +def striptrail(strptr)#0 byte i for i = 1 to ^strptr @@ -1228,7 +1232,7 @@ def striptrail(strptr) fin next end -def parsecmd(strptr) +def parsecmd(strptr)#1 byte cmd cmd = 0 @@ -1241,7 +1245,7 @@ def parsecmd(strptr) stripspaces(strptr) return cmd end -def execmod(modfile) +def execmod(modfile)#1 byte moddci[17] word saveheap, savesym, saveflags From 873b2b58f9772624abc41874cd5ad4592e820683 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sun, 27 Aug 2017 20:59:01 -0700 Subject: [PATCH 6/6] Update README.md --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index a85fd3b..98cc2a6 100755 --- a/README.md +++ b/README.md @@ -465,7 +465,7 @@ keyin = @keyin2plus // address-of keyin2plus function key = keyin() ``` -Lambda functions are anonymous functions that can be used to return a value (or multiple values). They can be used as function pointers to routines that need a quick and dirty expression. They are written an '&' (a poor man's lambda symbol) followed by parameters in parentheses, and the resultant expression. There are no local variables allowed. +Lambda functions are anonymous functions that can be used to return a value (or multiple values). They can be used as function pointers to routines that need a quick and dirty expression. They are written as '&' (a poor man's lambda symbol) followed by parameters in parentheses, and the resultant expression. There are no local variables allowed. ``` word result @@ -493,7 +493,7 @@ if ^pushbttn3 < 128 key = $CE // N fin else - key = key | $E0 + key = key | $E0 fin ``` @@ -503,7 +503,7 @@ The `when`/`is`/`otherwise`/`wend` statement is similar to the `if`/`elsif`/`els when keypressed is keyarrowup cursup - breaking + break is keyarrowdown cursdown break