Saturday, 7 August 2021

Fig-Forth At PC=Forty (Part 5)

FIG-Forth was a popular and very compact, public-domain version of the medium speed Forth systems programming language and environment during the early 1980s. In part 1, I talked about how to get FIG-Forth for the IBM PC running on PCjs and in part 2 I implemented a very rudimentary interim disk-based line editor. Part 3 dives into machine code routines and a PC BIOS interface, so that I could implement the screen functions I needed for my full-screen editor and in Part 4 I used them to implement that full-screen editor.

Here I'd like to explore a bit more graphics, since the PC BIOS interface can plot pixels (in any of 4 colours).

So, let's start with Plot. I get most of my BIOS programming information from wikipedia, though I've used an independent web page too. Implementing plot is just an INT10H function (where AH=24), so let's try it:

: PLOT ( CLR X Y )
  >R >R 3072 + 0 R> R>
  INT10H
;

4 VMODE takes us into 320x 200 graphics. You can still type in text, but you can't see the cursor. CLS fills the screen with a stripe - the bios call doesn't work the same way. We can create a graphics cls with:

: CLG 1536 SWAP 21760 * 0 6183 INT10H 0 0 AT ;

We can fill the screen with a colour:

: FCOL 200 0 DO I 320 0 DO OVER OVER I SWAP PLOT LOOP DROP LOOP DROP ;

So, 0 CLS 1 FCOL will then fill the screen in cyan in 37.6s. This makes the plot rate 37.6/(320*200=64000) = 1702 pixels per second, or if we exclude the non-plot functions (43µs+32µs*4)*320*200 = 10.9s for the FORTH code itself, so 26.456s or 2419 pixels per second. Writing a simple random number generator:

0 VARIABLE SEED

: RND SEED @ 1+ 75 * DUP SEED ! U* SWAP DROP ;

Means we can fill the screen with random pixels with:

: RNDPIX 200 0 DO I 320 0 DO 4 RND OVER I SWAP PLOT LOOP DROP LOOP ;

Is what we get part of the way running this after CLS. It randomly plots successive pixels with the colours black, cyan, magenta or grey.

Lines

More usefully we can draw lines. The Jupiter Ace manual gives a nice routine for drawing lines (page 79), however it uses the definition PICK which isn't available on FIG-Forth. It will also turn out that the Bresenham routine, which although it's faster in pure assembler, is slower when the instruction execution rate is much slower than division or multiplication. And that's true for the 8088 where each Forth instruction is about 30µs, but a multiplication also takes about 60µs. Thus, if the Bresenham algorithm is at least 2 instructions longer, multiplies (or divides) are faster. And the Bresenham algorithm on the Jupiter Ace takes: 14 basic loop instructions + DIAG (some of the time) = 4 instructions + SQUARE the rest of the time = 8 or 7 instructions. And Step = 12 instructions. So, that's about 14+6+12 = 32 instructions per loop. By comparison, the main loop in FIGnition is 22 instructions. On this basis we'd be able to achieve about 1500 points per second, a diagonal line across the screen would take about 0.2 seconds.

It's possible to consider the fastest potential line drawing code and base the full line drawing algorithm around that. The quickest way is to consider that again, for the longest axis, its coordinate will increment by 1 on each pass and on the other axis, some fraction of 1. So we can consider a 16-bit fraction, in the range 0..1 on that axis, which we can multiply by the longer axis. In each case we need to add an offset for each coordinate to get the final location.

: DAxis ( col grad offsetg offseth limh )
  0 DO ( col grad offg offh)
    OVER >R >R >R 2DUP ( c g c g : f h f)
    I U* SWAP DROP R> + ( c g c g*i+f : h f)
    R I + PLOT R> R> SWAP
  LOOP
;

So, in this version we need about 20 instructions and we need a second version where the x coordinates map to the do loop. The problem with this version is handling negative gradients, because using U* to generate gradients won't generate negative results in the high word. However, this can be fixed by sorting the coordinates. Consider (with a normal x-y coordinate system) a vector in the second quadrant at about 153º (a gradient of about -1/2). If we sort the coordinates so that we draw from right to left, then the y coordinates will draw upwards. Similarly a line in the 4th quadrant drawn at 288º (a gradient of 2/3), if we sort the coordinates so that we draw from top to bottom, then the x coordinates are ordered left to right. And we can achieve this by XOR'ing the DO loop coordinate by 0xffff (and adding 1 to the DO LOOP coordinate offset). Furthermore we can 'improve' the line drawing by modifying the plot routine to add an origin ( ox, oy) and set the colour ( fgCol). This gives us:

0 VARIABLE oxy 0 ,

: Oplot ( col dx dy )
  >R >R 3072 + 0 oxy 2@ R> + SWAP R> +
  INT10H
;

So, OPLOT is 4 words longer than PLOT. Also we want x in the first word of oxy and y in the second word. Then DAxis is:

0 VARIABLE XDIR

: DAXISY ( col grad limh sgn&dx sgn&dy)
  OXY >R R 2+ +! R> +!
  0 DO ( col grad)
    2DUP ( c g c g)
    I U* SWAP DROP ( c g c g*i)
    XDIR @ I XOR OPLOT ( c g )
  LOOP DROP DROP
;

: SGN 0< MINUS ;
( Here Y is the major axis. There are 4 cases,
  maj>0, min>0 = first quadrant, normal.
  maj >0, min <0 = second quadrant [ \ ]. Set ox+=dx.
               Since the gradient is always unsigned,
               a left to right draw will cover the correct x direction.
               However, y will draw from bottom to top, giving [ / ]
               So, y needs to be drawn from top to bottom too,
               XDIR=-1, oy+=dy.
  maj <0, min <0. = third quadrant, set ox+=dx and oy+=dy. That's because
                dy<0, dx<0 is / kind of line so simply moving oxy fixes
                the problem.
  maj <0, min >0 = fourth quadrant.
               XDIR=-1.
  So, if dy^dx <0, then XDIR=-1 else 0.
)
: QUADFIX ( c min maj )
  2DUP >R >R ( c min maj : min maj)
  ABS SWAP ABS SWAP ( c |min| |maj| : min maj )
  >R 0 SWAP R U/ SWAP DROP R> ( c  g |maj| : min maj)
  R> R> 2DUP XOR SGN XDIR ! ( c g |maj| min maj sgn(min^maj)!XDIR [Quadrants 2 and 4])
  OVER SGN SWAP OVER AND >R ( c g |maj| min sgn.min : maj&sgn.min)
  AND R> ( c g |maj| min&sgn.min maj&sgn.min)
