home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 December / simtel1292_SIMTEL_1292_Walnut_Creek.iso / msdos / forth / forthed.arc / F83-OVL.SCR < prev    next >
Text File  |  1987-07-22  |  6KB  |  1 lines
  1. \ FED overlay for L&P F83 Forth                10:37 22Jul87 GmK                                                                Author: Guy M. Kelly    (c) 1987                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ EXEC Overlays                                11:05 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 CREATE dos-err#         2 ALLOT                                                                                                \ Note: S-SAVE and dos-err# must be in the code segment!                                                                                                                                                                                                    --> \ EXEC Overlays                                22:44 10Jul87 GmK HEX                ASSEMBLER                                    CREATE dos-err?    ( -- flag )                          U< IF                      CS: AX   dos-err# #) MOV   AX AX XOR  ELSE                      CS: 0 #  dos-err# #) MOV -1 # AX MOV  THEN                          AX PUSH  NEXT                                               FORTH                                        CODE ALLOCATE-MEM ( #paragraphs -- start-seg T | #available F )                    BX POP   48 #  AH MOV   21 INT                                   U< 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:43 22Jul87 GmK            HEX                                                  CODE EXEC  ( param-blk-addr file-spec-addr mode -- flag )                  AX POP    DX POP    BX POP                                      IP PUSH   RP PUSH   DS PUSH   ES PUSH                           CS:   SP  S-SAVE    #) MOV                                      CS:   SS  S-SAVE 2+ #) MOV                                                    4B #  AH MOV   21 INT   CLI                       CS:   S-SAVE    #)  SP MOV                                      CS:   S-SAVE 2+ #)  SS MOV            STI                       ES POP    DS POP    RP POP    IP POP                                  dos-err? #) JMP   END-CODE                                                                                     CODE >OVL  ( p1 p2 p3 cmd -- ) AX POP  DX POP  CX POP  BX POP              FF C, 1E C, OVERLAY-LOC , \ OVERLAY-LOC S#) CALL                NEXT   END-CODE   DECIMAL                       --> \ EXEC Overlays                                16:54 22Jul87 GmK                                                                 CODE CS@       ( -- seg ) CS PUSH  NEXT  END-CODE                              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" Overlay load error" ;             --> \ EXEC Overlays                                09:23 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 ;