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

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

\ FED overlay for LMI PC/FORTH                 10:21 22Jul87 GmK                                                                Author: Guy M. Kelly    (c) 1987                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ EXEC Overlays                                09:37 22Jul87 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                                10:02 22Jul87 GmK                                                                 HEX                                                                                                                             CODE ALLOCATE-MEM ( #paragraphs -- start-seg T | #available F )                    BX POP   AH, # 48 MOV   21 INT                                  1$ JNC  BX PUSH   AX, AX XOR   2$ JMP                      1$:  AX PUSH   AX, # -1 MOV                                     2$:  AX PUSH   NEXT,  END-CODE                                                                                    CODE RELEASE-MEM   ( seg-of-block-to-release -- flag )                             ES POP   AH, # 49 MOV   21 INT   BX, CS MOV                     ES, BX MOV   AX, # -1 MOV   1$ JNC                              AX INC   1$: AX PUSH   NEXT,   END-CODE                                                                      DECIMAL                                                    --> \ EXEC Overlays                                09:58 22Jul87 GmK            HEX                                                  CODE EXEC  ( param-blk-addr file-spec-addr mode -- flag )                  AX POP   DX POP   BX POP                                        SI PUSH   BP PUSH   DS PUSH   ES PUSH                           CS:  S-SAVE    , SP MOV                                         CS:  S-SAVE 2+ , SS MOV                                                    AH, # 4B MOV  21 INT  CLI                            CS:      SP, S-SAVE MOV                                         CS:   SS, S-SAVE 2+ MOV          STI                            ES POP   DS POP   BP POP   SI POP   AX, # -1 MOV                1$ JNC   AX INC   1$: AX PUSH   NEXT,   END-CODE                                                                     CODE >OVL  ( p1 p2 p3 cmd -- ) AX POP  DX POP  CX POP  BX POP              FORTH  FF C, 1E C, OVERLAY-LOC ,  ASSEMBLER RESET               ( OVERLAY-LOC CALLF ) NEXT,  END-CODE   DECIMAL --> \ EXEC Overlays                                10:22 22Jul87 GmK                                                                 : GRAB-MEMORY  ( -- ) ?FREESEG      OVERLAY-LOC 2+ !                                  ?FREESEG 16 + PARAM-BLOCK    ! ;                                                                          : GET-MEMORY   ( -- ) OVERLAY-SIZE @   ALLOCATE-MEM IF                         DUP    OVERLAY-LOC 2+ !                                              16 + PARAM-BLOCK !            ELSE                         ABORT" Insufficient memory."                                    GRAB-MEMORY                        THEN ;                                                                        : GET-OVERLAY  ( -- ) PARAM-BLOCK  FILE-SPEC  3 EXEC                           0= ABORT" Error loading overlay." ;                                                                                                                                                                                                         --> \ EXEC Overlays                                09:19 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             COUNT  FILE-SPEC  SWAP CMOVE  GET-MEMORY                        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  0 0 ROT  2 >OVL ;                                                                               : L        ( -- )      FED-CHK  0 0 0    3 >OVL ;