;

: DAXISX ( col grad limh sgn&dy sgn&dx)
  OXY >R R +! R> 2+ +!
  0 DO ( col grad)
    2DUP ( c g c g)
    I U* SWAP DROP ( c g c g*i)
    XDIR @ I XOR SWAP OPLOT ( c g )
  LOOP DROP DROP
;

So, this is 13 words + 4 for OPLOT, Saving 3 words. Now drawing the longest line ought to take about (43µs+4*32µs+32µs*16)*320 = 0.22s. In practice, timed basic plotting rate is 27.8s=32000 pixels, or 0.278s for the 320 pixels so that's a maximum of 1151 pixels per second, which is slowish, but tolerable.


: DRAW ( col dx dy)
  2DUP OR 0= IF
    DROP DROP DROP
  ELSE
  OVER OXY SWAP OVER @ + >R ( col dx dy &OXY : X')
  2+ @ OVER + >R ( col dx dy : Y' X')
  OVER ABS OVER ABS > IF
    SWAP QUADFIX DAXISX
  ELSE
    QUADFIX DAXISY
  THEN
THEN
  R> R> OXY 2!
;

: RLINE
  3 RND 1+ ( COLOR)
  200 RND 320 RND 2DUP OXY 2!
  320 RND SWAP - SWAP 200 RND SWAP - DRAW
;

: RLINES BEGIN RLINE ?TERMINAL UNTIL ;



Circles

Our circle algorithm, on the other hand will be copied straight from the equivalent FIGnition version.

Method: we know x^2+y^2 = const. So, we start at [0,r], which gives r^2 We can go straight up, which gives:
   [x^2+[y+1]^2] - x^2-y^2 => a difference of +2y+1.
Or we can do [x-1]^2 => a diff of 1-2x.
So, the rule is that when the accumulation of 2y+1>1-2x, then we do 1-2x. By only calculating the error, we don't need to calculate r*r and therefore there is no danger of 16-bit arithmetic overflow even for radius's larger than the width of the highest screen resolution.

: NEXTP ( X Y DIFF )
 OVER DUP + 1+ + >R  ( CALC WITH INC Y )
 OVER DUP + 1 - R> 2DUP > IF
   SWAP DROP
 ELSE
   SWAP - >R SWAP 1 - SWAP R>
 THEN SWAP 1+ SWAP
;

0 VARIABLE FG

: DXYPLOT ( COL DX DY)
  >R 2DUP R OPLOT R> ;

: OCTPLOT ( CX CY DX DY)
  4 0 DO
    DXYPLOT SWAP
    DXYPLOT NEG
  LOOP
; ( -- CX CY )

: CIRC ( COL X Y R )
  >R SWAP OXY 2! ( COL : R)
  R> 0 0 >R ( COL DX=R, DY=0 : DIFF=0)
  BEGIN
   OCTPLOT R> NEXTP >R
  2DUP < UNTIL R>
  DROP DROP DROP
;

: CIRCS ( CIRCLES)
  0 DO 3 RND 1+ 160 100 I CIRC 2 +LOOP DROP DROP ;




: CIRCBM 0 DO I 3 AND 160 100 98 CIRC LOOP ;

And with a ticks routine of the form: HEX : TICKS 40 6C L@ ; DECIMAL we can time it fairly well. 20 CIRCBM draws 98*2*pi pixels per circle and takes 174 ticks. So that's 12315 pixels in 9.56s or 1288 pixels per second. Amazingly, a bit faster than line drawing!

Conclusion

Once we can choose a graphics mode and implement a plot function we can build on that with simple line-drawing and circle-drawing algorithms. An original IBM PC running FIG-Forth draws lines like a lazy 8-bit computer, but for graphics of moderate complexity, that's tolerable. The real challenge is that a classic line drawing algorithm involves quite a lot of stack variables with extensive stack shuffling, making an efficient program far more involved than the equivalent even in 8-bit assembler and that the overhead of the Forth interpreter means the Bresenham line drawing algorithm is slower than one that uses division.

Sunday, 25 July 2021

Fig-Forth At PC=Forty (Part 4)

In part 1, I talked about how to get FIG-Forth for the IBM PC running on PCjs. FIG-Forth was a popular and very compact, public-domain version of the medium speed Forth systems programming language and environment during the early 1980s. Then part 2 covered how to implement a very rudimentary disk-based line editor as a precursor to an interactive full-screen editor; while part 3 dives into machine code routines and a PC BIOS interface, because there was no real screen cursor control via the existing commands.

Let's Edit!

Now, at least we can implement a screen editor. One of the constraints I'll impose will be to keep the editor to within 1kB of source code. At first that'll be easy, because all I want to support is normal characters, cursor control, return and escape to update. However, I know that I'll probably want to add the ability to copy text from a marker point using <ctrl-c>. But even a simple decision like this raises possible issues. Consider this, if I type VLIST I find I can press <ctrl-c> to stop the listing:

However, if I type this definition:

: T1 BEGIN KEY DUP . 27 = UNTIL ;

I find that <ctrl-c> doesn't break out of T1, instead it simply displays 3 and I really do have to press <esc> to quit the routine. But it could be that Forth still checks it automatically, just not with the above sequence of commands in T1. No, from the FIG-Forth source we can see, the breakout of VLIST is simply due to it executing ?TERMINAL and exiting if any key has been pressed. So, that potential problem is sorted!

VLIST Source Code:

DB 85H
DB 'VLIS'
DB 'T'+80H
DW UDOT-5
VLIST DW DOCOL
DW LIT,80H
DW OUTT
DW STORE
DW CONT
DW AT
DW AT
VLIS1 DW OUTT ;BEGIN
DW AT
DW CSLL
DW GREAT
DW ZBRAN ;IF
DW OFFSET VLIS2-$
DW CR
DW ZERO
DW OUTT
DW STORE ;ENDIF
VLIS2 DW DUPE
DW IDDOT
DW SPACE
DW SPACE

DW PFA
DW LFA
DW AT
DW DUPE
DW ZEQU
DW QTERM
DW ORR
DW ZBRAN ;UNTIL

DW OFFSET VLIS1-$
DW DROP
DW SEMIS

The Editor Itself

The first goal in the editor is to convert y x coordinates in the current screen to a memory location in a buffer. This is a minor change from the initial part of the code in EDL:

: EDYX& ( Y X -- ADDR)
  >R 15 AND 8 /MOD SCR @ B/SCR * +
  BLOCK SWAP C/L * + R> +
;

We want to be able to constrain Y and X coordinates to within the bounds of the screen (in this case with wrap around):

: 1- 1 - ; ( oddly enough missing from FIG-Forth, but I use it quite a bit in the editor)

: EDLIM ( Y X -- Y' X')
  DUP 0< IF
    DROP 1- 0
  THEN
  DUP C/L 1- > IF
    DROP 1+ 0
  THEN
  SWAP 15 AND SWAP
  OVER 2+ OVER 4 + AT
;

The key part of a screen editor is to be able to process characters, I've picked the vi cursor keys:

: DOKEY ( R C K  )
  >R
  R 8 = IF ( CTRL-H, Left)
    1-
  THEN
  R 12 = IF ( CTRL-L, Right)
    1+
  THEN
  SWAP R 11 = IF ( CTRL-K, Up )
    1-
  THEN
  R 10 = IF ( CTRL-J, Down)
   1+
  THEN
  SWAP R 13 = IF ( CR or CTRL-M)
    64 +
  THEN
  EDLIM
  R 31 > R 128 < AND IF ( PRINTABLE)
    2DUP EDYX& R SWAP C!
    R EMIT 1+ UPDATE EDLIM
  THEN
  R>
;

Finally we want to put it all together in a top-level function:

: ED ( scr -- )
  CLS LIST 0 0 EDLIM
  BEGIN
   KEY DOKEY
  27 = UNTIL
  DROP DROP
;

Interestingly, once I'd cleared up an initial bug where the cursor wasn't advanced when I typed a character, and another where I'd missed an AND when checking for printable characters, I was able to use the editor itself to edit improvements ( namely, putting the initial cursor at the right location instead of (0,0)).

Finally, although Forth isn't always as compact as its proponents like me often claim, in fact this editor in itself uses a mere 306 bytes, probably the most compact interactive editor I've seen and there's still over half the screen left for improvements. For example, there's no support for delete ( left, space, left); for inserting a line; copying text, nor blocks. But for the moment, it's easily far more enjoyable than the line editor it replaces.

Exercise For The Reader

The biggest user-interface problem I've found with extensions to the editor has been to decide which control character to use to mark the text location for copying. To explain: many archaic screen editors, including some early word processors used a mark, edit sequence for text manipulation. The user would move the cursor to where they wanted to perform an 'advanced' edit operation; mark the initial location; then move the cursor to either where they wanted the edit operation to finish; mark the end of that edit text; then finally, possibly move the cursor to some other location and complete the edit. For example, on the Quill word processor for the Sinclair QL, you'd Type F3, 'E' (for Erase), move the cursor to where you wanted to erase a block; press enter; move to where the erase should finish (and it would highlight the text as you went along); press enter; confirm you wanted to erase it and then it would. Or in the Turbo C editor you'd Mark an initial starting location; then Mark again an ending location and then perform an operation like 'Copy' to duplicate the text, or 'Delete' or 'Move' to move the text.

Or on a BBC Micro, the BASIC editor was essentially a line editor which supported two cursor positions (!!) If you needed to manipulate a line instead of just retyping it, you'd list the line (if it wasn't on the screen), then move the cursor keys and a second cursor would appear, moving to where you wanted on the screen; while the cursor at your editing position would remain. You'd then hit COPY and it would copy from the second cursor to your editing position, advancing both cursors.

