home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
forth
/
compiler
/
forthed
/
mvp_ovl.scr
< prev
next >
Wrap
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 ;