home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / FPC355_2.ZIP / FPCSRC.ZIP / SAVEREST.SEQ < prev    next >
Encoding:
Text File  |  1989-06-16  |  4.8 KB  |  140 lines
  1. \ SAVEREST.SEQ  Save and restore words for variables or values.
  2.  
  3. FILES DEFINITIONS
  4.  
  5. VARIABLE SAVEREST.SEQ
  6.  
  7. FORTH DEFINITIONS   META IN-META
  8.  
  9. comment:
  10.  
  11.         These words allow you to quickly save the contents of a
  12.         variable of value on the return stack, and set it to some other
  13.         value temporarily with SAVE!>.  The previous contents may then
  14.         be restored with RESTORE>.
  15.  
  16.         Here is an example, first the old way:
  17.  
  18.                 VARIABLE MYSTUFF
  19.  
  20.                 : DEF   ( --- )
  21.                         32 MYSTUFF DUP @ >R !
  22.                         ... Do something with the new MYSTUFF ...
  23.                         R> MYSTUFF ! ;
  24.  
  25.         Here is an example of how to use SAVE!> and RESTORE>:
  26.  
  27.                 : DEF   ( --- )
  28.                         32 SAVE!> MYSTUFF
  29.                         ... Do something with the new MYSTUFF ...
  30.                         RESTORE> MYSTUFF ;
  31.  
  32. comment;
  33.  
  34. CODE %SAVE!>    ( n1 --- )
  35. \ Save the BODY contents of the following definition on the return stack
  36. \ and set its BODY to n1.
  37.                 LODSW ES:
  38.                 MOV BX, AX
  39.                 ADD BX, # 3
  40.                 SUB RP, # 2
  41.                 MOV AX, 0 [BX]
  42.                 MOV 0 [RP], AX
  43.                 POP 0 [BX]
  44.                 NEXT            END-CODE
  45.  
  46. CODE %SAVE>     ( --- )
  47. \ Save the BODY contents of the following definition on the return stack.
  48.                 LODSW ES:
  49.                 MOV BX, AX
  50.                 SUB RP, # 2
  51.                 MOV AX, 3 [BX]
  52.                 MOV 0 [RP], AX
  53.                 NEXT            END-CODE
  54.  
  55. CODE %RESTORE>  ( --- )
  56. \ Restore the BODY of the following definition from the return stack.
  57.                 XCHG RP, SP
  58.                 POP DX
  59.                 XCHG RP, SP
  60.                 LODSW ES:
  61.                 MOV BX, AX
  62.                 MOV 3 [BX], DX
  63.                 NEXT            END-CODE
  64.  
  65. CODE %USAVE!>   ( n1 --- )
  66. \ Save the USER data area for the following definition on the return
  67. \ stack and set it to n1.
  68.                 LODSW ES:
  69.                 MOV BX, AX
  70.                 MOV BX, 3 [BX]          \ get body contents
  71.                 ADD BX, UP              \ add to USER table
  72.                 SUB RP, # 2
  73.                 MOV AX, 0 [BX]          \ save contents in AX
  74.                 MOV 0 [RP], AX          \ move AX to return stack
  75.                 POP 0 [BX]              \ pop data stack into USER table
  76.                 NEXT            END-CODE
  77.  
  78. CODE %USAVE>    ( --- )
  79. \ Save the USER data area for the following definition on the return
  80. \ stack.
  81.                 LODSW ES:
  82.                 MOV BX, AX
  83.                 SUB RP, # 2
  84.                 MOV BX, 3 [BX]          \ get body contents
  85.                 ADD BX, UP              \ add to USER table
  86.                 MOV AX, 0 [BX]          \ get USER table contents
  87.                 MOV 0 [RP], AX
  88.                 NEXT            END-CODE
  89.  
  90. CODE %URESTORE> ( --- )
  91. \ Restore the USER data area of the following definition from the
  92. \ return stack.
  93.                 XCHG RP, SP
  94.                 POP DX
  95.                 XCHG RP, SP
  96.                 LODSW ES:
  97.                 MOV BX, AX
  98.                 MOV BX, 3 [BX]          \ get body contents
  99.                 ADD BX, UP              \ add to USER table
  100.                 MOV 0 [BX], DX
  101.                 NEXT            END-CODE
  102.  
  103. : ?COMP         ( --- )
  104. \ Abort if we are not in compiling.
  105.                 STATE @ 0= ABORT" Use only while compiling" ;
  106.  
  107. : SAVE!>        ( n1 | <name> --- )
  108. \ Leaves value in <name> on return stack and sets body of <name> to n1,
  109. \ the equivalent of "VARIABLE-NAME DUP @ >R !".
  110.                 ?COMP
  111.                 ' DUP @REL>ABS DUP
  112.                 [  [ASSEMBLER] DOUSER-VARIABLE META ] LITERAL = SWAP
  113.                 [  [ASSEMBLER] DOUSER-DEFER    META ] LITERAL = OR
  114.                 IF      COMPILE %USAVE!>
  115.                 ELSE    COMPILE %SAVE!>
  116.                 THEN    X, ; IMMEDIATE
  117.  
  118. : SAVE>         ( | <name> --- )
  119. \ Saves value in <name> body on the return stack.
  120. \ Equivelant to "VARIABLE-NAME @ >R".
  121.                 ?COMP
  122.                 ' DUP @REL>ABS DUP
  123.                 [  [ASSEMBLER] DOUSER-VARIABLE META ] LITERAL = SWAP
  124.                 [  [ASSEMBLER] DOUSER-DEFER    META ] LITERAL = OR
  125.                 IF      COMPILE %USAVE>
  126.                 ELSE    COMPILE %SAVE>
  127.                 THEN    X, ; IMMEDIATE
  128.  
  129. : RESTORE>      ( | <name> --- )
  130. \ Restore body of <name> from the return stack.
  131. \ Equivelant to "R> VARIABLE-NAME !".
  132.                 ?COMP
  133.                 ' DUP @REL>ABS DUP
  134.                 [  [ASSEMBLER] DOUSER-VARIABLE META ] LITERAL = SWAP
  135.                 [  [ASSEMBLER] DOUSER-DEFER    META ] LITERAL = OR
  136.                 IF      COMPILE %URESTORE>
  137.                 ELSE    COMPILE %RESTORE>
  138.                 THEN    X, ; IMMEDIATE
  139.  
  140.