So, in my system, which is similar to how editing works on FIGnition, I'd want to Mark the position where I wanted to copy / erase from; move to where I wanted to paste or finish a delete to and then COPY / MOVE a character at a time from the source to the destination (or Erase the text).

However, the most obvious control character to use, <ctrl-m> is already used for Return, and everything else seems rather contrived. Then I thought, what happens if I use <ctrl-symbol> instead? Do they produce interesting control codes? I found out quite a number produce 0s, but some actually generate the control codes in the range 0..31 that you can't generate from <ctrl-a> to <ctrl-z>.

This is what I found out:

 Ctrl+  Code  Ctrl+  Code
 \  28  ]  29
 6  30  -  31

So, what I'd like to know is whether this is just an artefact of the simulator being used on a Mac or whether it's common to other emulators and an actual IBM PC?

Conclusion

Once I'd implemented some earlier, critical definitions it turned out to be quite easy and satisfying to write a full-screen editor. The biggest challenges were in making sure certain key presses wouldn't collide with any system behaviour and finally thinking about some user-interface decisions for some future enhancements.

The editor also nicely illustrates some key Forth aspirations: the editor turns out to be very compact (though of course it's very rudimentary too); and I was able to use it to debug and improve itself once I'd reached some critical level of functionality. It was so easy and tiny, I wonder why it wasn't a standard part of FIG-FORTH, given that it was designed in an era when cursor addressable VDUs were already the norm.

Sunday, 18 July 2021

Fig-Forth At PC=Forty (Part 3)

 In part 1, I talked about how to get FIG-Forth for the IBM PC running on PCjs. FIG-Forth was a popular and very compact, public-domain version of the medium speed Forth systems programming language and environment during the early 1980s. Then part 2 covers how to implement a very rudimentary disk-based editor as a precursor to an interactive full-screen editor.

It would be possible to implement a full-screen editor entirely using the existing word set, if it provided definitions that could control the position of the cursor on the screen and the ability to clear the screen.

Unfortunately, it's not possible to do that either by sending display control codes via EMIT, nor via any other special commands. EMIT does support some control codes, carriage return is 13 EMIT, backspace is 8 EMIT, cursor right is 9 EMIT and cursor down is 10 EMIT. 

The rest just produce graphics characters.

Let's Do Some Machine Code!

It's inevitable I'd have to get onto some machine code at some point, and it turns out, pretty early on. That means I need some useful Forth and 8086 resources.

Firstly, there's an indispensable guide to the FIG-Forth core: The Systems Guide To FIG-Forth. In it, it says you can write machine code definitions using the ;CODE command. The idea is that you'd write something of the form:

: myMachineCodeDef ;CODE opCode0 C, opCode1 C, etc... ;

But that doesn't work as I imagined. Instead I found you need to do:

CREATE myMachineCodeDef opCode0 C, opCode1 C, etc... SMUDGE

Here, CREATE generates a CFA which points to the parameter field (by default), and because FIG-FORTH is an Indirect Threaded Forth, that's the machine code that gets executed. It's not quite the only way of doing it. The Jupiter Ace's method for executing machine code is to define a CODE word which jumps to machine code in the parameter field:

DEFINER CODE DOES> CALL ;
CODE Noop 253 C, 233 C,

And Direct threaded Forths merely need to build a header without a CFA, because in these cases, the CFA is machine code itself. 

Probably the compact resource for translating 8086 instructions is the 8086 datasheet itself. I obtained a copy from Carnegie Mellon University (which incidentally did some pioneering work in parallel processors in the 1970s).

The most critical action a machine code definition must perform is to jump to the next command. My solution is to use the NOOP word whose behaviour does nothing but jump to the next word to execute. We find the CFA of NOOP and take the contents to find the first executable 8086 instruction:

' NOOP CFA @ 

NOOP is just a single byte jump instruction followed by an 8-bit displacement. Because it's a relative address, we need to add the address following the jump to the 8-bit displacement and because a displacement is a signed 8-bit integer, we need to perform a sign extension to find the true address for NEXT. Finally, we'll need the jump instruction that can handle a 16-bit displacement, which is code 233. This gives us the following, new definitions:

: SXT DUP 127 > IF 256 - THEN ;
: NEXT [ ' NOOP @ DUP 1+ C@ SXT ( 2+ ) +  ] LITERAL 233 C, HERE - , ;

A simple, obvious machine code definitions to add to FIG-FORTH is a pair of shift operations, because shifts are really common operations in systems languages, but in FIG-FORTH it seems strangely absent.

To write a workable machine code definition we also need to know what 8086 registers must be preserved in Forth and which can be overwritten. The Forth.ASM assembler code from the original FIGFORTH.ZIP file tells us that SI=IP, SP points to the parameter stack, BP points to the return stack; AX must be preserved and CS, DS, SS all point to the same segment for the Forth executable. However, DX, BX, CX, DI, ES can all be freely modified. So, the shift operations will involve popping the count from the top of the stack into CX (which can be trashed); then the value into BX (which can be trashed); shifting BX by CL and then pushing the result. This gives us:

CREATE << HEX 59 C, ( pop cx) 5B C, ( pop bx)  0D3 C, 0E3 C, ( shl bx,cl) 53 C, ( push bx)
NEXT DECIMAL SMUDGE

CREATE << HEX 59 C, ( pop cx) 5B C, ( pop bx)  0D3 C, 0EB C, ( shr bx,cl) 53 C, ( push bx)
NEXT DECIMAL SMUDGE

This means we can now e.g. multiply or divide by a power of 2 over 100 cycles (20µs) faster than before :-) .

BIOS Functions

Let's go back to cursor control now. The easiest way to do that is via the BIOS functions on an IBM PC.  It turns out all the screen control functions are INT 10H BIOS functions, so by creating a generic INT10H BIOS definition, we can then simply supply all the parameters to it in a higher level Forth definition. This function will be simple and only involves popping the registers DX through to AX; then calling INT10H.  It isn't documented, but INT10H can foul up BP.

CREATE INT10H ( AX BX CX DX --)
HEX
  05A C, ( POP DX )
  059 C, ( POP CX )
  05B C, ( POP BX)
  89 C, 0F8 C, ( MOV DI,AX mod=11 reg=111=di r/m=000=AX )
  058 C, ( POP AX )
  057 C, ( PUSH DI)
  1E C, ( PUSH DS)
  55 C, ( PUSH BP [101])
  0CD C, 10 C, ( INT10H)
  5D C, ( POP BP)
  1F C, ( POP DS)
  058 C, ( POP AX)
  NEXT
DECIMAL SMUDGE

The only real complexity is that we need to load AX, but we also need to save AX too. It doesn't matter if DI gets trashed as Forth doesn't use it.

There are now quite a number of fun things we can add that use INT10H:

: AT ( R C ) SWAP 8 <<  + >R ( DX) 512 0 R> INT10H ; ( jupiter ace command for gotoxy)
; VMODE ( n -- ) 0 0 0 INT10H ; ( 0= 40 column 2= 80 column 4=cga)
: CLS  1536 15 0 1999 INT10H 0 0 AT ;

So, we can do 0 VMODE then 1536 HEX 1E00 0 1827 DECIMAL INT10H to put the screen into a 40 column mode with yellow text on a white background.



And with these commands, we can now write a full-screen editor!

Wednesday, 7 July 2021

Fig-Forth At PC=Forty (Part 2)

In part 1, I talked about how to get FIG-Forth for the IBM PC running on PCjs. FIG-Forth was a popular public-domain version of the Forth systems programming language and environment during the early 1980s, which offered a high degree of control, incredible compactness and a performance much better than the ubiquitous language BASIC and although quite a bit slower than assembler, comparable with high level language compilers of the day.

I Need An Editor

I found it was possible to copy and paste text from an editor into PCjs (actually, I simply copied it from the blog post as I was writing it), but it's quite an awkward way to program in Forth. I really want to be able to write code and store it on the emulated PC's disk.

And that's a problem for two reasons. Firstly, the FIG-Forth implementation I have is fairly minimalistic, with no text editor and just the raw disk block operations.

FIG-Forth is weird in that sense, because it was designed with a view to be the OS, language and editor. It doesn't really have any concept of a file system, just raw, absolutely addressed 0.5kB (or however big the disk sector is) disk blocks that can be read (into an in-memory cache) and written. Yet the executable is an MS-DOS program which is dependent on a file system, that absolutely can't be messed up by FORTH itself.

I Once Had a PC FIG-Forth

Some slightly later FORTHs fixed this by allowing users to create files and then access blocks within those files. I picked up one of those during the public-domain disk mail-ordering era of the later 1980s. It came on a single 360kB MSDOS disk (maybe 2) and was actually very complete, with a substantiative editor; maths libraries; libraries for handling more than 64kB; a string library and possibly hooks into MSDOS. I think maybe it even had a full-screen editor.

In FIG-Forth a screen itself always refers to 1kB of editable text, made from consecutive blocks, which is roughly the size of typical microcomputer screens ( 64x16 or eg 40x25). This Forth's screen editor was an overtyping editor, which meant that typing didn't insert characters, but simply replaced whatever was at the cursor position. However, I think you could copy lines around the screen which helped. Because the screen editor worked on a fixed character grid, it would have been extremely wasteful to type code in with the kind of indentations we would use today, instead definitions would spread out as much as possible.

I ordered that PC-based FIG-Forth while at University on a whim, because I liked Forth; having learned it on a Jupiter Ace and played with a version or two on a ZX Spectrum (Abersoft Forth). However, at the time, I was at the University Of East Anglia where the computer science course wasn't PC based. Instead we did all our course material on a DEC Vax (or Micro Vax I) or on early Macintosh computers (512kB, Mac Plus and later Mac II); or on Sun Workstations. Literally, nobody was interested in PCs even though the rest of the world had largely switched to them. And why would we? We already had access to a variety of graphical environments and PCs just felt like a step into the past.

But FIG-Forth for the PC did pique my interest which is why I tried it out.

The Solution

So, my solution is fairly simple. To avoid this new FIG-Forth on PCjs from overwriting MS-DOS files I'll simply swap the disk to a different one once I've run FORTH.EXE. It doesn't matter what I use for the image, I can just clone the existing disk, because Forth just cares about the sectors and I can just overwrite what I want.

There are standard line-oriented editors for Forth, but I'm not really interested in them (they're a pain), but I think a screen-oriented editor would be OK. However, to bootstrap that I'll have to write a simple line editor on one screen; then write my full-screen editor on another screen, so that I can then load my full-screen editor without needing the line editor.

