W tym odcinku nie będę przedstawiał nowych słów FORTH-a, gdyż nie starczy na to miejsca. Cały artykuł dotyczy jednego, ale jakże ważnego elementu tego języka, jakim jest Edytor FORTH-a (nie mylić z Edytorem Wprowadzania). W pierwszym odcinku cyklu obiecałem przedstawić kasetową wersję Forth-a. Aby dotrzymać słowa rozszerzyłem obsługę Edytora na to urządzenie. Dzięki temu możliwy jest zapis wersji źródłowej na kasetę, oraz odczyt i kompilacja z tego urządzenia.
Czytelnicy, którzy wprowadzą do swego komputera Edytor FORTH-a, zdobędą narzędzie umożliwiające pełne wykorzystanie dobrodziejstw tego języka. A zatem do dzieła ! Aby tego dokonać należy: Posiadać implementację Extended fig-FORTH, wprowadzić do FORTH-a Edytor Wprowadzania (6/7 lub 10 nr. TA) oraz Assembler (8 nr. TA).
Uwaga ! Wszyscy, którzy wprowadzili do swego komputera starszą wersję EDW, powinni najpierw wpisać w trybie bezpośrednim następującą deklarację :
: EW ; RETURN
Prezentowany listing Edytora składa się z trzech części. Pierwsza - to główny program edytora. Druga - to zestaw słów dla posiadaczy stacji dysków. Część trzecia, przeznaczona dla posiadaczy magnetofonów, zostanie przedstawiona w następnym docinku. Listingi należy wprowadzać do komputera przy pomocy Edytora Wprowadzania (EDW).
Listing 1 01N7 ( EDYTOR-FORTH ) 0200 03CO ( autor: Roland Pantola ) 04Q9 ( [c] 1992 T.A. ) 05C7 0 VARIABLE #GGE 06GS : GGE #GGE @ ; 07KS 129 #GGE ! 08VP CODE INSTR 093P 3 ,X LDA, XSAVE 3 + STA, 0ANE 2 ,X LDY, 0BJG 0= IF, XSAVE 3 + DEC, 0CBU THEN, DEY, XSAVE 2+ STY, 0DFE 0 ,X LDY, 4 ,X LDA, 0EVJ BEGIN, XSAVE 2+ )Y CMP, 0F0L 0= NOT IF, DEY, THEN, 0GFP 0= UNTIL, 4 ,X STY, 0HE5 POPTWO JMP, C; 0I1H ( A ADR DLU --- NR ) 0JUD : SELECT <BUILDS SMUDGE ] DOES> 0KMB SWAP 2 * + @ EXECUTE ; 0LAM : % COMPILE CLIT BL WORD HERE 0MFR NUMBER DROP -1 OVER 256 <=< 0= 0NSD IF CR ."Error: % " DUP . 0OSI ENDIF C, ; 0P5S IMMEDIATE 0Q3H 0 VARIABLE #C 2 ALLOT 0RJM 64 #C C! 0SBT 0 #C 1+ C! 0TRH 32 #C 2+ C! 0U9L 96 #C 3 + C! 0V00 10A1 --> 1100 1200 13VQ CODE CMOVE> 2 ,X LDA, XSAVE 2+ 14M4 STA, 4 ,X LDA, XSAVE 4 + STA, 153F 1 ,X LDA, CLC, 5 ,X ADC, 166P XSAVE 5 + STA, 1 ,X LDA, 17HF CLC, 3 ,X ADC, XSAVE 3 + STA, 18QU BEGIN, 0 ,X LDY, 19BA BEGIN, DEY, XSAVE 4 + )Y LDA, 1A91 XSAVE 2+ )Y STA, 0 % CPY, 0= 1B2P UNTIL, XSAVE 5 + DEC, XSAVE 1CTC 3 + DEC, 0 ,X LDA, 0= IF, 1D0U 1 ,X LDA, 0= NOT 1EC5 IF, 1 ,X DEC, THEN, THEN, 1FE2 0 % LDA, 0 ,X STA, 1GF6 1 ,X LDA, 0= UNTIL, 1H9K INX, INX, XSAVE STX, POPTWO 1IIJ JMP, C; 1J00 1K0U CODE ASC-PEEK XSAVE STX, 1L68 2 ,X LDA, XSAVE 2+ STA, 1M3P 3 ,X LDA, XSAVE 3 + STA, 1NNC 0 ,X LDY, 1O6Q BEGIN, DEY, XSAVE 2+ )Y LDA, 1PEJ 96 % AND, .A LSR, .A LSR, 1Q03 .A LSR, .A LSR, .A LSR, TAX, 1RGO XSAVE 2+ )Y LDA, 1SFR 255 96 - # AND, #C ,X ORA, 1TH5 XSAVE 2+ )Y STA, 0 # CPY, 1UKB 0= UNTIL, XSAVE LDX, 1VE5 POPTWO JMP, C; 20A1 --> 2100 2200 23S9 : PEEK-ASC OVER OVER 2 0 24OV DO ASC-PEEK LOOP ; 25P4 ( ADDR DLU --- ) 26EO 4 VARIABLE XPOS 4 VARIABLE YPOS 279G : XPOS@ XPOS @ ; 289S : YPOS@ YPOS @ ; 29EI : POSE YPOS ! XPOS ! ; 2AMR 48 CONSTANT ZERO 2BL5 : X! % 85 ! ; : Y! % 84 C! ; 2CEA : X@ % 85 @ ; : Y@ % 84 C@ ; 2DNM : POS Y! X! ; 2EQ0 : 0.R ' ZERO CFA ' SPACE ! .R 2FTK ' BL CFA ' SPACE ! ; 2GPI : BEEP 253 EMIT ; 2H00 2I77 VOCABULARY EDITOR IMMEDIATE 2JFB EDITOR DEFINITIONS 2K86 : #DLE [ 112 C, 66 C, 48032 , 2LBD 2 C, 2 C, 2 C, 2 C, 2 C, 2 C, 2MPR 2 C, 2 C, 2 C, 2 C, 2 C, 2 C, 2 2N3T C, 2 C, 2 C, 2 C, 2 C, 2 C, 2 2O3T C, 2 C, 2 C, 2 C, 2 C, 2 C, 2 2P9S C, 2 C, 2 C, 65 C, 47998 , ] ; 2QFH : #SCR? 0 % 10 POS ." SCR" 2R9S 0 % 12 POS SCR @ 3 0.R ; 2SVL : ADBUFF HERE 260 + ; 2T88 : LBUFF ADBUFF 2 - ; 2UIA : CZYBUFF ADBUFF % 4 - 2V5D @ 31886 = ; 30A1 --> 3100 3200 33A1 : #BUFF? CZYBUFF IF LBUFF 34NE @ ELSE 0 ADBUFF 2 - ! 31886 351V ADBUFF 4 - ! 0 ENDIF 0 % 16 POS 36NA ." BUF" 0 % 18 POS % 3 0.R ; 377A : #DISPE ' #DLE 47998 % 34 38EN CMOVE 47998 560 ! 48032 % 88 ! 39PC ; : #RAMKA % 125 EMIT % 88 @ 3ASM % 28 0 DO DUP I % 40 * + % 3 + 3BFO % 124 SWAP OVER OVER % 33 + ! ! 3CQS LOOP DROP #SCR? #BUFF? ; 3DLC 0 VARIABLE #LINIA0 3EAK : #W# SCR @ B/SCR * DUP B/SCR + 3FMT SWAP ; : #WEJ #W# DO I 3GQD BLOCK % 128 ASC-PEEK LOOP ; 3H49 : #WYJ #W# DO I BLOCK % 128 3IGF PEEK-ASC LOOP ; 3JDU 48036 CONSTANT ADE: : ADLINE 3KLT % 40 * ADE: + ; 3L7K : #KP SWAP OVER OVER 1 - C! 3MFA OVER OVER 32 + C! DROP DROP ; 3NIH : KK7 ADLINE % 84 #KP ; 3OM3 : PP? ADLINE % 124 # KP ; 3PR9 : #LIN# DUP % 4 /MOD SCR @ 3QRP B/SCR * + BLOCK SWAP % 32 * + 3RPG SWAP ADLINE #LINIA0 @ % 40 * - 3SUC ; : LIN-E: #LIN# % 32 CMOVE ; 3TOK : EK-E: #LINIA0 @ DUP % 28 + 3UOR SWAP DO I LIN-E: LOOP ; 3VSA : LIN-BUF #LIN# SWAP % 32 40EP CMOVE ; --> 4100 4200 43II : EK-BUF #LINIA0 @ DUP % 28 + 44NP SWAP DO I LIN-BUF LOOP ; 45N5 : E:V ADLINE DUP % 40 - % 26 46NO ADLINE DO I DUP % 40 + % 32 47MF CMOVE -40 +LOOP % 32 ERASE ; 4800 49HH : E:^ ADLINE % 40 + 4A6H % 28 ADLINE 4B19 SWAP DO I DUP % 40 - % 32 4C9T CMOVE % 40 +LOOP % 27 ADLINE 4DGB % 32 ERASE ; 4E00 4FU7 : LINB #LINIA0 @ + ; 4GE3 : E: ADE: % 4 - |
Listing 1 cd. 4H18 XPOS@ + YPOS@ 4IOM % 40 * + ; : E:@ E: C@ ; 4J7H : E:! E: C! ; 4K00 4L1F : #KUR E:@ DUP % 127 > 4MLD IF % 128 4NRR - ELSE % 128 + 4OCK ENDIF E:! ; 4P00 4QTS : &PP 4R8I POSE #LINIA0 @ DUP 0= 4STB IF 0 KK? ELSE 0 PP? ENDIF 4TGV % 4 = IF % 27 KK? ELSE % 27 4UTT PP? ENDIF ; 4V00 50A1 --> 5100 5200 53L9 : #POS SWAP DUP % 4 < IF DROP 54TL % 35 SWAP % 1 - SWAP ENDIF 55OI DUP % 35 > IF DROP % 4 SWAP 56FP 1+ SWAP ENDIF SWAP 57R7 DUP 0 < IF #LINIA0 @ IF % 27 585V LINB LIN-BUF 598Q -1 #LINIA0 +! 0 E:V 0 LINB 5AC9 LIN-E: DROP 0 5BE1 ELSE DROP % 27 ENDIF ENDIF 5CJ7 DUP % 27 > IF #LINIA0 @ 4 = 5DIT IF DROP 0 ELSE 5EQT 0 LINB LIN-BUF 1 #LINIA0 +! 0 5FF2 E:^ % 27 LINB LIN-E 5GUV DROP % 27 ENDIF ENDIF &PP ; 5HTS : #PISZ DUP SP@ 1 ASC-PEEK #KUR 5I12 E:! XPOS@ 1+ YPOS@ #POS #KUR ; 5JSP : #KXY@ #KUR XPOS@ YPOS@ ; 5K06 : #PK #POS #KUR ; 5LM8 : ?< #KXY@ SWAP 1 - SWAP #PK ; 5MDB : ?> #KXY@ SWAP 1+ SWAP #PK ; 5NVJ : ?^ #KXY@ 1 - #PK ; 5O5J : ?V #KXY@ 1+ #PK ; 5PRQ : #RET #KXY@ 1+ SWAP DROP % 4 5Q7Q SWAP #PK 0 LBUFF ! #BUFF? ; 5R8S : #COF #KXY@ SWAP 1 - SWAP #POS 5S2G 0 E:! #KUR ; : BFREE 430 LBUFF 5TH5 @ % 32 * + 471 @ HERE - U< ; 5UTL : >BUFF YPOS@ ADLINE ADBUFF 5VHU LBUFF @ % 32 * + % 32 CMOVE 60AG 1 LBUFF +! #BUFF? ; --> 6100 6200 630O 0 VARIABLE #CM 67 ALLOT 64SF : #BU# % 28 #LIN# DROP DUP 65SR % 32 + % 96 ; 66CT : #EB# % 27 ADLINE % 28 LINB 67LK #LIN# DROP ; 68EH : BUFV #BU# CMOVE> ; 6900 6A0O : BUF^ #BU# OVER >R >R SVAP R> 6817 CMOVE R> % 64 + % 32 ERASE ; 6CSL : XSP DO I C@ 0= 0= IF DROP I 6DPI LEAVE ENDIF LOOP ; 6E00 6F7F : OSTLIN #LINIA0 @ % 4 = IF 0 6GUF % 27 ADLINE DUP % 32 + 6HIG SWAP XSP ELSE 0 % 31 #LIN# 6I8U DROP DUP % 32 + SWAP XSP 6JSL ENDIF 0= ; 6K00 6LF9 : #^^ BFREE IF #KUR >BUFF 6M84 YPOS@ E:^ #LINIA0 @ 6N5I % 4 < IF #EB# SWAP % 32 6O6D CMOVE ENDIF BUF^ #KUR 6PEV ELSE BEEP BEEP ENDIF ; 6Q00 6RUP : #VV OSTLIN IF 6SQN #KUR BUFV #LINIA0 @ % 4 < 6T0V IF #EB# % 32 CMOVE ENDIF 6U5P YPOS@ E:V #KUR ELSE BEEP 6VKC ENDIF ; 70A1 --> 7100 7200 736U : #<BF OSTLIN IF LBUFF @ IF #VV 7441 -1 LBUFF +! ADBUFF LBUFF @ 75IC 32 * + YPOS@ ADLINE % 32 76VT CMOVE #BUFF? #KUR ENDIF ELSE 77MC BEEP ENDIF ; 787N : X#CM #CM XPOS@ + % 4 - ; 79S3 : XSPAC #CM % 63 + DUP X#CM 7ANJ XSP #CM % 64 + DUP ROT 7BFS DO I C@ 0= I 1+ C@ 7C6Q 0= * IF DROP I LEAVE 7DJK ENDIF LOOP X#CM - ; 7EK5 : <#CD> YPOS@ #LINIA0 @ XPOS@ 7FRS YPOS@ 1+ #POS #LINIA0 @ = 0= 7G0T - YPOS ! 7H54 YPOS@ ADLINE #CM OVER OVER 7IVN YPOS@ % 27 < IF SWAP % 40 7JDQ + SWAP % 32 + ENDIF ; 7KKO : 32CM % 32 CMOVE ; 7LBI : >#CM #KUR <#CM> #CN 66 7ME9 ERASE 32CM 32CM ; 7NK9 : <#CM <#CM> SWAP 32CM SWAP 7OR6 32CM #KUR ; 7P13 : #> >#CM XSPAC #CM % 63 + 7QNH C@ 0= OVER X#CM + #CM - % 63 7R32 < + IF X#CM DUP 1+ ROT 7SVG CMOVE> 0 X#CM C! ELSE BEEP 7TNH DROP ENDIF <#CM ; 7U2K : #< >#CM 1+ DUP 1 - 7VUH XSPAC CMOVE <#CM ; 80A1 --> 8133 ( --- ) 8200 83CI : #DUP DUP DUP % 127 > 8466 IF % 128 - ENDIF ; 85DE : ESC DROP KEY #DUP BL = IF 863S DROP 300 ELSE #PISZ ENDIF ; 87NL : #KLA0 [ 27 C, 28 C, 29 C, 30 884V C, 31 C, 155 C, 126 C, 254 C, 89K0 255 C, 156 C, 157 C, 127 C, 8AAE ] ; 8BPO : #NR-KLAW ' #KLA0 % 12 INSTR ; 8C00 8D1I SELECT #WYB0 #PISZ ESC ?^ ?V ?< 8ESJ ?> #RET #COF #< #> #^^ #VV 8F3R #<BF ; 8G5I FORTH DEFINITIONS 8HAI : (E) EDITOR #WEJ 8I54 1 752 C! #DISPE #RAMKA 8J2T XPOS@ YPOS@ #POS 8KEM EK-E: #KUR 8L2B BEGIN 8MSA KEY DUP #NR-KLAW #WYB0 8NB9 300 = UNTIL 8O06 #KUR EK-BUF #WYJ FORTH ; 8P00 8Q96 : EXFO % 125 EMIT % 80 % 88 +! 8RGF ." FORTH" CR 0 752 C! ; 8SLP : CLEAR % 16 0 DO I SCR @ 8TMH (LINE) DROP C/L BLANKS UPDATE 8U8P LOOP ; 8VD2 ( END ) |
--- * --- * ---
Listing 2 01RD ( ED-DYSK ) 0200 03RO : MARK SCR @ % 8 * % 8 0 DO I 041E OVER + BLOCK DROP UPDATE 054U LOOP DROP ; 06MM : E. (E) EXFO ; 07SU : L. SCR ! E. ; 08HS : F. MARK FLUSH ; 09RM : INDE EMPTY-BUFFERS 0A2E GGE SWAP GGE 1 - MIN 0BE5 DO I 8 * BLOCK 32 -TRAILING 0CAL OVER @ DUP 8224 = 0= * IF CR 0DA0 I . SPACE TYPE ELSE 2DROP ENDIF 0EIA ?TERMINAL IF LEAVE ENDIF 0F1O LOOP EMPTY-BUFFERS ; 0GSN : IND 1 INDE ; 0HD2 ( END )
EDYTOR FORTH-a
Działanie większości klawiszy w tym programie odpowiada standardowi edytora atari, dlatego też nie będę opisywał tych funkcji. Część komend edytora może być wydawana jedynie z FORTH-a, przez napisanie ich nazwy i zatwierdzenie klawiszem RETURN.
Są to :
L. - Wywołuje edytor wraz z podanym przed komendą numerem ekranu. Np. 10 L. (RETURN) to wywołanie edytora wraz z ekranem numer 10.
E. - Wywołanie edytora z bieżącym ekranem.
Wyjście z edytora do FORTH-a jest możliwe po naciśnięciu ESC a następnie SPACJI
CLEAR - Czyszczenie bieżącego ekranu. Często istnieje taka potrzeba, gdy wywołamy z dysku ekran nie zapisany (serduszka).
IND - Przegląd nazw ekranów (Directory). Dowolny klawisz zatrzymuje przeglądanie.
Dla dysku :
F. - zapis bieżącego ekranu na dysk. Uwaga : zapis na dysku nie odbywa się w formacie DOS-a, dlatego też należy stosować czystą, sformatowaną dyskietkę.
Niestety, ograniczona ilość miejsca na łamach Tajemnic Atari nie pozwala mi opisać wszystkich funkcji edytora. Zostaną one zamieszczone w następnym odcinku z tego cyklu.
Roland Pantoła
Tajemnice Atari 11/92r.