Simtel MSDOS 1992 June/SIMTEL_0692.cdr/msdos/forth/forthed.arc/PCF-OVL.SCR

Text File | 1987-07-22 | 6KB | 1 lines

\ FED overlay for GmK PC-Forth                 13:57 10Jul87 GmK                                                                Author Guy M. Kelly (c) 1987                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ EXEC Overlays                                10:48 10Jul87 GmK                                                                 VARIABLE FIRST-EDIT    FIRST-EDIT ON                            VARIABLE OVERLAY-SIZE            \ size in 16 byte paragraphs                                                                   CREATE OVERLAY-LOC    256 ,  0 , \ starting offset and segment  CREATE PARAM-BLOCK      0 ,  0 , \ start-seg, relocation factor CREATE FILE-SPEC       64 ALLOT  \ overlay file-spec.                                                                           CREATE S-SAVE           4 ALLOT  \ to save stack for EXEC funct                                                                \ Note: S-SAVE must be in the code segment!                                                                                                                                                                                                                                                                                 --> \ EXEC Overlays                                15:46 08Jul87 GmK\                   VARIABLE dos-err#                           \ SUB dos-err?      ( -- flag )                          CY IF, \           CS SEG,   AX  dos-err# #A MOV,    AX AX XOR,  ELSE, \           CS SEG,  0 #  dos-err# #A MOV, -1 #  AX MOV,  THEN, \                          AX PUSH,  NEXT,  END-CODE            \ the above variable and subroutine are in the Forth system                                                                      CODE ALLOCATE-MEM ( #paragraphs -- start-seg T | #available F )                    BX POP,  "48 "21-INT,                                            CY IF,  BX PUSH,  ELSE,  AX PUSH,  THEN,                       dos-err? REL JMP,  END-CODE                                                                                  CODE RELEASE-MEM   ( seg-of-block-to-release -- flag )                             ES POP,  "49 "21-INT,  CS BX MOV,                               BX ES MOV,  dos-err? REL JMP,  END-CODE --> \ EXEC Overlays                                09:28 22Jul87 GmK                                                                 CODE EXEC  ( param-blk-addr file-spec-addr mode -- flag )                  AX POP,   DX POP,   BX POP,                                     I PUSH,   R PUSH,  DS PUSH,  ES PUSH,                           CS SEG,   SP  S-SAVE    #A MOV,                                 CS SEG,   SS  S-SAVE 2+ #A MOV,                                                    "4B "21-INT,  CLI,                           CS SEG,   S-SAVE    #A  SP MOV,                                 CS SEG,   S-SAVE 2+ #A  SS MOV,  STI,                           ES POP,   DS POP,   R POP,   I POP,                             dos-err? REL JMP,   END-CODE                                                                                         CODE >OVL  ( p1 p2 p3 cmd -- )                                             AX POP,  DX POP,  CX POP,  BX POP,                               OVERLAY-LOC #A FAR CALL,    NEXT,  END-CODE    --> \ EXEC Overlays                                10:45 10Jul87 GmK                                                                 : GET-MEMORY   ( -- ) OVERLAY-SIZE @    ALLOCATE-MEM IF                        DUP  OVERLAY-LOC 2+ !                                               "10 + PARAM-BLOCK !             ELSE                        . ." pp, not enough memory!" ABORT  THEN ;                                                                       : GET-OVERLAY  ( -- ) PARAM-BLOCK  FILE-SPEC  3 EXEC                           0= IF  .DOS  ABORT  THEN ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  --> \ EXEC Overlays                                09:16 15Jul87 GmK                                                                 : FED-CHK ( -- ) FIRST-EDIT @ ABORT" FED not loaded." ;                                                                         : (FED)    ( -- ) 134  64 *  OVERLAY-SIZE !   \ 134K for FED               FILE-SPEC 64 ERASE  " FED.OVL"     \ (FED) inits FED            FILE-SPEC SWAP CMOVE  GET-MEMORY   \ $ > file-spec              GET-OVERLAY  0 0 0  0 >OVL  FIRST-EDIT OFF ;                                                                         : >FED     ( -- ) FIRST-EDIT @ IF  (FED)  THEN  0 0 0  0 >OVL ;                                                                 : EDIT     ( -- ) FIRST-EDIT @ IF  (FED)  THEN  0 0 0  1 >OVL ;                                                                 : DISP     ( scr# -- ) FED-CHK  1 ?ENOUGH  0 0 ROT  2 >OVL ;                                                                    : L        ( -- )      FED-CHK  0 0 0  3 >OVL ;