All my line editor will be able to do is copy the rest of the command line of text from the input terminal to a specified line of text in the currently edited block and update it. Super-simple! Because screens map to multiple blocks, we need to specify the screen we want to edit and that's held in the variable SCR, which gets updated when we type n LIST.

To modify line l of the current block I'll add a word called EDL which would be used as:

l EDL : BM1 ." S" 10000 0 DO LOOP ." E" ;

At the end, EDL updates the block to say it's been edited. I can choose other screens to edit using LIST as much as I want - forth will cache them in its block buffers and write them back to disk as needed. 

I'll also need to know how much I can write on the current line so text doesn't get truncated, so I'll add a command EDMAR which displays the margins. This means I need two commands as follows:

: EDMAR
  SPACE
  55 49 DO ." ....:...." I EMIT LOOP
  ." ...."
;

: EDL ( l --)
  15 AND 8 /MOD SCR @ B/SCR * + BLOCK
  SWAP C/L * + DUP C/L BL FILL ( clear line )
  IN @ TIB @ + DUP 64 + SWAP DO ( dst I= maxTib tib )
    I C@ -DUP IF
 OVER C! 1+
    ELSE
 I IN ! LEAVE
    THEN
  LOOP
  UPDATE DROP
;

So, a bit of an editing session might look like:




