1// ******************************************************** 2// Copyright (c) 2016 Rob Judd <judd@ob-wan.com> 3// Based on C version by Charles Childers et al 4// ISC License - see included file LICENSE 5// Minor adjustments by Charles Childers, 2018 6// ******************************************************** 7 8program listener; 9 10{$mode objfpc}{$H+} 11{$macro on} 12 13uses 14 SysUtils, bridge in 'bridge.pas', nga in 'nga.pas'; 15 16{$include 'nga.inc'} 17 18const 19 TIB = 1471; 20 21//implementation 22 23procedure include_file(fname : PChar); 24var 25 source : array[0..65535] of Char; 26 fp : File of Char; 27 f : THandle; 28begin 29 f := FileOpen(fname, fmOpenRead); 30 if f <> THandle(-1) then 31 begin 32 writeln('+ load ', fname); 33 Assign(fp, fname); 34 Reset(fp); 35 while not eof(fp) do 36 begin 37 read_token(fp, source); 38 evaluate(source); 39 end; 40 Close(fp); 41 end; 42 FileClose(f); 43end; 44 45procedure dump_stack(); 46var 47 i : Cell; 48begin 49 write('Stack: '); 50 for i := 1 to sp do 51 if i = sp then 52 write(format('< %d >', [data[i]])) 53 else 54 write(format('%d ', [data[i]])); 55 writeln(); 56end; 57 58procedure prompt(); 59begin 60 if memory[Compiler] = 0 then 61 write(LineEnding, 'ok '); 62end; 63 64 65// ******************************************************** 66// Main program 67// ******************************************************** 68var 69 input : array[0..1023] of Char; 70 i, n : Cell; 71begin 72 ngaPrepare(); 73 n := ngaLoadImage('ngaImage'); 74 if n = 0 then 75 exit(); 76 update_rx(); 77 writeln(format('RETRO 12 (rx-%d.%d)', [memory[4] div 100, memory[4] mod 100])); 78 //include_file('retro.forth'); 79 writeln(format('%d MAX, TIB @ %d, Heap @ %d', [IMAGE_SIZE, TIB, Heap])); 80 writeln(); 81 while true do 82 begin 83 prompt(); 84 Dictionary := memory[2]; 85 read_token(input); 86 if strcomp(input, 'bye') = 0 then 87 begin 88 exit(); 89 end 90 else if strcomp(input, 'words') = 0 then 91 begin 92 i := Dictionary; 93 while i <> 0 do 94 begin 95 string_extract(d_name(i)); 96 write(format('%s ', [string_data])); 97 i := memory[i]; 98 end; 99 writeln(format('(%d entries)', [d_count_entries(Dictionary)])); 100 end 101 else if strcomp(input, '.p') = 0 then 102 writeln(format('__%s__', [string_extract(data[sp])])) 103 else if strcomp(input, '.s') = 0 then 104 dump_stack() 105 else 106 evaluate(input); 107 end; 108end. 109 110