Patches from https://github.com/nealcrook/hForth.git up to commit cdccc69

[hf86v099.git] / hf86ram.asm

diff --git a/hf86ram.asm b/hf86ram.asm
index 2d31ef5..1a9f57b 100644 (file)
--- a/hf86ram.asm
+++ b/hf86ram.asm
@@ -7,6 +7,10 @@ PAGE 62,132    ;62 lines per page, 132 characters per line
 ;      hForth 8086 RAM model v0.9.9 by Wonyong Koh, 1997\r
 ;\r
 ;\r
+; 1997. 7. 11.\r
+;      Fix SPACES. Thank Benjamin Hoyt.\r
+; 1997. 6. 23.\r
+;      Fix pack".\r
 ; 1997. 2. 19.\r
 ;      Split environmental variable systemID into CPU and Model.\r
 ; 1997. 2. 6.\r
@@ -1177,24 +1181,6 @@ ZBRAN1:  MOV     SI,[SI]                 ;IP:=(IP)
                AND     BX,0FFFEh\r
                $NEXT\r
 \r
-; pack" is dependent of cell alignment.\r
-;\r
-;   pack"       ( c-addr u a-addr -- a-addr2 )\r
-;              Place a string c-addr u at a-addr and gives the next\r
-;              cell-aligned address. Fill the rest of the last cell with\r
-;              null character.\r
-;\r
-;   : pack"     2DUP SWAP CHARS + CHAR+ DUP >R  \ ca u aa aa+u+1\r
-;              1 CHARS - 0 SWAP !              \ fill 0 at the end of string\r
-;              2DUP C! CHAR+ SWAP              \ c-addr a-addr+1 u\r
-;              CHARS MOVE R> ; COMPILE-ONLY\r
-\r
-               $COLON  5,'pack"',PackQuote,_SLINK\r
-               DW      TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
-               DW      DoLIT,CHARR,Minus,Zero,SWAP,Store\r
-               DW      TwoDUP,CStore,CHARPlus,SWAP\r
-               DW      CHARS,MOVE,RFrom,EXIT\r
-\r
 ;   CELLS      ( n1 -- n2 )                    \ CORE\r
 ;              Calculate number of address units for n1 cells.\r
 ;\r
@@ -1954,6 +1940,22 @@ AddrLastName     EQU     $-CELLL
                $COLON  7,'name>xt',NameToXT,_SLINK\r
                DW      COUNT,DoLIT,MASKK,ANDD,Plus,ALIGNED,CELLPlus,EXIT\r
 \r
+;   pack"       ( c-addr u a-addr -- a-addr2 )\r
+;              Place a string c-addr u at a-addr and gives the next\r
+;              cell-aligned address. Fill the rest of the last cell with\r
+;              null character.\r
+;\r
+;   : pack"     2DUP SWAP CHARS + CHAR+ DUP >R  \ ca u aa aa+u+1\r
+;              ALIGNED cell- 0 SWAP !          \ fill 0 at the end of string\r
+;              2DUP C! CHAR+ SWAP              \ c-addr a-addr+1 u\r
+;              CHARS MOVE R> ALIGNED ; COMPILE-ONLY\r
+\r
+               $COLON  5,'pack"',PackQuote,_SLINK\r
+               DW      TwoDUP,SWAP,CHARS,Plus,CHARPlus,DUPP,ToR\r
+               DW      ALIGNED,CellMinus,Zero,SWAP,Store\r
+               DW      TwoDUP,CStore,CHARPlus,SWAP\r
+               DW      CHARS,MOVE,RFrom,ALIGNED,EXIT\r
+\r
 ;   PARSE-WORD ( "<spaces>ccc<space>" -- c-addr u )\r
 ;              Skip leading spaces and parse a word. Return the name.\r
 ;\r
@@ -3467,13 +3469,14 @@ SMREM4          DW      DoLIT,-11,THROW
 ;   SPACES     ( n -- )                        \ CORE\r
 ;              Send n spaces to the output device if n is greater than zero.\r
 ;\r
-;   : SPACES   ?DUP IF 0 DO SPACE LOOP THEN ;\r
+;   : SPACES   DUP 0 > IF 0 DO SPACE LOOP EXIT THEN  DROP;\r
 \r
                $COLON  6,'SPACES',SPACES,_FLINK\r
-               DW      QuestionDUP,ZBranch,SPACES2\r
+               DW      DUPP,Zero,GreaterThan,ZBranch,SPACES1\r
                DW      Zero,DoDO\r
-SPACES1        DW      SPACE,DoLOOP,SPACES1\r
-SPACES2        DW      EXIT\r
+SPACES2        DW      SPACE,DoLOOP,SPACES2\r
+               DW      EXIT\r
+SPACES1        DW      DROP,EXIT\r
 \r
 ;   TO         Interpretation: ( x "<spaces>name" -- ) \ CORE EXT\r
 ;              Compilation:    ( "<spaces>name" -- )\r