Of course, I'll want to put these two commands as my first two definitions on my first editable block, though in reality I chose block 50. Does this code work? Yes, because I corrected the bugs before publishing it ;-) . When I've finished editing though I should type FLUSH to copy any remaining buffers back to disk and save the disk on my local computer so nothing gets lost. When I boot up Forth again, I'll mount that disk; then I'll type LOAD to compile the code back from source.

In the future I might modify FIG-FORTH to be standalone (or add commands so that I can use it with MS-DOS). If it's standalone, I'll allow 1kB at the beginning of the disk as a bootstrap, then 16kB for the Forth executable; so the first editable block will be number 17. 

Conclusion

FIG-FORTH and most early Forth editors were crude line-oriented things which I hate, so I've no intention of just loading up those early Forth editors even though might be relatively easy. Instead I've written a minimalistic editor which I'll use to bootstrap the better editor. That's also one of the good things about Forth, if you don't like what you've got - roll something you do.

FIG-FORTH for the PC (and early FORTHs) were also very (in my opinion) clumsy systems for handling files with zero integration with the operating system, in this case MS-DOS 2.0. This version of FIG-FORTH is odd, because it runs under MS-DOS, but can't edit code on MS-DOS disks. So, I'll use an empty disk for this purpose.

Saturday, 3 July 2021

Fig-Forth At PC=Forty (Part 1)

Fig-Forth was a dialect of the up-and-coming systems language from the late 1970s and into the early 1980s. Forth itself was notable for becoming the standard language to control radio telescopes, but Fig-Forth was an attempt to produce an open-source version of the language easily ported to different processors.

And indeed that's what happened: within a few years it had been ported from the pdp-11 to a number of 8 bit CPUs like the 6502, the RCA 1802 (which was used on a number of space probes), the Intel 8080, the Zilog Z80 and later back up to a new generation of 16-bit microprocessors like the Intel 8086 and Motorola 68000. You can see the the list of popular (for the time) CPUs it used to run on here.

