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

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

\ FED overlay for UNIFORTH                     10:20 22Jul87 GmK                                                                Author Guy M. Kelly (c) 1987                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    \ EXEC Overlays                                17:07 22Jul87 GmK VARIABLE FIRST-EDIT    -1 FIRST-EDIT !                          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 CREATE dos-err#         2 ALLOT                                \ Note: S-SAVE and dos-err# must be in the code segment!                                                                        \ delete this copy of MYSEG if it is already in UNIFORTH         CODE MYSEG ( -- seg ) CS PUSH,  NEXT,  END-CODE                                                  \ 2+ added because of WORD ??  : (")      ( -- addr count ) R>    2+   COUNT 2DUP +  >R ;      : ,"       ( -- ) A' "  WORD C@    2+   1+ ALLOT ;              : "        ( -- ) COMPILE (")  ," ; IMMEDIATE              --> \ EXEC Overlays                                16:57 22Jul87 GmK HEX                                                             SUBROUTINE dos-err?    ( -- flag )                      CY IF,         CS SEG         AX   dos-err# ) MOV,   AX AX XOR,  ELSE,         CS SEG   WORD  0 #  dos-err# ) MOV, -1 # AX MOV,  THEN,                                    AX PUSH,  NEXT,  END-CODE                                                                     CODE ALLOCATE-MEM ( #paragraphs -- start-seg T | #available F )                    BX POP,   48 #  AH MOV,   21 INT,                                CY IF,  BX PUSH,  ELSE,  AX PUSH,  THEN,                       dos-err? JMP,   END-CODE                                                                                     CODE RELEASE-MEM   ( seg-of-block-to-release -- flag )                             ES POP,  49 #  AH MOV,  21 INT,  CS BX MOV,                     BX ES MOV,  dos-err? JMP,  END-CODE          DECIMAL                                                    --> \ EXEC Overlays                                10:36 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 SEG  SP  S-SAVE    ) MOV,                                    CS SEG  SS  S-SAVE 2+ ) MOV,                                                    4B # AH MOV,   21 INT,  CLI,                    CS SEG  S-SAVE    )  SP MOV,                                    CS SEG  S-SAVE 2+ )  SS MOV,            STI,                    ES POP,   DS POP,    BP POP,   SI POP,                          dos-err? JMP,  END-CODE                              DECIMAL                                                         CODE >OVL  ( p1 p2 p3 cmd -- )                                             AX POP,  DX POP,  CX POP,  BX POP,                                   OVERLAY-LOC ) LCALL,    NEXT,  END-CODE    --> \ EXEC Overlays                                10:19 22Jul87 GmK                                                                                HEX          \ use 1000 for UNIFORTH Sampler     : GRAB-MEMORY  ( -- ) MYSEG       1000 +  OVERLAY-LOC 2+ !                            MYSEG  10 + 1000 +  PARAM-BLOCK    ! ;                   DECIMAL      \ use 2000 for Professional vers?                                                                   : 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= IF                    dos-err# @ .  ."  EXEC failed"  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  0 FIRST-EDIT ! ;                                                                         : >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 ;