From 10274bdf27ce5e3de56980a7861baee36df62421 Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Thu, 1 Feb 2018 18:10:02 -0800 Subject: [PATCH] Synchronize CMDs --- src/vmsrc/a1cmd.pla | 626 +++++++++++++++++++++++-------------------- src/vmsrc/soscmd.pla | 345 ++++++++++++++++++------ 2 files changed, 594 insertions(+), 377 deletions(-) diff --git a/src/vmsrc/a1cmd.pla b/src/vmsrc/a1cmd.pla index 71d6841..bd9a226 100755 --- a/src/vmsrc/a1cmd.pla +++ b/src/vmsrc/a1cmd.pla @@ -1,3 +1,6 @@ +const FALSE = 0 +const TRUE = not FALSE + const RELADDR = $1000 const inbuff = $200 const freemem = $0006 @@ -31,15 +34,19 @@ const CFFAEntryPtr = $0B // Pedefined functions. // predef syscall(cmd,null)#1, call(addr,areg,xreg,yreg,status)#1 -predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, prbyte(b)#0, prword(w)#0 +predef cin()#1, rdstr(p)#1, toupper(c)#1, strcpy(dst,src)#1, strcat(dst,src)#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, sext(a)#1, divmod(a,b)#2 -predef loadmod(mod)#1, execmod(modfile)#1, lookupstrmod(str)#1 +predef uword_isgt(a,b)#1, uword_isge(a,b)#1, uword_islt(a,b)#1, uword_isle(a,b)#1 +predef sext(a)#1, divmod(a,b)#2, execmod(modfile)#1 // -// System variables. +// Exported CMDSYS table // -word version = $0100 // 01.00 +word version = $0100 // 01.00 +word syspath +word syscmdln +word = @execmod word systemflags = 0 word heap word symtbl, lastsym @@ -68,14 +75,17 @@ word cmdptr = @hexchar // make it point to a zero // byte syslibstr[] = "CMDSYS" byte machidstr[] = "MACHID" -byte syspathstr[] = "SYSPATH" byte putcstr[] = "PUTC" byte putlnstr[] = "PUTLN" byte putsstr[] = "PUTS" byte putistr[] = "PUTI" +byte putbstr[] = "PUTB" +byte putwstr[] = "PUTH" byte getcstr[] = "GETC" byte getsstr[] = "GETS" byte toupstr[] = "TOUPPER" +byte strcpystr[] = "STRCPY" +byte strcatstr[] = "STRCAT" byte sysstr[] = "SYSCALL" byte callstr[] = "CALL" byte hpmarkstr[] = "HEAPMARK" @@ -91,8 +101,6 @@ byte uisltstr[] = "ISULT" byte uislestr[] = "ISULE" byte sextstr[] = "SEXT" byte divmodstr[] = "DIVMOD" -byte argstr[] = "ARGS" -byte syspath[] = "" // Set to NULL word exports[] = @syslibstr, @version word = @sysstr, @syscall word = @callstr, @call @@ -100,6 +108,8 @@ word = @putcstr, @cout word = @putlnstr, @crout word = @putsstr, @prstr word = @putistr, @print +word = @putbstr, @prbyte +word = @putwstr, @prword word = @getcstr, @cin word = @getsstr, @rdstr word = @toupstr, @toupper @@ -110,6 +120,8 @@ word = @hprelstr, @releaseheap word = @hpavlstr, @availheap word = @memsetstr, @memset word = @memcpystr, @memcpy +word = @strcpystr, @strcpy +word = @strcatstr, @strcat word = @uisgtstr, @uword_isgt word = @uisgestr, @uword_isge word = @uisltstr, @uword_islt @@ -117,11 +129,19 @@ word = @uislestr, @uword_isle word = @sextstr, @sext word = @divmodstr, @divmod word = @machidstr, @machid -word = @syspathstr,@syspath -word = @argstr, @cmdptr word = 0 word syslibsym = @exports // +// Utility functions +// +asm saveX#0 + STX XREG+1 +end +asm restoreX#0 +XREG LDX #$00 + RTS +end +// // CALL CFFA1 API ENTRYPOINT // SYSCALL(CMD, 0) // @@ -189,189 +209,189 @@ end // With optimizations from Peter Ferrie // asm memset(addr,value,size)#0 - 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 + 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 + 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 - + 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 - INX - RTS + INX + INX + RTS end // // COPY MEMORY // MEMCPY(DSTADDR, SRCADDR, SIZE) // asm memcpy(dst,src,size)#0 - INX - INX - INX - LDA ESTKL-3,X - ORA ESTKH-3,X - BEQ CPYMEX - LDA ESTKL-2,X - CMP ESTKL-1,X - LDA ESTKH-2,X - SBC ESTKH-1,X - BCC REVCPY + INX + INX + INX + LDA ESTKL-3,X + ORA ESTKH-3,X + BEQ CPYMEX + LDA ESTKL-2,X + CMP ESTKL-1,X + LDA ESTKH-2,X + SBC ESTKH-1,X + BCC REVCPY ; ; FORWARD COPY ; - LDA ESTKL-1,X - STA DSTL - LDA ESTKH-1,X - STA DSTH - LDA ESTKL-2,X - STA SRCL - LDA ESTKH-2,X - STA SRCH - LDY ESTKL-3,X - BEQ FORCPYLP - INC ESTKH-3,X - LDY #$00 + LDA ESTKL-1,X + STA DSTL + LDA ESTKH-1,X + STA DSTH + LDA ESTKL-2,X + STA SRCL + LDA ESTKH-2,X + STA SRCH + LDY ESTKL-3,X + BEQ FORCPYLP + INC ESTKH-3,X + LDY #$00 FORCPYLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL-3,X - BNE FORCPYLP - DEC ESTKH-3,X - BNE FORCPYLP - RTS + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL-3,X + BNE FORCPYLP + DEC ESTKH-3,X + BNE FORCPYLP + RTS ; ; REVERSE COPY ; REVCPY ;CLC - LDA ESTKL-3,X - ADC ESTKL,X - STA DSTL - LDA ESTKH-3,X - ADC ESTKH,X - STA DSTH - CLC - LDA ESTKL-3,X - ADC ESTKL-2,X - STA SRCL - LDA ESTKH-3,X - ADC ESTKH-2,X - STA SRCH - DEC DSTH - DEC SRCH - LDY #$FF - LDA ESTKL-3,X - BEQ REVCPYLP - INC ESTKH-3,X + LDA ESTKL-3,X + ADC ESTKL-1,X + STA DSTL + LDA ESTKH-3,X + ADC ESTKH-1,X + STA DSTH + CLC + LDA ESTKL-3,X + ADC ESTKL-2,X + STA SRCL + LDA ESTKH-3,X + ADC ESTKH-2,X + STA SRCH + DEC DSTH + DEC SRCH + LDY #$FF + LDA ESTKL-3,X + BEQ REVCPYLP + INC ESTKH-3,X REVCPYLP LDA (SRC),Y - STA (DST),Y - DEY - CPY #$FF - BNE + - DEC DSTH - DEC SRCH -+ DEC ESTKL-3,X - BNE REVCPYLP - DEC ESTKH-3,X - BNE REVCPYLP + STA (DST),Y + DEY + CPY #$FF + BNE + + DEC DSTH + DEC SRCH ++ DEC ESTKL-3,X + BNE REVCPYLP + DEC ESTKH-3,X + BNE REVCPYLP CPYMEX RTS end // // Unsigned word comparisons. // asm uword_isge(a,b)#1 - 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(a,b)#1 - 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(a,b)#1 - 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(a,b)#1 - 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 asm divmod(a,b)#2 JSR INTERP ; CALL DINTERP !BYTE $36, $5C ; DIVMOD, RET end asm sext(a)#1 - LDY #$00 - LDA ESTKL,X - BPL + - DEY -+ STY ESTKH,X - RTS + LDY #$00 + LDA ESTKL,X + BPL + + DEY ++ STY ESTKH,X + RTS end // // Addresses of internal routines. // asm interp()#1 - DEX - LDA #IINTERP - STA ESTKH,X - RTS + DEX + LDA #IINTERP + STA ESTKH,X + RTS end // // A DCI string is one that has the high bit set for every character except the last. @@ -389,28 +409,28 @@ end // return len //end asm dcitos(dci, str)#1 - 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 @@ -429,43 +449,43 @@ end // return ^str //end asm stodci(str, dci)#1 - 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(c)#1 - LDA ESTKL,X + LDA ESTKL,X TOUPR AND #$7F - CMP #'a' - BCC + - CMP #'z'+1 - BCS + - SBC #$1F -+ STA ESTKL,X - RTS + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS end // // Module symbols are entered into the symbol table @@ -493,77 +513,74 @@ end // loop // return 0 asm lookuptbl(dci, tbl)#1 - 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 + INX + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH +-- LDY #$00 +- LDA (DST),Y + BEQ + + CMP (SRC),Y + BNE ++ + INY + ASL + BCS - + LDA (DST),Y + STA ESTKL,X ; MATCH + INY + LDA (DST),Y + STA ESTKH,X + RTS ++ STA ESTKL,X ; NO MATCH + STA ESTKH,X + RTS +++ +- LDA (DST),Y ; NEXT ENTRY + BPL + + INY + BNE - ++ TYA + CLC + ADC #$03 + ADC DSTL + STA DSTL + BCC -- + INC DSTH + BNE -- end // // CONSOLE I/O // asm cout(c)#0 - LDA ESTKL,X - JSR TOUPR - ORA #$80 - JMP $FFEF + LDA ESTKL,X + JSR TOUPR + ORA #$80 + JMP $FFEF end asm cin()#1 - DEX -- LDA $D011 - BPL - - LDA $D010 - AND #$7F - STA ESTKL,X - LDA #$00 - STA ESTKH,X - RTS + DEX +- LDA $D011 + BPL - + LDA $D010 + AND #$7F + STA ESTKL,X + LDA #$00 + STA ESTKH,X + RTS end def crout()#0 cout($0D) end def prstr(str)#0 byte i - i = 1 - while i <= ^str - cout((str)[i]) - i = i + 1 - loop + for i = 1 to ^str + cout(^(str + i)) + next end def print(i)#0 if i < 0; cout('-'); i = -i; fin @@ -580,7 +597,7 @@ def rdstr(prompt)#1 when ch is $15 // right arrow if ^inbuff < maxlen //inbuff.0 < maxlen - inbuff.0 = inbuff.0 + 1 + inbuff.0++ ch = inbuff[inbuff.0] cout(ch) fin @@ -589,7 +606,7 @@ def rdstr(prompt)#1 if inbuff.0 cout('\\') cout(inbuff[inbuff.0]) - inbuff.0 = inbuff.0 - 1 + inbuff.0-- fin break is $04 // ctrl-d @@ -597,8 +614,8 @@ def rdstr(prompt)#1 cout('#') cout(inbuff[inbuff.0]) memcpy(inbuff + inbuff.0, inbuff + inbuff.0 + 1, maxlen - inbuff.0) - maxlen = maxlen - 1 - inbuff.0 = inbuff.0 - 1 + maxlen-- + inbuff.0-- fin break is $0C // ctrl-l @@ -617,7 +634,7 @@ def rdstr(prompt)#1 otherwise if ch >= ' ' cout(ch) - inbuff.0 = inbuff.0 + 1 + inbuff.0++ inbuff[inbuff.0] = ch if inbuff.0 > maxlen maxlen = inbuff.0 @@ -637,6 +654,19 @@ def prword(v)#0 prbyte(v) end // +// String routines. +// +def strcpy(dst, src)#1 + memcpy(dst+1, src+1, ^src) + ^dst = ^src + return dst +end +def strcat(dst, src)#1 + memcpy(dst + ^dst + 1, src + 1, ^src) + ^dst = ^dst + ^src + return dst +end +// // CFFA1 routines // FILE I/O // @@ -847,9 +877,9 @@ def loadmod(mod)#1 addr = rld=>1 + modfix //if uword_isge(addr, modaddr) // Skip fixups to header //if type & $80 // WORD sized fixup. - // fixup = *addr + fixup = *addr //else // BYTE sized fixup. - fixup = ^addr + // fixup = ^addr //fin if ^rld & $10 // EXTERN reference. fixup = fixup + lookupextern(esd, rld->3) @@ -921,17 +951,17 @@ end def stripchars(strptr)#1 while ^strptr and ^(strptr + 1) <> ' ' memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- loop return ^strptr end def stripspaces(strptr)#0 while ^strptr and ^(strptr + ^strptr) <= ' ' - ^strptr = ^strptr - 1 + ^strptr-- loop while ^strptr and ^(strptr + 1) <= ' ' memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- loop end def striptrail(strptr)#0 @@ -952,7 +982,7 @@ def parsecmd(strptr)#1 if ^strptr cmd = ^(strptr + 1) memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- fin stripspaces(strptr) return cmd @@ -964,14 +994,14 @@ def execmod(modfile)#1 perr = 1 if stodci(modfile, @moddci) saveheap = heap - savesym = lastsym - saveflags = systemflags - if loadmod(@moddci) < modkeep - lastsym = savesym - heap = saveheap - fin - ^lastsym = 0 - systemflags = saveflags + savesym = lastsym + saveflags = systemflags + if loadmod(@moddci) < modkeep + lastsym = savesym + heap = saveheap + fin + ^lastsym = 0 + systemflags = saveflags fin return -perr end @@ -1001,7 +1031,7 @@ cmdptr = heap memset(cmdptr, 0, 128) readfile(@autorun, cmdptr + 1) while ^(cmdptr + ^cmdptr + 1) >= ' ' - ^cmdptr = ^cmdptr + 1 + ^cmdptr++ loop perr = 0 // @@ -1015,24 +1045,24 @@ fin // // Handle commands. // -while 1 +while TRUE if ^cmdptr when toupper(parsecmd(cmdptr)) is 'Q' - quit - is 'M' - syscall($02, 0) - break - is '+' - execmod(cmdptr) - break - otherwise - prstr(@huhstr) + quit + is 'M' + syscall($02, 0) + break + is '+' + execmod(cmdptr) + break + otherwise + prstr(@huhstr) wend if perr prstr(@errorstr) - prbyte(perr) - perr = 0 + prbyte(perr) + perr = 0 else prstr(@okstr) fin diff --git a/src/vmsrc/soscmd.pla b/src/vmsrc/soscmd.pla index 1beed56..840fa08 100755 --- a/src/vmsrc/soscmd.pla +++ b/src/vmsrc/soscmd.pla @@ -26,13 +26,14 @@ const O_READ_WRITE = 3 // Pedefined functions. // predef syscall(cmd,params)#1, call(addr,areg,xreg,yreg,status)#1 -predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, cin()#1, rdstr(p)#1, toupper(c)#1 +predef crout()#0, cout(c)#0, prstr(s)#0, print(i)#0, prbyte(b)#0, prword(w)#0 +predef cin()#1, rdstr(p)#1, toupper(c)#1, strcpy(dst,src)#1, strcat(dst,src)#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, sext(a)#1, divmod(a,b)#2 predef execmod(modfile)#1 // -// System variables. +// Exported CMDSYS table // word version = $0100 // 01.00 word syspath @@ -62,9 +63,13 @@ byte putcstr[] = "PUTC" byte putlnstr[] = "PUTLN" byte putsstr[] = "PUTS" byte putistr[] = "PUTI" +byte putbstr[] = "PUTB" +byte putwstr[] = "PUTH" byte getcstr[] = "GETC" byte getsstr[] = "GETS" byte toupstr[] = "TOUPPER" +byte strcpystr[] = "STRCPY" +byte strcatstr[] = "STRCAT" byte hpmarkstr[] = "HEAPMARK" byte hpalignstr[] = "HEAPALLOCALIGN" byte hpallocstr[] = "HEAPALLOC" @@ -79,9 +84,6 @@ byte uislestr[] = "ISULE" byte sysmods[] // overlay with exported strings byte sextstr[] = "SEXT" byte divmodstr[] = "DIVMOD" -byte loadstr[] = "MODLOAD" -byte execstr[] = "MODEXEC" -byte modadrstr[] = "RELADDR" byte prefix[] // Overlay with exported symbols table word exports[] = @sysmodstr, @version word = @sysstr, @syscall @@ -90,6 +92,8 @@ word = @putcstr, @cout word = @putlnstr, @crout word = @putsstr, @prstr word = @putistr, @print +word = @putbstr, @prbyte +word = @putwstr, @prword word = @getcstr, @cin word = @getsstr, @rdstr word = @toupstr, @toupper @@ -119,6 +123,16 @@ byte modseg[15] word symtbl, lastsym byte perr, terr, lerr // +// Utility functions +// +asm saveX#0 + STX XREG+1 +end +asm restoreX#0 +XREG LDX #$00 + RTS +end +// // CALL SOS // SYSCALL(CMD, PARAMS) // @@ -634,6 +648,176 @@ asm lookuptbl(dci, tbl)#1 + INC DSTH BNE --- end +// def lookupidx(esd, index) +// word sym +// while ^esd +// sym = esd +// esd = sym + dcitos(sym, @str) +// if esd->0 & $10 and esd->1 == index +// return sym +// fin +// esd = esd + 3 +// loop +//end +asm lookupidx(esd, index)#1 + LDA ESTKL,X + STA TMPL + INX +--- LDA ESTKH,X + STA SRCH + LDA ESTKL,X +-- STA SRCL + LDY #$00 +- LDA (SRC),Y + BPL + + INY + BNE - ++ BEQ ++ ; END OF ESD + INY + LDA (SRC),Y + INY + AND #$10 ; EXTERN FLAG? + BEQ + + LDA (SRC),Y + CMP TMPL + BEQ +++ ; MATCH ++ INY + TYA + SEC + ADC SRCL + STA ESTKL,X ; SYM PTRL + BCC -- + INC ESTKH,X ; SYM PTRH + BNE --- +++ STA ESTKL,X ; END OF ESD + STA ESTKH,X ++++ RTS +end +//def lookupdef(addr, deftbl)#1 +// while deftbl->0 == $20 +// if deftbl=>3 == addr +// return deftbl +// fin +// deftbl = deftbl + 5 +// loop +// return 0 +//end +asm lookupdef(addr, deftbl)#1 + LDA ESTKH,X + STA SRCH + LDA ESTKL,X + STA SRCL + INX +- LDY #$00 + LDA (SRC),Y + CMP #$20 ; JSR OPCODE? + BNE ++ + LDY #$03 + LDA (SRC),Y + CMP ESTKL,X + BNE + + INY + LDA (SRC),Y + CMP ESTKH,X + BNE + + LDA SRCL ; MATCH + STA ESTKL,X + LDA SRCH + STA ESTKH,X + RTS ++ LDA #$05 + CLC + ADC SRCL + STA SRCL + BCC - + INC SRCH + BNE - +++ STY ESTKL,X + STY ESTKH,X + RTS +end +// +// Reloc internal data +// +//def reloc(modfix, modofst, bytecode, rld)#3 +// word addr, fixup +// while ^rld +// if ^rld & $10 // EXTERN reference. +// return rld, addr, fixup +// fin +// addr = rld=>1 + modfix +// fixup = *addr + modofst +// if uword_isge(fixup, bytecode) // Bytecode address. +// return rld, addr, fixup +// fin +// *addr = fixup +// rld = rld + 4 +// loop +// return rld, addr, fixup +//end +asm reloc(modfix, modofst, bytecode, rld)#3 + LDA ESTKL,X + STA SRCL + LDA ESTKH,X + STA SRCH + LDY #$00 +- LDA (SRC),Y + BEQ RLDEX ; END OF RLD + PHA + INY + LDA (SRC),Y + INY + CLC + ADC ESTKL+3,X ; ADDR=ENTRY=>1+MODFIX + STA DSTL + LDA (SRC),Y + ADC ESTKH+3,X + STA DSTH + PLA + AND #$10 ; EXTERN REF - EXIT + BNE RLDEX + TAY ; FIXUP=*ADDR+MODOFST + LDA (DST),Y + INY + CLC + ADC ESTKL+2,X + STA TMPL + LDA (DST),Y + ADC ESTKH+2,X + CMP ESTKH+1,X ; FIXUP >= BYTECODE? + BCC + + STA TMPH + BNE RLDEX ; YEP, EXIT + LDA TMPL + CMP ESTKL+1,X + BCS RLDEX ; YEP, EXIT + LDA TMPH ++ STA (DST),Y ; *ADDR=FIXUP + DEY + LDA TMPL + STA (DST),Y + LDA SRCL ; NEXT ENTRY +; CLC + ADC #$04 + STA SRCL + BCC - + INC SRCH + BNE - +RLDEX INX + LDA TMPL + STA ESTKL,X + LDA TMPH + STA ESTKH,X + LDA DSTL + STA ESTKL+1,X + LDA DSTH + STA ESTKH+1,X + LDA SRCL + STA ESTKL+2,X + LDA SRCH + STA ESTKH+2,X + RTS +end // // SOS routines // FILE I/O @@ -926,21 +1110,16 @@ end def lookupextern(esd, index)#1 word sym, addr byte str[16] - while ^esd - sym = esd - esd = sym + dcitos(sym, @str) - if esd->0 & $10 and esd->1 == index - addr = lookuptbl(sym, symtbl) - if !addr - lerr = $81 - cout('?') - prstr(@str) - crout - fin - return addr + sym = lookupidx(esd, index) + if sym + addr = lookuptbl(sym, symtbl) + if !addr + perr = $81 + dcitos(sym, @str) + cout('?'); prstr(@str); crout fin - esd = esd + 3 - loop + return addr + fin return 0 end def adddef(ext, addr, deflast)#1 @@ -953,15 +1132,6 @@ def adddef(ext, addr, deflast)#1 defentry=>5 = ext // ext is byte, so this nulls out next entry return defentry end -def lookupdef(addr, deftbl)#1 - while deftbl->0 == $20 - if deftbl=>3 == addr - return deftbl - fin - deftbl = deftbl + 6 - loop - return 0 -end def loadmod(mod)#1 word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup word addr, defaddr, modaddr, modfix, modofst, modend @@ -987,7 +1157,7 @@ def loadmod(mod)#1 moddep = @header.1 defofst = modsize + RELADDR init = 0 - if rdlen > 4 and header:2 == $DA7F // DAVE+1 = magic number :-) + if rdlen > 4 and header:2 == $6502 // DAVE+1 = magic number :-) // // This is an EXTended RELocatable (data+bytecode) module. // @@ -1086,31 +1256,36 @@ def loadmod(mod)#1 // Run through the Re-Location Dictionary. // while ^rld - 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. - // fixup = ^addr - //fin - if ^rld & $10 // EXTERN reference. - fixup = fixup + lookupextern(esd, rld->3) - else // INTERN fixup. - fixup = fixup + modofst - if uword_isge(fixup, bytecode) - // - // Bytecode address - replace with call def directory. - // - fixup = lookupdef(fixup + codefix, deftbl) - fin - fin - //if ^rld & $80 // WORD sized fixup. - *addr = fixup - //else // BYTE sized fixup. - // ^addr = fixup - //fin + rld, addr, fixup = reloc(modfix, modofst, bytecode, rld) + if ^rld + *addr = ^rld & $10 ?? *addr + lookupextern(esd, rld->3) :: lookupdef(fixup + codefix, deftbl) + rld = rld + 4 fin - rld = rld + 4 + //addr = rld=>1 + modfix + //if uword_isge(addr, modaddr) // Skip fixups to header + // if type & $80 // WORD sized fixup. + // fixup = *addr + // else // BYTE sized fixup. + // fixup = ^addr + // fin + // if ^rld & $10 // EXTERN reference. + // fixup = fixup + lookupextern(esd, rld->3) + // else // INTERN fixup. + // fixup = fixup + modofst + // if uword_isge(fixup, bytecode) + // // + // // Bytecode address - replace with call def directory. + // // + // fixup = lookupdef(fixup + codefix, deftbl) + // fin + // fin + // if type & $80 // WORD sized fixup. + // *addr = fixup + // else // BYTE sized fixup. + // ^addr = fixup + // fin + //fin + //rld = rld + 4 loop // // Run through the External/Entry Symbol Directory. @@ -1139,17 +1314,17 @@ def loadmod(mod)#1 // memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr)) fin - // - // Free up end-of-module main memory. - // - releaseheap(bytecode) - else - return -perr + //else + // return -perr fin if lerr return -lerr fin // + // Free up end-of-module main memory. + // + releaseheap(bytecode) + // // Call init routine if it exists. // fixup = 0 @@ -1215,24 +1390,26 @@ def catalog(optpath)#1 fin for i = firstblk to entriesblk type = ^entry - if type <> 0 + if type len = type & $0F ^entry = len prstr(entry) - 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 - fin - for len = 19 - len downto 0 + type = ' ' + when entry->$10 + is $0F // Is it a directory? + type = '/' + break + is $FF // SYSTEM file + type = '-' + break + is $FE // REL file + type = '+' + wend + cout(type) + for len = 18 - len downto 0 cout(' ') next - filecnt = filecnt - 1 + filecnt-- fin entry = entry + entrylen next @@ -1246,26 +1423,26 @@ def catalog(optpath)#1 return 0 end def stripchars(strptr)#1 - while ^strptr and ^(strptr + 1) <> ' ' + while ^strptr and ^(strptr + 1) > ' ' memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- loop return ^strptr end def stripspaces(strptr)#0 while ^strptr and ^(strptr + ^strptr) <= ' ' - ^strptr = ^strptr - 1 + ^strptr-- loop while ^strptr and ^(strptr + 1) <= ' ' memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- loop end def striptrail(strptr)#1 byte i for i = 1 to ^strptr - if (strptr)[i] <= ' ' + if ^(strptr + i) <= ' ' ^strptr = i - 1 break fin @@ -1280,7 +1457,7 @@ def parsecmd(strptr)#1 if ^strptr cmd = ^(strptr + 1) memcpy(strptr + 1, strptr + 2, ^strptr) - ^strptr = ^strptr - 1 + ^strptr-- fin stripspaces(strptr) return cmd @@ -1316,7 +1493,7 @@ init_cons // // Print PLASMA version // -prstr("PLASMA "); prbyte(version.1); cout('.'); prbyte(version.0); crout +prstr("PLASMA Pre3 "); prbyte(version.1); cout('.'); prbyte(version.0); crout // // Init 2K symbol table. // @@ -1365,6 +1542,14 @@ while 1 is 'P' setpfx(cmdptr) break + is '/' + repeat + prefix-- + until prefix[prefix] == '/' + if prefix > 1 + setpfx(@prefix) + fin + break is 'S' setpfx(cmdptr) strcat(getpfx(@sysmods), "SYS/")) @@ -1373,7 +1558,9 @@ while 1 volumes break is '+' + saveX execmod(striptrail(cmdptr)) + restoreX write(refcons, @textmode, 3) break otherwise