BCPL: The pieces needed to run the BCPL 2 kit on Fuzix
authorAlan Cox <alan@linux.intel.com>
Fri, 18 Mar 2016 18:11:08 +0000 (18:11 +0000)
committerAlan Cox <alan@linux.intel.com>
Fri, 18 Mar 2016 18:11:08 +0000 (18:11 +0000)
You will need a bit over 50K of TPA at the moment in order to run this,
but that is sufficient to actually recompile the compiler.

See the README

Applications/BCPL/Makefile [new file with mode: 0644]
Applications/BCPL/README [new file with mode: 0644]
Applications/BCPL/blib.c [new file with mode: 0644]
Applications/BCPL/blib.h [new file with mode: 0644]
Applications/BCPL/blib16.b [new file with mode: 0644]
Applications/BCPL/blib16.i [new file with mode: 0644]
Applications/BCPL/icint.c [new file with mode: 0644]

diff --git a/Applications/BCPL/Makefile b/Applications/BCPL/Makefile
new file mode 100644 (file)
index 0000000..05038cf
--- /dev/null
@@ -0,0 +1,23 @@
+#
+#      IntCode engine
+#
+
+FCC = fcc
+FCCOPTS = -O2 #--nostdio
+PLATFORM =
+
+SRC = icint.c blib.c
+OBJ = $(SRC:.c=.rel)
+
+.SUFFIXES: .c .rel
+
+all: icint
+
+.c.rel:
+       $(FCC) $(PLATFORM) $(FCCOPTS) -c $<
+
+icint: $(OBJ)
+       $(FCC) $(PLATFORM) $(FCCOPTS) -o $@ $(OBJ)
+
+clean:
+       rm -f icint *.rel *.asm *.lst core *.sym *.map *.noi *.lk *.ihx *.tmp *.bin *~
diff --git a/Applications/BCPL/README b/Applications/BCPL/README
new file mode 100644 (file)
index 0000000..888a283
--- /dev/null
@@ -0,0 +1,87 @@
+This is a port of Robert Nordier's cint implementation to 16bit. Mostly it's
+a clean-up of all the signed/unsigned handling errors that are invisible in
+the 32bit version.
+
+Because this is a 16bit version you will also need to concatenate the supplied
+.i files for the compiler with the included blib16.i not the supplied blib.b
+which is blib modified for 16 rather than 32bits and is derived from the
+original BCPL distribution.
+
+For the BCPL kit see:
+http://www.nordier.com/software/bcpl.html
+
+Performance on the whole is pretty bad. Much of that is because SDCC doesn't
+generate particularly good code for this. It is however possible to
+recompile BCPL with it if you have a free weekend.
+
+Various things would improve the performance I suspect such as using local
+variables for some of the key pointers so SDCC makes them register pairs
+would help no end.
+
+
+How To Use
+----------
+
+The BCPL compiler produces OCODE in a file called OCODE. The cg code
+generator turns this into INTCODE which is a sort of assemblerish thing.
+
+There is no linker. Just cat the INTCODE files together in any order, the
+BCPL globals do all the magic!
+
+The BCPL kit comes with the BCPL (.b) files and the compiled intcode .i
+files for the compiler itself. So you can can
+
+cat cg.i blib16.i iclib.i > codegen.i
+cat syn.i trn.i blib16.i iclib.i > b.i
+
+Now you can do
+
+icint b.i <file.b
+icint codegen 
+
+and INTCODE contains your output file to run.
+
+Thus once you've written a minimal INTCODE interpreter for your system you
+have effectively fully bootstrapped the compiler and you can now write an
+OCODE or INTCODE to native code generator, then bootstrap the compiler with
+that to get a native compiler.
+
+In the FUZIX 8bit case it's a bit more complicated. While native code
+support will be a nice addition it's also going to be less compact so things
+like BCPL won't actually fit. The later compilers use a thing called
+CINTCODE which is much uglier but was designed to be compact on 8bit
+machines and run at a bearable speed. This was used for things like the BBC
+Micro BCPL environment. INTCODE is more reflective of older eras and word
+addressed machines.
+
+Probably what we actually need (if anyone really cares) is an INTCODE to
+something-saner and more compact bytecode convertor with a separate runtime
+engine.
+
+BCPLKIT COPYRIGHT
+-----------------
+
+Most of the files here are taken from a BCPL compiler kit distribution
+dating from the early 1980s.  None of the files bears a copyright
+notice in the original, but -- on the basis of other files in the
+distribution -- it seems reasonable to assume these are:
+
+   (c) Copyright 1978-1980 Tripos Research Group
+       University of Cambridge
+       Computer Laboratory
+
+Changes and additions are
+
+    (c) Copyright 2004, 2012 Robert Nordier
+
+and are freely redistributable.
+
+Robert Nordier
+www.nordier.com
+
+For more on BCPL see
+
+http://www.cl.cam.ac.uk/users/mr/BCPL.html
+
+Note that BCPL is not free software although it is available as a source
+release free for private or academic use.
diff --git a/Applications/BCPL/blib.c b/Applications/BCPL/blib.c
new file mode 100644 (file)
index 0000000..7f40677
--- /dev/null
@@ -0,0 +1,163 @@
+/* Copyright (c) 2004 Robert Nordier.  All rights reserved. */
+
+/* $Id: blib.c,v 1.5 2004/12/11 11:55:14 rn Exp $ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include "blib.h"
+
+#define FTSZ 20
+
+extern uint16_t *M;
+
+static int ft[FTSZ];
+static int fi, fo;
+
+uint16_t getbyte(uint16_t s, uint16_t i)
+{
+    uint16_t n = M[s + i / 2];
+    if (!(i & 1))
+        n >>= 8;
+    return n & 0xFF;
+}
+
+void putbyte(uint16_t s, uint16_t i, uint16_t ch)
+{
+    uint16_t *p = M + s + i/2;
+    if (i & 1) {
+        *p &= 0xFF00;
+        *p |= (uint8_t)ch;
+    } else {
+        *p &= 0x00FF;
+        *p |= ch << 8;
+    }
+}
+
+static char *cstr(uint16_t s)
+{
+    char *st;
+    int n, i;
+
+    n = getbyte(s, 0);
+    st = sbrk(n + 1);
+    if (st == (char *)-1) {
+        write(2, "OOM\n", 4);
+        exit(1);
+    }
+    for (i = 1; i <= n; i++)
+        st[i - 1] = getbyte(s, i);
+    st[n] = 0;
+    return st;
+}
+
+static int ftslot(void)
+{
+    int i;
+
+    for (i = 3; i < FTSZ; i++)
+        if (ft[i] == -1)
+            return i;
+    return -1;
+}
+
+void initio(void)
+{
+    int i;
+    ft[0] = 0;
+    ft[1] = 1;
+    ft[2] = 2;
+    for (i = 3; i < FTSZ; i++)
+        ft[i] = -1;
+    fi = 0;
+    fo = 1;
+}
+
+int16_t findinput(uint16_t s)
+{
+    char *st = cstr(s);
+    int x;
+
+    x = ftslot();
+    if (x != -1) {
+        ft[x] = open(st, O_RDONLY);
+        if (ft[x] == -1)
+            x = -1;
+    }
+    brk(st);
+    return x + 1;
+}
+
+int16_t findoutput(uint16_t s)
+{
+    char *st = cstr(s);
+    int x;
+
+    x = ftslot();
+    if (x != -1) {
+        ft[x] = open(st, O_WRONLY|O_CREAT|O_TRUNC, 0666);
+        if (ft[x] == -1)
+            x = -1;
+    }
+    brk(st);
+    return x + 1;
+}
+
+void selectinput(int16_t x)
+{
+    fi = x - 1;
+}
+
+void selectoutput(int16_t x)
+{
+    fo = x - 1;
+}
+
+int16_t input(void)
+{
+    return fi + 1;
+}
+
+int16_t output(void)
+{
+    return fo + 1;
+}
+
+int16_t rdch(void)
+{
+    char c;
+    if (read(ft[fi], &c, 1))
+        return c;
+    return -1;
+}
+
+void wrch(int16_t c)
+{
+    char cv = c;
+    write(ft[fo], &cv, 1);
+}
+
+void endread(void)
+{
+    if (fi > 2) {
+        close(ft[fi]);
+        ft[fi] = -1;
+    }
+    fi = 0;
+}
+
+void endwrite(void)
+{
+    if (fo > 2) {
+        close(ft[fo]);
+        ft[fo] = -1;
+    }
+    fo = 1;
+}
+
+void mapstore(void)
+{
+    fprintf(stderr, "\nMAPSTORE NOT IMPLEMENTED\n");
+}
diff --git a/Applications/BCPL/blib.h b/Applications/BCPL/blib.h
new file mode 100644 (file)
index 0000000..c0eb088
--- /dev/null
@@ -0,0 +1,23 @@
+/* Copyright (c) 2004 Robert Nordier.  All rights reserved. */
+
+/* $Id: blib.h,v 1.3 2004/12/11 11:27:20 rn Exp $ */
+
+#ifndef BLIB_H_
+#define BLIB_H_
+
+uint16_t getbyte(uint16_t, uint16_t);
+void putbyte(uint16_t, uint16_t, uint16_t);
+void initio(void);
+int16_t findinput(uint16_t);
+int16_t findoutput(uint16_t);
+void selectinput(int16_t);
+void selectoutput(int16_t);
+int16_t input(void);
+int16_t output(void);
+int16_t rdch(void);
+void wrch(int16_t);
+void endread(void);
+void endwrite(void);
+void mapstore(void);
+
+#endif
diff --git a/Applications/BCPL/blib16.b b/Applications/BCPL/blib16.b
new file mode 100644 (file)
index 0000000..5acef0f
--- /dev/null
@@ -0,0 +1,102 @@
+// $Id: blib.bcpl,v 1.3 2004/12/21 13:08:58 rn Exp $
+
+//   BLIB
+
+GET "LIBHDR"
+
+LET WRITES(S) BE  FOR I = 1 TO GETBYTE(S, 0) DO WRCH(GETBYTE(S, I))
+
+AND UNPACKSTRING(S, V) BE
+         FOR I = 0 TO GETBYTE(S, 0) DO V!I := GETBYTE(S, I)
+
+AND PACKSTRING(V, S) = VALOF
+    $( LET N = V!0 & 255
+       LET I = N/2
+       FOR P = 0 TO N DO PUTBYTE(S, P, V!P)
+       SWITCHON N&1 INTO
+       $(
+          CASE 0: PUTBYTE(S, N+1, 0)
+          CASE 1: $)
+       RESULTIS I  $)
+
+// THE DEFINITIONS THAT FOLLOW ARE MACHINE INDEPENDENT
+
+AND WRITED(N, D) BE
+
+$(1 LET T = VEC 20
+    AND I, K = 0, N
+    TEST N<0 THEN D := D-1 ELSE K := -N
+    T!I, K, I := K REM 10, K/10, I+1 REPEATUNTIL K=0
+    FOR J = I+1 TO D DO WRCH('*S')
+    IF N<0 DO WRCH('-')
+    FOR J = I-1 TO 0 BY -1 DO WRCH('0'-T!J)  $)1
+
+AND WRITEN(N) BE WRITED(N, 0)
+
+
+AND NEWLINE() BE WRCH('*N')
+
+AND NEWPAGE() BE WRCH('*P')
+
+AND READN() = VALOF
+
+$(1 LET SUM = 0
+    AND NEG = FALSE
+
+L: TERMINATOR := RDCH()
+    SWITCHON TERMINATOR INTO
+    $(  CASE '*S':
+        CASE '*T':
+        CASE '*N':    GOTO L
+
+        CASE '-':     NEG := TRUE
+        CASE '+':     TERMINATOR := RDCH()   $)
+    WHILE '0'<=TERMINATOR<='9' DO
+                 $( SUM := 10*SUM + TERMINATOR - '0'
+                    TERMINATOR := RDCH()  $)
+    IF NEG DO SUM := -SUM
+    RESULTIS SUM   $)1
+
+AND WRITEOCT(N, D) BE
+    $( IF D>1 DO WRITEOCT(N>>3, D-1)
+       WRCH((N/\7)+'0')  $)
+
+AND WRITEHEX(N, D) BE
+    $( IF D>1 DO WRITEHEX(N>>4, D-1)
+       WRCH((N&15)!TABLE
+            '0','1','2','3','4','5','6','7',
+            '8','9','A','B','C','D','E','F')  $)
+
+
+AND WRITEF(FORMAT, A, B, C, D, E, F, G, H, I, J, K) BE
+
+$(1 LET T = @A
+
+    FOR P = 1 TO GETBYTE(FORMAT, 0) DO
+    $(2 LET K = GETBYTE(FORMAT, P)
+
+        TEST K='%'
+
+          THEN $(3 LET F, Q, N = 0, T!0, 0
+                   AND TYPE = GETBYTE(FORMAT, P+1)
+                   P := P + 1
+                   SWITCHON TYPE INTO
+                $( DEFAULT: WRCH(TYPE); ENDCASE
+
+                   CASE 'S': F := WRITES; GOTO L
+                   CASE 'C': F := WRCH; GOTO L
+                   CASE 'O': F := WRITEOCT; GOTO M
+                   CASE 'X': F := WRITEHEX; GOTO M
+                   CASE 'I': F := WRITED; GOTO M
+                   CASE 'N': F := WRITED; GOTO L
+
+                M: P := P + 1
+                   N := GETBYTE(FORMAT, P)
+                   N := '0'<=N<='9' -> N-'0', N-'A'+10
+
+                L: F(Q, N); T := T + 1  $)3
+
+            OR WRCH(K)  $)2  $)1
+
+
+AND MAPSTORE() BE WRITES("*NMAPSTORE NOT IMPLEMENTED*N")
diff --git a/Applications/BCPL/blib16.i b/Applications/BCPL/blib16.i
new file mode 100644 (file)
index 0000000..ff8d634
--- /dev/null
@@ -0,0 +1,45 @@
+JL13 
+$ 1 L1 SP3 LIP2 SP6 L0 SP7 LIG85 K4 SP4 JL14 15 LIP2 SP9 LIP3 SP10 LIG8/
+5 K7 SP7 LIG14 K5 LIP3 A1 SP3 14 LIP3 LIP4 X15 TL15 X4 
+$ 2 L0 SP4 LIP2 SP7 L0 SP8 LIG85 K5 SP5 JL16 17 LIP2 SP8 LIP4 SP9 LIG85/
+ K6 SP6 LIP4 AIP3 SP7 LIP6 SIP7 LIP4 A1 SP4 16 LIP4 LIP5 X15 TL17 X4 
+$ 3 L0 AIP2 X1 L255 X18 SP4 LIP4 L2 X6 SP5 L0 SP6 LIP4 SP7 JL19 20 LIP3/
+ SP10 LIP6 SP11 LIP6 AIP2 X1 SP12 LIG86 K8 LIP6 A1 SP6 19 LIP6 LIP7 X15/
+ TL20 JL21 23 LIP3 SP8 L1 AIP4 SP9 L0 SP10 LIG86 K6 24 JL22 21 L1 LIP4 /
+X18 X23 D2 DL22 D0 DL23 D1 DL24 22 LIP5 JL18 18 X4 
+$ 4 LP7 SP4 L0 SP5 LIP2 SP6 LIP2 L0 X12 FL25 LIP3 L1 X9 SP3 JL26 25 LIP/
+2 X2 SP6 26 27 LIP6 L10 X7 SP28 LIP5 AIP4 SP29 LIP28 SIP29 LIP6 L10 X6 /
+SP6 L1 AIP5 SP5 L0 LIP6 X10 FL27 L1 AIP5 SP28 LIP3 SP29 JL28 29 L32 SP3/
+2 LIG14 K30 LIP28 A1 SP28 28 LIP28 LIP29 X15 TL29 LIP2 L0 X12 FL30 L45 /
+SP30 LIG14 K28 30 LIP5 L1 X9 SP28 JL31 32 L48 SP31 LIP28 AIP4 X1 SP32 L/
+IP31 LIP32 X9 SP31 LIG14 K29 LIP28 A-1 SP28 31 LIP28 L0 X13 TL32 X4 
+$ 5 LIP2 SP5 L0 SP6 LIG68 K3 X4 
+$ 6 L10 SP4 LIG14 K2 X4 
+$ 7 L12 SP4 LIG14 K2 X4 
+$ 8 L0 SP2 L0 SP3 34 LIG13 K4 SG71 JL36 38 39 40 JIL35 41 L-1 SP3 42 LI/
+G13 K4 SG71 JL37 36 LIG71 X23 D5 DL37 D32 DL38 D9 DL39 D10 DL40 D45 DL4/
+1 D43 DL42 37 JL44 43 LIP2 L10 X5 AIG71 L48 X9 SP2 LIG13 K4 SG71 44 L48/
+ LIG71 X15 FL45 LIG71 L57 X15 TL43 45 LIP3 FL46 LIP2 X2 SP2 46 LIP2 JL3/
+3 33 X4 
+$ 9 LIP3 L1 X14 FL47 LIP2 L3 X17 SP6 LIP3 L1 X9 SP7 LIG77 K4 47 L7 LIP2/
+ X18 A48 SP6 LIG14 K4 X4 
+$ 10 LIP3 L1 X14 FL48 LIP2 L4 X17 SP6 LIP3 L1 X9 SP7 LIG75 K4 48 L15 LI/
+P2 X18 AL49 X1 SP6 LIG14 K4 X4 
+$ 11 LP3 SP14 L1 SP15 LIP2 SP18 L0 SP19 LIG85 K16 SP16 JL50 51 LIP2 SP1/
+9 LIP15 SP20 LIG85 K17 SP17 L37 LIP17 X10 FL52 L0 SP18 L0 AIP14 X1 SP19/
+ L0 SP20 LIP2 SP23 L1 AIP15 SP24 LIG85 K21 SP21 L1 AIP15 SP15 JL58 60 L/
+IP21 SP24 LIG14 K22 JL59 61 LIG60 SP18 JIL55 62 LIG14 SP18 JIL55 63 LIG/
+77 SP18 JIL57 64 LIG75 SP18 JIL57 65 LIG68 SP18 JIL57 66 LIG68 SP18 JIL/
+55 56 L1 AIP15 SP15 LIP2 SP24 LIP15 SP25 LIG85 K22 SP20 L48 LIP20 X15 F/
+L68 LIP20 L57 X15 FL68 LIP20 L48 X9 SP22 JL67 68 LIP20 L65 X9 A10 SP22 /
+67 LIP22 SP20 54 LIP19 SP24 LIP20 SP25 LIP18 K22 L1 AIP14 SP14 JL59 58 /
+LIP21 X23 D6 DL60 D83 DL61 D67 DL62 D79 DL63 D88 DL64 D73 DL65 D78 DL66/
+ 59 JL53 52 LIP17 SP20 LIG14 K18 53 LIP15 A1 SP15 50 LIP15 LIP16 X15 TL/
+51 X4 
+$ 12 LL499 SP4 LIG60 K2 X4 13 
+35 DL34 49 D48 D49 D50 D51 D52 D53 D54 D55 D56 D57 D65 D66 D67 D68 D69 /
+D70 55 DL54 57 DL56 499 C26 C10 C77 C65 C80 C83 C84 C79 C82 C69 C32 C78/
+ C79 C84 C32 C73 C77 C80 C76 C69 C77 C69 C78 C84 C69 C68 C10 
+G60L1 G67L2 G66L3 G68L4 G62L5 G63L6 G64L7 G70L8 G77L9 G75L10 G76L11 G78/
+L12 
+Z
diff --git a/Applications/BCPL/icint.c b/Applications/BCPL/icint.c
new file mode 100644 (file)
index 0000000..1bcd130
--- /dev/null
@@ -0,0 +1,355 @@
+/* Copyright (c) 2004 Robert Nordier.  All rights reserved. */
+
+/* $Id: icint.c,v 1.6 2004/12/11 12:01:53 rn Exp $ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+#include <unistd.h>
+#include <fcntl.h>
+#include "blib.h"
+
+#define VSIZE 20000
+#define MGLOB 1
+#define MPROG 402
+
+#define FALSE 0
+#define TRUE 1
+
+#define FSHIFT 13
+#define IBIT 010000
+#define PBIT 04000
+#define GBIT 02000
+#define DBIT 01000
+#define ABITS 0777
+#define WORDSIZE 16
+#define BYTESIZE 8
+
+#define LIG1 0012001
+#define K2 0140002
+#define X22 0160026
+
+#if 1
+#define itrace(x)
+#define itrace2(x,y)
+#define itrace3(x,y,z)
+#define itrace4(x,y,z, a)
+#else
+#define itrace(x)              fprintf(stderr, x)
+#define itrace2(x,y)           fprintf(stderr, x, y)
+#define itrace3(x,y,z)         fprintf(stderr, x, y, z)
+#define itrace4(x,y,z,a)       fprintf(stderr, x, y, z, a)
+#endif
+
+uint16_t *M;
+int fp;
+
+static uint16_t G;
+static uint16_t P;
+static int Ch;
+static int16_t *Labv;
+static int Cp;
+static uint16_t A;
+static uint16_t B;
+static uint16_t C;
+static uint16_t D;
+static uint16_t W;
+
+static void assemble(void);
+static void stw(uint16_t);
+static void stc(uint16_t);
+static void rch(void);
+static int16_t rdn(void);
+static void setlab(int);
+static void labref(int16_t, uint16_t);
+static int16_t interpret(void);
+static int16_t icgetbyte(uint16_t, uint16_t);
+static void icputbyte(uint16_t, uint16_t, uint16_t);
+
+static void writes(const char *p) {
+ write(1, p, strlen(p));
+}
+
+#ifdef __linux__
+static const char *_itoa(int v)
+{
+ static char buf[16];
+ sprintf(buf, "%d", v);
+ return buf;
+}
+#endif
+
+static void
+assemble(void)
+{
+    int16_t v[501];
+    uint16_t f = 0;
+    uint16_t i;
+
+    Labv = v;
+clear:
+    for (i = 0; i <= 500; i++) Labv[i] = 0;
+    Cp = 0;
+next:
+    rch();
+sw:
+    switch (Ch) {
+
+    default: if (Ch == EOF) return;
+        printf("\nBAD CH %c AT P = %d\n", Ch, P);
+        goto next;
+
+    case '0': case '1': case '2': case '3': case '4':
+    case '5': case '6': case '7': case '8': case '9':
+        setlab(rdn());
+        Cp = 0;
+        goto sw;
+
+    case '$': case ' ': case '\n': goto next;
+
+    case 'L': f = 0; break;
+    case 'S': f = 1; break;
+    case 'A': f = 2; break;
+    case 'J': f = 3; break;
+    case 'T': f = 4; break;
+    case 'F': f = 5; break;
+    case 'K': f = 6; break;
+    case 'X': f = 7; break;
+
+    case 'C': rch(); stc(rdn()); goto sw;
+
+    case 'D': rch();
+        if (Ch == 'L') {
+            rch();
+            stw(0);
+            labref(rdn(), P - 1);
+        } else
+            stw(rdn());
+        goto sw;
+
+    case 'G': rch();
+        A = rdn() + G;
+        if (Ch == 'L') rch();
+        else printf("\nBAD CODE AT P = %d\n", P);
+        M[A] = 0;
+        labref(rdn(), A);
+        goto sw;
+    case 'Z': for (i = 0; i <= 500; i++)
+        if (Labv[i] > 0) printf("L%d UNSET\n", i);
+        goto clear;
+    }
+    W = f << FSHIFT;
+    rch();
+    if (Ch == 'I') { W = W + IBIT; rch(); }
+    if (Ch == 'P') { W = W + PBIT; rch(); }
+    if (Ch == 'G') { W = W + GBIT; rch(); }
+
+    if (Ch == 'L') {
+        rch();
+        stw(W + DBIT);
+        stw(0);
+        labref(rdn(), P - 1);
+    } else {
+        uint16_t a = rdn();
+        if ((a & ABITS) == a)
+            stw(W + a);
+        else { stw(W + DBIT); stw(a); }
+    }
+    goto sw;
+}
+
+static void
+stw(uint16_t w)
+{
+    M[P++] = w;
+    Cp = 0;
+}
+
+static void
+stc(uint16_t c)
+{
+    if (Cp == 0) { stw(0); Cp = WORDSIZE; }
+    Cp -= BYTESIZE;
+    M[P - 1] += c << Cp;
+}
+
+static void
+rch(void)
+{
+    /* FIXME: blows up on EOF */
+    for (;;) {
+        if (read(fp, &Ch, 1) == 0)
+         Ch = -1;
+//        putchar(Ch);
+        if (Ch != '/') return;
+        do read(fp, &Ch, 1); while (Ch != '\n');
+    }
+}
+
+static int16_t
+rdn(void)
+{
+    int a = 0, b = FALSE;
+    if (Ch == '-') { b = TRUE; rch(); }
+    while ('0' <= Ch && Ch <= '9') { a = 10 * a + Ch - '0'; rch(); }
+    if (b) a = -a;
+    return a;
+}
+
+static void
+setlab(int n)
+{
+    int16_t k = Labv[n];
+    if (k < 0) printf("L%d ALREADY SET TO %d AT P = %d\n", n, -k, P);
+    while (k > 0) {
+       uint16_t kp = k;
+        uint16_t nv = M[kp];
+//        if (n == 499)fprintf(stderr, "setlab %d to %d\n", (unsigned int)kp, (unsigned int)P);
+        M[kp] = P;
+        k = nv;
+    }
+    Labv[n] = -P;
+}
+
+static void
+labref(int16_t n, uint16_t a)
+{
+    int16_t k = Labv[n];
+//    if (n == 499)
+//     fprintf(stderr, "Labref %d = %d\n", n, (int)k);
+    if (k < 0) k = -k; else Labv[n] = a;
+//    if (n == 499)
+//    fprintf(stderr, "Mod %d by %d from %d\n", (unsigned int)a, (int)k, (unsigned int)M[a]);
+    M[a] += k;
+}
+
+static int16_t interpret(void)
+{
+fetch:
+    itrace2("%d = ", C);
+
+    if (C >= VSIZE || P >= VSIZE || C == 0) {
+     fprintf(stderr, "FAULT %d %d\n", C, P);
+     exit(1);
+    }
+    W = M[C++];
+    if ((W & DBIT) == 0)
+        D = W & ABITS;
+    else
+        D = M[C++];
+
+    itrace3("OP %d, D %d ", W >> FSHIFT, D);
+
+    if ((W & PBIT) != 0) { D += P; itrace("+P"); }
+    if ((W & GBIT) != 0) { D += G; itrace("+G"); }
+    if ((W & IBIT) != 0) { D = M[D]; itrace("[]"); }
+    
+    itrace4("->%d [A%dB%d]\n", D, A, B);
+
+    switch (W >> FSHIFT) {
+    error: default: writes("\nINTCODE ERROR AT C = ");
+                    writes(_itoa(C-1));
+                    writes("\n");
+        return -1;
+    case 0: B = A; A = D; goto fetch;
+    case 1: M[D] = A; goto fetch;
+    case 2: A = A + D; goto fetch;
+    case 3: C = D; goto fetch;
+    case 4: A = !A;
+    case 5: if (!A) C = D; goto fetch;
+    case 6: D += P;
+        M[D] = P; M[D + 1] = C;
+        P = D; C = A;
+        goto fetch;
+    case 7: switch (D) {
+        default: goto error;
+        case 1: A = M[A]; goto fetch;
+        case 2: A = -A; goto fetch;
+        case 3: A = ~A; goto fetch;
+        case 4: C = M[P + 1];
+            P = M[P];
+            goto fetch;
+        case 5: A = (int16_t)B * (int16_t)A; goto fetch;
+        case 6: A = (int16_t)B / (int16_t)A; goto fetch;
+        case 7: A = (int16_t)B % (int16_t)A; goto fetch;
+        case 8: A = (int16_t)B + (int16_t)A; goto fetch;
+        case 9: A = (int16_t)B - (int16_t)A; goto fetch;
+        case 10: A = B == A ? ~0 : 0; goto fetch;
+        case 11: A = B != A ? ~0 : 0; goto fetch;
+        case 12: A = (int16_t)B < (int16_t)A  ? ~0 : 0; goto fetch;
+        case 13: A = (int16_t)B >= (int16_t)A ? ~0 : 0; goto fetch;
+        case 14: A = (int16_t)B > (int16_t)A ? ~0 : 0; goto fetch;
+        case 15: A = (int16_t)B <= (int16_t)A ? ~0 : 0; goto fetch;
+        case 16: A = B << A; goto fetch;
+        case 17: A = B >> A; goto fetch;
+        case 18: A = B & A; goto fetch;
+        case 19: A = B | A; goto fetch;
+        case 20: A = B ^ A; goto fetch;
+        case 21: A = B ^ ~A; goto fetch;
+        case 22: return 0;
+        case 23: B = M[C]; D = M[C + 1];
+            while (B != 0) {
+                B--; C += 2;
+                if (A == M[C]) { D = M[C + 1]; break; }
+            }
+            C = D;
+            goto fetch;
+
+        case 24: selectinput(A); goto fetch;
+        case 25: selectoutput(A); goto fetch;
+        case 26: A = rdch(); goto fetch;
+        case 27: wrch(A); goto fetch;
+        case 28: A = findinput(A); goto fetch;
+        case 29: A = findoutput(A); goto fetch;
+        case 30: return A;
+        case 31: A = M[P]; goto fetch;
+        case 32: P = A; C = B; goto fetch;
+        case 33: endread(); goto fetch;
+        case 34: endwrite(); goto fetch;
+        case 35: D = P + B + 1;
+                 M[D] = M[P];
+                 M[D + 1] = M[P + 1];
+                 M[D + 2] = P;
+                 M[D + 3] = B;
+                 P = D;
+                 C = A;
+                 goto fetch;
+        case 36: A = getbyte(A, B); goto fetch;
+        case 37: putbyte(A, B, M[P + 4]); goto fetch;
+        case 38: A = input(); goto fetch;
+        case 39: A = output(); goto fetch;
+        }
+    }
+}
+
+uint16_t pgvec[VSIZE];
+
+int main(int argc, char *argv[])
+{
+
+    if (argc != 2) {
+        write(2, "usage: icint file\n",18);
+        return 1;
+    }
+    fp = open(argv[1], O_RDONLY);
+    if (fp == -1) {
+        perror(argv[1]);
+        return 0;
+    }
+    M = pgvec;
+    G = MGLOB;
+    P = MPROG;
+    M[P++] = LIG1;
+    M[P++] = K2;
+    M[P++] = X22;
+    initio();
+    writes("INTCODE SYSTEM ENTERED\n");
+    assemble();
+    close(fp);
+    writes("\nPROGRAM SIZE = ");
+    writes(_itoa(P - MPROG));
+    writes("\n");
+    C = MPROG;
+    return interpret();
+}