FORTH
cz. 10
W tym odcinku nie będę przedstawiał nowych słów
FORTHa, gdyż nic starczy na to miejsca. Cały artykuł dotyczy jednego, ale jakże ważnego elementu tego języka,
jakim jest Edytor FORTHa (nie mylić z Edytorem Wprowadzania). W pierwszym odcinku cyklu obiecałem przedstawić kasetową wersję FORTHa. 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 Fortha, 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 FORTHa 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 odcinku. Listingi należy
wprowadzić do komputera przy pomocy Edytora Wprowadzania (EDW).
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 .
00SI 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,
106Q BEGIN, DEY, XSAVE 2+ )Y LDA,
1PEJ 96 # AND, .A LSR, .A LSR,
lQ03 .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
240V 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
2177 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,
2M3T C, 2 C, 2 C, 2 C, 2 C, 2 C, 2
203T 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 : KK? ADLINE % 84 #KP ;
30M3 : 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
4311 : 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 -
4H18 XPOS@ + YPOS@
4IOM % 40 * + ; : E:@ E: C@ ;
4J7H : E:! E: C! ;
4K00
4L1F : #KUR E:@ DUP % 127 >
4MLD IF % 128
4NRR - ELSE % 128 +
40CK 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
5501 DUP % 35 > IF DROP % 4 SWAP
56FP 1+ SWAP ENDIF SWAP
57R7 DUP 0 < IF #LINIA0 8 IF % 27
585V LINB LIN-BUF
598Q -l #LINIA0 +! 0 E:V 0 LIMB
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
5112 E:! XPOS@ 1+ YPOSC #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 ;
505J ?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
6300 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
6A00 : BUF^ #BU# OVER >R >R SWAP R>
6B17 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
606D CMOVE ENDIF BUF^ #KUR
6PEV ELSE BEEP BEEP ENDIF ;
6Q00
6RUP : #W 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 -l 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 : <#CM> 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> #CM 66
7ME9 ERASE 32CM 32CM ;
7NK9 : <#CM <#CM> SWAP 32CM SWAP
70R6 32CM #KUR ;
7P13 : #>> >#CM XSPAC #CM % 63 +
7QNH C@ O= 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 X#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
8154 1 752 C! #DISPE #RAMKA
8J2T XPOS@ YPOS@ #POS
8KEM EK-E: #KUR
8L2B BEGIN
8MSA KEY DUP #NR-KLAW #WYB0
8NB9 300 = UNTIL
8006 #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 )
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
0F10 LOOP EMPTY-BUFFERS ;
0GSN : IND 1 INDE ;
0HD2 ( END )
EDYTOR FORTHa
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 FORTHa, przez napisanie Ich nazwy
I zatwierdzenie klawiszem RETURN.
Są to:
L. - Wywołuje edytor wraz z podanym przed komedą
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 FORTHa 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 DOSa, 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
|