The point of this blog (series, maybe), though is to experiment with Fig-Forth for the original 8088-based IBM PC, because that landmark computer is 40 years old this year and I thought it would be interesting to plunge back into a development environment from that era.

The first step is to find a suitable emulator. I chose an IBM PC 5150 emulator from PcJs.org. I chose this emulator above some other small machine emulators, partly because it means you can try out my experiments for yourself under the browser you're reading this on, but primarily because the PcJs emulators run at the actual speeds of the computers they're emulating (roughly - I think the disk access is faster). Finally, PcJs works with raw image files for disks and they can be created with the dd command under Linux.

Imaging Fig-Forth

Although I could download the PC version of Fig-Forth from the Fig-Forth website. My MacBook (under Catalina) wouldn't expand it using the gui-based archiver, but it turns out you can use the command line unzip FIGFORTH.ZIP to expand the contents.

This Fig-Forth is designed for MS-DOS version 2.0 onwards, which came out 2 years later than the PC itself; so my quest for authenticity isn't perfect. I'll just have to console myself with the idea that an original PC could have run it.

So, the next step is to generate a suitable disk image. Again that's fairly easy. All I need to do is boot the PCJS 5150 PC with a disk image and then save it. I can then mount it on the Mac and drop the FORTH.EXE into it.



Finally, I can run Fig-Forth. Unfortunately, that doesn't work. Although Fig-Forth only uses 16kB, and the PC has 64kB which would be plenty on an 8-bit machine; it's not enough for Fig-Forth!

It turns out I needed to refresh the page too, pressing the reset button wasn't good enough. The next memory size is 96kB and that does work.

Running Fig-Forth

The 8088 is a much better processor for running Fig-Forth on than pretty much any 8-bit CPU, because the 8088 has far more 16-bit registers than 8-bit CPUs, a full set of 16-bit ALU operations. However, the 8088 still needs far more instructions than e.g. a 6809 to execute the inner interpreter:

