From 3356cdd036e4a3164eb00400d5f726aa6f0eb84a Mon Sep 17 00:00:00 2001 From: David Schmenk Date: Sat, 17 Mar 2018 15:06:31 -0700 Subject: [PATCH] Break out cmd into module --- src/inc/cmdsys.plh | 12 +- src/makefile | 13 +- src/mkrel | 1 + src/vmsrc/apple/plvm03.s | 230 ++++-- src/vmsrc/apple/soscmd.pla | 1353 ++---------------------------------- src/vmsrc/apple/sossys.pla | 1229 ++++++++++++++++++++++++++++++++ 6 files changed, 1494 insertions(+), 1344 deletions(-) create mode 100755 src/vmsrc/apple/sossys.pla diff --git a/src/inc/cmdsys.plh b/src/inc/cmdsys.plh index a5bb328..b204545 100644 --- a/src/inc/cmdsys.plh +++ b/src/inc/cmdsys.plh @@ -2,7 +2,7 @@ import cmdsys // // Useful values for everyone // - const _SYSVER_ = $0100 // Version built against + const _SYSVER_ = $0200 // Version built against const FALSE = 0 const TRUE = not FALSE const NULL = 0 @@ -46,8 +46,14 @@ import cmdsys word syspath word cmdline word modexec - byte refcons - byte devcons + word sysopen + word sysclose + word sysread + word syswrite + byte syserr + byte modid // Apple /// specific + byte refcons // Apple /// specific + byte devcons // Apple /// specific end // // CMD exported functions diff --git a/src/makefile b/src/makefile index 0a72c46..82e749c 100755 --- a/src/makefile +++ b/src/makefile @@ -6,6 +6,7 @@ PLVM01 = rel/apple/A1PLASMA\#060280 PLVM02 = rel/apple/PLASMA.SYSTEM\#FF2000 PLVM802 = rel/apple/PLASMA16.SYSTEM\#FF2000 PLVM03 = rel/apple/SOS.INTERP\#050000 +SOSCMD = rel/apple/SOS.CMD\#0FE1000 CMD = rel/apple/CMD\#061000 PLVMZP_C64 = vmsrc/c64/plvmzp.inc PLVMC64 = rel/c64/PLASMA @@ -75,7 +76,7 @@ TXTTYPE = .TXT #SYSTYPE = \#FF2000 #TXTTYPE = \#040000 -apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) +apple: $(PLVMZP_APL) $(PLASM) $(PLVM) $(PLVM01) $(PLVM02) $(PLVM802) $(PLVM03) $(CMD) $(SOSCMD) $(PLASMAPLASM) $(CODEOPT) $(ARGS) $(MEMMGR) $(MEMTEST) $(FIBER) $(FIBERTEST) $(LONGJMP) $(ED) $(MON) $(SOS) $(ROD) $(SIEVE) $(UTHERNET2) $(UTHERNET) $(ETHERIP) $(INET) $(DHCP) $(HTTPD) $(ROGUE) $(ROGUEMAP) $(ROGUECOMBAT) $(GRAFIX) $(GFXDEMO) $(DGR) $(DGRTEST) $(FILEIO_APL) $(CONIO_APL) $(JOYBUZZ) $(PORTIO) $(SPIPORT) $(SDFAT) $(FATCAT) $(FATGET) $(FATPUT) $(FATWDSK) $(FATRDSK) $(SANE) $(FPSTR) $(FPU) $(SANITY) $(RPNCALC) $(SNDSEQ) $(PLAYSEQ) -rm vmsrc/plvmzp.inc c64: $(PLVMZP_C64) $(PLASM) $(PLVM) $(PLVMC64) @@ -148,16 +149,20 @@ $(CMD): vmsrc/apple/cmd.pla vmsrc/apple/cmdstub.s $(PLVM02) $(PLASM) ./$(PLASM) -AOW < vmsrc/apple/cmd.pla > vmsrc/apple/cmd.a acme --setpc 8192 -o $(CMD) vmsrc/apple/cmdstub.s +$(SOSCMD): vmsrc/apple/soscmd.pla $(PLVM03) $(PLASM) + ./$(PLASM) -AMOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a + acme --setpc 4094 -o $(SOSCMD) vmsrc/apple/soscmd.a + $(PLVM02): vmsrc/apple/plvm02.s acme -o $(PLVM02) -l vmsrc/apple/plvm02.sym vmsrc/apple/plvm02.s $(PLVM802): vmsrc/apple/plvm802.s acme -o $(PLVM802) -l vmsrc/apple/plvm802.sym vmsrc/apple/plvm802.s -vmsrc/apple/soscmd.a: vmsrc/apple/soscmd.pla $(PLASM) - ./$(PLASM) -AOW < vmsrc/apple/soscmd.pla > vmsrc/apple/soscmd.a +vmsrc/apple/sossys.a: vmsrc/apple/sossys.pla $(PLASM) + ./$(PLASM) -AOW < vmsrc/apple/sossys.pla > vmsrc/apple/sossys.a -$(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/soscmd.a +$(PLVM03): vmsrc/apple/plvm03.s vmsrc/apple/sossys.a acme -o $(PLVM03) -l vmsrc/apple/plvm03.sym vmsrc/apple/plvm03.s # diff --git a/src/mkrel b/src/mkrel index 687e882..e8a1af0 100755 --- a/src/mkrel +++ b/src/mkrel @@ -2,6 +2,7 @@ cp rel/apple/CMD#061000 prodos/CMD.BIN cp rel/apple/PLASMA.SYSTEM#FF2000 prodos/PLASMA.SYSTEM.SYS cp rel/apple/PLASMA16.SYSTEM#FF2000 prodos/PLASMA16.SYSTEM.SYS cp rel/apple/SOS.INTERP#050000 prodos/SOS.INTERP.\$05 +cp rel/apple/SOS.CMD#FE1000 prodos/SOS.CMD.REL cp ../doc/Editor.md prodos/EDITOR.README.TXT rm -rf prodos/sys diff --git a/src/vmsrc/apple/plvm03.s b/src/vmsrc/apple/plvm03.s index fd1a9fd..e7afc82 100755 --- a/src/vmsrc/apple/plvm03.s +++ b/src/vmsrc/apple/plvm03.s @@ -534,7 +534,6 @@ CB LDA #$00 BCC + INC IPH + LDY #$FF -CW LA INY ;+INC_IP BMI - DEX @@ -544,14 +543,14 @@ LA INY ;+INC_IP LDA (IP),Y STA ESTKH,X JMP NEXTOP -;CW DEX -; INY ;+INC_IP -; LDA (IP),Y -; STA ESTKL,X -; INY -; LDA (IP),Y -; STA ESTKH,X -; JMP NEXTOP +CW DEX + INY ;+INC_IP + LDA (IP),Y + STA ESTKL,X + INY + LDA (IP),Y + STA ESTKH,X + JMP NEXTOP ;* ;* CONSTANT STRING ;* @@ -663,7 +662,7 @@ LLA INY ;+INC_IP ;* ;* LOAD VALUE FROM LOCAL FRAME OFFSET ;* -_LLB INY ;+INC_IP +LLB INY ;+INC_IP LDA (IP),Y STY IPY TAY @@ -673,8 +672,8 @@ _LLB INY ;+INC_IP LDA #$00 STA ESTKH,X LDY IPY - RTS -_LLW INY ;+INC_IP + JMP NEXTOP +LLW INY ;+INC_IP LDA (IP),Y STY IPY TAY @@ -685,29 +684,81 @@ _LLW INY ;+INC_IP LDA (IFP),Y STA ESTKH,X LDY IPY - RTS -LLB JSR _LLB - JMP NEXTOP -LLW JSR _LLW JMP NEXTOP ;* ;* ADD VALUE FROM LOCAL FRAME OFFSET ;* -ADDLB JSR _LLB - JMP ADD -ADDLW JSR _LLW - JMP ADD +ADDLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ LDY IPY + JMP NEXTOP +ADDLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (IFP),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* INDEX VALUE FROM LOCAL FRAME OFFSET ;* -IDXLB JSR _LLB - JMP IDXW -IDXLW JSR _LLW - JMP IDXW +IDXLB INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + LDA (IFP),Y + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXLW INY ;+INC_IP + LDA (IP),Y + STY IPY + TAY + STA TMPL + LDA (IFP),Y + ASL + STA TMPL + INY + LDA (IFP),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* LOAD VALUE FROM ABSOLUTE ADDRESS ;* -_LAB INY ;+INC_IP +LAB INY ;+INC_IP LDA (IP),Y STA ESTKH-2,X INY ;+INC_IP @@ -718,8 +769,8 @@ _LAB INY ;+INC_IP STA ESTKL,X LDA #$00 STA ESTKH,X - RTS -_LAW INY ;+INC_IP + JMP NEXTOP +LAW INY ;+INC_IP LDA (IP),Y STA TMPL INY ;+INC_IP @@ -734,25 +785,88 @@ _LAW INY ;+INC_IP LDA (TMP),Y STA ESTKH,X LDY IPY - RTS -LAB JSR _LAB - JMP NEXTOP -LAW JSR _LAW JMP NEXTOP ;* ;* ADD VALUE FROM ABSOLUTE ADDRESS ;* -ADDAB JSR _LAB - JMP ADD -ADDAW JSR _LAW - JMP ADD +ADDAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + CLC + ADC ESTKL,X + STA ESTKL,X + BCC + + INC ESTKH,X ++ JMP NEXTOP +ADDAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + CLC + ADC ESTKL,X + STA ESTKL,X + INY + LDA (SRC),Y + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* INDEX VALUE FROM ABSOLUTE ADDRESS ;* -IDXAB JSR _LAB - JMP IDXW -IDXAW JSR _LAW - JMP IDXW +IDXAB INY ;+INC_IP + LDA (IP),Y + STA ESTKH-2,X + INY ;+INC_IP + LDA (IP),Y + STA ESTKH-1,X + LDA (ESTKH-2,X) + STY IPY + LDY #$00 + ASL + BCC + + INY + CLC ++ ADC ESTKL,X + STA ESTKL,X + TYA + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP +IDXAW INY ;+INC_IP + LDA (IP),Y + STA SRCL + INY ;+INC_IP + LDA (IP),Y + STA SRCH + STY IPY + LDY #$00 + LDA (SRC),Y + ASL + STA TMPL + INY + LDA (SRC),Y + ROL + STA TMPH + LDA TMPL + CLC + ADC ESTKL,X + STA ESTKL,X + LDA TMPH + ADC ESTKH,X + STA ESTKH,X + LDY IPY + JMP NEXTOP ;* ;* STORE VALUE TO ADDRESS ;* @@ -976,20 +1090,17 @@ SEL INX STY TMPX ; CLEAR TMPX LDA (IP),Y STA TMPL ; CASE COUNT - LDA ESTKL-1,X INC IPL BNE CASELP INC IPH -CASELP CMP (IP),Y - BNE + +CASELP LDA ESTKL-1,X + CMP (IP),Y + BEQ + LDA ESTKH-1,X INY - CMP (IP),Y - BEQ BRNCH - LDA ESTKL-1,X - DEY -+ INY - INY + SBC (IP),Y + BMI CASEEND +- INY INY DEC TMPL BEQ FIXNEXT @@ -997,6 +1108,27 @@ CASELP CMP (IP),Y BNE CASELP INC IPH BNE CASELP ++ LDA ESTKH-1,X + INY + SBC (IP),Y + BEQ BRNCH + BPL - +CASEEND LDA #$00 + STA TMPH + DEC TMPL + LDA TMPL + ASL ; SKIP REMAINING CASES + ROL TMPH + ASL + ROL TMPH +; CLC + ADC IPL + STA IPL + LDA TMPH + ADC IPH + STA IPH + INY + INY FIXNEXT TYA LDY #$00 SEC @@ -1217,6 +1349,6 @@ LEAVE INY ;+INC_IP STA IFPH RET RTS SOSCMD = * - !SOURCE "vmsrc/apple/soscmd.a" + !SOURCE "vmsrc/apple/sossys.a" } SEGEND = * diff --git a/src/vmsrc/apple/soscmd.pla b/src/vmsrc/apple/soscmd.pla index b5bf840..02d8b3d 100755 --- a/src/vmsrc/apple/soscmd.pla +++ b/src/vmsrc/apple/soscmd.pla @@ -1,128 +1,10 @@ -const membank = $FFEF -const RELADDR = $1000 -// -// System flags: memory allocator screen holes. -// -const restxt1 = $0001 -const restxt2 = $0002 -const resxtxt1 = $0004 -const resxtxt2 = $0008 -const reshgr1 = $0010 -const reshgr2 = $0020 -const resxhgr1 = $0040 -const resxhgr2 = $0080 -// -// Module don't free memory -// -const modkeep = $2000 -const modinitkeep = $4000 -// -// 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, 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 -// -// Exported CMDSYS table -// -word version = $0202 // 02.00 -word syspath -word cmdlnptr -word = @execmod -byte refcons = 0 -byte devcons = 0 -// -// String pool. -// +include "inc/cmdsys.plh" byte console[] = ".CONSOLE" byte textmode[] = 16, 0, 15 -byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' -// -// Exported Machine ID. -// -byte machid = $F2 // Apple ///, 80 columns -// -// Working input buffer overlayed with strings table -// +byte prefix[64] = "" +byte err[] +byte autorun word cmdptr -byte cmdln = "" -// -// Standard Library exported functions. -// -byte sysmodstr[] = "CMDSYS" -byte machidstr[] = "MACHID" -byte sysstr[] = "SYSCALL" -byte callstr[] = "CALL" -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" -byte hprelstr[] = "HEAPRELEASE" -byte hpavlstr[] = "HEAPAVAIL" -byte sysmods[] = "" // overlay with exported strings -byte memsetstr[] = "MEMSET" -byte memcpystr[] = "MEMCPY" -byte uisgtstr[] = "ISUGT" -byte uisgestr[] = "ISUGE" -byte uisltstr[] = "ISULT" -byte uislestr[] = "ISULE" -byte sextstr[] = "SEXT" -byte divmodstr[] = "DIVMOD" -byte autorun[] = "AUTORUN" -byte prefix[] = "" // Overlay with exported symbols table -word exports[] = @sysmodstr, @version -word = @sysstr, @syscall -word = @callstr, @call -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 -word = @hpmarkstr, @markheap -word = @hpallocstr,@allocheap -word = @hpalignstr,@allocalignheap -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 -word = @uislestr, @uword_isle -word = @sextstr, @sext -word = @divmodstr, @divmod -word = @machidstr, @machid -word = 0 -word sysmodsym = @exports -// -// System variables. -// -word systemflags = 0 -word heap = $2000 -byte modid = 0 -byte modseg[15] -word symtbl, lastsym -byte perr, terr // // Utility functions // @@ -134,655 +16,6 @@ XREG LDX #$00 RTS end // -// CALL SOS -// SYSCALL(CMD, PARAMS) -// -asm syscall(cmd,params)#1 - LDA ESTKL,X - LDY ESTKH,X - STA PARAMS - STY PARAMS+1 - INX - LDA ESTKL,X - STA CMD - BRK -CMD !BYTE 00 -PARAMS !WORD 0000 - LDY #$00 - STA ESTKL,X - STY ESTKH,X - RTS -end -// -// CALL 6502 ROUTINE -// CALL(AREG, XREG, YREG, STATUS, ADDR) -// -asm call(addr,areg,xreg,yreg,sstatus)#1 -REGVALS = SRC - PHP - LDA ESTKL,X - STA TMPL - LDA ESTKH,X - STA TMPH - INX - LDA ESTKL,X - PHA - INX - LDY ESTKL,X - INX - LDA ESTKL+1,X - PHA - LDA ESTKL,X - INX - STX ESP - TAX - PLA - PLP - JSR JMPTMP - PHP - STA REGVALS+0 - STX REGVALS+1 - STY REGVALS+2 - PLA - STA REGVALS+3 - LDX ESP - LDA #REGVALS - STA ESTKL,X - STY ESTKH,X - PLP - RTS -end -// -// SET MEMORY TO VALUE -// MEMSET(ADDR, VALUE, SIZE) -// 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 -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 - 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 -; -; 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 -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 -; -; REVERSE COPY -; -REVCPY ;CLC - 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 -CPYMEX RTS -end -// -// COPY FROM MAIN MEM TO EXT MEM. -// -// MEMXCPY(DSTSEG, SRC, SIZE) -// -asm memxcpy(dst,src,size)#0 - LDA ESTKL,X - ORA ESTKH,X - BEQ CPYXMEX - LDY #$00 - STY DSTL - LDA ESTKH+2,X - CLC - ADC #$60 - STA DSTH - LDA ESTKL+2,X - CLC - ADC #$7F - STA DSTX - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH - INC ESTKH,X -CPYXLP LDA (SRC),Y - STA (DST),Y - INY - BNE + - INC DSTH - INC SRCH -+ DEC ESTKL,X - BNE CPYXLP - DEC ESTKH,X - BNE CPYXLP - LDA #$00 - STA DSTX -CPYXMEX INX - INX - INX - RTS -end -// -// POKE BYTE VAL INTO EXT MEM. -// -// XPOKEB(SEG, DST, BYTEVAL) -// -asm xpokeb(seg, dst, byteval)#0 - LDA ESTKL+1,X - STA DSTL - LDA ESTKH+1,X - CLC - ADC #$60 - STA DSTH - LDA ESTKL+2,X - CLC - ADC #$7F - STA DSTX - LDY #$00 - LDA ESTKL,X - STA (DST),Y - STY DSTX - INX - INX - INX - 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 -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 -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 -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 -end -asm divmod(a,b)#2 - JSR INTERP ; CALL INTERP - !BYTE $36, $5C ; DIVMOD, RET -end -asm sext(a)#1 - LDY #$00 - LDA ESTKL,X - BPL + - DEY -+ STY ESTKH,X - RTS -end -// -// Addresses of internal routines. -// -asm interp()#1 - DEX - LDA #XINTERP - 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. -// -//def dcitos(dci, str) -// byte len, c -// len = 0 -// repeat -// c = (dci).[len] -// len = len + 1 -// (str).[len] = c & $7F -// until !(c & $80) -// ^str = len -// 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 -end -//def stodci(str, dci) -// byte len, c -// len = ^str -// if len == 0 -// return -// fin -// c = toupper((str).[len]) & $7F -// len = len - 1 -// (dci).[len] = c -// while len -// c = toupper((str).[len]) | $80 -// len = len - 1 -// (dci).[len] = c -// loop -// 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 -end -asm toupper(c)#1 - LDA ESTKL,X -TOUPR AND #$7F - CMP #'a' - BCC + - CMP #'z'+1 - BCS + - SBC #$1F -+ STA ESTKL,X - RTS -end -// -// Lookup routines. -// -//def lookuptbl(dci, tbl) -// word match -// while ^tbl -// match = dci -// while ^tbl == ^match -// if !(^tbl & $80) -// return (tbl):1 -// fin -// tbl = tbl + 1 -// match = match + 1 -// loop -// while (^tbl & $80) -// tbl = tbl + 1 -// loop -// tbl = tbl + 3 -// loop -// return 0 -asm lookuptbl(dci, tbl)#1 - LDY #$00 - STY DSTL - LDA ESTKH,X - CLC - ADC #$60 - STA DSTH - LDA ESTKL,X - CLC - ADC #$7F - STA DSTX - LDA ESTKL+1,X - STA SRCL - LDA ESTKH+1,X - STA SRCH -- 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 - LDA #$00 - STA DSTX - 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 -// 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 + 6 -// 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 #$06 - 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 // @@ -793,7 +26,7 @@ def getpfx(path)#1 params.0 = 2 params:1 = path params.3 = 128 - perr = syscall($C7, @params) + syscall($C7, @params) return path end def setpfx(path)#1 @@ -804,69 +37,17 @@ def setpfx(path)#1 params:1 = path params:3 = @fileinfo params.5 = 2 - perr = syscall($C4, @params) // Get file info - if not perr and (fileinfo.1 == $00 or fileinfo.1 == $0F) // Make sure it's a directory + if not syscall($C4, @params) and (fileinfo.1 == $00 or fileinfo.1 == $0F) // Make sure it's a directory params.0 = 1 params:1 = path - perr = syscall($C6, @params) + syscall($C6, @params) else - perr = $44 + getpfx(path) // Get current path fin return path end -def volume(devname, volname)#1 - byte params[9] - - params.0 = 4 - params:1 = devname - params:3 = volname - params:5 = 0 - params:7 = 0 - perr = syscall($C5, @params) - return perr -end -def open(path)#1 - byte params[7] - - params.0 = 4 - params:1 = path - params.3 = 0 - params:4 = 0 - params.6 = 0 - perr = syscall($C8, @params) - return params.3 -end -def close(refnum)#1 - byte params[2] - - params.0 = 1 - params.1 = refnum - perr = syscall($CC, @params) - return perr -end -def read(refnum, buff, len)#1 - byte params[8] - - params.0 = 4 - params.1 = refnum - params:2 = buff - params:4 = len - params:6 = 0 - perr = syscall($CA, @params) - return params:6 -end -def write(refnum, buff, len)#1 - byte params[6] - - params.0 = 3 - params.1 = refnum - params:2 = buff - params:4 = len - perr = syscall($CB, @params) - return perr -end // -// DEVICE I/O +// CONSOLE I/O // def dev_control(devnum, code, list)#1 byte params[5] @@ -875,8 +56,7 @@ def dev_control(devnum, code, list)#1 params.1 = devnum params.2 = code params:3 = list - perr = syscall($83, @params) - return perr + return syscall($83, @params) end def dev_getnum(name)#1 byte params[4] @@ -884,7 +64,7 @@ def dev_getnum(name)#1 params.0 = 2 params:1 = name params.3 = 0 - perr = syscall($84, @params) + syscall($84, @params) return params.3 end def dev_info(devnum, name, list, listlen)#1 @@ -895,390 +75,29 @@ def dev_info(devnum, name, list, listlen)#1 params:2 = name params:4 = list params.6 = listlen - perr = syscall($85, @params) - return perr + return syscall($85, @params) end -// -// MEMORY CALLS -// -def seg_find(search, pages, id)#3 - byte params[10] - - params.0 = 6 - params.1 = search - params.2 = id - params:3 = pages - params:5 = 0 - params:7 = 0 - params.9 = 0 - perr = syscall($41, @params) - return params.9, params:5, params:7 -end -def seg_release(segnum)#1 - byte params[2] - - params.0 = 1 - params.1 = segnum - perr = syscall($45, @params) - return perr -end -// -// CONSOLE I/O -// def init_cons()#0 byte nlmode[2] - if !refcons - refcons = open(@console) + if !cmdsys.refcons + cmdsys.refcons = cmdsys:sysopen(@console) fin - write(refcons, @textmode, 3) - devcons = dev_getnum(@console) - nlmode:0 = $0D80 + cmdsys:syswrite(refcons, @textmode, 3) + cmdsys.devcons = dev_getnum(@console) + nlmode:0 = $0D80 //nlmode.0 = $80 //nlmode.1 = $0D dev_control(devcons, $02, @nlmode) end -def cout(ch)#0 - byte nc - - nc = 1 - if ch == $0D - ch = $0A0D - nc = 2 - fin - write(refcons, @ch, nc) -end -def crout()#0 - cout($0D) -end -def cin()#1 - byte ch - read(refcons, @ch, 1) - return ch & $7F -end -def prstr(str)#0 - write(refcons, str + 1, ^str) - if str->[^str] == $0D - cout($0A) - fin -end -def print(i)#0 - if i < 0; cout('-'); i = -i; fin - if i >= 10; print(i / 10); fin - cout(i % 10 + '0') -end -def rdstr(prompt)#1 - cout(prompt) - ^heap = read(refcons, heap + 1, 128) - if heap->[^heap] == $0D - ^heap-- - fin - crout - return heap -end -def prbyte(v)#0 - cout(hexchar[(v >> 4) & $0F]) - cout(hexchar[v & $0F]) -end -def prword(v)#0 - prbyte(v >> 8) - prbyte(v) -end -// -// Heap routines. -// -def availheap()#1 - byte fp - return @fp - heap -end -def allocheap(size)#1 - word addr - addr = heap - heap = heap + size - if uword_isge(heap, @addr) - return 0 - fin - return addr -end -def allocalignheap(size, pow2, freeaddr)#1 - word align, addr - if freeaddr - *freeaddr = heap - fin - align = (1 << pow2) - 1 - addr = (heap | align) + 1 - heap = addr + size - if uword_isge(heap, @addr) - return 0 - fin - return addr -end -def markheap()#1 - return heap -end -def releaseheap(newheap)#1 - heap = newheap - return @newheap - heap -end -// -// Symbol table routines. -// -def addsym(sym, addr)#0 - while ^sym & $80 - xpokeb(symtbl.0, lastsym, ^sym) - lastsym = lastsym + 1 - sym = sym + 1 - loop - xpokeb(symtbl.0, lastsym, ^sym) - xpokeb(symtbl.0, lastsym + 1, addr.0) - xpokeb(symtbl.0, lastsym + 2, addr.1) - xpokeb(symtbl.0, lastsym + 3, 0) - lastsym = lastsym + 3 -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 -// -// Module routines. -// -def lookupextern(esd, index)#1 - word sym, addr - byte str[16] - sym = lookupidx(esd, index) - if sym - addr = lookuptbl(sym, symtbl) - if !addr - perr = $81 - dcitos(sym, @str) - cout('?'); prstr(@str); crout - fin - return addr - fin - return 0 -end -def adddef(ext, addr, deflast)#1 - word defentry - defentry = *deflast - *deflast = defentry + 6 - defentry->0 = $20 - defentry=>1 = interp - defentry=>3 = addr - defentry=>5 = ext // ext is byte, so this nulls out next entry - return defentry -end -def loadmod(mod)#1 - word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup - word addr, defaddr, modaddr, modfix, modofst, modend - word deftbl, deflast, codeseg - word moddep, rld, esd, sym - byte lerr, defext, str[16], filename[33] - byte header[128] - lerr = 0 - // - // Read the RELocatable module header (first 128 bytes) - // - dcitos(mod, @filename) - refnum = open(@filename) - if !refnum - // - // Try system path - // - refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) - fin - if refnum - rdlen = read(refnum, @header, 128) - modsize = header:0 - moddep = @header.1 - defofst = modsize + RELADDR - defext = 0 - init = 0 - if rdlen > 4 and header:2 == $6502 // magic number - // - // This is an EXTended RELocatable (data+bytecode) module. - // - systemflags = header:4 | systemflags - defofst = header:6 - defcnt = header:8 - init = header:10 - moddep = @header.12 - // - // Load module dependencies. - // - while ^moddep - if !lookuptbl(moddep, symtbl) - if refnum - close(refnum) - refnum = 0 - fin - if loadmod(moddep) < 0 - return -perr - fin - fin - moddep = moddep + dcitos(moddep, @str) - loop - // - // Init def table. - // - deftbl = allocheap(defcnt * 6 + 1) - deflast = deftbl - ^deflast = 0 - if !refnum - // - // Reset read pointer. - // - refnum = open(@filename) - rdlen = read(refnum, @header, 128) - fin - fin - // - // Alloc heap space for relocated module (data + bytecode). - // - moddep++ - 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. - // - addsym(mod, modaddr) - // - // Apply all fixups and symbol import/export. - // - modfix = modaddr - modfix - modofst = modfix - RELADDR - modend = modaddr + modsize - bytecode = defofst + modofst - rld = modend // Re-Locatable Directory - esd = rld // Extern+Entry Symbol Directory - while ^esd // Scan to end of ESD - esd = esd + 4 - loop - esd++ - if defcnt - // - // Locate bytecode defs in allocated segment. - // - modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12) - if perr - return -perr - fin - modid++ - defext = codeseg.0 + $7F // (codeseg.0 | $80) - 1 - defaddr = (codeseg & $FF00) + $6000 - codefix = defaddr - bytecode - defofst = defaddr - defofst - fin - // - // Run through the DeFinition Dictionary. - // - while ^rld == $02 - // - // This is a bytcode def entry - add it to the def directory. - // - adddef(defext, rld=>1 + defofst, @deflast) - rld = rld + 4 - loop - // - // Run through the Re-Location Dictionary. - // - while ^rld - 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 - //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. - // - while ^esd - sym = esd - esd = esd + dcitos(esd, @str) - if ^esd & $08 - // - // EXPORT symbol - add it to the global symbol table. - // - addr = esd=>1 + modofst - if uword_isge(addr, bytecode) - // - // Use the def directory address for bytecode. - // - addr = lookupdef(addr + codefix, deftbl) - fin - addsym(sym, addr) - fin - esd = esd + 3 - loop - if defext - // - // Copy bytecode to code segment. - // - memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr)) - fin - fin - if lerr - return -lerr - fin - // - // Free up end-of-module main memory. - // - releaseheap(bytecode) - // - // Call init routine if it exists. - // - fixup = 0 - if init - fixup = adddef(defext, init + defofst, @deflast)() - if fixup < 0 - perr = -fixup - fin - fin - return fixup +def volume(devname, volname)#1 + byte params[9] + + params.0 = 4 + params:1 = devname + params:3 = volname + params:5 = 0 + params:7 = 0 + return syscall($C5, @params) end // // Command mode @@ -1291,39 +110,39 @@ def volumes()#0 for i = $01 to $18 if dev_info(i, @devname, @info, 11) == 0 - prstr(@devname) + puts(@devname) if volume(@devname, @volname) == 0 - prstr(" => /") - prstr(@volname) - cout('/') + puts(" => /") + puts(@volname) + putc('/') fin - crout + putln fin next - perr = 0 end def catalog(path)#0 byte refnum byte firstblk byte entrylen, entriesblk byte i, type, len - word entry, filecnt + word entry, filecnt, catptr if !^path path = @prefix fin - refnum = open(path) - if perr + refnum = cmdsys:sysopen(path) + if not refnum return fin + catptr = heapmark firstblk = 1 repeat - if read(refnum, heap, 512) == 512 - entry = heap + 4 + if cmdsys:sysread(refnum, catptr, 512) == 512 + entry = catptr + 4 if firstblk - entrylen = heap->$23 - entriesblk = heap->$24 - filecnt = heap=>$25 + entrylen = catptr->$23 + entriesblk = catptr->$24 + filecnt = catptr=>$25 entry = entry + entrylen fin for i = firstblk to entriesblk @@ -1331,7 +150,7 @@ def catalog(path)#0 if type len = type & $0F ^entry = len - prstr(entry) + puts(entry) type = ' ' when entry->$10 is $0F // Is it a directory? @@ -1343,9 +162,9 @@ def catalog(path)#0 is $FE // REL file type = '+' wend - cout(type) + putc(type) for len = 18 - len downto 0 - cout(' ') + putc(' ') next filecnt-- fin @@ -1356,8 +175,8 @@ def catalog(path)#0 filecnt = 0 fin until filecnt == 0 - close(refnum) - crout() + cmdsys:sysclose(refnum) + putln() end def stripchars(strptr)#1 while ^strptr and ^(strptr + 1) > ' ' @@ -1399,30 +218,6 @@ def parsecmd(strptr)#1 stripspaces(strptr) return cmd end -def execmod(modfile)#1 - byte moddci[17] - word saveheap, savesym, saveflags - - perr = 1 - if stodci(modfile, @moddci) - saveheap = heap - savesym = lastsym - saveflags = systemflags - if loadmod(@moddci) < modkeep - lastsym = savesym - heap = saveheap - while modid - modid-- - seg_release(modseg[modid]) - loop - else - modid = 0 - fin - xpokeb(symtbl.0, lastsym, 0) - systemflags = saveflags - fin - return -perr -end // // Init console. // @@ -1430,42 +225,24 @@ init_cons // // Print PLASMA version // -prstr("PLASMA 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout -// -// Init 2K symbol table. -// -drop, symtbl, drop = seg_find($00, $08, $11) -lastsym = symtbl & $FF00 -xpokeb(symtbl.0, lastsym, 0) -while *sysmodsym - stodci(sysmodsym=>0, heap) - addsym(heap, sysmodsym=>2) - sysmodsym = sysmodsym + 4 -loop -// -// Clear system path -// -sysmods = 0 -syspath = @sysmods +puts("PLASMA 2.0 Dev\n")//; prbyte(version.1); cout('.'); prbyte(version.0); crout // // Try to load autorun. // -cmdlnptr = @cmdln -cmdptr = heap +cmdptr = heapmark ^cmdptr = 0 -autorun = open(@autorun) +autorun = cmdsys:sysopen("AUTORUN") if autorun > 0 - ^cmdptr = read(autorun, cmdptr + 1, 64) - close(autorun) + ^cmdptr = cmdsys:sysread(autorun, cmdptr + 1, 64) + cmdsys:sysclose(autorun) else // // Print some startup info. // - prstr("MEM:$") - prword(availheap) - crout + puts("MEM:$") + puth(heapavail) + putln fin -perr = 0 // // Handle commands. // @@ -1493,32 +270,32 @@ while 1 break is 'S' setpfx(cmdptr) - strcat(getpfx(@sysmods), "SYS/")) + strcat(getpfx(cmdsys:syspath), "SYS/")) break is 'V' volumes break is '+' saveX - execmod(striptrail(cmdptr)) + cmdsys:modexec(striptrail(cmdptr)) restoreX //close(0) init_cons break otherwise - prstr("?\n") + puts("?\n") wend - if perr - terr = perr - prstr("ERR:$") - prbyte(terr) + if cmdsys.syserr + err = cmdsys.syserr + puts("ERR:$") + putb(err) else - prstr("OK") + puts("OK") fin - crout() + putln fin - prstr(getpfx(@prefix)) - cmdptr = rdstr($BA) - strcpy(@cmdln, cmdptr) + puts(getpfx(@prefix)) + cmdptr = gets($BA) + strcpy(cmdsys:cmdline, cmdptr) loop done diff --git a/src/vmsrc/apple/sossys.pla b/src/vmsrc/apple/sossys.pla new file mode 100755 index 0000000..674db6f --- /dev/null +++ b/src/vmsrc/apple/sossys.pla @@ -0,0 +1,1229 @@ +const membank = $FFEF +const RELADDR = $1000 +// +// System flags: memory allocator screen holes. +// +const restxt1 = $0001 +const restxt2 = $0002 +const resxtxt1 = $0004 +const resxtxt2 = $0008 +const reshgr1 = $0010 +const reshgr2 = $0020 +const resxhgr1 = $0040 +const resxhgr2 = $0080 +// +// Module don't free memory +// +const modkeep = $2000 +const modinitkeep = $4000 +// +// 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, 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, open(path)#1, close(refnum)#1, read(refnum, buff, len)#1, write(refnum, buff, len)#1 +// +// Exported CMDSYS table +// +word version = $0200 // 02.00 +word syspath +word cmdlnptr +word = @execmod, @open, @close, @read, @write +byte refcons = 0 +byte devcons = 0 +byte modid = 0 +// +// String pool. +// +byte hexchar[] = '0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F' +// +// Exported Machine ID. +// +byte machid = $F2 // Apple ///, 80 columns +// +// Working input buffer overlayed with strings table +// +byte cmdln = "" +// +// Standard Library exported functions. +// +byte sysmodstr[] = "CMDSYS" +byte machidstr[] = "MACHID" +byte sysstr[] = "SYSCALL" +byte callstr[] = "CALL" +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" +byte hprelstr[] = "HEAPRELEASE" +byte hpavlstr[] = "HEAPAVAIL" +byte memsetstr[] = "MEMSET" +byte memcpystr[] = "MEMCPY" +byte uisgtstr[] = "ISUGT" +byte uisgestr[] = "ISUGE" +byte uisltstr[] = "ISULT" +byte uislestr[] = "ISULE" +byte sextstr[] = "SEXT" +byte divmodstr[] = "DIVMOD" +byte sysmods[] = "" // overlay sys path with exports +word exports[] = @sysmodstr, @version +word = @sysstr, @syscall +word = @callstr, @call +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 +word = @hpmarkstr, @markheap +word = @hpallocstr,@allocheap +word = @hpalignstr,@allocalignheap +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 +word = @uislestr, @uword_isle +word = @sextstr, @sext +word = @divmodstr, @divmod +word = @machidstr, @machid +word = 0 +word sysmodsym = @exports +// +// System variables. +// +word systemflags = 0 +word heap = $2000 +byte modseg[15] +word symtbl, lastsym +byte perr +// +// CALL SOS +// SYSCALL(CMD, PARAMS) +// +asm syscall(cmd,params)#1 + LDA ESTKL,X + LDY ESTKH,X + STA PARAMS + STY PARAMS+1 + INX + LDA ESTKL,X + STA CMD + BRK +CMD !BYTE 00 +PARAMS !WORD 0000 + LDY #$00 + STA ESTKL,X + STY ESTKH,X + RTS +end +// +// CALL 6502 ROUTINE +// CALL(AREG, XREG, YREG, STATUS, ADDR) +// +asm call(addr,areg,xreg,yreg,sstatus)#1 +REGVALS = SRC + PHP + LDA ESTKL,X + STA TMPL + LDA ESTKH,X + STA TMPH + INX + LDA ESTKL,X + PHA + INX + LDY ESTKL,X + INX + LDA ESTKL+1,X + PHA + LDA ESTKL,X + INX + STX ESP + TAX + PLA + PLP + JSR JMPTMP + PHP + STA REGVALS+0 + STX REGVALS+1 + STY REGVALS+2 + PLA + STA REGVALS+3 + LDX ESP + LDA #REGVALS + STA ESTKL,X + STY ESTKH,X + PLP + RTS +end +// +// SET MEMORY TO VALUE +// MEMSET(ADDR, VALUE, SIZE) +// 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 +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 + 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 +; +; 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 +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 +; +; REVERSE COPY +; +REVCPY ;CLC + 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 +CPYMEX RTS +end +// +// COPY FROM MAIN MEM TO EXT MEM. +// +// MEMXCPY(DSTSEG, SRC, SIZE) +// +asm memxcpy(dst,src,size)#0 + LDA ESTKL,X + ORA ESTKH,X + BEQ CPYXMEX + LDY #$00 + STY DSTL + LDA ESTKH+2,X + CLC + ADC #$60 + STA DSTH + LDA ESTKL+2,X + CLC + ADC #$7F + STA DSTX + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH + INC ESTKH,X +CPYXLP LDA (SRC),Y + STA (DST),Y + INY + BNE + + INC DSTH + INC SRCH ++ DEC ESTKL,X + BNE CPYXLP + DEC ESTKH,X + BNE CPYXLP + LDA #$00 + STA DSTX +CPYXMEX INX + INX + INX + RTS +end +// +// POKE BYTE VAL INTO EXT MEM. +// +// XPOKEB(SEG, DST, BYTEVAL) +// +asm xpokeb(seg, dst, byteval)#0 + LDA ESTKL+1,X + STA DSTL + LDA ESTKH+1,X + CLC + ADC #$60 + STA DSTH + LDA ESTKL+2,X + CLC + ADC #$7F + STA DSTX + LDY #$00 + LDA ESTKL,X + STA (DST),Y + STY DSTX + INX + INX + INX + 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 +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 +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 +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 +end +asm divmod(a,b)#2 + JSR INTERP ; CALL INTERP + !BYTE $36, $5C ; DIVMOD, RET +end +asm sext(a)#1 + LDY #$00 + LDA ESTKL,X + BPL + + DEY ++ STY ESTKH,X + RTS +end +// +// Addresses of internal routines. +// +asm interp()#1 + DEX + LDA #XINTERP + 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. +// +//def dcitos(dci, str) +// byte len, c +// len = 0 +// repeat +// c = (dci).[len] +// len = len + 1 +// (str).[len] = c & $7F +// until !(c & $80) +// ^str = len +// 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 +end +//def stodci(str, dci) +// byte len, c +// len = ^str +// if len == 0 +// return +// fin +// c = toupper((str).[len]) & $7F +// len = len - 1 +// (dci).[len] = c +// while len +// c = toupper((str).[len]) | $80 +// len = len - 1 +// (dci).[len] = c +// loop +// 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 +end +asm toupper(c)#1 + LDA ESTKL,X +TOUPR AND #$7F + CMP #'a' + BCC + + CMP #'z'+1 + BCS + + SBC #$1F ++ STA ESTKL,X + RTS +end +// +// Lookup routines. +// +//def lookuptbl(dci, tbl) +// word match +// while ^tbl +// match = dci +// while ^tbl == ^match +// if !(^tbl & $80) +// return (tbl):1 +// fin +// tbl = tbl + 1 +// match = match + 1 +// loop +// while (^tbl & $80) +// tbl = tbl + 1 +// loop +// tbl = tbl + 3 +// loop +// return 0 +asm lookuptbl(dci, tbl)#1 + LDY #$00 + STY DSTL + LDA ESTKH,X + CLC + ADC #$60 + STA DSTH + LDA ESTKL,X + CLC + ADC #$7F + STA DSTX + LDA ESTKL+1,X + STA SRCL + LDA ESTKH+1,X + STA SRCH +- 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 + LDA #$00 + STA DSTX + 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 +// 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 + 6 +// 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 #$06 + 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 +// +def open(path)#1 + byte params[7] + + params.0 = 4 + params:1 = path + params.3 = 0 + params:4 = 0 + params.6 = 0 + perr = syscall($C8, @params) + return params.3 +end +def close(refnum)#1 + byte params[2] + + params.0 = 1 + params.1 = refnum + perr = syscall($CC, @params) + return perr +end +def read(refnum, buff, len)#1 + byte params[8] + + params.0 = 4 + params.1 = refnum + params:2 = buff + params:4 = len + params:6 = 0 + perr = syscall($CA, @params) + return params:6 +end +def write(refnum, buff, len)#1 + byte params[6] + + params.0 = 3 + params.1 = refnum + params:2 = buff + params:4 = len + perr = syscall($CB, @params) + return perr +end +// +// MEMORY CALLS +// +def seg_find(search, pages, id)#3 + byte params[10] + + params.0 = 6 + params.1 = search + params.2 = id + params:3 = pages + params:5 = 0 + params:7 = 0 + params.9 = 0 + perr = syscall($41, @params) + return params.9, params:5, params:7 +end +def seg_release(segnum)#1 + byte params[2] + + params.0 = 1 + params.1 = segnum + perr = syscall($45, @params) + return perr +end +// +// CONSOLE I/O +// +def cout(ch)#0 + byte nc + + nc = 1 + if ch == $0D + ch = $0A0D + nc = 2 + fin + write(refcons, @ch, nc) +end +def crout()#0 + cout($0D) +end +def cin()#1 + byte ch + read(refcons, @ch, 1) + return ch & $7F +end +def prstr(str)#0 + write(refcons, str + 1, ^str) + if str->[^str] == $0D + cout($0A) + fin +end +def print(i)#0 + if i < 0; cout('-'); i = -i; fin + if i >= 10; print(i / 10); fin + cout(i % 10 + '0') +end +def rdstr(prompt)#1 + cout(prompt) + ^heap = read(refcons, heap + 1, 128) + if heap->[^heap] == $0D + ^heap-- + fin + crout + return heap +end +def prbyte(v)#0 + cout(hexchar[(v >> 4) & $0F]) + cout(hexchar[v & $0F]) +end +def prword(v)#0 + prbyte(v >> 8) + prbyte(v) +end +// +// Heap routines. +// +def availheap()#1 + byte fp + return @fp - heap +end +def allocheap(size)#1 + word addr + addr = heap + heap = heap + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def allocalignheap(size, pow2, freeaddr)#1 + word align, addr + if freeaddr + *freeaddr = heap + fin + align = (1 << pow2) - 1 + addr = (heap | align) + 1 + heap = addr + size + if uword_isge(heap, @addr) + return 0 + fin + return addr +end +def markheap()#1 + return heap +end +def releaseheap(newheap)#1 + heap = newheap + return @newheap - heap +end +// +// Symbol table routines. +// +def addsym(sym, addr)#0 + while ^sym & $80 + xpokeb(symtbl.0, lastsym, ^sym) + lastsym = lastsym + 1 + sym = sym + 1 + loop + xpokeb(symtbl.0, lastsym, ^sym) + xpokeb(symtbl.0, lastsym + 1, addr.0) + xpokeb(symtbl.0, lastsym + 2, addr.1) + xpokeb(symtbl.0, lastsym + 3, 0) + lastsym = lastsym + 3 +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 +// +// Module routines. +// +def lookupextern(esd, index)#1 + word sym, addr + byte str[16] + sym = lookupidx(esd, index) + if sym + addr = lookuptbl(sym, symtbl) + if !addr + perr = $81 + dcitos(sym, @str) + cout('?'); prstr(@str); crout + fin + return addr + fin + return 0 +end +def adddef(ext, addr, deflast)#1 + word defentry + defentry = *deflast + *deflast = defentry + 6 + defentry->0 = $20 + defentry=>1 = interp + defentry=>3 = addr + defentry=>5 = ext // ext is byte, so this nulls out next entry + return defentry +end +def loadmod(mod)#1 + word refnum, rdlen, modsize, bytecode, codefix, defofst, defcnt, init, fixup + word addr, defaddr, modaddr, modfix, modofst, modend + word deftbl, deflast, codeseg + word moddep, rld, esd, sym + byte lerr, defext, str[16], filename[33] + byte header[128] + lerr = 0 + // + // Read the RELocatable module header (first 128 bytes) + // + dcitos(mod, @filename) + refnum = open(@filename) + if !refnum + // + // Try system path + // + refnum = open(strcpy(@filename,strcat(strcpy(@header, @sysmods), @filename))) + fin + if refnum + rdlen = read(refnum, @header, 128) + modsize = header:0 + moddep = @header.1 + defofst = modsize + RELADDR + defext = 0 + init = 0 + if rdlen > 4 and header:2 == $6502 // magic number + // + // This is an EXTended RELocatable (data+bytecode) module. + // + systemflags = header:4 | systemflags + defofst = header:6 + defcnt = header:8 + init = header:10 + moddep = @header.12 + // + // Load module dependencies. + // + while ^moddep + if !lookuptbl(moddep, symtbl) + if refnum + close(refnum) + refnum = 0 + fin + if loadmod(moddep) < 0 + return -perr + fin + fin + moddep = moddep + dcitos(moddep, @str) + loop + // + // Init def table. + // + deftbl = allocheap(defcnt * 6 + 1) + deflast = deftbl + ^deflast = 0 + if !refnum + // + // Reset read pointer. + // + refnum = open(@filename) + rdlen = read(refnum, @header, 128) + fin + fin + // + // Alloc heap space for relocated module (data + bytecode). + // + moddep++ + 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. + // + addsym(mod, modaddr) + // + // Apply all fixups and symbol import/export. + // + modfix = modaddr - modfix + modofst = modfix - RELADDR + modend = modaddr + modsize + bytecode = defofst + modofst + rld = modend // Re-Locatable Directory + esd = rld // Extern+Entry Symbol Directory + while ^esd // Scan to end of ESD + esd = esd + 4 + loop + esd++ + if defcnt + // + // Locate bytecode defs in allocated segment. + // + modseg[modid], codeseg, drop = seg_find($00, (rld - bytecode + 255) >> 8, modid + $12) + if perr + return -perr + fin + modid++ + defext = codeseg.0 + $7F // (codeseg.0 | $80) - 1 + defaddr = (codeseg & $FF00) + $6000 + codefix = defaddr - bytecode + defofst = defaddr - defofst + fin + // + // Run through the DeFinition Dictionary. + // + while ^rld == $02 + // + // This is a bytcode def entry - add it to the def directory. + // + adddef(defext, rld=>1 + defofst, @deflast) + rld = rld + 4 + loop + // + // Run through the Re-Location Dictionary. + // + while ^rld + 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 + //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. + // + while ^esd + sym = esd + esd = esd + dcitos(esd, @str) + if ^esd & $08 + // + // EXPORT symbol - add it to the global symbol table. + // + addr = esd=>1 + modofst + if uword_isge(addr, bytecode) + // + // Use the def directory address for bytecode. + // + addr = lookupdef(addr + codefix, deftbl) + fin + addsym(sym, addr) + fin + esd = esd + 3 + loop + if defext + // + // Copy bytecode to code segment. + // + memxcpy(codeseg, bytecode, modsize - (bytecode - modaddr)) + fin + fin + if lerr + return -lerr + fin + // + // Free up end-of-module main memory. + // + releaseheap(bytecode) + // + // Call init routine if it exists. + // + fixup = 0 + if init + fixup = adddef(defext, init + defofst, @deflast)() + if fixup < 0 + perr = -fixup + fin + fin + return fixup +end +def execmod(modfile)#1 + byte moddci[17] + word saveheap, savesym, saveflags + + perr = 1 + if stodci(modfile, @moddci) + saveheap = heap + savesym = lastsym + saveflags = systemflags + if loadmod(@moddci) < modkeep + lastsym = savesym + heap = saveheap + while modid + modid-- + seg_release(modseg[modid]) + loop + else + modid = 0 + fin + xpokeb(symtbl.0, lastsym, 0) + systemflags = saveflags + fin + return -perr +end +// +// Init 2K symbol table. +// +drop, symtbl, drop = seg_find($00, $08, $11) +lastsym = symtbl & $FF00 +xpokeb(symtbl.0, lastsym, 0) +while *sysmodsym + stodci(sysmodsym=>0, heap) + addsym(heap, sysmodsym=>2) + sysmodsym = sysmodsym + 4 +loop +// +// Clear system path and command line +// +sysmods = 0 +syspath = @sysmods +cmdlnptr = @cmdln +// +// Exec command line parser +// +execmod("SOS.CMD") +done