diff --git a/Source/Forth/camel80.azm b/Source/Forth/camel80.azm index 9027dd9c..bf71bd6e 100644 --- a/Source/Forth/camel80.azm +++ b/Source/Forth/camel80.azm @@ -5,7 +5,6 @@ CIOIST EQU 02h ; CHARACTER INPUT STATUS BID_BOOT EQU 00h ;HB_BNKCALL EQU 0fff9h BF_SYSRESET EQU 0F0h ; RESTART SYSTEM - BF_SYSRES_INT EQU 00h ; RESET HBIOS INTERNAL BF_SYSRES_WARM EQU 01h ; WARM START (RESTART BOOT LOADER) BF_SYSRES_COLD EQU 02h ; COLD START @@ -72,6 +71,11 @@ FTH_LOC EQU 0200h ; keywords are being passed in a ; macro. ; b1ackmai1er difficultylevelhigh@gmail.com +; 03-Dec 20 v1.02 Add James Bowmans double +; precision words as per RC2014 +; version. Increase terminal +; input buffer (TIB) size. +; b1ackmai1er difficultylevelhigh@gmail.com ; =============================================== ; Macros to define Forth headers ; HEAD label,length,name,action @@ -154,9 +158,11 @@ reset: ld hl,0FDFFh ; HBIOS address, rounded down jp COLD ; enter top-level Forth word ; Memory map: -; Terminal Input Buffer, 128 bytes + ; FTH_LOC Forth kernel = starts after ROMLDR ; ? h Forth dictionary (user RAM) +; EM-400h Terminal Input Buffer, 512 bytes +; Below user area ; EM-200h User area, 128 bytes ; EM-180h Parameter stack, 128B, grows down ; EM-100h HOLD area, 40 bytes, grows down @@ -338,14 +344,9 @@ KEY2: DW SAVEKEY,CFETCH,LIT,0,SAVEKEY,CSTORE ;X BYE i*x -- return to CP/M head bye,3,bye,docode - ;LD A,BID_BOOT ; BOOT BANK - ;LD HL,0 ; ADDRESS ZERO - ;CALL HB_BNKCALL ; DOES NOT RETURN LD B,BF_SYSRESET ; SYSTEM RESTART LD C,BF_SYSRES_WARM ; WARM START - CALL 0FFF0h ; CALL HBIOS - - HALT + JP 0FFF0h ; CALL HBIOS ; STACK OPERATIONS ============================== diff --git a/Source/Forth/camel80h.azm b/Source/Forth/camel80h.azm index b3b6f079..15f195ef 100644 --- a/Source/Forth/camel80h.azm +++ b/Source/Forth/camel80h.azm @@ -39,7 +39,7 @@ ;Z tibsize -- n size of TIB head TIBSIZE,7,TIBSIZE,docon - dw 124 ; 2 chars safety zone + dw 512-2 ; 2 chars safety zone ;X tib -- a-addr Terminal Input Buffer ; HEX 82 CONSTANT TIB CP/M systems: 126 bytes @@ -47,7 +47,7 @@ ; head TIB,3,TIB,docon ; dw 82h head TIB,3,TIB,douser - dw -80h + dw -512 ;Z u0 -- a-addr current user area adrs ; 0 USER U0 @@ -1011,6 +1011,75 @@ WDS1: DW DUP,COUNT,TYPE,SPACE,NFATOLFA,FETCH DOTS1: DW II,FETCH,UDOT,LIT,-2,XPLUSLOOP,DOTS1 DOTS2: DW EXIT +;C D. d -- display d signed + head DDOT,2,D.,docolon + DW LESSNUM,DUP,TOR,DABS,NUMS + DW RFROM,SIGN,NUMGREATER,TYPE,SPACE,EXIT + +;X D+ d1 d2 -- d1+d2 Add double numbers + head DPLUS,2,D+,docode + exx + pop bc ; BC'=d2lo + exx + pop hl ; HL=d1hi,BC=d2hi + exx + pop hl ; HL'=d1lo + add hl,bc + push hl ; 2OS=d1lo+d2lo + exx + adc hl,bc ; HL=d1hi+d2hi+cy + ld b,h + ld c,l + next + +;C 2>R d -- 2 to R + head TWOTOR,3,2!>R,docolon + DW SWOP,RFROM,SWOP,TOR,SWOP,TOR,TOR,EXIT + +;C 2R> d -- fetch 2 from R + head TWORFROM,3,2R!>,docolon + DW RFROM,RFROM,RFROM,SWOP,ROT,TOR,EXIT + +TNEGATE: + call docolon + DW TOR,TWODUP,OR,DUP,qbranch,TNEG1,DROP,DNEGATE,lit,1 +TNEG1: + DW RFROM,PLUS,NEGATE,EXIT + +qtneg: + call docolon + DW ZEROLESS,qbranch,qtneg1,TNEGATE +qtneg1: + DW EXIT + +TSTAR: + call docolon + DW TWODUP,XOR,TOR + DW TOR,DABS,RFROM,ABS + DW TWOTOR + DW RFETCH,UMSTAR,lit,0 + DW TWORFROM,UMSTAR + DW DPLUS + DW RFROM + DW qtneg + DW EXIT + +TDIV: + call docolon + DW OVER,TOR,TOR + DW DUP,qtneg + DW RFETCH,UMSLASHMOD + DW ROT,ROT + DW RFROM,UMSLASHMOD + DW NIP,SWOP + DW RFROM,ZEROLESS,qbranch,tdiv1,DNEGATE +tdiv1: + DW EXIT + +;C M*/ d1 n2 u3 -- d=(d1*n2)/u3 double precision mult. div + head MSTARSLASH,3,M*/,docolon + DW TOR,TSTAR,RFROM,TDIV,EXIT + ;Z COLD -- cold start Forth system ; UINIT U0 #INIT CMOVE init user area ; 80 COUNT INTERPRET interpret CP/M cmd