-
Notifications
You must be signed in to change notification settings - Fork 6
/
BOILER.FTH
1 lines (1 loc) · 165 KB
/
BOILER.FTH
1
********************** fig-FORTH MODEL ********************** Through the courtesy of FORTH INTEREST GROUP P. O. BOX 1105 SAN CARLOS, CA. 94070 RELEASE 1 WITH COMPILER SECURITY AND VARIABLE LENGTH NAMES Further distribution must include the above notice. ( ERROR MESSAGES ) EMPTY STACK DICTIONARY FULL HAS INCORRECT ADDRESS MODE ISN'T UNIQUE DISC RANGE ? FULL STACK DISC ERROR ! FORTH INTEREST GROUP MAY 1, 1979( ERROR MESSAGES ) COMPILATION ONLY, USE IN DEFINITION EXECUTION ONLY CONDITIONALS NOT PAIRED DEFINITON NOT FINISHED IN PROTECTED DICTIONARY USE ONLY WHEN LOADING DECLARE VOCABULARY OFF CURRENT EDITING SCREEN FORTH INTEREST GROUP MAY 1, 1979 ( fig-FORTH EDITOR V2.0 SCR 1 of 6) FORTH DEFINITIONS HEX : TEXT HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ; : LINE DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ; : 2DROP DROP DROP ; : 2SWAP ROT >R ROT R> ; VOCABULARY EDITOR IMMEDIATE HEX : WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP C/L /MOD C/L * ROT BLOCK + CR C/L TYPE CR HERE C@ - SPACES 5E EMIT [COMPILE] EDITOR QUIT ; --> ( fig-FORTH EDITOR V2.0 SCR 2 of 6) EDITOR DEFINITIONS HEX 0 R# ! : #LOCATE R# @ C/L /MOD ; : #LEAD #LOCATE LINE SWAP ; : #LAG #LEAD DUP >R + C/L R> - ; : -MOVE LINE C/L CMOVE UPDATE ; : H LINE PAD 1+ C/L DUP PAD C! CMOVE ; : E LINE C/L BLANKS UPDATE ; : S DUP 1- 0E DO I LINE I 1+ -MOVE -1 +LOOP E ; : D DUP H 0F DUP ROT DO I 1+ LINE I -MOVE LOOP E ; : M R# +! CR SPACE #LEAD TYPE 5F EMIT #LAG TYPE #LOCATE . DROP ; : T DUP C/L * R# ! H 0 M ; --> ( fig-FORTH EDITOR V2.0 SCR 3 of 6) : L SCR @ LIST 0 M ; : R PAD 1+ SWAP -MOVE ; : P 1 TEXT R ; : I DUP S R ; : TOP 0 R# ! ; : CLEAR SCR ! 10 0 DO FORTH I EDITOR E LOOP ; : COPY ( source target --- ) FORTH B/SCR * SWAP B/SCR * SWAP ( compute 1st buffers) B/SCR 0 DO DUP I + BUFFER DROP LOOP ( reserve buffers) B/SCR 0 DO OVER I + BLOCK OVER I + BLOCK B/BUF CMOVE UPDATE LOOP DROP DROP FLUSH EDITOR ; --> ( fig-FORTH EDITOR V2.0 SCR 4 of 6) : -TEXT SWAP -DUP IF OVER + SWAP DO DUP C@ FORTH I C@ - IF 0= LEAVE ELSE 1+ THEN LOOP ELSE DROP 0= THEN ; : MATCH >R >R 2DUP R> R> 2SWAP OVER + SWAP DO 2DUP FORTH I -TEXT IF >R 2DROP R> - I SWAP - 0 SWAP 0 0 LEAVE THEN LOOP 2DROP SWAP 0= SWAP ; : 1LINE #LAG PAD COUNT MATCH R# +! ; : FIND BEGIN 3FF R# @ < IF TOP PAD HERE C/L 1+ CMOVE 0 ERROR ENDIF 1LINE UNTIL ; --> ( fig-FORTH EDITOR V2.0 SCR 5 of 6) : DELETE >R #LAG + FORTH R - #LAG R MINUS R# +! #LEAD + SWAP CMOVE R> BLANKS UPDATE ; : N FIND 0 M ; : F 1 TEXT N ; : B PAD C@ MINUS M ; : X 1 TEXT FIND PAD C@ DELETE 0 M ; : TILL #LEAD + 1 TEXT 1LINE 0= 0 ?ERROR #LEAD + SWAP - DELETE 0 M ; --> ( fig-FORTH EDITOR V2.0 SCR 6 of 6) : C 1 TEXT PAD COUNT #LAG ROT OVER MIN >R FORTH R R# +! R - >R DUP HERE R CMOVE HERE #LEAD + R> CMOVE R> CMOVE UPDATE 0 M ; : TS 10 0 DO FORTH I EDITOR T LOOP TOP ; FORTH DEFINITIONS DECIMAL LATEST 12 +ORIGIN ! HERE 28 +ORIGIN ! HERE 30 +ORIGIN ! ' EDITOR 6 + 32 +ORIGIN ! HERE FENCE ! ;S ( DEBUG SCR 1 of 2) 0 VARIABLE BASE' : <HEX BASE @ BASE' ! HEX ; ( 0/1 SWITCH TO HEX) : HEX> BASE' @ BASE ! ; ( 1/0 AND BACK) ( 1/0 PRINT IN HEX REGARDLESS OF BASE) : H. <HEX 0 <# # # # # #> TYPE SPACE HEX> ; ( 1/0 IDEM FOR A SINGLE BYTE) : B. <HEX 0 <# # # #> TYPE HEX> ; : BASE? BASE @ H. ; ( 0/0 TRUE VALUE OF BASE) : ^ ( 0/0 NON DESTRUCTIVE STACK PRINT) CR ." S: " SP@ S0 @ ( FIND LIMITS) BEGIN OVER OVER = 0= WHILE 2 - DUP @ H. REPEAT DROP DROP ; --> ( DEBUG SCR 2 of 2) <HEX : DUMP ( 2/0 DUMPS FROM ADDRESS-2 AMOUNT-1 BYTES) OVER + SWAP FFF0 AND DO CR I H. ." : " I 10 0 DO DUP I + C@ B. I 2 MOD IF SPACE THEN LOOP 1B EMIT 67 EMIT 10 0 DO DUP I + C@ EMIT LOOP 1B EMIT 47 EMIT DROP 10 +LOOP CR ; ( fig-FORTH 8080 Assembler with Z80 extensions SCR 1 of 5) HEX VOCABULARY ASSEMBLER IMMEDIATE ' ASSEMBLER CFA ' ;CODE 0A + ! : 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 : 8* DUP + DUP + DUP + ; ASSEMBLER DEFINITIONS --> ( fig-FORTH 8080 Assembler with Z80 extensions SCR 2 of 5) 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 : 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, , ; --> ( fig-FORTH 8080 Assembler with Z80 extensions SCR 3 of 5) 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 08 1MI EXAF D9 1MI EXX C0 1MI RNZ C8 1MI RZ D0 1MI RNC D8 1MI RC E0 1MI RPO E8 1MI RPE F0 1MI RP F8 1MI RM C9 1MI RET 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 --> ( fig-FORTH 8080 Assembler with Z80 extensions SCR 4 of 5) 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 C4 5MI CNZ CC 5MI CZ D4 5MI CNC DC 5MI CC E4 5MI CPO EC 5MI CPE F4 5MI CP FC 5MI CM CD 5MI CALL C3 5MI JMP C2 CONSTANT 0= D2 CONSTANT CS E2 CONSTANT PE F2 CONSTANT 0< : NOT 8 + ; : MOV 8* 40 + + C, ; : MVI 8* 6 + C, C, ; : LXI 8* 1+ C, , ; : PCIX DD C, E9 C, ; : PCIY FD C, E9 C, ; --> ( fig-FORTH 8080 Assembler with Z80 extensions SCR 5 of 5) : ENDIF 2 ?PAIRS HERE SWAP ! ; : THEN [COMPILE] ENDIF ; : IF C, HERE 0 , 2 ; : ELSE 2 ?PAIRS C3 IF ROT SWAP ENDIF 2 ; : BEGIN HERE 1 ; : UNTIL SWAP 1 ?PAIRS C, , ; : AGAIN 1 ?PAIRS C3 C, , ; : WHILE IF 2+ ; : REPEAT >R >R AGAIN R> R> 2- ENDIF ; FORTH DEFINITIONS DECIMAL ;S