( MOVE & CLEAR BOB 4-AUG-83 ) : MOVE-SCR SWAP BLOCK 2 - ! UPDATE FLUSH ; : CLEAR-SCR DUP SCR ! BLOCK 1024 BLANKS UPDATE FLUSH ; : -ROT ROT ROT ; 11 LOAD ( LOAD WORDS ) : LOAD-THRU 1+ SWAP DO I LOAD LOOP ; ;S \ ERROR MESSAGES ) BOB 7-AUG-83 EMPTY STACK DICTIONARY FULL HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISK RANGE ? FULL STACK DISK ERROR ! CAN'T OPEN FILE PATCH ERROR 8080 FIG-FORTH FOR THE KAYPRO II ( ERROR MESSAGES ) BOB COMPILATION ONLY, USE IN DEFFINATION EXECUTION ONLY CONDITIONALS NOT PAIRED DEFINITION NOT FINISHED IN PROTECTED DICTIONARY USE ONLY WHEN LOADING OFF CURRENT EDITING SCREEN DECLARE VOCABULARY EDITOR HELP SCREEN < KEY-PAD MAP > BOB 09/19/83 ARROW-KEYS - MOVE ONE POSITION IN THE DIRECTION ^ V <- -> INDICATED '^P' - Prints the screen ------------------------------------------------------------ | Toggle | Move Up |Clear ( Kill )| Delete Line | | Insert Mode | 4 Lines | Screen |( Into Buffer)| ------------------------------------------------------------ | Move Left |Yank Back Line| Move Right | Delete | | One Word |( From Buffer)| One Word | Word | ------------------------------------------------------------ | Delete | Move Down | Clear | Exit The | | Character | 4 Lines | Line | Editor | --------------------------------------------- And | | Insert Line | Exit Editor | Write To | | | No Update | The Disk | ------------------------------------------------------------ \ MAGIC INCANTATION TO ADD TO FORTH BOB DECIMAL HERE FENCE ! HERE 28 +ORIGIN ! HERE 30 +ORIGIN ! LATEST 12 +ORIGIN ! ' FORTH 6 + 32 +ORIGIN ! ;S ( LOAD STATUS BOB AUG-83 ) 12 LOAD ( NEW-FORGET ) 13 LOAD ( PATCH ) 14 LOAD ( CRT ) 15 LOAD ( S. ) 16 LOAD ( SQUIT ) 17 LOAD ( WHERE ) 18 LOAD ( ERR ) 7 LOAD ( MAGIC ) PATCH SQUIT QUIT PATCH NEW-FORGET FORGET PATCH ERR ERROR ;S ( L+ / LOAD WITH PRINT OF FIRST LINE BOB 5-AUG-83 ) : LOAD ." LOADING " DUP DECIMAL . CR DUP 0 SWAP .LINE CR LOAD CR ; : NL SCR @ 1+ LIST ; : -L SCR @ 1 - LIST ; : CLEAR-THRU 1+ SWAP DO I BLOCK 1024 BLANKS UPDATE LOOP FLUSH ; ;S \ NEW-FORGET BOB 5-AUG-83 \ NEEDED TO FIX FORGET SO THAT A FENCE ABOVE 32000 \ DOES NOT FIGURE AS A NEGITIVE IE. YOU CAN'T FORGET \ WORDS ABOVE 32000 HEX : NEW-FORGET CURRENT @ CONTEXT @ - 18 ?ERROR [COMPILE] ' DUP FENCE @ U< 15 ?ERROR DUP NFA DP ! LFA @ CURRENT @ ! ; DECIMAL : ERASE-DATE BLOCK 40 + 24 BLANKS UPDATE ; ;S \ PATCH BOB 09/19/83 DECIMAL : GET-TWO-CFA'S ( ----- CFA1 CFA2 ) [COMPILE] ' CFA [COMPILE] ' CFA ; : PATCH GET-TWO-CFA'S DUP @ ' : CFA @ = IF 2+ DUP -ROT ! ' ;S CFA SWAP 2+ ! ELSE 12 ERROR QUIT THEN ; ;S This word ( patch ) allows you to replace an already existing word without having to re-compile. It puts a call to the new word at the start of the old word. \ CRT FUNCTIONS RWB 6-AUG-83 HEX : XYCRT 1B EMIT 3D EMIT 20 + EMIT 20 + EMIT ; : HOME 1E EMIT ; : CLEAR-LINE 18 EMIT ; : HOME&CLEAR 1A EMIT ; : CLEAR 17 EMIT ; : INSERT-LINE 1B EMIT 45 EMIT ; DECIMAL : RETURN 0 22 XYCRT ; ;S These are the crt control words for the KAYPRO II. \ S. BASE. BOB 09/20/83 DECIMAL : OCTAL 8 BASE ! ; : BINARY 2 BASE ! ; : S. DEPTH IF SP@ 2 - S0 @ 2 - DO I @ . -2 +LOOP ELSE ." EMPTY STACK " THEN ; : BASE. BASE @ DUP DECIMAL ." BASE = " . BASE ! ; : $ HEX ; IMMEDIATE : % DECIMAL ; IMMEDIATE : | OCTAL ; IMMEDIATE : ~ BINARY ; IMMEDIATE : NOT $ FFFF % XOR ; : -! DUP @ ROT - SWAP ! ; : .VOC CONTEXT @ 4 - NFA ID. ; ;S These words provided by Kevin Appert \ STATUS RWB 6-AUG-83 : STATUS CR HOME CLEAR-LINE S. ." " BASE. ." " .VOC CR CLEAR-LINE RETURN ; : SQUIT 0 BLK ! [COMPILE] [ BEGIN RP! CR QUERY INTERPRET STATE @ 0= IF ." OK " THEN STATUS AGAIN ; ;S These are the words that print the stack, base and vocabulary at the top of the screen in a "window" made by homming the cursor and clearing the second line. This status display is invaluable for debugging programs, and was done with the help of Kevin. \ WHERE BOB 09/19/83 HEX 0 VARIABLE ERRLOC : WHERE BLK @ IF BLK @ DUP SCR ! CR CR ." SCR# " DUP . IN @ 3FF MIN DUP ERRLOC ! C/L /MOD DUP ." LINE# " . C/L * ROT BLOCK + CR CR C/L -TRAILING TYPE IN @ 3FFF > + ELSE IN @ THEN CR HERE C@ DUP DUP 1+ ERRLOC -! >R - HERE R + 1+ C@ 20 = IF 1- THEN SPACES R> 0 DO 5E EMIT LOOP ; DECIMAL ;S This word finds where an error in compilation occurrs and underlines it. This makes it very easy to de-bug code. \ ERR OOPS BOB 7-AUG-83 HEX : ERR WARNING @ 0< IF (ABORT) THEN WHERE CR ." HUH?" CR MESSAGE SP! BLK @ -DUP IF IN @ SWAP THEN SQUIT ; : OOPS SWAP DROP EDITOR E-INIT ERRLOC @ MOVE-CURSOR BEGIN DISPLAY-STATUS 0 MOVE-CURSOR &MODE @ IF E-INSERT ELSE E-OVERSTRIKE ENDIF AGAIN ; FORTH DEFINITIONS DECIMAL ;S Err repalces error and uses where to find and underline the misstake. Opps puts you in the editor and positions the cursor at the error. \ PPA-CP/M RWB 6-AUG-83 : FCB <BUILDS 37 HERE OVER ERASE ALLOT DOES> ; : SET-DMA 26 SWAP FDOS DROP DROP ; : READ-SEC SET-DMA 20 SWAP FDOS DROP ; : WRITE-SEC SET-DMA 21 SWAP FDOS DROP IF 8 ERROR THEN ; : OPEN/MAKE DUP 15 SWAP FDOS DROP 255 = IF 22 SWAP FDOS DROP 255 = 10 ?ERROR ELSE DROP THEN ; FCB PPA-FILE : CLOSE-FILE 16 SWAP FDOS DROP 255 = 8 ?ERROR ; : OPEN-FILE 15 SWAP FDOS DROP 255 = 10 ?ERROR ; : ZERO-CR 32 + 0 SWAP ! ; : RESET-DISKS 13 0 FDOS DROP DROP OPENDIR ; ;S These are CP/M Control words \ FILENAME BOB 7-AUG-83 : FILENAME ( FCB ADDRESS | FILENAME | <NAMETEXT> ) DUP 37 ERASE DUP 2 SWAP ! 1+ DUP 11 BLANKS BLK @ IF BLK @ BLOCK ELSE TIB @ ENDIF IN @ + 8 0 DO DUP C@ DUP 46 = IF DROP LEAVE ELSE DUP 33 < IF DROP LEAVE ELSE ROT DUP I + ROT SWAP C! SWAP 1+ 1 IN +! THEN THEN LOOP DUP C@ 46 = IF SWAP 8 + SWAP 1+ 1 IN +! 3 0 DO DUP C@ DUP 33 < IF DROP LEAVE ELSE ROT DUP I + ROT SWAP C! SWAP 1+ 1 IN +! ENDIF LOOP ENDIF DROP DROP ; ;S This word makes a CP/M File Name. ****** ON DISK B ONLY ! ****** \ CP/M RWB 6-AUG-83 VOCABULARY CP/M IMMEDIATE CP/M DEFINITIONS DECIMAL 25 LOAD 26 LOAD FORTH DEFINITIONS DECIMAL ;S This word loads and makes the vocabulary CP/M containing the CP/M control words. \ STORE BOB 7-AUG-83 : STORE (S CHAR --- CHAR ) DUP 10 <> IF DUP LOG-POINTER @ LOG-BUFF + C! LOG-POINTER @ 1+ DUP 128 = IF LFILE LOG-BUFF CP/M WRITE-SEC DROP 0 THEN LOG-POINTER ! THEN ; ;S This word stores what was written on the crt to disk b in a file called FORTH.LOG. \ LEMIT RWB 6-AUG-83 HEX : LEMIT 7F AND STORE PEMIT 1 OUT +! ; DECIMAL ;S This word replaces EMIT to write to the log file. \ LOG BOB 7-AUG-83 VOCABULARY LOG IMMEDIATE LOG DEFINITIONS DECIMAL 0 VARIABLE LOG-BUFF 128 ALLOT 0 VARIABLE LOG-POINTER CP/M FCB LFILE LFILE FILENAME FORTH.LOG 30 LOAD 31 LOAD FORTH DEFINITIONS DECIMAL : START-LOG CP/M RESET-DISKS LOG LFILE CP/M OPEN/MAKE LOG LFILE CP/M ZERO-CR LOG ' LEMIT CFA TEMIT ! ; : END-LOG LOG LFILE CP/M CLOSE-FILE CRT-ENABLE ; ;S These turn on and off the log words. \ BACK UP THE DISK RWB 6-AUG-83 : ?EMPTY-SCR BLOCK C/L -TRAILING SWAP DROP 0= ; : BACK-UP-DISK 150 1 DO I DUP CR . ?EMPTY-SCR IF ." NOT COPIED " ELSE ." COPIED" I DUP 150 + MOVE-SCR THEN LOOP ; ;S This word copies any screen with something written in the first line to disk b. This backs up all screens most efficiently. \ TRIAD-THRU BOB 09/19/83 : TRIAD-THRU (S FIRST SCREEN | LAST SCREEN --- ) 1+ SWAP DO I TRIAD 3 +LOOP ; ;S This word allows you to print a range of screens in groups of threes ( triads ). This is helpful for documentation. RWB 6-AUG-83 \ MAKE NEW SCR FILE BOB 7-AUG-83 0 VARIABLE NEW-DMA 128 ALLOT NEW-DMA 128 BLANKS CP/M FCB NEW-FILE NEW-FILE CP/M FILENAME FORTH.SCR : MAKE-NEW ." PUT THE DISK YOU WANT TO MAKE A SCREEN FILE" CR ." ON IN DISK B HIT ANY KEY WHEN READY" CR ." *** DISK B MUST HAVE AT LEAST 150 K LEFT ***" CR ." *** AND NO FORTH.SCR FILE ***" KEY DROP NEW-FILE CP/M OPEN/MAKE 1200 0 DO NEW-FILE NEW-DMA WRITE-SEC LOOP NEW-FILE CP/M CLOSE-FILE ; ;S ( FORTH EXTENSIONS RWB AUG-83 ) : EXTENSIONS ; 2 LOAD 61 97 LOAD-THRU \ EDITOR LOAD SCREENS 10 LOAD \ OOPS SQUIT ETC. 102 LOAD \ DECOMPILER 27 LOAD \ CP/M 108 LOAD \ ASSEMBLER 7 LOAD \ MAGIC INCANTATION ;S \ SCREEN ORIENTED EDITOR BOB 09/19/83 \ \ FROM Dr. Dobb's Journal \ NUMBER 59 , SEPTEMBER 1981 \ \ BY Henery Laxen \ 1259 Cornell Ave. \ Berkley, California 94706 \ ( 415 ) 525-8582 \ \ At least it started life as this editor \ I've only commented the code I've changed \ For a description of the hows and why-fors of \ the remainder I suggest you read Dr. Dobb's. ;S ( EDITOR SCREEN 1 BYE BOB 09/19/83 ) : BYE ( --- ) FLUSH ( Clear all the screen buffers ) HERE 256 / 1+ ( find out how big FORTH is ) ( in CP/M records [ 256 bytes ] ) CR ." Forth is " . ." Records Long" ( tell us ) CR ." LEAVING FORTH Have A Nice Day " ( say goodbye ) BYE ; ( call the regular FORTH BYE ) ;S ( EDITOR SCREEN 2 UTILITIES BOB 5-AUG-83 ) : BEEP 7 EMIT ; : MAKET <BUILDS DOES> ; : \ IN @ C/L / 1+ C/L * IN ! ; IMMEDIATE : DEPTH SP@ S0 @ SWAP - 2 / 0 MAX ; : (S 41 WORD ; IMMEDIATE : (P 41 WORD ; IMMEDIATE : L DEPTH IF DUP SCR ! ELSE SCR @ ENDIF LIST ; ;S \ EDITOR SCREEN 3 BOB 5-AUG-83 : 2DROP DROP DROP ; : 2* DUP + ; : BOUNDS OVER + SWAP ; : BMOVE -DUP IF >R R + 1 - SWAP 1 - R> BOUNDS SWAP DO I C@ OVER C! 1 - -1 +LOOP DROP ELSE 2DROP ENDIF ; : MOVE ROT ROT 2DUP U< IF ROT BMOVE ELSE ROT CMOVE ENDIF ; : 1- 1 - ; : 2- 2 - ; ;S \ EDITOR SCREEN 4 BOB 5-AUG-83 : >= < 0= ; : <> = 0= ; : <= > 0= ; : U> SWAP U< ; : RE-FORTH IN @ >R BLK @ >R 0 IN ! 0 BLK ! QUERY INTERPRET R> BLK ! R> IN ! ; : ?DUP -DUP ; ;S \ EDITOR SCREEN 5 -TIDY BOB 5-AUG-83 : CASE: <BUILDS ] SMUDGE DOES> SWAP 2* + @ EXECUTE ; \ I didn't use this version of case : -TIDY BOUNDS DO I C@ BL < IF BL I C! ENDIF LOOP ; ;S \ EDITOR SCREEN 6 RAW KEY BOB 09/19/83 HEX : RAW-KEY BEGIN 7 P@ 1 AND UNTIL 5 P@ ; DECIMAL ;S This word simply reads the keybord of my KAYPRO II without going through CP/M. This way I can define the keypad and arrow keys to perform the functions of the editor. \ EDITOR SCREEN 7 CASE BOB 5-AUG-83 : CASE ?COMP CSP @ !CSP 4 ; IMMEDIATE : OF 4 ?PAIRS COMPILE OVER COMPILE = COMPILE 0BRANCH HERE 0 , COMPILE DROP 5 ; IMMEDIATE : ENDOF 5 ?PAIRS COMPILE BRANCH HERE 0 , SWAP 2 [COMPILE] ENDIF 4 ; IMMEDIATE : ENDCASE 4 ?PAIRS COMPILE DROP BEGIN SP@ CSP @ = 0= WHILE 2 [COMPILE] ENDIF REPEAT CSP ! ; IMMEDIATE ;S For an example of how to use these words, see screen 91. \ EDITOR SCREEN 8 &EID BOB 5-AUG-83 CR ." ENTER YOUR INITALS IN THREE LETTERS " &EID 4 EXPECT ;S This screen puts your initals in &EID. This way you only have to do it once. The date is added in COLD. The editor then stamps them in the upper right corner of the screen each time you update the screen. \ EDITOR SCREEN 9 PRINTER WORDS BOB 09/19/83 : PRINTER-EMIT (S CHAR --- TO PRINTER ) 05 SWAP FDOS DROP DROP ; : BOTH-EMIT (S CHAR --- TO PRINTER AND CRT ) DUP PRINTER-EMIT PEMIT ; : PRINTER-ENABLE (S --- ) ' PRINTER-EMIT CFA TEMIT ! ; : CRT-ENABLE (S --- ) ' PEMIT CFA TEMIT ! ; : BOTH-ENABLE ' BOTH-EMIT CFA TEMIT ! ; ;S My version of FORTH differs from standard 8080 FIG-FORTH in thatI am using vectored execution I/O. The user variable TEMIT contains the CFA of the word to use, and all EMIT does is TEMIT @ EXECUTE. FDOS is another deviation. It is a call to 0005H ( CP/M ). I tried to be compatable with Z-80 FORTH. the use is ( function # / DE registers --- A reg. / HL reg. ) \ EDITOR SCREEN 10 MORE PRINTER BOB 5-AUG-83 : ^P (P Toggle the printer on / off ) TEMIT @ ' PEMIT CFA = IF BOTH-ENABLE ELSE CRT-ENABLE THEN ; : BURP (P Form-feed to the printer ) PRINTER-ENABLE 12 EMIT CRT-ENABLE ; ;S This is an attempt to be compatable with regular 8080 FIG-FORTH.After the editor has loaded, the word ^P is re-defined to be control P . This editor will not let you print control charactors in the screen. \ EDITOR SCREEN 11 VARIABLES BOB 5-AUG-83 VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS 0 VARIABLE &MODE 0 VARIABLE &CURSOR 0 VARIABLE &OLD-MODE 0 VARIABLE &UPDATE 0 VARIABLE &BUF-ADR 0 VARIABLE LINE-BUFFER 64 ALLOT (P Used by DELETE-LINE ) 0 VARIABLE OVERRUN (P Used by INSERT-CHAR ) ;S \ EDITOR SCREEN 12 FILTER BOB 5-AUG-83 : FILTER (S --- ) &EID 20 OVER + SWAP DO I C@ 0= IF 32 I C! THEN LOOP ; ;S FILTER removes the trailing nulls from the date stamp &EID that expect leaves behind. You see the KAYPRO II prints them ( the nulls ). \ EDITOR SCREEN 13 VARIABLES BOB 5-AUG-83 5 CONSTANT %X-OFF 2 CONSTANT %Y-OFF B/SCR B/BUF * CONSTANT C/SCR C/SCR C/L / CONSTANT L/SCR 0 VARIABLE 'CRTXY 0 VARIABLE 'CRTCLR-SCR 0 VARIABLE 'CLEAR-TO-EOL ;S \ EDITOR SCREEN 14 CRT CALLS BOB 5-AUG-83 : CRTXY 'CRTXY @ EXECUTE ; : CRTCLR-SCR 'CRTCLR-SCR @ EXECUTE ; : CLEAR-TO-EOL 'CLEAR-TO-EOL @ EXECUTE ; : CURPOS &CURSOR @ ; : +CURPOS &CURSOR +! CURPOS 0 MAX [ C/SCR 1- ] LITERAL MIN &CURSOR ! ; : MOVE-CURSOR +CURPOS CURPOS C/L /MOD %Y-OFF + SWAP %X-OFF + SWAP CRTXY ; ;S \ EDITOR SCREEN 15 BOB 5-AUG-83 : BUF-ADR &BUF-ADR @ + ; : BUFPOS CURPOS BUF-ADR ; : E-UPDATE 1 &UPDATE ! ; : BUF-MOVE ROT BUF-ADR ROT BUF-ADR ROT MOVE E-UPDATE ; : ?PRINTABLE DUP 32 < SWAP 126 > OR 0= ; : >LINE# C/L / ; : LINE#> C/L * ; : CHARS-TO-EOL C/L MOD C/L SWAP - ; ;S \ EDITOR SCREEN 16 DISPLAY BOB 5-AUG-83 : DISPLAY-TO-EOL DUP BUF-ADR OVER CHARS-TO-EOL -TRAILING ROT OVER + >R TYPE R> CLEAR-TO-EOL ; : ?EMPTY-LINE LINE#> BUF-ADR C/L -TRAILING SWAP DROP 0= ; : DISPLAY-TO-EOS CURPOS SWAP L/SCR SWAP DO I LINE#> DUP &CURSOR ! 0 MOVE-CURSOR DISPLAY-TO-EOL LOOP &CURSOR ! 0 MOVE-CURSOR ; ;S \ EDITOR SCREEN 17 EXPAND / SHRINK BOB 5-AUG-83 : EXPAND DUP DUP C/L + C/SCR OVER - BUF-MOVE BUF-ADR C/L BLANKS E-UPDATE ; : SHRINK DUP C/L + SWAP OVER C/SCR SWAP - BUF-MOVE [ L/SCR 1- ] LITERAL LINE#> BUF-ADR C/L BLANKS E-UPDATE ; : INSERT-LINE [ L/SCR 1- ] LITERAL ?EMPTY-LINE IF DUP EXPAND >LINE# DISPLAY-TO-EOS ELSE BEEP ENDIF ; ;S \ EDITOR SCREEN 18 INSERT CHAR BOB 09/19/83 : SCAN-2BL (S ADDR --- # ) (P Returns the number of ) 0 SWAP (P chars to a double space ) BUF-ADR C/SCR 1- BUF-ADR SWAP DO I C@ BL = IF I 1+ C@ BL = IF DROP I 1+ LEAVE THEN THEN LOOP ; ;S This word is used by INS-CHAR to find the next occurrence of a double blank ( ie two blanks in a row ), so it can remove them. \ EDITOR SCREEN 19 INSERT-CHAR BOB 09/19/83 : INS-CHAR (S CHAR POS --- ) DUP DUP 1+ OVER SCAN-2BL -DUP IF BUFPOS - DUP CURPOS C/L MOD + C/L / OVERRUN ! BUF-MOVE BUF-ADR C! ELSE BEEP DROP DROP DROP DROP THEN ; ;S This word works by eating double blanks. This meens you compress the print on that line. In other words JUNK TRASH becomes, JUNK TRASH instead of, JUNK TRASH This word also wraps the characters that fall off of the end of the line to the next line . \ EDITOR SCREEN 20 DELETE BOB 5-AUG-83 : DELETE-LINE >LINE# DUP LINE#> DUP BUF-ADR LINE-BUFFER 64 CMOVE SHRINK DISPLAY-TO-EOS ; : DEL-CHAR DUP DUP 1+ SWAP OVER CHARS-TO-EOL BUF-MOVE DUP CHARS-TO-EOL + 1- BUF-ADR BL SWAP C! ; : R-ARROW 1 +CURPOS ; : L-ARROW -1 +CURPOS ; ;S \ EDITOR SCREEN 21 YANK-BACK BOB 5-AUG-83 : YANK-BACK (S --- ) [ L/SCR 1- ] LITERAL ?EMPTY-LINE IF DUP EXPAND >LINE# DUP LINE#> BUF-ADR LINE-BUFFER SWAP 64 CMOVE DISPLAY-TO-EOS ELSE BEEP THEN ; ;S Yank-back moves the line stored in the line-buffer by del-line into the screen at the present cursor position , and moves all of the rest of the lines down 1 line. If the last line (line 15)is not blank , Yank-back will not work. \ EDITOR SCREEN 22 COMMANDS BOB 5-AUG-83 : U-ARROW C/L MINUS +CURPOS ; : D-ARROW C/L +CURPOS ; : I-LINE CURPOS INSERT-LINE ; : D-LINE CURPOS DELETE-LINE ; : Y-BACK CURPOS YANK-BACK ; : D-CHAR CURPOS DEL-CHAR CURPOS DISPLAY-TO-EOL ; : INSERT-MODE &MODE 1 TOGGLE ; : RETURN CURPOS >LINE# 1+ [ L/SCR 1- ] LITERAL MIN LINE#> &CURSOR ! ; ;S \ EDITOR SCREEN 23 COMMANDS BOB 7-AUG-83 : MODE-RESTORE 27 EMIT 93 EMIT ; : EXIT-EDIT MODE-RESTORE CR R> DROP R> DROP R> DROP R> DROP R> DROP ; : EXIT-UPDATE C/SCR MOVE-CURSOR CR CR SCR @ . &UPDATE @ IF FILTER (P GET THE NULLS OUT OF &EID ) &EID [ C/L 22 - ] LITERAL BUF-ADR 22 CMOVE ." MODIFIED" UPDATE ELSE ." UNMODIFIED" ENDIF EXIT-EDIT ; ;S \ EDITOR SCREEN 24 COMMANDS BOB 5-AUG-83 : EXIT-SCRATCH C/SCR MOVE-CURSOR CR CR SCR ? ." Abandoned" EXIT-EDIT ; : E-TAB 8 CURPOS 8 MOD - +CURPOS ; : SCAN+= 2DUP = IF DROP 2DROP 0 ELSE 0 ROT ROT DO OVER I C@ = IF LEAVE ELSE 1+ ENDIF LOOP SWAP DROP ENDIF ; : SCAN+<> 2DUP = IF DROP 2DROP 0 ELSE 0 ROT ROT DO OVER I C@ <> IF LEAVE ELSE 1+ ENDIF LOOP SWAP DROP ENDIF ; ;S \ EDITOR SCREEN 25 COMMANDS BOB 5-AUG-83 : SCAN-= 2DUP = IF DROP 2DROP 0 ELSE 0 ROT ROT DO OVER I C@ = IF LEAVE ELSE 1- ENDIF -1 +LOOP SWAP DROP ENDIF ; : SCAN-<> 2DUP = IF DROP 2DROP 0 ELSE 0 ROT ROT DO OVER I C@ <> IF LEAVE ELSE 1- ENDIF -1 +LOOP SWAP DROP ENDIF ; : MOVE-LEFT-WORD BL 0 BUF-ADR BUFPOS SCAN-= >R BL 0 BUF-ADR BUFPOS R + SCAN-<> R> + >R BL 0 BUF-ADR BUFPOS R + SCAN-= R> + DUP BUFPOS + C@ BL = IF 1+ ENDIF ; ;S \ EDITOR SCREEN 26 COMMANDS BOB 5-AUG-83 : MOVE-RIGHT-WORD BL [ C/SCR 1- ] LITERAL BUF-ADR BUFPOS SCAN+= >R BL [ C/SCR 1- ] LITERAL BUF-ADR BUFPOS R + SCAN+<> R> + ; : R-WORD MOVE-RIGHT-WORD +CURPOS ; ;S \ EDITOR SCREEN 27 COMMANDS BOB 5-AUG-83 : L-WORD MOVE-LEFT-WORD +CURPOS ; : DEL-CHARS 2DUP + OVER DUP CHARS-TO-EOL BUF-MOVE DUP CHARS-TO-EOL + OVER - BUF-ADR SWAP BLANKS ; : D-WORD MOVE-RIGHT-WORD CURPOS BUF-ADR CURPOS CHARS-TO-EOL -TRAILING SWAP DROP MIN CURPOS DEL-CHARS CURPOS DISPLAY-TO-EOL ; : U-TAB 4 C/L * MINUS +CURPOS ; : PRINT-SCR (S --- ) (P PRINTS OUT THE SCREEN ) BURP PRINTER-ENABLE SCR @ LIST CRT-ENABLE ; ;S \ EDITOR SCREEN 28 COMMANDS BOB 5-AUG-83 : D-TAB 4 C/L * +CURPOS ; : CLR-SCREEN 0 &CURSOR ! CURPOS BUF-ADR C/SCR BLANKS 0 DISPLAY-TO-EOS E-UPDATE ; : DISPLAY-STATUS &MODE @ &OLD-MODE @ <> IF 40 0 CRTXY &MODE @ IF ." INSERT ON" ELSE 9 SPACES ENDIF &MODE @ &OLD-MODE ! ENDIF CURPOS C/L /MOD 35 0 CRTXY 2 .R 28 0 CRTXY 2 .R ; ;S \ EDITOR SCREEN 29 COMMANDS BOB 5-AUG-83 : CLR-LINE CURPOS DUP >LINE# LINE#> &CURSOR ! CURPOS BUF-ADR C/L BLANKS E-UPDATE 0 MOVE-CURSOR CURPOS CLEAR-TO-EOL &CURSOR ! ; : DELETE-KEY (S --- ) BL BUFPOS C! BL EMIT L-ARROW ; ;S The delete key moves the cursor to the left and errases the char \ EDITOR SCREEN 30 HELP BOB 5-AUG-83 : HELP (S --- ) CRTCLR-SCR CR CR L/SCR 0 DO I 6 .LINE CR LOOP CR ." *** Hit Any Key To Return To The Editor " KEY DROP CRTCLR-SCR 0 %Y-OFF CRTXY L/SCR 0 DO I 3 .R CR LOOP 10 0 CRTXY ." SCR:" SCR @ 4 .R 6 SPACES ." X= Y=" CR 15 SPACES ." PRESS '^Q' FOR HELP" 0 DISPLAY-TO-EOS ; ;S Help displays the help screen ( screen 6 ). On this screen is the function map for all the functions of the editor and where they are on the keybord. \ EDITOR SCREEN 31 CONTROL-CHAR BOB 5-AUG-83 HEX : CONTROL-CHAR CASE (S KEY --- ) 0D OF RETURN ENDOF D0 OF L-WORD ENDOF 09 OF E-TAB ENDOF D1 OF Y-BACK ENDOF 7F OF DELETE-KEY ENDOF D2 OF R-WORD ENDOF F1 OF U-ARROW ENDOF D3 OF D-WORD ENDOF F2 OF D-ARROW ENDOF C0 OF D-CHAR ENDOF F3 OF L-ARROW ENDOF C1 OF D-TAB ENDOF F4 OF R-ARROW ENDOF C2 OF CLR-LINE ENDOF E1 OF INSERT-MODE ENDOF C3 OF EXIT-UPDATE ENDOF E2 OF U-TAB ENDOF B1 OF I-LINE ENDOF E3 OF CLR-SCREEN ENDOF B2 OF EXIT-SCRATCH ENDOF E4 OF D-LINE ENDOF 08 OF L-ARROW ENDOF 11 OF HELP ENDOF 10 OF PRINT-SCR ENDOF BEEP ENDCASE ; DECIMAL ;S (P MAPS THE FUNCTIONS TO THE KEYBORD ) \ EDITOR SCREEN 32 MOTOR OFF BOB 09/19/83 HEX : MOTOR-OFF 1C P@ 40 OR 1C P! ; DECIMAL ;S The CP/M on my KAYPRO II keeps the motor running on the disk drive until another call is made to it after a disk access. This is very annoying since I am bypassing CP/M to get a key. This word sets bit 7 of the system bitport ( 1CH ). This turns the motor off. \ EDITOR SCREEN 33 E-OVERSTRIKE BOB 5-AUG-83 : E-OVERSTRIKE RAW-KEY DUP ?PRINTABLE IF DUP EMIT BUFPOS C! E-UPDATE 1 +CURPOS ELSE CONTROL-CHAR ENDIF ; ;S \ EDITOR SCREEN 34 E-INSERT BOB 5-AUG-83 : E-INSERT RAW-KEY DUP ?PRINTABLE IF CURPOS INS-CHAR CURPOS DISPLAY-TO-EOL OVERRUN @ -DUP IF CURPOS SWAP OVER >LINE# 1+ SWAP OVER + SWAP DO I LINE#> DUP &CURSOR ! 0 MOVE-CURSOR DISPLAY-TO-EOL LOOP &CURSOR ! THEN 1 +CURPOS ELSE CONTROL-CHAR ENDIF ; ;S \ EDITOR SCREEN 35 E-INIT BOB 5-AUG-83 : E-INIT DEPTH IF SCR ! ENDIF SCR @ BLOCK &BUF-ADR ! MOTOR-OFF CRTCLR-SCR 0 &MODE ! 0 &CURSOR ! 0 &UPDATE ! 0 %Y-OFF CRTXY L/SCR 0 DO I 3 .R CR LOOP 10 0 CRTXY ." SCR: " SCR @ 4 .R 6 SPACES ." X= Y=" CR 19 SPACES ." PRESS '^Q' FOR HELP" 0 DISPLAY-TO-EOS ; ;S \ EDITOR SCREEN 36 CRT-FUNCTIONS BOB 5-AUG-83 : KAY-CRTXY 27 EMIT 61 EMIT 32 + EMIT 32 + EMIT ; : KAY-CRTCLR-SCR 26 EMIT ; : KAY-CRTCLR-EOL DROP 24 EMIT ; ' KAY-CRTXY CFA 'CRTXY ! ' KAY-CRTCLR-SCR CFA 'CRTCLR-SCR ! ' KAY-CRTCLR-EOL CFA 'CLEAR-TO-EOL ! ;S \ EDITOR SCREEN 37 E BOB 5-AUG-83 FORTH DEFINITIONS : E EDITOR E-INIT BEGIN DISPLAY-STATUS 0 MOVE-CURSOR &MODE @ IF E-INSERT ELSE E-OVERSTRIKE ENDIF AGAIN FORTH ; : NE SCR @ 1+ E ; : LE SCR @ 1- E ; ;S NE stands for "next edit " ie edit the next screen LE stands for edit the "last" screen ie this screen number minus1. BOB 09/19/83 \ RECURSIVE DECOMPILER BOB 5-AUG-83 \ FROM FORTH DIMENTIONS IV/2 \ PAGE 28 \ BY ROBERT DUDLY ACKERMAN 103 106 LOAD-THRU ;S \ DECOMPILER SCREEN 1 BOB 5-AUG-83 VOCABULARY DECOMPILER IMMEDIATE DECOMPILER DEFINITIONS DECIMAL : MYSELF LATEST PFA CFA , ; IMMEDIATE 0 VARIABLE GIN : GIN+ CR GIN @ 2+ DUP GIN ! SPACES ; : DIN CR GIN @ SPACES ; ;S \ DECOMPILER SCREEN 2 BOB 3-AUG-83 : GCHK DUP @ 2+ ' COMPILE = IF 2+ DUP @ 2+ NFA ID. 2+ ELSE DUP @ 2+ DUP ' LIT = OVER ' BRANCH = OR OVER ' 0BRANCH = OR OVER ' (LOOP) = OR SWAP ' (+LOOP) = OR IF 2+ DUP @ SPACE . 2+ ELSE DUP @ 2+ 33000 = ( SHOULD BE CLIT ) IF 2+ DUP C@ SPACE . 1+ ELSE DUP @ 2+ ' (.") = IF 2+ DUP COUNT TYPE DUP C@ 1+ + ELSE 2+ THEN THEN THEN THEN -2 GIN +! ; ;S \ DECOMPILER SCREEN 3 BOB 3-AUG-83 : (GOESINTO) DUP CFA @ ' : CFA @ = OVER ' ERROR = 0= AND IF ( COLON DEF AND NOT ERROR ) BEGIN DUP @ DUP ' ;S CFA = OVER ' (;CODE) CFA = OR 0= WHILE 2+ DUP GIN+ NFA ID. KEY DUP 81 = IF SP! QUIT ELSE 13 = IF MYSELF ELSE DROP THEN THEN GCHK REPEAT 2+ DIN NFA ID. THEN DROP ; ;S \ DECOMPILER SCREEN 4 BOB 5-AUG-83 FORTH DEFINITIONS DECIMAL : GOESINTO DECOMPILER -FIND IF DROP 0 GIN ! (GOESINTO) ELSE ." NOT FOUND " THEN ; ;S \ 8080 ASSEMBLER BOB 5-AUG-83 \ FROM FORTH DIMENTIONS III/6 \ PAGE 180 \ BY J. J. CASSADY 109 113 LOAD-THRU ;S \ ASSEMBLER SCREEN 1 BOB 5-AUG-83 ( FIGFORTH 8080 ASSEMBLER ) ( FROM FORTH DIMENSIONS VOL.3 #6) HEX VOCABULARY ASSEMBLER IMMEDIATE : 8* DUP + DUP + DUP + ; ' ASSEMBLER CFA ' ;CODE 8 + ! : CODE ?EXEC CREATE [COMPILE] ASSEMBLER !CSP ; IMMEDIATE : C; CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE : LABEL ?EXEC 0 VARIABLE SMUDGE -2 ALLOT [COMPILE] ASSEMBLER !CSP ; IMMEDIATE ASSEMBLER DEFINITIONS ;S \ ASSEMBLER SCREEN 2 BOB 7-AUG-83 HEX 4 CONSTANT H 5 CONSTANT L 7 CONSTANT A 6 CONSTANT PSW 2 CONSTANT D 3 CONSTANT E 0 CONSTANT B 1 CONSTANT C 6 CONSTANT M 6 CONSTANT SP ' ;S 0B + @ CONSTANT (NEXT) C2 CONSTANT 0= D2 CONSTANT CS E2 CONSTANT PE F2 CONSTANT 0< ;S \ ASSEMBLER SCREEN 3 BOB 7-AUG-83 HEX : 1MI <BUILDS C, DOES> C@ C, ; : 2MI <BUILDS C, DOES> C@ + C, ; : 3MI <BUILDS C, DOES> C@ SWAP 8* + C, ; : 4MI <BUILDS C, DOES> C@ C, C, ; : 5MI <BUILDS C, DOES> C@ C, , ; : PSH1, C3 C, (NEXT) 1 - , ; : PSH2, C3 C, (NEXT) 2 - , ; : NEXT, C3 C, (NEXT) , ; : NOT, 8 + ; : MOV, 8* 40 + + C, ; : MVI, 8* 6 + C, C, ; : LXI, 8* 1+ C, , ; : THEN, HERE SWAP ! ; ;S \ ASSEMBLER SCREEN 4 BOB 7-AUG-83 HEX 00 1MI NOP, 76 1MI HLT, F3 1MI DI, FB 1MI EI, 07 1MI RLC, 0F 1MI RRC, 17 1MI RAL, 1F 1MI RAR, E9 1MI PCHL, F9 1MI SPHL, E3 1MI XTHL, EB 1MI XCHG, 27 1MI DAA, 2F 1MI CMA, 37 1MI STC, 3F 1MI CMC, 80 2MI ADD, 88 2MI ADC, 90 2MI SUB, 98 2MI SBB, A0 2MI ANA, A8 2MI XRA, B0 2MI ORA, B8 2MI CMP, 09 3MI DAD, C1 3MI POP, C5 3MI PUSH, 02 3MI STAX, 0A 3MI LDAX, 04 3MI INR, 05 3MI DCR, 03 3MI INX, 0B 3MI DCX, C7 3MI RST, D3 4MI OUT, DB 4MI IN, C6 4MI ADI, CE 4MI ACI, D6 4MI SUI, DE 4MI SBI, E6 4MI ANI, EE 4MI XRI, F6 4MI ORI, FE 4MI CPI, 22 5MI SHLD, 2A 5MI LHLD, 32 5MI STA, 3A 5MI LDA, CD 5MI CALL, C9 1MI RET, C3 5MI JMP, ;S \ ASSEMBLER SCREEN 5 BOB 7-AUG-83 HEX : IF, C, HERE 0 , ; : ELSE, C3 IF, SWAP THEN, ; : BEGIN, HERE ; : UNTIL, C, , ; : WHILE, IF, ; : REPEAT, SWAP C3 C, , THEN, ; FORTH DEFINITIONS HEX CODE CSWAP H POP, L A MOV, H L MOV, A H MOV, PSH1, C; DECIMAL ;S \ ASSEMBLER SCREEN 9 BOB 5-AUG-83 CODE CSWAP H POP, L A MOV, H L MOV, A H MOV, PSH1, DECIMAL ;S
