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

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

\ FED overlay for MVP Forth                    10:34 22Jul87 GmK                                                                \ Author: Guy M. Kelly    (c) 1987                                                                                              \ Copy these six screens to an MVP style diskette using FED                                                                      : ASCII    ( -- char ) BL WORD 1+ C@  STATE @                              IF  [COMPILE] LITERAL  THEN ; IMMEDIATE              : (")      ( -- addr count ) R>  COUNT  2DUP + >R ;             : ,"       ( -- ) ASCII "  WORD C@ 1+ ALLOT ;                   : "        ( -- ) COMPILE (") ," ; IMMEDIATE                               HEX                                                  : CS:      ( -- ) 2E C, ;                                                  DECIMAL                                                                                                             151 155 THRU                                                    \ EXEC Overlays                                17:15 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                                                                \ Note: S-SAVE must be in the code segment!                                                                                                                                                                                                                                                                                     \ EXEC Overlays                                18:46 18Jul87 GmK HEX               ASSEMBLER RESET                               CREATE DOS-ERR    AX, AX XOR    AX PUSH  NEXT JMP               CREATE DOS-OK     AX, # -1 MOV  AX PUSH  NEXT JMP                                 FORTH                                                                                                         CODE ALLOCATE-MEM ( #paragraphs -- start-seg T | #available F )                    BX POP   AH, # 48 MOV  21 INT  BX PUSH                          DOS-ERR JB  BX POP  AX PUSH  DOS-OK JMP                         END-CODE                                                                                                     CODE RELEASE-MEM   ( seg-of-block-to-release -- flag )                             ES POP   AH, # 49 MOV   21 INT   BX, CS MOV                     ES, BX MOV  DOS-ERR JB  DOS-OK JMP  END-CODE DECIMAL                                                         CODE CS@           ( -- seg ) CS PUSH  NEXT JMP  END-CODE      \ EXEC Overlays                                10:34 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                            HERE 5 + JNB  DOS-ERR JMP  DOS-OK JMP  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 JMP   END-CODE   DECIMAL \ EXEC Overlays                                10:34 22Jul87 GmK                                                                                HEX                                              : GRAB-MEMORY  ( -- ) CS@ 1000 +  OVERLAY-LOC 2+ !                                    CS@ 1010 +  PARAM-BLOCK    ! ;                           DECIMAL                                                                                                          : 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                                18:19 18Jul87 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                                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  0 0 ROT  2 >OVL ;                                                                               : L        ( -- )      FED-CHK  0 0 0    3 >OVL ;