NEXT:
LODSW ;AX <- (IP)
MOV BX,AX
NEXT1: MOV DX,BX ; (W) <- (IP)
INC DX ; (W) <- (W) + 1
JMP WORD PTR [BX] ; TO `CFA'

Which, coupled with the fact that the 8088 is a crippled 8086 and individual instructions are longer means that PC Forth isn't particularly fast. We can compare it with the Jupiter ACE / Fignition Forth benchmarks I published a little while ago:

They are (and thankfully, the code can be copied and pasted into the PC emulator):

: BM1 CR ." S"  10000 0 DO LOOP  ." E" ;
: BM2  CR ." S"  0 BEGIN  1+ DUP 9999 >  UNTIL DROP  ." E" ;
: BM3  CR ." S"  0 BEGIN  1+ DUP DUP / OVER  * OVER + OVER -
  DROP DUP 9999 >  UNTIL ." E"  DROP ;
: BM4  CR ." S"  0 BEGIN  1+ DUP 2 / 3  * 4 + 5 - DROP DUP
  9999 > UNTIL  ." E" DROP ;
: BM5SUB ;
: BM5  CR ." S" 0 BEGIN  1+ DUP 2 / 3  * 4 + 5 - DROP BM5SUB
  DUP 9999 > UNTIL  ." E" DROP ;
: BM6  CR ." S" 0 BEGIN  1+ DUP 2 / 3 * 4 + 5 -  DROP BM5SUB
  5 0 DO LOOP  DUP 9999 > UNTIL  ." E" DROP ;
5 ARR M [*]
: BM7  CR ." S" 0 BEGIN  1+ DUP 2 / 3 * 4 + 5 -  DROP BM5SUB
  5 0 DO DUP I M ! LOOP  DUP 9999 > UNTIL  ." E" DROP ;
: BM1F  10000 0 DO  10.9 9.8 F+ 7.6 F-  5.4 F* 3.2 F/  2DROP  LOOP ;
: BM3L  0 10000 0 DO  I + NEG [**] I AND  I OR I XOR  LOOP DROP ;

[* this needs an extra definition:  : ARR <BUILDS DUP + ALLOT DOES> OVER + + ; ]
[** MINUS is used instead of NEG]

 BMx
 Jupiter-Ace (fast mode)
 (FIGnition 1.0.0)
 PC FIG-FORTH  PC vs Ace
 PC FIG-FORTH vs BASICA
 BM1  1.6  0.0116  0.43  3.7  22
 BM2  0.54  0.046  0.22  2.5  15.7
 BM3  7.66  0.218 2.09  2.6  4.2
 BM4  6.46  0.228  2.04  2.4  4.4
 BM5  6.52  0.252  2.09  3.1  4.7
 BM6  7.38  0.320  2.43  3.0  7.0
 BM7  12.98  0.660  3.30  3.9  8.2
 BM3L  1.0  0.034  0.27  3.7  N/A
 BM1F  14.18  0.33  N/A  N/A  N/A
     Mean
    3.11  9.46
 Mean (subsets) BM1.. BM7 22.4  BM1.. BM3L  23.3  N/A

And so it looks like an IBM PC running FIG-Forth is about 3x faster than a Jupiter ACE. Probably the most telling tests are BM1, which represents 10K loops in 0.43s. This means a single Loop takes about 43µs, or about 200 clock cycles. BM3 adds a division, multiplication, addition and subtraction and 4 stack ops, i.e. 8 extra instructions. That adds 2.96-0.43 = 2.53s / 80000 = about 31.6µs per operation.

By contrast, it means FIG-Forth is perhaps 10x slower than assembler, or perhaps 5 to 10x faster than BASIC, or BASICA (which means Advanced Basic). FIG-Forth is relatively slow, because of the seemingly pointless MOV DX,BX; INC DX instructions.

Conclusion

FIG-Forth was an early public-domain systems language designed to run as the language and Operating System for a small computer, in as little as 16kB or so. Thanks to the increased memory needs of 16-bit CPUs and their OS's and the trend towards running Forth on a mainstream OS; 64kB isn't enough for a 16kB FigForth (though it is large enough for BASICA, which is a larger executable); I had to increase the PC's memory to 96kB (though I would have guessed 80kB would be big enough).

Prior to using PCJS I attempted to use a few different emulators including DosBox and Tiny8086, but neither seemed to have easily defined accurate timings.

Development environments from the past and the computers themselves were always fast enough and lean enough, because developers adjusted the implementations to match the capabilities of the hardware; despite the machines themselves being around 100,000x slower than modern computers. Nevertheless, it's fair to use modern facilities (such as being able to paste code into the emulator) to make our lives easier.

Thursday, 31 December 2020

#rEUnion Manifesto

 Now we've left the EU, I thought I'd write a bit of a blog post on what I think should be the priorities for being able to re-join the EU at some point in the future. I want to start with an assessment of how we got here, as well as a step-by-step manifesto for how we get back. This will take a long time, perhaps a decade or two (it took nearly five decades for Euroskeptics to engineer our exit) so we need to plan strategically for that kind of distance.

Why We Are Here

The easiest explanation for why the UK has split from the EU is that we're following a parody of the 1930s. In a much earlier blog post from 2008 on the subject of the global crash. Here I wrote:

 "The 1929 Crash was a culmination of 5 years of massive stock market growth which was ultimately boosted by heavy speculative investment. The market initially recovered over the next several months of 1930, but this was not enough to prevent the subsequent Great Depression and corresponding global recessions in Britain and more importantly in Germany (where the economic (and social) instability lead directly to the the rise in power of extreme political parties and subsequently the Nazi dictatorship and World War II)."

"So, when we come to look at the Crunch we actually see the hallmarks of previous crashes all over again. We see deregulated markets leading to a financial boom and subsequent serious bust."
"What we can predict is that this is only the start of the problem"

You can read the rest in the actual blog post itself. My concern at the time - although I didn't state it directly, because I didn't think that governments would actually do it, was that we would follow the same path as the 1930s, because we know what happened then.

However, I was wrong. In reality we followed pretty much exactly the same path, with the exception of the US for the first 8 years and the UK for the first two years which implemented a half-baked Keynesian solution which refinanced banks at the expense of refinancing people. In the EU they followed the path of austerity.

The Five Steps Of Failure

The 1930s followed a basic pattern which we've been roughly copying. This can be summarised as:

  1. A global crash which lead nations to..
  2. Implement austerity in order to 'manage' their finances.  This is a classic right-wing economic approach which treats national economies like domestic economies. It cannot be emphasised enough that it doesn't work. I have a blog entry from 2015 which explains why they are not the same. Nevertheless, the EU imposed austerity (or SAPs) from 2009 and the UK imposed it on itself from 2010. In reality austerity causes..
  3. People to react by becoming more politically extreme, in particular by shifting towards right-wing Nationalism. I think the reasons for this are pretty simple. When people are faced with austerity, they spend far more of their time looking after their immediate needs and so their cognitive horizons shrink. In essence austerity prevents people from looking at the wider problems and so people are lead to more populist, political thinking: simple immediate solutions rather than complex wider solutions. But right-wing nationalism has the edge, because the shrinking of horizons forces a more nationalistic viewpoint. What happens outside of those horizons is threatening. This leads to..
  4. The destabilisation of Europe. In Austerity Europe of the 1920s (post Versailles) and 1930s (post Wall Street Crash), both phases lead to destabilisation from Fascist governments. Italy broke away in the 1920s under Mussolini and Spain entered a (partly Nazi supported) civil war in the early 1930s. And of course Germany went Nazi in the very early 1930s. But the same patterns of political destabilisation appeared across Europe and the US; ranging from Oswald Moseley's Black Shirts to the America First movement in the US. Europe was destabilised.
  5. Ultimately, because Nationalist governments have a relatively local focus, they are lead into conflict with either themselves or other countries. So, the whole process ended with War.

Now, it's understandable that the EU, if lead largely by Germany (which I think essentially has control of the Eurogroup) would choose austerity, rather than Keynesianism. And the reason is that from the German perspective in the early 1920s, the reaction to the conditions for the Treaty of Versailles was to print money. It was this printing of money that lead to hyper-inflation and the emergence of Nationalist and subsequently fascist groups like, obviously the National Socialists. Thus Germany, in particular its Ordoliberal school of economics has a deep aversion to non-austerity: they believe in keeping a tight control over money, but this is, at least in some circumstances, like this one, the wrong lesson.

With the final step of Brexit under a hard right, nationalist government we are fully into Stage 4. It's taken a whole decade of austerity to get there (cf 1919 to 1929) and there's been a lot of resistance, but it's safe to say we're at the beginning of step 4 now.

The important thing to note in all of these, even above the individual steps is that the further we progress with them, the harder it is to turn around and recover.

So, in the 1930s, the US recovered first because it didn't go very far down step 2. It pursued poor policies during the Hoover period (Dust Bowl, great depression), but then FDR was elected and he instituted the New Deal, which dug the US out of its mess, thus avoiding steps 3 to 4 (though there were plenty of elements of 3 in the US of the 1930s).

The UK managed to take some steps in the late 1930s towards economic recovery, but was still partially in the grip of appeasement (i.e. Nazi Sympathy) at the outbreak of World War 2.

The Manifesto

1. A Common Understanding Of The Root Problem

Without being able to agree on the five steps above, we cannot agree on the root cause of the problem. At the moment the pro-EU movement has literally no agreement. The consequence of this, for example, means that because we don't think austerity is the primary cause that lead to World War 2 (and there are other, specific concrete political critical events and causes), we have no insight into the underlying forces that drove Brexit and no map for where we're heading. For us, Brexit came out of nowhere - just individual Euroskeptics who forced a decision on the Conservative party. That was something we wouldn't have predicated. Also, we don't know what's coming next, because we only see the problem in terms of the issues Brexit presents us as a country, in other words, we have a Nationalistic view of Brexit where the EU plays the part of the good guys and we're constantly reacting to the situation.

And our myopic view of the EU as "the good guys" is what also prevents us from criticising the EU (or rather in this case the Eurogroup) where it is part of the problem. i.e. because the Eurogroup is pro-austerity, British Europhiles are pro-austerity. This position has to be rejected. By rejecting austerity as reasonable reaction to the crash of 2008 Centrists will be able to work together with left-wing Europhiles (though it'll be harder to work with right-wing Europhiles).

But to re-iterate, without a common unerstanding of the root problem, we have no control over Brexit.

2. A Common Narrative

The Remain campaign and Remain movement, to this day, 5 years later is obsessed with economic technicalities as a foundation for EU membership. This is a mistake.

The primary reason why Brexiters won was because they have a narrative about Britain as the plucky buccaneers that can do anything when not hindered by the continent. The EU plays the part of the oppressive King or evil dictator and Brexit is about being free of that. All Brexiter arguments are driven by this sense of identity, even though it's inaccurate.

For us to regain the initiative we have to have a narrative about Brtain as belonging with the EU. We need a narrative that says that our natural place is alongside the rest of the continent: helping to make its decisions; supporting it at every step; sharing with its culture, its history, its people, its languages and its purpose of diversity, responsibility and liberation.

Note how 'belonging with' is emphasised. The 'with' is important because we need to convey a peer relationship, not a subservient relationship.

3. Addressing Media Responsibility and Accountability

This is a short point. 80% of the media by print during the referendum was owned by tax-dodging pro-Brexit billionaires. Unless this changes we'll almost certainly lose again. Basically we need a law that's comparable to media laws in some of the rest of Europe where firstly, the ownership is based on a Trust which provides a remit for the media's general political flavour (it's OK to be right-wing or left-wing, it's not OK to just be a mouthpiece for the proprietor). The paper itself should be worker owned by the journalists and readers. This applies to whatever form of media is relevant in the future.

Secondly, there needs to be some level of accountability whereby the media can play fast and loose with facts the way it happened with the referendum. For example, to force media to redisplay corrections with the same prominence of the original erroneous articles.

4. Guerrilla Ops (Picking Battles We Can Win)

Ultimately we need to get back in the EU, but in the same sense that Euroskeptics fought a number of minor battles, most of which were fabrications or merely symbolic and most of which they lost.

But to keep up some kind of morale we should pick fights we can win. I would suggest that the first fight we pick is one over Metrification. Arch Brexiters want us to return to Imperial measurements. JRM, for example has mandated imperial units be used in all his correspondence. I would have thought that at the earliest opportunity, they will try and revert back to Imperial measurements for general use.

We should stop this and push back, to get everyone using metric in ordinary day-to-day activities and communications as well as all formal information. Dump Imperial at all levels.

We can win this one too. That's because:
  1. We've gotten used to talking in terms of metres over the past year in a way we never did before.
  2. Educational establishments in the UK will back us up: they won't be bothered, particularly in sciences, to backtrack on 50 years of progress.
  3. Industry will back us, because Imperial units have a direct financial cost. 
  4. The NHS could back us, by switching to e.g. only giving out metric weights for children.

5. Building a Shadow EU in the UK

We should start preparing for a future with the EU, and the way to do that is to build business and cultural resilience. Even though the Brexit deal is thin, it provides for British companies to adhere to EU standards. Thus, by building networks of British companies that operate on that basis, these companies will be forced to exclude business that breaks those rules: they gain financially by EU commerce and companies that don't will find it harder to compete, despite the UK government's attempts to tip the level playing field.

My suggestion for a name: BEBA: the British European Business Alliance.

BECA would be the cultural counter part. The New European could provide the basis for educational material to provide holidays, cultural exchanges and language tuition and importantly instil more of a sense of European identity in the young until the point when we have #rEUnion.

6. Proportional Representation

Remainers failed in the General election in 2019 for a whole host of reasons, but the simplest is that we failed to collaborate in our opposition to the Conservative and Brexit party and they went onto win the election on just 43% of the vote.

The next election will be easier for the Conservatives than this one, because possibly Scotland will be leaving the UK by then and constitutional boundary changes will lead to a net loss of over 20 current Labour seats.

Therefore it will be more imperative for Labour to collaborate with other opposition parties in the 2025 (or 2024) election, against an environment friendlier towards electioneering since the Electoral Commission's powers will have been curtailed by the Conservatives in the intervening period.

The only way I can see for Labour to gain the confidence of other parties is to promise proportional representation if they win - and the form of PR must be specified so that Labour can't pull the same trick the Conservatives pulled after the 2010 election, where a PR referendum was held, but only AV was an option. Future edits to this post will include more references and possibly diagrams!

7. A Robust Mechanism For A New Referendum

With steps 1 to 6 in place, we would finally be in a suitable position for a fair referendum, along the lines of the one held in 1975, which was based on facts rather than propaganda. Media balance would be better, representation of the people would be more equitable; relationships with the EU would be coherent and ready for re-admittance; cultural affinity for the EU and Europe would be higher; we'd have a UK narrative that would fit into EU membership and rEUnion groups would be more easily able to work together.

8. A Formal British Constitution

Finally, and within the EU, a reformed UK constitution could be defined to make it harder, much harder for the UK to be subverted in the way it was up through the Brexit referendum. Part of the reason why we belong with the EU is because of the checks and balances it provides, but the same applies domestically. There's never a substitute for active participation in politics, but the mechanisms within the state should facilitate both representation and accountability in such a way as to protect both security and prosperity for the people.

Conclusion

We've lost every battle since 2008, primarily because we lack an insight into the wider picture and a model for what to expect. We can't get to #rEUnion by carrying on as we are, with the same arguments. Instead we need to find a common framework for why we're here; a common EU centric narrative for the UK that embodies us belonging with it and finally a strategy that addresses all the institutional failings that prevented us from being about to mount a robust defence of our existing constitution.

The end result should put the UK on a much firmer foundation for the good of all within and without the UK, for the rest of the 21st century.