// Author David Holdsworth <ecldh@leeds.ac.uk>
// KDF9 program mode emulator
// Ths program is written C--, i.e. a strict subset of C without using pointer arithmetic, or struct
// but I could not resist the C++ comment convention
// The main emulation routines are also valid as Java
// Has run with gcc on Win98SE, FreeBSD UNIX and GNU/Linux, and with both gcc and cc on Solaris
// Param 1 is a binary file as generated by kal3.exe, i.e. 6 bytes to a word (big-endian) memory image starting at word 0
// Param 2 is the initial verbosity level (default 0)
// 1 gives EXITs, 2 gives store accesses and jumps taken, 4 gives each instruction, 5 gives divide diagnostics
// Param 3 is the code address at which diagnostics switch to maximum format %o/%o
// Param 4 is the number of the most interesting Q-store
// Findlay compatible tracing is turned on by a -t switch before the above parameters
// -tc100000 turns on tracing at the 100000th instruction executed
// -t4503/1 turns on tracing at the first visit to the program address 4503/1
// Paper tape input is on a file called ptr.txt (end message is @, subten is ~, not-equals is #)
// Paper tape output is on punch.txt (via OUT 8) -- actually all OUT 8 output to a non-zero stream is in this file
// Ops' console query OUT; is answered with N dot em first time. Second time fails
// There is a very half-hearted attempt to emulate time.
// Overflow on SHA used to be imperfect, and should be OK now.
// Don't know what it does on =+Mq =+Iq =+Cq. I assume that =+Qq sets overflow, as it works using the nest.
// Not all instructions are implemented, but those that have are all tested.
// Floating point underflow is not handled properly
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <fcntl.h>
#ifndef O_BINARY
#define O_BINARY 0
#endif
// KDF9 clock time approx
#define TICK 060
typedef unsigned char byte;
typedef char *String;
/* maximum possible shift without sign extension or loss of data = wordlength - 25 */
#define MAXSHIFT 7
// diagnostic variables
int lastorder = -1;
int qmon = 1; // Q-store whose value is printed each instruction
int verbose = 0; // no diagnostics by default
int maxdiag = -1; // turns verbosity to 9 when pc has this value
// variable emulating KDF9 registers etc
int np = -1; // nesting store poiner
int nestms[17], nestls[17]; // each cell is two halves, N1 is nestms[np] and nestls[np] (bogus extra cell for NEGF)
int sjnsp = -1; // SJNS store poiner
int sjns[17]; // SJNS cells
int pc = 0; // program counter
int qc[16], qi[16], qm[16]; // counter, increment and modifier of Q-stores
int vr = 0; // overflow register
int tr = 0; // test register
int wms, wls; // working location for storing extracted contents of N1 etc, result of add48(), sub48(), etc
int wms2, wls2; // working location for storing extracted contents of N2 etc, used in douible-length operations
FILE *ptr = NULL; // paper tape reader
FILE *punchdv; // paper tape punch
int tcpu = 0; // CPU time so far
int tio = 0; // I/O time so far = paper tape reader time
byte store[32768*6];
// The main store is stored as a sequence of bytes so word 1000 is the 6 bytes from store[6000] to store[6005].
// The nesting store is stored as two arrays and a pointer np.
// N1 is (nestms[np]<<24) + nestls[np]
// N2 is (nestms[np-1]<<24) + nestls[np-1]
// Empty nest is np = -1, and full nest is np = 15
// The program counter works in bytes, and is in variable pc
// The SJNS works similarly. Each cell holds the byte address of the program counter, not word/syll.
// Q-stores are held in three arrays, qc[16], qi[16], qm[16].
// Higher significant bits are always zero.
// Overflow register is variable vr, and test register is variable tr
// --- Bill Findlay's trace calculation
int trStartpc = -1; // value of program counter at which tracing is to start
FILE *trfile = NULL;
int instructionCount = 0; // total number of instructions executed so far
int trStartic = -1; // value of instructionCount at which tracing is to start
int diagStartic = -1; // value of instructionCount at which max diagnostic is to start
// --- Bill Findlay's code to generate his hash function
unsigned int hashms, hashls;
void rotateHashRightBy1()
// Only used by next routine
{ const unsigned int ms = hashms;
const unsigned int ls = hashls;
hashms = (ms >> 1) | ((ls & 1) << 23);
hashls = (ls >> 1) | ((ms & 1) << 23);
}
void hashState(int pc)
// Calculate 48-bit hash value to be output in the trace file
{ int i;
char vrc = ' '; // representation of overflow register
hashms = 0;
hashls = 0;
for (i = 0; i<16; i++)
{ rotateHashRightBy1();
hashms ^= (qc[i]<<8 | qi[i]>>8);
hashls ^= (qm[i] |(qi[i] & 255)<<16);
};
for (i = sjnsp; i>=0; i--)
{ rotateHashRightBy1();
hashls ^= sjns[i]/6 + ((sjns[i]%6)<<13);
};
for (i = np; i>=0; i--)
{ rotateHashRightBy1();
hashms ^= nestms[i];
hashls ^= nestls[i];
};
if ( vr != 0 )
vrc = 'V';
// fprintf(trfile, "#%05o/%o; %d; %d; %d; #%08o%08o; %01d\n", pc/6, pc%6,
// instructionCount, np+1, sjnsp+1, hashms, hashls, vr);
// Sample from Bill: #07351/4 85920 738930 4 4 V #6400000000000000
// The proper hash has been replaced by monitoring of N1 etc (DH's preference)
if ( np >= 0 )
fprintf(trfile, "#%05o/%o; %d;%2d;%2d; %c #%08o%08o;\n", pc/6, pc%6,
instructionCount, np+1, sjnsp+1, vrc, nestms[np], nestls[np]);
else
fprintf(trfile, "#%05o/%o; %d;%2d;%2d; %c E M P T Y\n", pc/6, pc%6,
instructionCount, np+1, sjnsp+1, vrc);
}
// --- end of Bill Findlay's trace calculation
void illegal(String s)
// report illegal instruction and end
{ int i;
printf("FAILS %s\n", s);
printf("LINK %05o/%o\n", pc/6, pc%6);
sjnsp ++;
while ( --sjnsp >= 0 )
printf("SJNS %05o/%o\n", sjns[sjnsp]/6, sjns[sjnsp]%6);
if ( np < 0 )
printf("NEST EMPTY\n");
else
{ printf("N1 = %08o%08o\n", nestms[np], nestls[np]);
if ( np > 0 )
printf("N2 = %08o%08o\nCELLS %d\n", nestms[np-1], nestls[np-1], np+1);
}
printf("\nlast order = %03o\n", lastorder);
printf("Word 0 = %03o %03o %03o %03o %03o %03o\n",
store[0], store[1], store[2], store[3], store[4], store[5]);
for ( i = qmon; i<=qmon; i++ )
printf("Q%d = %06o / %06o / %06o\n", i, qc[i], qi[i], qm[i]);
printf("code = %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[pc-9], store[pc-8], store[pc-7], store[pc-6], store[pc-5], store[pc-4], store[pc-3],
store[pc-2], store[pc-1], store[pc], store[pc+1], store[pc+2]);
exit(1);
}
void notyetimplemented(int i, char *s)
// Instructions are only implemented when the need arises.
{ printf("Instruction %03o %s not yet implemented\n", i, s);
illegal("Unimplemented instruction");
exit(1);
}
// Conversion table for I/O
char lpchar[] = " |\n\f\t|%':=()£*,/0123456789|<;+-.|ABCDEFGHIJKLMNOPQRSTUVWXYZ||@|| ";
char nptchar[] = " |\n|\t||||||||||/0123456789_~;+-.|ABCDEFGHIJKLMNOPQRSTUVWXYZ||@|| "; // case normal - ~ is subten
char sptchar[] = " |\n|\t||||||||||:^[]<>=!%()_$;#*,|abcdefghijklmnopqrstuvwxyz||@|| "; // case shift
unsigned char ptkdf9[256]; // array for getting the KDF9 char equivalent to ASCII, add 0100 for shift n only, 0200 for s
// forward references
void put48(int a);
void out32eldon2();
void readptr(int q, int em)
// read paper tape PRQ (em=0) or PREQ (em=1)
{ static int kase = -1;
int addr0 = qi[q];
int addr1 = qm[q];
int nchars = (addr1-addr0+1)*8;
int i = 0;
int w;
static int c = 07; // initial case normal char
unsigned char *charbuff = (char *)malloc(nchars*sizeof(char));
printf("reading paper tape (q = %d)\n", q);
while ( i < nchars-1 && c >= 0 )
{ if ( em != 0 && c == 075 ) // em on read to em
{ c -= 256; // terminates loop and puts em in as last char
kase = 0100; // Bill assumes case normal
} // -- I used to force a case character after end message by kase = -1;
else
{ if ( (c & 0300) == 0 ) // if same in both cases
charbuff[i++] = c;
else if ( (w = c & 0300) == kase )
charbuff[i++] = c & 077; // in same case as current
else if ( c != 0377 ) // not a character to ignore
{ if ( (kase = w) == 0100 ) // change to case normal
charbuff[i++] = 07;
else
charbuff[i++] = 06; // change to case shift
charbuff[i++] = c & 077;
}
c = fgetc(ptr);
if ( c >= 0 ) // not end of file or end message on PREQq
c = ptkdf9[c&255];
}
}
printf("Last char was %o i = %d\n", c, i);
if ( c < 0 && (c&2) != 0 ) // end of file, not end message
illegal("Reading off end of paper tape input");
if ( i < nchars ) // need another character
if ( (w = c & 0300) == 0 || w == kase ) // now deal with the last character
{ charbuff[i++] = c & 077; // note: may be em
c = fgetc(ptr);
if ( c >0 )
c = ptkdf9[c&255];
}
else if ( w == 0100 ) // change to case normal
{ charbuff[i++] = 07;
kase = 0100;
}
else if ( w == 0200 ) // change to case shift
{ charbuff[i++] = 06;
kase = 0200;
}
while ( (i&7) != 0 ) // word needs padding
charbuff[i++] = 0;
nchars = i; // number of KDF9 chars to transfer (multiple of 8)
w = addr0*6;
for ( i = 0; i<nchars; i+=4 )
{ store[w++] = (charbuff[i]<<2) + (charbuff[i+1]>>4);
store[w++] = ((charbuff[i+1]<<4) + (charbuff[i+2]>>2))&0377;
store[w++] = ((charbuff[i+2]<<6) + charbuff[i+3])&0377;
}
tio += nchars * 0400000;
w = addr0*6;
printf("PT syll %o: %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n", addr0,
store[w], store[w+1], store[w+2], store[w+3], store[w+4], store[w+5],
store[w+6], store[w+7], store[w+8], store[w+9], store[w+10], store[w+11]);
printf("PT char %o/%o: %02o %02o %02o %02o %02o %02o %02o %02o %02o %02o %02o %02o\n", pc/6, pc%6,
charbuff[0], charbuff[1], charbuff[2], charbuff[3], charbuff[4], charbuff[5],
charbuff[6], charbuff[7], charbuff[8], charbuff[9], charbuff[10], charbuff[11]);
free(charbuff);
return;
}
void loadprogram(char *fn)
{ int dv = open(fn, O_RDONLY + O_BINARY);
int n;
if ( dv < 0 )
{ perror(fn);
illegal("Cannot load program file");
exit(1);
}
n = read(dv, store, 8192*6);
close(dv);
printf("%d bytes loaded from %s\n", n, fn);
}
void outinstr()
// all OUTs except 0
{ int n, m, i, j, s0, s1, s2, dv;
unsigned char buff[1024*8]; // OUT 8 transfer up to 1024 KDF9 words
char *ptch = nptchar;
int z = 0; // used in OUT 9
static int opsquery = 0; // last query response
switch (n = nestls[np--])
{ case 9: // OUT get time used so far
z = tio; // adds in the i/o time to CPU time
case 3: // OUT get time used so far
if ( np >= 15 ) illegal("004 Nest full on obeying OUT 3, 9, etc");
z += tcpu;
nestls[++np] = z & 077777777; // put time to 23 integral places
nestms[np] = (z >> 24) & 077777777;
break;
case 5: // OUT 5 claim peripheral device
n = nestls[np]; // get parameter, but leave it in the nest as the device number
printf("Claiming peripheral of type %o\n", n);
if ( n != 2 )
notyetimplemented(n, "Other types of peripheral");
if ( ptr == NULL )
{ ptr = fopen("ptr.txt", "r");
if ( ptr == NULL )
{ perror("ptr.txt");
illegal("Cannot find paper tape reader");
}
}
break;
case 6: // OUT 6 release peripheral device
n = nestls[np--]; // get parameter
printf("deallocated device %d\n", n);
break;
case 8: // OUT 8
n = nestms[np--]; // remove parameter
n = (((n<<8) | (nestls[np+1]>>16))&0177777)*6;
m = (nestls[np+1]&0177777)*6 + 6;
if ( store[n+5] >= 030 ) // if line printer stream
ptch = lpchar; // use the line printer character table
printf("OUT 8 stream %o\n %05o/%o", store[n+5], (pc-3)/6, (pc-3)%6);
for ( i = sjnsp; i>=0; i -- )
printf(" %05o/%o", sjns[i]/6, sjns[i]%6);
printf("\n");
printf(" %o: %08o %08o %08o %08o %08o %08o\n", n,
store[n]*65536 + store[n+1]*256 + store[n+2], store[n+3]*65536 + store[n+4]*256 + store[n+5],
store[n+6]*65536 + store[n+7]*256 + store[n+8], store[n+9]*65536 + store[n+10]*256 + store[n+11],
store[n+12]*65536 + store[n+13]*256 + store[n+14], store[n+15]*65536 + store[n+16]*256 + store[n+17]);
if ( m - n > 1024*6 )
notyetimplemented(m - n, "OUT 8 with more than 1024 words");
j = 0;
for ( i = n+6; i<m; i += 3 ) // half a word at a time
{ s0 = store[i]; s1 = store[i+1]; s2 = store[i+2];
buff[j++] = s0>>2; buff[j++] = ((s0&3)<<4) + ((s1>>4)&017);
buff[j++] = ((s1&017)<<2) + ((s2>>6)&3);
buff[j++] = s2&077;
}
if ( (s0 = store[n+5]) == 0 ) // stream 0 is ops console
{ i = -1;
while ( ++i < j )
if ( buff[i] == 034 ) // semicolon -- This is special for Walgol
{ if ( opsquery != 0 ) // not first time through
illegal("Looping of OUT query");
else if ( buff[4] == 057 ) // query for diagnostic stream from translator - OUT;
opsquery = 056377500; // N.em
else // query from controller
opsquery = 023203775; // 30.em
// else if ( (opsquery&040000000) == 0 ) // second time through
// opsquery = 037750000; // dot em or 021203775; // 10.em
buff[++i] = opsquery >> 18;
buff[++i] = (opsquery >> 12) & 077;
buff[++i] = (opsquery >> 6) & 077;
buff[++i] = opsquery & 077;
store[m-6] = opsquery >> 16; store[m-5] = (opsquery >> 8) & 0377; store[m-4] = opsquery & 0377;
store[m-3] = 0; store[m-2] = 0; store[m-1] = 0; // put .em in last word of query
j = i+1;
}
}
n = 0;
for ( i = 0; i<j; i++ )
if ( (m = ptch[buff[i]]) != '|' ) // not a dummy or shift character
buff[n++] = m;
else if ( (m = buff[i]) == 6 ) // case shift
ptch = sptchar;
else if ( m == 7 )
ptch = nptchar;
buff[n] = 0;
printf("OUT 8:%s\n", buff);
if ( s0 != 0 )
{ fprintf(punchdv, "%s", buff);
fflush(punchdv);
}
break;
case 1: // OUT 1 -- call new program
wms = nestms[np-1]; // top half of 2nd word of program name
printf("OUT 1: %08o\n", wms);
if ( (wms >> 18) != 023 ) // not calling WALGOL controller
notyetimplemented(n, "OUT");
else
{ char word1[6]; // need to keep word 1 across OUT 1
np -= 2; // remove N1, N2
memcpy(word1, store+6, 6);
loadprogram("walgolc.bin");
memcpy(store+6, word1, 6);
pc = 0;
opsquery = 0; // Allow another OUT8 query
}
break;
case 2: // OUT 2 -- enter new program already loaded into store
printf("OUT 2: Enter load and go program\n");
np = -1; // empty nest (should we do this or not)
sjnsp = -1; // empty SJNS (should we do this or not)
vr = 0; // clear overflow
pc = 0; // jump to word 0
store[10] = 100; // set store limit for KAL4 experiments
store[11] = 255;
store[42] = 0115; // bogus date 31/03/69
store[43] = 0023; // bogus date
store[44] = 0320; // bogus date
store[45] = 0114; // bogus date
store[46] = 0365; // bogus date
store[47] = 0231; // bogus date
break;
case 17: // OUT 17 CPU time in N1, notional elapsed time in N2
if ( np >= 15 ) illegal("040 ");
z = tcpu + tio;
nestls[++np] = z & 077777777; // put time to 23 integral places
nestms[np] = (z >> 24) & 077777777;
z = tcpu;
nestls[++np] = z & 077777777; // put time to 23 integral places
nestms[np] = (z >> 24) & 077777777;
break;
case 32: // OUT 32 read Eldon2/PROMPT system area
out32eldon2();
break;
case 50: // OUT 50 job accounting info - ignore
np --; // discard param from N1
break;
case 51: // OUT 51 change job number
np --; // discard param from N1
break;
case 012345: // OUT 12345 - Eldon2 system program identification -- output binary to file - just for KAL4 bootstrap
dv = open("tmp.bin", O_WRONLY + O_BINARY + O_CREAT + O_TRUNC, 0640);
if ( dv < 0 )
perror("Binary output file");
else
{ i = qm[1]*6; // start of binary program
j = 05340*6; // known size of binary program
printf("Binary file tmp.bin written - %d bytes\n", write(dv, store + i, j));
close(dv);
} // then drop through
default: notyetimplemented(n, "OUT");
}
}
void jump(f, a1, a2)
// obey jump specified by params
// f, a1 and a2 are the three syllables of the jump instruction
// for short loops f and a1 are zero, and the destination is in a2
{ int s = f&7;
int w = ((f&010)<<9) + ((a1&017)<<8) + a2;
if ( s >= 6 )
illegal("00 L - Bad syllable number in destination address");
if ( verbose >= 2 )
if ( np < 0 )
printf("%05o/%o Jump to %05o/%o Nest EMPTY\n", (pc-3)/6, (pc-3)%6, w, s);
else
printf("%05o/%o Jump to %05o/%o N1 = %08o %08o NEST cells %d\n", (pc-3)/6, (pc-3)%6, w, s, nestms[np], nestls[np], np+1);
pc = w*6 + s;
}
int shiftvalue()
// calculate shift value and load N1 into wms and wls
{ int w = 0;
int q2 = store[pc++];
if ( (q2&1) == 0 ) // shift count in Q-store
{ if ( (q2 = qc[q2>>4]) & 0100000 ) // if -ve shift value
q2 -= 0200000; // make number truly negative
}
else // shift count embedded in instruction
{ if ( (q2 = q2>>1) & 0100 ) // if -ve shift value
q2 -= 0200; // make number truly negative
}
wms = nestms[np]; wls = nestls[np]; // load N1 into W-register
return q2;
}
void shift95(int n)
// shift a 95-bit aritmetic value held in wms, wls, wms2, wls2
// and set overflow if the sign digit is shifted off left
{ int w, shval;
int s24 = 0; // 24 copies of the sign digit
shval = MAXSHIFT; // maximum that can be shifted in one word
if ( (wms&040000000) != 0 ) // negative operand
s24 = 077777777; // notional half word above wms
wms2 &= 037777777; // just in case sign digit of N2 was set (bad idea?)
if ( n < 0 ) // shift right
{ if ( (n = -n) < shval ) // n is now positive number of places to shift
shval = n; // only one shift operation needed
while ( n > 0 )
{ wls2 |= (wms2<<24); wls2 = wls2 >> shval; wls2 &= 077777777;
wms2 |= (wls<<23); wms2 = wms2 >> shval; wms2 &= 037777777;
wls |= (wms<<24); wls = wls >> shval; wls &= 077777777;
wms |= (s24<<24); wms = wms >> shval; wms &= 077777777;
if ( (n -= shval) < shval )
shval = n;
}
}
else // shift left or not at all
{ if ( n < shval )
shval = n;
while ( n > 0 )
{ wls2 = wls2 << shval; w = wls2 >> 24; wls2 &= 077777777;
wms2 = (wms2 << shval) | w; w = wms2 >> 23; wms2 &= 037777777;
wls = (wls << shval) | w; w = wls >> 24; wls &= 077777777;
wms = (wms << shval) | w; w = wms >> 24; wms &= 077777777;
if ( (s24 >> (24 - shval)) != w ) // if bits shifted off are not copies of the sign digit ...
vr = 1; // ... set overflow
if ( (n -= shval) < shval )
shval = n;
}
if ( ((s24 ^ wms) & 040000000) != 0 ) // if the sign digit has changed
vr = 1;
}
}
void add48(int xms, int xls)
// adds the 48-bit number in xms, xls to wms, wls
{ xms |= (xms & 040000000) << 1; // propagate sign digit one place
wms |= (wms & 040000000) << 1; // propagate sign digit one place
if ( ((wls += xls)&0100000000) != 0 ) // carry has occurred
{ wls &= 077777777; // mask out the carry bit
wms += xms + 1; // and add it into to the top half
}
else
wms += xms;
// printf("wms = %08o masked = %08o\n", wms, (((wms & 0140000000) + 040000000) & 0100000000));
if ( (((wms & 0140000000) + 040000000) & 0100000000) != 0 )
vr = 1; // set VR if top carry != sign digit
wms &= 077777777;
}
void sub48(int xms, int xls)
// subtracts the 48-bit number in xms, xls from wms, wls
// overflow needs attention !!!
{ xms |= (xms & 040000000) << 1; // propagate sign digit one place
wms |= (wms & 040000000) << 1; // propagate sign digit one place
if ( (wls -= xls) < 0 ) // borrow has occurred
{ wls &= 077777777; // mask out the borrow bit
wms -= (xms + 1) & 0177777777; // and subtract it from the top half
}
else
wms -= xms;
// printf("wms = %08o masked = %08o\n", wms, (((wms & 0140000000) + 040000000) & 0100000000));
if ( (((wms & 0140000000) + 040000000) & 0100000000) != 0 )
vr = 1; // set VR if propagated sign digit != actual sign digit
wms &= 077777777;
}
void neg12(int *x, int n)
// negates the array of n 12-bit numbers in x
// x is not known to be non-zero
// x[0] is least significant digit
// used by routine dividedouble
{ int i = -1;
while ( ++i < n && x[i] == 0 ) ;
if ( i >= n ) // x is zero
return;
x[i] = 010000 - x[i];
while ( ++i < n )
x[i] = 07777 - x[i];
}
void dividedouble(int skip, int xms, int xls, int dms, int dls)
// divide the double length number in wms, wls, xms, xls by the denominator dms, dls
// skip is the number of bits to ignore at the start of xms (1 for fixed point, 9 for floating point), also wms2
// The double length result is left in wms, wls, wms2, wls2 for floating point (i.e. skip = 9)
// The single length result is left in wms2, wls2 for fixed point (i.e. skip = 1), and a remainder in wms, wls for DIVR
// For %I skip is set to zero, and the numerator is in xms, xls, wms, wls are set to zero
{ int i, j, w, c, d;
int res[8]; // uses 8 12-bit digits to accumulate the number
int num[9]; // uses 8 12-bit digits for numerator - top digit is always 0
int den[4]; // uses 4 12-bit digits for denominator
int rp = 4; // position of current result digit
int dp = 4; // position of most sig digit on denominator
int np = 8; // position of most sig digit on numerator
int sign = 1; // indicates +ve result
int div;
if ( dms == 0 && dls == 0 ) // divide by zero
{ wms = 0; wls = 0;
wms2 = 0; wls2 = 0;
vr = 1; // set overflow
return;
}
// the original version used left justified values in num and res, but gave the wrong result for %R
// this experimantal version uses right justified values
num[0] = xls&07777;
num[1] = xls >> 12;
num[2] = xms&07777;
num[3] = (wls << (12 - skip)) & 07777 // include skip bits of N1
| (xms >> 12) & (07777 >> skip); // mask out the ignored bit of N2
num[4] = (wls >> skip)&07777;
num[5] = (wms << (12 - skip) | wls >> (12 + skip)) &07777;
num[6] = (wms>>skip)&07777;
num[7] = wms >> (12 + skip); // deal with sign digit propagation later
num[8] = 0;
den[0] = dls&07777; den[1] = dls >> 12; den[2] = dms&07777; den[3] = dms >> 12;
for ( i = 0; i<8; i++ )
res[i] = 0;
if ( (wms & 040000000) != 0 )
{ sign = -1;
num[7] |= (07777 << (12 - skip)) & 07777; // propagate the sign digit
if ( verbose >= 5 )
printf("- num = %04o %04o %04o %04o %04o %04o %04o %04o\n",
num[7], num[6], num[5], num[4], num[3], num[2], num[1], num[0]);
neg12(num, 8);
}
if ( (dms & 040000000) != 0 )
{ sign = -sign;
if ( verbose >= 5 )
printf("- den = %04o %04o %04o %04o\n", den[3], den[2], den[1], den[0]);
neg12(den, 4);
}
while ( den[--dp] == 0 )
rp ++;
while ( --np >= 0 && num[np] == 0 )
rp --;
if ( np < 0 ) // numerator is zero
{ wms = 0; wls = 0;
wms2 = 0; wls2 = 0;
return;
}
// Loop invariant: n0 = res * den + num, where n0 is the original numerator
// terminate when num is small enough
// np is position of most sig digit of num that is bigger then den[dp]
// rp is position of current result digit -- digits more sig than rp are correct, and those less then rp are 0
if ( dp == 0 )
div = (den[dp]<<7);
else
div = (den[dp]<<7) + (den[dp-1]>>5);
while ( rp >= 0 ) // loops until there is no more result to be had
{ if ( np == 0 )
w = ((num[np+1]<<19) + (num[np]<<7)) / div + 1; // w is putative result digit
else
w = ((num[np+1]<<19) + (num[np]<<7) + (num[np-1]>>5)) / div + 1;
if ( verbose >= 5 )
{ printf("a num = %04o %04o %04o %04o %04o %04o %04o %04o\n",
num[7], num[6], num[5], num[4], num[3], num[2], num[1], num[0]);
printf("a res = %04o %04o %04o %04o %04o %04o %04o %04o\n",
res[7], res[6], res[5], res[4], res[3], res[2], res[1], res[0]);
printf("a den = %04o %04o %04o %04o\n", den[3], den[2], den[1], den[0]);
printf("a rp = %d, np = %d, dp = %d -> w = %d (%o)\n", rp, np, dp, w, w);
}
// now need to subtract w * den from num to restore loop invariant when w goes into res
c = 0; // carry digit
for ( i = 0; i<= dp; i++ ) // loop to subtract den * w from num
{ c += den[i] * w - num[j = np - dp + i] + 010000;
num[j] = (d = (-c) & 07777); // new digit
c = ((c+d) >> 12) - 1;
}
num[np+1] -= c;
if ( verbose >= 5 )
printf("b c = %d :: num[%d+1] = %d\n", c, np, num[np+1]);
while ( num[np+1] < 0 ) // w was too big and carried over the top
{ w --; // try one less
if ( verbose >= 5 )
{ printf("c Gone back to add in one or two more\n");
printf("c num = %04o %04o %04o %04o %04o %04o %04o %04o\n",
num[7], num[6], num[5], num[4], num[3], num[2], num[1], num[0]);
printf("c res = %04o %04o %04o %04o %04o %04o %04o %04o\n",
res[7], res[6], res[5], res[4], res[3], res[2], res[1], res[0]);
}
c = 0;
for ( i = 0; i<= dp; i++ ) // loop to add den into num
{ c += num[j = np - dp + i] + den[i];
num[j] = c & 07777;
c = c >> 12;
}
num[np+1] += c;
}
res[rp--] = w; // result digit put in to res array
if ( num[np+1] != 0 )
{ if ( verbose >= 5 )
{ printf("d num = %04o %04o %04o %04o %04o %04o %04o %04o\n",
num[7], num[6], num[5], num[4], num[3], num[2], num[1], num[0]);
printf("d res = %04o %04o %04o %04o %04o %04o %04o %04o\n",
res[7], res[6], res[5], res[4], res[3], res[2], res[1], res[0]);
}
illegal("Division error -- non-zero carry");
}
num[np+1] = 0; // substraction of final carry
np --; // keeps rp and np in step
}
// at this point we have done the division abs(num) / abs(den)
if ( skip != 0 ) // not integer divide %I
{ if ( sign < 0 )
neg12(res, 8);
wms = ((res[7]<<12 | res[6]) << skip) & 077777777 | res[5]>>(12 - skip);
wls = res[5]<<(12 + skip) & 07777 | res[4] << skip | res[3]>>(12 - skip);
wms2 = (res[3]<<12 | res[2]) & 077777777 >> skip;
// mask off the ignored bit(s) at the start of N2
wls2 = res[1]<<12 | res[0];
if ( skip == 1 ) // fixed point - check overflow and deal with neg result
{ if ( wms != 0 || wls != 0 ) // not a positive result < 1
{ wms2 |= (wms&040000000); // set N1 sign digit
if ( wms != 077777777 || wls != 077777777 )
vr = 1; // overflow -- don't know what N1 should be in this case
}
wms = num[3] << 12 | num[2]; // only used by %R ..
wls = num[1] << 12 | num[0]; // .. unlikely to work for -ve operands
}
}
else // integer divide %I - need to sort out remainder etc
{ if ( verbose >= 5 )
printf("wms = %08o, wls = %08o\n", wms, wls);
if ( (xms & 040000000) != 0 ) // negative numerator - need to negate remainder
neg12(num, 4);
wms = (num[3]<<12) | num[2];
wls = (num[1]<<12) | num[0];
if ( (wms | wls) == 0 ) // integer divide with zero remainder
{ if ( sign < 0 )
neg12(res, 4); // only 48 bits are relevant
sign = 0; // result now has the correct sign
}
else if ( sign < 0 ) // integer divide with non-zero remainder and negative result
{ if ( (dms & 040000000) != 0 ) // negative denominator (and positive numerator )
sub48(dms, dls); // remainder now becomes negative, i.e. rem0 - den
else
add48(dms, dls); // remainder now becomes den - rem0
sign = 077777777; // causes result to be notted, i.e. res := -res-1 if neg with non-zero remainder
}
else // integer divide with non-zero remainder and non-negative result
sign = 0;
wms2 = ((res[3]<<12) | res[2]) ^ sign;
wls2 = (((res[2]<<24) | (res[1]<<12) | res[0]) & 077777777) ^ sign;
}
}
void timesdouble(int skip)
// multiply double-length wms, wls and wms2, wls2, leaving result in wms, wls, wms2, wls2
// skip is the number of bits to skip at the start of N2
// = 1 for fixed point, 9 for floating point
{ int i, j, w, d;
int res[8]; // uses 8 12-bit digits to accumulate the number
int op1[8]; // uses 4 12-bit digits for operand 1 -- sign extended to top half
int op2[8]; // uses 4 12-bit digits for operand 2
if ( wms < wms2 ) // use smaller operand as multiplier
{ w = wms; wms = wms2; wms2 = w;
w = wls; wls = wls2; wls2 = w;
}
// printf("N1 = %08o %08o\n", wms, wls);
// printf("N2 = %08o %08o\n", wms2, wls2);
if ( (wms & 040000000) == 0 ) // op1 is +ve
w = 0;
else if ( wms == 040000000 && wms2 == 040000000 && wls ==0 && wls2 == 0 )
{ vr = 1; wms2 = 0; // the only possible overflow condition, i.e. -1/0 x -1/0
return; // other result values are already OK
}
else // op1 is -ve
w = 07777; // sign digit extension
for ( i = 4; i<8; i++ )
op1[i] = w;
op1[0] = wls&07777; op1[1] = wls >> 12; op1[2] = wms&07777; op1[3] = wms >> 12;
if ( (wms2 & 040000000) == 0 ) // op2 is +ve
w = 0;
else // op2 is -ve
w = 07777; // sign digit extension
for ( i = 4; i<8; i++ )
op2[i] = w;
op2[0] = wls2&07777; op2[1] = wls2 >> 12; op2[2] = wms2&07777; op2[3] = wms2 >> 12;
// printf("op1 = %04o %04o %04o %04o %04o %04o %04o %04o\n", op1[7], op1[6], op1[5], op1[4], op1[3], op1[2], op1[1], op1[0]);
// printf("op2 = %04o %04o %04o %04o %04o %04o %04o %04o\n", op2[7], op2[6], op2[5], op2[4], op2[3], op2[2], op2[1], op2[0]);
for ( i = 0; i<8; i++ )
res[i] = 0;
for ( j = 0; j<8; j++ )
{ d = op2[j]; // multiplying digit
// printf("D j = %04o %d\n", d, j);
if ( d != 0 ) // a little optimisation
{ w = 0; // carry
for ( i = j; i<8; i++ )
{ w = op1[i-j]*d + res[i] + w;
// printf("i j w = %04o %04o %08o\n", i, j, w);
res[i] = 07777 & w; // digit value masked according to radix
w = w >> 12; // new carry digit
}
// printf("Lost carry = %o\n", w);
}
}
// printf("res = %04o %04o %04o %04o %04o %04o %04o %04o\n", res[7], res[6], res[5], res[4], res[3], res[2], res[1], res[0]);
wls2 = (res[1]<<12) | res[0]; wms2 = ((res[3]&(07777>>skip))<<12) | res[2];
wls = ((res[5]<<(skip+12)) | (res[4]<<skip) | (res[3]>>(12-skip))) & 077777777;
wms = ((res[7]<<(skip+12)) | (res[6]<<skip) | (res[5]>>(12-skip))) & 077777777;
return;
}
int fix39()
// converts wms into the top half of a fixed point version of floating point
// leaves the mantissa as a 39-bit integer with sign extended to 48 bits
// and return the exponent as the result
// used in floating point arithmetic
{ int res = (wms >> 15) & 0377; // pick out the exponent
if ( (wms & 040000000) == 0 ) // +ve number
wms &= 077777; // bottom 15 bits are the number
else // -ve number
wms |= 077700000; // bottom 15 bits are the number, add in sign digits
return res;
}
void float39(int exp)
// converts wms, wls into a proper floating point number
// using the exponent in exp
// a later enhancement is needed for double length -- or see below
// should this routine be obsoleted and always use float78?
// used in floating point arithmetic
{ int sign = wms & 040000000;
if ( ((wms<<8) & 040000000) != sign ) // must have been add causing carry or maybe divide
{ exp ++;
wls = ((wms<<23) + (wls>>1)) & 077777777; // bottom half down one place
wms = (wms>>1) + sign;
}
else
while ( ((wms<<9) & 040000000) == sign && exp >= 0 ) // need to reduce exponent
{ exp --;
wms = (wms<<1) + (wls>>23);
wls = (wls<<1) & 077777777; // bottom half up one place
}
if ( exp >= 0 )
wms = (wms & 040077777) + (exp<<15); // put in the exponent
else
{ wms = 0; wls = 0; // tiny numbers are put to zero
}
}
void float78(int exp)
// converts wms, wls, wms2, slw2 into a proper floating point number
// using the exponent in exp
// a later enhancement is needed for double length
// used in floating point arithmetic
{ int sign = wms & 040000000;
if ( ((wms<<8) & 040000000) != sign ) // must have been add causing carry or maybe divide
{ exp ++;
wls2 = ((wms2<<23) + (wls2>>1)) & 077777777; // bottom half down one place
wms2 = ((wms2>>1) + (wls<<14)) & 077777;
wls = ((wms<<23) + (wls>>1)) & 077777777; // bottom half down one place
wms = (wms>>1) + sign;
}
else
while ( ((wms<<9) & 040000000) == sign && exp >= 0 ) // need to reduce exponent
{ exp --;
wms = (wms<<1) + (wls>>23);
wls = ((wls<<1) + (wms2>>14) & 077777777); // bottom half of MS word up one place
wms2 = ((wms2<<1) + (wls2>>23) & 077777777);
wls2 = (wls2<<1) & 077777777; // bottom half of LS word up one place
}
if ( exp >= 0 )
wms = (wms & 040077777) + (exp<<15); // put in the exponent
else
{ wms = 0; wls = 0; // tiny numbers are put to zero
}
}
int scaleup(int e1, int e2)
// shifts wms, wls right to correspond with e2, rather than e1
{ int shift = e2 - e1;
int sign = -(wms>>23);
wls = ((wms<<(24-shift)) + (wls>>shift)) & 077777777;
wms = (((sign<<24) + wms)>>shift) & 077777777;
return e2;
}
int scaleup2(int e1, int e2)
// shifts wms2, wls2 right to correspond with e2, rather than e1
{ int shift = e2 - e1;
int sign = -(wms2>>23);
wls2 = ((wms2<<(24-shift)) + (wls2>>shift)) & 077777777;
wms2 = (((sign<<24) + wms2)>>shift) & 077777777;
return e2;
}
void put48(int a)
{ if ( np < 0 ) illegal("00N");
a &= 0177777;
wms = nestms[np]; wls = nestls[np--];
if ( verbose >= 2 )
printf("%05o/%o: Storing in word address %o = %08o %08o\n", (pc-3)/6, (pc-3)%6, a, wms, wls);
if ( a >= 32768 ) illegal("00 L - KDF9 too small");
a *= 6;
store[a] = wms >> 16; store[a+1] = (wms >> 8) & 0377; store[a+2] = wms & 0377;
store[a+3] = wls >> 16; store[a+4] = (wls >> 8) & 0377; store[a+5] = wls & 0377;
}
void get48(int a)
{ if ( np >= 15 ) illegal("00N");
a &= 0177777;
if ( a >= 32768 )
{ printf("Fetching from word address %o\n", a);
illegal("00 L - KDF9 too small");
}
a *= 6;
nestms[++np] = ((store[a]*256) + store[a+1])*256 + store[a+2];
nestls[np] = ((store[a+3]*256) + store[a+4])*256 + store[a+5];
if ( verbose >= 2 )
printf("%05o/%o: Fetching from word address %o = %08o %08o\n", (pc-3)/6, (pc-3)%6, a/6, nestms[np], nestls[np]);
}
void put24(int m1, int m2)
// get 24 bit half word, M2M1H
{ int a = ((m1 + m2 + m2) & 0377777) * 3;
if ( np < 0 ) illegal("00N");
wms = nestms[np--];
if ( a >= 32768*6 - 3 )
{ printf("Storing in half-word address %o + half %o = %o\n", m2, m1, a);
illegal("00 L - KDF9 too small");
}
store[a] = wms >> 16; store[a+1] = (wms >> 8) & 0377; store[a+2] = wms & 0377;
if ( verbose >= 2 )
printf("%05o/%o: Storing in word address %o = %08o %08o\n", (pc-3)/6, (pc-3)%6, a/6, nestms[np], nestls[np]);
}
void get24(int m1, int m2)
// get 24 bit half word, M2M1H
{ int a = ((m1 + m2 + m2) & 0377777) * 3;
if ( np >= 15 ) illegal("00N");
if ( a >= 32768*6 - 3 )
{ printf("Fetching from half-word address %o + half %o = %o\n", m2, m1, a);
illegal("00 L - KDF9 too small");
}
nestms[++np] = ((store[a]*256) + store[a+1])*256 + store[a+2];
nestls[np] = 0;
if ( verbose >= 2 )
printf("%05o/%o: Fetching from word address %o = %08o %08o\n", (pc-3)/6, (pc-3)%6, a/6, nestms[np], nestls[np]);
}
char *jmnem[] = {"???","J!=","JGEZ","???","JLEZ","???","J!=Z","???","JNV","OUT","JNEN","J","JNEJ","JS","JNTR","EXIT","???"
,"J=","J<Z","???","J>Z","???","J=Z","???","JV","???","JEN","???","JEJ","???","JTR","???","JC0Z"
,"JC1Z","JC2Z","JC3Z","JC4Z","JC5Z","JC6Z","JC7Z","JC8Z","JC9Z","JC10Z","JC11Z","JC12Z","JC13Z"
,"JC14Z","JC15Z","JC0NZ","JC1NZ","JC2NZ","JC3NZ","JC4NZ","JC5NZ","JC6NZ","JC7NZ","JC8NZ","JC9NZ"
,"JC10NZ","JC11NZ","JC12NZ","JC13NZ","JC14NZ","JC15NZ"};
char *smnem[] = {"???","VR","=TR","BITS","*F","*DF","???","*+F","NEGD","OR","PERM","TOB","ROUNDH","NEV","ROUND","DUMMY","ROUNDF"
,"ROUNDHF","-DF","+DF","FLOAT","FLOATD","ABS","NEG","ABSF","NEGF","MAX","NOT","*D","*","-","SIGN","???","ZERO"
,"DUP","DUPD","%I","FIX","???","STR","CONT","REVD","ERASE","-D","AND","???","+","+D","%","%D","%F","%DF","%R"
,"REV","CAB","FRB","STAND","NEGDF","MAXF","???","+F","-F","???","SIGNF"};
char *memmnem[] = {"E#%oM%d", "=E#%oM%d", "E#%oM%dQ", "=E#%oM%dQ"};
char *f2syll[] = {"M%dM%d","=M%dM%d","M%dM%dQ","=M%dM%dQ","M%dM%dH","=M%dM%dH","M%dM%dQH","=M%dM%dQH","M%dM%dN","=M%dM%dN",
"M%dM%dQN","=M%dM%dQN","M%dM%dHN","=M%dM%dHN","M%dM%dQHN","=M%dM%dQHN","CTQ%d","PARQ%d","METQ%d","???",
"MFRQ%d,","PREQ%d","MBRQ%d","MBREQ%d","PWQ%d,","MWEQ%d,","???","???","MFSKQ%d","???","MBSKQ%d","???","M+I%d",
"M-I%d","NC%d","DC%d","I%d=+1","I%d=-1","I%d=+2","I%d=-2","???","M%dTOQ%d","I%dTOQ%d","IM%dTOQ%d","C%dTOQ%d",
"CM%dTOQ%d","CI%dTOQ%d","Q%dTOQ%d","???","SHAC%d","SHADC%d","*+C%d","SHLC%d","???","SHLDC%d","SHCC%d","=",
"","=+","LINK","=LINK","???","???","JC%dNZS"};
char diagbuff[20];
char *showmnemonic(int pc)
// Shows the mnemonic at the given program counter
{ int f = store[pc++];
int a1 = store[pc++];
int a2 = store[pc++];
int q2 = a1>>4;
int q1 = a1&017;
char *fmt;
if ( (f&0300) == 0 ) // single syllable instruction
return smnem[f];
if ( (f&0300) == 0200 ) // jump instruction
return jmnem[(f&0160) + (a1>>4)];
strcpy(diagbuff, "???");
if ( f == 0304 ) // SET instruction
sprintf(diagbuff, "SET %d", ((char)a1)*256 + (a2&255));
else if ( (f&0304) == 0300 ) // main store fetch or store instruction
{ fmt = memmnem[f&3];
if ( q2 == 0 )
if ( (f&1) == 0 )
fmt = "E#%o";
else
fmt = "=E#%o";
sprintf(diagbuff, fmt, ((f&070)<<9) + ((a1&017)<<8) + a2, q2);
}
else if ( (f&0300) == 0100 ) // 2 syllable instruction
{ fmt = f2syll[f&077];
if ( f < 0120 ) // swap round Q=store numbers for =MqMqQHN etc
{ q1 = q2;
q2 = a1&017;
}
else if ( (f&0374) == 0170 ) // fancy Q-store instruction
{ strcpy(diagbuff+9, fmt); // this will just be the first part of the format
if ( (q1&1) != 0 )
strcat(diagbuff+9, "R");
if ( q1 == 016 )
strcat(diagbuff+9, "Q");
else if ( (q1&010) != 0 )
strcat(diagbuff+9, "C");
else if ( (q1&04) != 0 )
strcat(diagbuff+9, "I");
else if ( (q1&02) != 0 )
strcat(diagbuff+9, "M");
strcat(diagbuff+9, "%d");
fmt = diagbuff+9;
}
else if ( (f&0370) == 0160 && (a1&1) != 0 ) // shift instruction
{ strcpy(diagbuff+9, fmt); // this will be the Q-store counter version
diagbuff[q1 = strlen(fmt)+6] = '%'; // replace the C
diagbuff[++q1] = '+'; // replace the %
q2 = ((char)(a1&0376))/2; // shift value as a signed number
fmt = diagbuff+9;
}
sprintf(diagbuff, fmt, q2, q1);
}
return diagbuff;
}
void interpret()
// The main emulation routine
{ qc[0] = 0; qi[0] = 0; qm[0] = 0; // implement Q0
while ( 1 == 1 )
{ int f; // function i.e. op code
int lastpc = pc; // address of current instruction
int q1, q2; // used when there are Q-store numbers embedded in the instruction
// also to hold exponents in floating point operations, and sundry other temporaries
instructionCount ++;
if ( pc == maxdiag // check for turn on point of max diagnostics ...
|| instructionCount == diagStartic ) // ... or instruction count
verbose = 9; // panic stations == get all the gen
if ( pc == trStartpc // check for turn on point of trace output
|| instructionCount == trStartic )
trfile = fopen("DHtrace.txt", "w");
f = store[pc++];
if ( verbose >= 4)
{ char *v = "";
if ( vr != 0 )
v = " V";
if ( np < 0 )
printf("%05o/%o code = %03o %03o %03o NEST empty Q%d %06o/%06o/%06o%s %s\n",
(lastpc)/6, (lastpc)%6, f, store[lastpc+1], store[lastpc+2],
qmon, qc[qmon], qi[qmon], qm[qmon], v, showmnemonic(lastpc));
else
printf("%05o/%o code = %03o %03o %03o N1 = %08o %08o Q%d %06o/%06o/%06o%s %s\n",
(lastpc)/6, (lastpc)%6, f, store[lastpc+1], store[lastpc+2],
nestms[np], nestls[np], qmon, qc[qmon], qi[qmon], qm[qmon], v, showmnemonic(lastpc));
}
lastorder = f; // diagnostic
tcpu += TICK; // very crude time simulation
if ( (f&0200) != 0 ) // 3-syllable instruction
{ int a1 = store[pc++];
int a2 = store[pc++];
tcpu += 3*TICK; // very crude time simulation
if ( (f&0300) == 0200 ) // jump instruction
{ switch ( (f&0360) + (a1>>4) )
{
/* --------------- */
case 0221: // J= jump if N1 = N2 and erase N1
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
if ( wms == nestms[np] && wls == nestls[np] ) // if N1 = N2
jump(f, a1, a2);
break;
/* --------------- */
case 0201: // J!= jump if N1 nE N2 and erase N1
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
if ( wms != nestms[np] || wls != nestls[np] ) // if N1 != N2
jump(f, a1, a2);
break;
/* --------------- */
case 0222: // J<Z jump if N1 < 0 and erase N1
if ( np < 0 ) illegal("00N");
wms = nestms[np--];
if ( (wms&040000000) != 0 ) // if N1 sign digit set
jump(f, a1, a2);
break;
/* --------------- */
case 0202: // JGEZ jump if N1 ≥ 0 and erase N1
if ( np < 0 ) illegal("00N");
wms = nestms[np--];
if ( (wms&040000000) == 0 ) // if N1 sign digit not set
jump(f, a1, a2);
break;
/* --------------- */
case 0224: // J>Z jump if N1 > 0 and erase N1
if ( np < 0 ) illegal("00N");
wms = nestms[np--];
if ( (wms&040000000) == 0 ) // if N1 not negative
{ wls = nestls[np+1];
if ( wms != 0 || wls != 0 ) // if N1 not zero
jump(f, a1, a2);
}
break;
/* --------------- */
case 0204: // JLEZ jump if N1 ≤ 0 and erase N1
if ( np < 0 ) illegal("00N");
wms = nestms[np--];
if ( (wms&040000000) != 0 ) // if N1 sign digit set
jump(f, a1, a2);
wls = nestls[np+1];
if ( wms == 0 && wls == 0 ) // if N1 = 0
jump(f, a1, a2);
break;
/* --------------- */
case 0226: // J=Z jump if N1 = 0 and erase N1
if ( np < 0 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
if ( wms == 0 && wls == 0 ) // if N1 = 0
jump(f, a1, a2);
break;
/* --------------- */
case 0206: // J!=Z jump if N1 != 0 and erase N1
if ( np < 0 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
if ( wms != 0 || wls != 0 ) // if N1 != 0
jump(f, a1, a2);
break;
/* --------------- */
case 0230: // JV jump if overflow is set
// printf("JV at %05o/%o vr = %d\n", (pc-3)/6, (pc-3)%6, vr);
if ( vr != 0 )
jump(f, a1, a2);
vr = 0;
break;
/* --------------- */
case 0210: // JNV jump if overflow is not set — probably true entry
// printf("JNV at %05o/%o vr = %d\n", (pc-3)/6, (pc-3)%6, vr);
if ( vr == 0 )
jump(f, a1, a2);
vr = 0;
break;
/* --------------- */
case 0232: // JEN jump if nesting store is empty
if ( np < 0 )
jump(f, a1, a2);
break;
/* --------------- */
case 0212: // JNEN if nesting store is not empty
if ( np >= 0 )
jump(f, a1, a2);
break;
/* --------------- */
case 0213: // J jump unconditionally
jump(f, a1, a2);
break;
/* --------------- */
case 0215: // JSE jump into a subroutine, address of next instruction is pushed into the SJNS
if ( sjnsp >= 15 ) illegal("00N - SJNS");
sjns[++sjnsp] = pc - 3; // address of start of jump instruction
jump(f, a1, a2);
break;
/* --------------- */
case 0234: // JEJ jump if SJNS is empty
if ( sjnsp < 0 )
jump(f, a1, a2);
break;
/* --------------- */
case 0214: // JNEJ jump if SJNS is not empty
if ( sjnsp >= 0 )
jump(f, a1, a2);
break;
/* --------------- */
case 0236: // JTR jump if test register is set
if ( tr != 0 )
jump(f, a1, a2);
tr = 0; // clear TR after test
break;
/* --------------- */
case 0216: // JNTR jump if test register is not set
if ( tr == 0 )
jump(f, a1, a2);
tr = 0;
break;
/* --------------- */
case 0240: // JCqZ jump if Cq is zero
case 0241: case 0242: case 0243: case 0244: case 0245: case 0246: case 0247:
case 0250: case 0251: case 0252: case 0253: case 0254: case 0255: case 0256: case 0257:
if ( qc[a1>>4] == 0 )
jump(f, a1, a2);
break;
/* --------------- */
case 0260: // JCqNZ jump if Cq is non-zero
case 0261: case 0262: case 0263: case 0264: case 0265: case 0266: case 0267:
case 0270: case 0271: case 0272: case 0273: case 0274: case 0275: case 0276: case 0277:
if ( qc[a1>>4] != 0 )
jump(f, a1, a2);
break;
/* --------------- */
case 0211: // OUT
if ( np < 0 || ( nestms[np] == 0 && nestls[np] == 0 ) )
{ printf("Program ends cleanly at address %05o/%o\n", (pc-3)/6, (pc-3)%6);
exit(0);
}
else
outinstr();
break;
/* --------------- */
case 0217: // EXIT etc
if ( sjnsp < 0 ) illegal("00N - EXIT with empty SJNS");
if ( f == 0200 ) // EXIT1
pc = sjns[sjnsp--] + 3;
else if ( f == 0202 ) // EXIT
pc = sjns[sjnsp--];
else // EXIT with extra bits in function code ???
illegal("00 L - Bad EXIT instruction");
pc += (((a1&017)<<8) + a2) * 6; // add on the address part
if ( verbose > 0 )
printf("%05o/%o Exit to %05o/%o SJNS cells %d NEST cells %d\n", lastpc/6, lastpc%6, pc/6, pc%6, sjnsp+1, np+1);
break;
/* --------------- */
default:
illegal("00 L - Illegal instruction - 3-syllable");
}
}
else if ( f == 0304 ) // SET instruction
{ if ( np >= 15 )
illegal("00N");
if ( (a1 & 0200) == 0 ) // non-negative operand
{ nestms[++np] = 0;
nestls[np] = (a1<<8) + a2;
}
else // SET -ve
{ nestms[++np] = 077777777;
nestls[np] = (a1<<8) + 077600000 + a2;
}
}
else if ( (f&0305) == 0300 ) // main store fetch instruction
{ get48(qm[q2 = a1>>4] + ((f&070)<<9) + ((a1&017)<<8) + a2);
if ( (f&2) != 0 && q2 != 0 ) // Q-store increment if not Q0
{ qm[q2] = (qm[q2] + qi[q2]) & 0177777;
qc[q2] = (qc[q2] - 1) & 0177777;
}
}
else if ( (f&0305) == 0301 ) // main store store instruction
{ put48(qm[q2 = a1>>4] + ((f&070)<<9) + ((a1&017)<<8) + a2);
if ( (f&2) != 0 && q2 != 0 ) // Q-store increment if not Q0
{ qm[q2] = (qm[q2] + qi[q2]) & 0177777;
qc[q2] = (qc[q2] - 1) & 0177777;
}
}
else
illegal("00 L - Main store reference??");
}
else // 1- or 2-syllable instruction
switch (f)
{ case 0000:
illegal("No instruction 000");
break;
/* --------------- */
case 001: // VR clear overflow register
vr = 0;
break;
/* --------------- */
case 002: // =TR set test register
if ( np < 0 ) illegal("00N");
tr = nestms[np--] >> 23;
break;
/* --------------- */
case 003: // BITS count number of bits in the word
if ( np < 0 ) illegal("00N");
wls = 0;
wms = nestms[np];
while ( wms != 0 )
{ wms &= wms - 1; // removes the least sig bit
wls ++;
}
wms = nestls[np];
while ( wms != 0 )
{ wms &= wms - 1; // removes the least sig bit
wls ++;
}
nestms[np] = 0;
nestls[np] = wls;
break;
/* --------------- */
case 007: // *+F like *DF but then followed by double-length addition
case 004: // *F floating-point multiply
case 005: // *DF floating-point multiply - double-length result from 48-bit operands
if ( np < 2 ) illegal("00N");
wms = nestms[np]; wls2 = nestls[np--];
q2 = fix39(); wms2 = wms; // q2 holds the exponent.
wms = nestms[np]; wls = nestls[np];
q2 += fix39() - 128; // exponent of result
timesdouble(9);
if ( f == 004 ) // single length result
float39(q2);
else // double length result
{ float78(q2);
nestms[np-1] = wms2; nestls[np-1] = wls2;
}
nestms[np] = wms; nestls[np] = wls;
if ( f != 007 ) // not *+F
break;
/* --------------- */
case 023: // +DF add double-length floating-point
if ( np < 3 ) illegal("00N");
notyetimplemented(0023, "+DF");
break;
/* --------------- */
// notyetimplemented(0005, "*DF");
break;
/* --------------- */
case 0006: // Illegal
illegal("00 L - No instruction 006");
break;
/* --------------- */
// notyetimplemented(0007, "*+F");
break;
/* --------------- */
case 010: // NEGD negate - double-length
if ( np < 1 ) illegal("00N");
wls = 0;
wms = 0;
wls2 = nestls[np-1]; // N2 least sig
wms2 = nestms[np-1] & 037777777; // N2 with sign digit cleared
// printf("2nd operand = %08o %08o\n", wms2, wls2);
sub48(wms2, wls2);
// printf("LS sub48 = %08o %08o\n", wms, wls);
nestls[np-1] = wls; // N2
nestms[np-1] = wms & 037777777; // N2
wls2 = nestls[np] + (wms>>23); // N1 least sig + borrow added from least sig half
wms2 = nestms[np]; // N1 most sig
// printf("old N1 + carry = %08o %08o\n", wms2, wls2);
wls = 0;
wms = 0;
sub48(wms2, wls2);
nestls[np] = wls; // N1 least sig
nestms[np] = wms; // N1 most sig
break;
/* --------------- */
case 011: // OR inclusive or
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
nestms[np] |= wms; nestls[np] |= wls;
break;
/* --------------- */
case 012: // PERM permute top 3 nest cells, N1 becomes N3
if ( np < 2 ) illegal("00N");
wms = nestms[np-1]; wls = nestls[np-1];
nestms[np-1] = nestms[np-2]; nestls[np-1] = nestls[np-2];
nestms[np-2] = nestms[np]; nestls[np-2] = nestls[np];
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 013: // TOB convert six chars in N1 to binary number, radix word in N2
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wms2 = nestms[np-1];
wls = nestls[np]; wls2 = nestls[np-1];
{ char n1[8], n2[8];
int res = 0;
int i;
n1[0] = wms>>18; n1[1] = (wms>>12) & 077; n1[2] = (wms>>6) & 077; n1[3] = wms & 077;
n1[4] = wls>>18; n1[5] = (wls>>12) & 077; n1[6] = (wls>>6) & 077; n1[7] = wls & 077;
n2[0] = wms2>>18; n2[1] = (wms2>>12) & 077; n2[2] = (wms2>>6) & 077; n2[3] = wms2 & 077;
n2[4] = wls2>>18; n2[5] = (wls2>>12) & 077; n2[6] = (wls2>>6) & 077; n2[7] = wls2 & 077;
// printf("N1 = %02o %02o %02o %02o %02o %02o %02o %02o\n", n1[0], n1[1], n1[2], n1[3], n1[4], n1[5], n1[6], n1[7]);
// printf("N2 = %02o %02o %02o %02o %02o %02o %02o %02o\n", n2[0], n2[2], n2[2], n2[3], n2[4], n2[5], n2[6], n2[7]);
for ( i = 0; i<8; i++ )
if ( n1[i] >= n2[i] )
illegal("Bad TOB instruction");
else
res = res*n2[i] + n1[i];
nestms[--np] = res>>24;
nestls[np] = res & 077777777;
}
break;
/* --------------- */
case 014: // ROUNDH round to half word
if ( np < 0 ) illegal("00N");
if ( (nestls[np] & 040000000) != 0 )
nestms[np] ++;
nestls[np] = 0;
break;
/* --------------- */
case 015: // NEV not equivalent, i.e. exclusive or
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
nestms[np] ^= wms; nestls[np] ^= wls;
break;
/* --------------- */
case 016: // ROUND round double number in N1,N2 to single in N1
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
if ( (nestms[np] & 020000000) != 0 ) // need to round
add48(0, 1);
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 017: // DUMMY do nothing as quickly as possible
// if ( np < 0 ) // take away the comment for a simple trace facility
// printf("Nest EMPTY\n");
// else
// printf("N1 = %08o %08o\n", nestms[np], nestls[np]);
break;
/* --------------- */
case 020: // ROUNDF round floating-point double number in N1,N2 to single in N1
if ( np < 0 ) illegal("00N");
nestms[np-1] = nestms[np];
nestls[np-1] = nestls[np]; // TEMP !!! just truncate
np --;
// notyetimplemented(0020, "ROUNDF");
break;
/* --------------- */
case 021: // ROUNDHF round floating-point number to half length
if ( np < 0 ) illegal("00N");
notyetimplemented(0021, "ROUNDHF");
break;
/* --------------- */
case 022: // -DF subtract double-length floating-point
notyetimplemented(0022, "-DF");
break;
/* --------------- */
case 024: // FLOAT convert fixed point number to floating-point
if ( np < 1 ) illegal("00N");
wls2 = nestls[np--] - 128; // number of integral places adjusted for exponent
if ( (wms = nestms[np]) + (wls = nestls[np]) != 0 ) // if number was not exactly zero
{ int sigbit = (wms & 040000000) >> 1;
while ( (wms & 020000000) == sigbit )
{ wls += wls; // shift it all up one
wms += wms + (wls>>24);
wls &= 077777777;
wls2 --; // and reduce the number of integral places
}
nestms[np] = (wms & 040000000) // sign digit
+ ((wls2&0377)<<15) // exponent
+ ((wms & 037777777)>>8); // top 15 bits of mantissa
nestls[np] = ((wms & 0377)<<16) // next 8 bits
+ (wls>>8); // last 16 bits - should this round?
}
break;
/* --------------- */
case 025: // FLOATD convert double-length fixed point number to floating-point
if ( np < 2 ) illegal("00N");
q2 = nestls[np--] - 128; // number of integral places adjusted for exponent
wms = nestms[np];
wls = nestls[np];
wms2 = nestms[np-1] & 037777777; // mask out any spurious sign bit in LS half
wls2 = nestls[np-1];
if ( (wms | wls | wms | wls) != 0 ) // if number was not exactly zero
{ int sigbit = (wms & 040000000) >> 1;
while ( (wms & 020000000) == sigbit )
{ wls2 += wls2; // shift it all up one
wms2 += wms2 + (wls2>>24);
wls2 &= 077777777;
wls += wls + (wms2>>23);
wms2 &= 037777777;
wms += wms + (wls>>24);
wls &= 077777777;
q2 --; // and reduce the number of integral places
}
q2 &= 0377;
nestms[np] = (wms & 040000000) // sign digit
+ (q2<<15) // exponent
+ ((wms & 037777777)>>8); // top 15 bits of mantissa
nestls[np] = ((wms & 0377)<<16) // next 8 bits
+ (wls>>8); // last 16 bits of top half
nestms[np-1] = ((q2-39)<<15) // exponent of bottom half
+ ((wls&0377)<<7) // last 8 bits of top half fixed are in bottom half of float
+ (wms2>>17); // completes top 24 bits of bottom mantissa
nestls[np-1] = ((wms2 & 0377777)<<7) // next 17 bits
+ (wls2>>17); // last 7 bits - should this round? - doubt it
}
break;
/* --------------- */
case 026: // ABS absolute value
if ( np < 0 ) illegal("00N");
if ( (nestms[np]&040000000) == 0 ) // if N1 >= 0
break; // operand is not negative, so do nothing
// break; // fall through onto NEG
/* --------------- */
case 027: // NEG negate
if ( np < 0 ) illegal("00N");
wms = 0; wls = 0; // first operand is zero
sub48(nestms[np], nestls[np]); // N1
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 032: // MAX re-order N1, N2 to that larger is in N1, set VR if swapped (or if equal!)
wms = nestms[np] ^ 040000000; wls = nestls[np]; // invert sign digits for a simple test
wms2 = nestms[np-1] ^ 040000000; wls2 = nestls[np-1];
if ( wms < wms2 || (wms == wms2 && wls2 >= wls) )
{ vr = 1;
nestls[np] = wls2;
nestls[np-1] = wls;
wms = nestms[np];
nestms[np] = nestms[np-1];
nestms[np-1] = wms;
}
break;
/* --------------- */
case 033: // NOT invert ones and zeroes
if ( np < 0 ) illegal("00N");
nestms[np] ^= 077777777; nestls[np] ^= 077777777;
break;
/* --------------- */
case 034: // *D multiply two 48-bit values to give double-length result
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wms2 = nestms[np-1];
wls = nestls[np]; wls2 = nestls[np-1];
timesdouble(1);
nestms[np] = wms; nestls[np] = wls;
nestms[np-1] = wms2; nestls[np-1] = wls2;
break;
/* --------------- */
case 035: // * multiply
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wms2 = nestms[np-1];
wls = nestls[np]; wls2 = nestls[np-1];
timesdouble(1);
if ( (wms2 & 020000000) != 0 ) // need to round
add48(0, 1);
nestms[--np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 036: // - subtract
if ( np < 1 ) illegal("00N");
wms = nestms[--np]; wls = nestls[np]; // first operand in N2
sub48(nestms[np+1], nestls[np+1]); // N1 before change in np
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 037: // SIGN +1 if N1 - N2 > 0, -1 if N1 - N2 < 0, 0 if N1 - N2 = 0,
if ( np < 1 ) illegal("00N");
wms = nestms[--np]; wls = nestls[np]; // first operand in N2
wms2 = nestms[np+1]; // N1 before change in np
if ( ((wms ^ wms2) & 040000000) == 0 ) // if signs are different, sub48 might overflow
sub48(wms2, nestls[np+1]); // so only subtract if signs are the same
if ( (wms & 040000000) != 0 ) // -ve result
wms = (wls = 077777777);
else if ( wms != 0 || wls != 0 ) // +ve result
{ wms = 0;
wls = 1;
} // or just leave the zero
nestms[np] = wms; nestls[np] = wls;
// notyetimplemented(0037, "SIGN");
break;
/* --------------- */
case 0040: // Illegal
illegal("No instruction 040");
break;
/* --------------- */
case 041: // ZERO put 0 in N1
if ( np >= 15 ) illegal("00N");
nestms[++np] = 0;
nestls[np] = 0;
break;
/* --------------- */
case 042: // DUP duplicate, i.e. put copy of N1 in N1
if ( np < 0 || np >= 15 ) illegal("00N");
nestms[np+1] = nestms[np]; nestls[np+1] = nestls[np]; np ++;
break;
/* --------------- */
case 043: // DUPD duplicate double-length
if ( np < 1 || np >= 14 ) illegal("00N");
nestms[np+2] = nestms[np]; nestls[np+2] = nestls[np];
nestms[np+1] = nestms[np-1]; nestls[np+1] = nestls[np-1]; np += 2;
break;
/* --------------- */
case 044: // %I integer divide, N1 = remainder, N2 = quotient
if ( np < 1 ) illegal("00N");
if ( (nestms[np-1]&040000000) != 0 ) // numerator is negative
wms = 077777777;
else
wms = 0;
wls = wms;
wms2 = nestms[np]; wls2 = nestls[np]; // denominator
dividedouble(0, nestms[np-1], nestls[np-1], wms2, wls2);
nestms[np] = wms; nestls[np] = wls;
nestms[np-1] = wms2; nestls[np-1] = wls2;
break;
/* --------------- */
case 045: // FIX convert floating-point to fixed point
if ( np < 0 || np >= 15 ) illegal("00N");
if ( (wms = nestms[np]) + (wls = nestls[np]) == 0 ) // number was exactly zero
{ nestls[++np] = 0; // or should it be 47;
nestms[np] = 0; // the programming manual does not say what happens here
} // should it just give -128?!? -- i.e. just do as for other numbers
else
{ nestls[np] = (wls<<8) & 077777400;
nestms[np] = (wls>>16) + ((wms<<8) & 037777400) + (wms & 040000000);
wls = ((wms>>15)&0377) - 128; // number of integral places
nestls[++np] = wls & 077777777;
if ( wls < 0 ) // small number
nestms[np] = 077777777;
else
nestms[np] = 0;
}
break;
/* --------------- */
case 0046: // Illegal
illegal("No instruction 046");
break;
/* --------------- */
case 047: // STR stretch 48-bit number to double-length
if ( np < 0 || np >= 15 ) illegal("00N");
if ( (wms = nestms[np]&040000000) != 0 ) // N1 < 0
{ nestms[np] -= wms; wms = 077777777;
}
nestms[++np] = wms; nestls[np] = wms;
break;
/* --------------- */
case 050: // CONT convert double length integer in N1, N2 to single length in N1
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
if ( wms == 0 && wls == 0 ) // if old N1 is zero
nestms[np] &= 037777777; // clear new N1 sign digit
else // either -ve or overflow
{ nestms[np] = (nestms[np] & 037777777)
| (wms&040000000); // set N1 sign digit as copy of old N1
if ( wms != 077777777 || wls != 077777777 )
vr = 1; // overflow
}
break;
/* --------------- */
case 051: // REVD swap N1 and N3, N2 and N4
if ( np < 3 ) illegal("00N");
wms = nestms[np-2]; wls = nestls[np-2];
nestms[np-2] = nestms[np]; nestls[np-2] = nestls[np];
nestms[np] = wms; nestls[np] = wls;
wms = nestms[np-1]; wls = nestls[np-1];
nestms[np-1] = nestms[np-3]; nestls[np-1] = nestls[np-3];
nestms[np-3] = wms; nestls[np-3] = wls;
break;
/* --------------- */
case 052: // ERASE remove top cell of the nest
if ( np < 0 ) illegal("00N");
np --;
break;
/* --------------- */
case 053: // -D subtract double-length
if ( np < 3 ) illegal("00N");
wls = nestls[np-3]; // N4 least sig
wms = nestms[np-3] & 037777777; // N4 with sign digit cleared
// printf("1st operand = %08o %08o\n", wms, wls);
wls2 = nestls[np-1]; // N2 least sig
wms2 = nestms[np-1] & 037777777; // N2 with sign digit cleared
// printf("2nd operand = %08o %08o\n", wms2, wls2);
sub48(wms2, wls2);
// printf("LS sub48 = %08o %08o\n", wms, wls);
nestls[np-3] = wls; // N4 least sig, will become N2
nestms[np-3] = wms & 037777777; // N2 eventually
wls2 = nestls[np] + (wms>>23); // N1 least sig + borrow added from least sig half
wms2 = nestms[np--]; // N1 most sig
// printf("old N1 + carry = %08o %08o\n", wms2, wls2);
wls = nestls[--np]; // N3 least sig
wms = nestms[np]; // N3 most sig
sub48(wms2, wls2);
nestls[np] = wls; // N1 least sig
nestms[np] = wms; // N1 most sig
break;
/* --------------- */
case 054: // AND logical and
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
nestms[np] &= wms; nestls[np] &= wls;
break;
/* --------------- */
case 0055: // Illegal
illegal("No instruction 055");
break;
/* --------------- */
case 056: // + add
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls = nestls[np--];
add48(nestms[np], nestls[np]);
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 0163: // 020 *+Cq equivalent to *D; SHADCq; +D;
if ( np < 3 ) illegal("00N");
q2 = shiftvalue(); // shift value in q2 and N1 loaded into wms, wls
wls = nestls[np]; wls2 = nestls[np-1]; // code from *D
timesdouble(1);
// nestms[np] = wms; nestls[np] = wls;
// nestms[np-1] = wms2; nestls[np-1] = wls2;
printf(" After multiply N1 = %08o %08o, N2 = %08o %08o, %c\n", wms, wls, wms2, wls2, ' ' + ('V'-' ')*vr);
shift95(q2); // code from SHADCq
nestms[np-1] = wms2; nestls[np-1] = wls2;
nestms[np] = wms; nestls[np] = wls;
printf(" After shift N1 = %08o %08o, N2 = %08o %08o %c\n", wms, wls, wms2, wls2, ' ' + ('V'-' ')*vr);
printf(" After shift N3 = %08o %08o, N4 = %08o %08o %c\n", nestms[np-2], nestls[np-2], nestms[np-3], nestls[np-3], ' ' + ('V'-' ')*vr);
// notyetimplemented(0163, "*+Cq");
// break; // drop thourgh onto +D
/* --------------- */
case 057: // +D add double-length
if ( np < 3 ) illegal("00N");
wls = nestls[np-3]; // N4 least sig
wms = nestms[np-3] & 037777777; // N4 with sign digit cleared
// printf("1st operand = %08o %08o\n", wms, wls);
wls2 = vr; // keep vr as next add48 may set it in error
wms2 = nestms[np-1] & 037777777; // N2 with sign digit cleared
// printf("2nd operand = %08o %08o\n", wms2, wls2);
add48(wms2, nestls[np-1]); // N2 least sig is in nestls[np-1]
vr = wls2; // undo any damage caused by add48
// printf("LS add48 = %08o %08o\n", wms, wls);
nestls[np-3] = wls; // N4 least sig, will become N2
nestms[np-3] = wms & 037777777; // N2 eventually
wls2 = nestls[np] + (wms>>23); // N1 least sig + carry added from least sig half
wms2 = nestms[np--]; // N1 most sig
// printf("old N1 + carry = %08o %08o\n", wms2, wls2);
wls = nestls[--np]; // N3 least sig
wms = nestms[np]; // N3 most sig
add48(wms2, wls2);
nestls[np] = wls; // N1 least sig
nestms[np] = wms; // N1 most sig
break;
/* --------------- */
case 060: // % divide
if ( np < 1 ) illegal("00N");
wms2 = nestms[np]; wls2 = nestls[np--];
wms = nestms[np]; wls = nestls[np];
dividedouble(1, 0, 0, wms2, wls2);
nestms[np] = wms2; nestls[np] = wls2;
// notyetimplemented(0060, "%");
break;
/* --------------- */
case 061: // %D divide double-length
if ( np < 2 ) illegal("00N");
wms2 = nestms[np]; wls2 = nestls[np--];
wms = nestms[np]; wls = nestls[np--];
dividedouble(1, nestms[np], nestls[np], wms2, wls2);
nestms[np] = wms2; nestls[np] = wls2;
// notyetimplemented(0061, "%D");
break;
/* --------------- */
case 062: // %F divide floating-point
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls2 = nestls[np--];
q2 = fix39(); wms2 = wms; // q2 holds the exponent.
wms = nestms[np]; wls = nestls[np];
q2 = fix39() + 128 - q2; // exponent of result
if ( verbose >= 5 )
printf("wms = %08o wls = %08o wms2 = %08o wls2 = %08o\n", wms, wls, wms2, wls2);
dividedouble(9, 0, 0, wms2, wls2);
if ( verbose >= 5 )
printf("wms = %08o wls = %08o wms2 = %08o wls2 = %08o\n", wms, wls, wms2, wls2);
wms = ((wls<<15) + wms2) & 077777777; wls = wls2;
float39(q2);
nestms[np] = wms; nestls[np] = wls;
// notyetimplemented(0062, "%F");
break;
/* --------------- */
case 063: // %DF divide double-length floating-point
if ( np < 2 ) illegal("00N");
notyetimplemented(0063, "%DF");
break;
/* --------------- */
case 064: // %R fancy divide for multi-length division
if ( np < 2 ) illegal("00N");
wms2 = nestms[np]; wls2 = nestls[np--];
wms = nestms[np]; wls = nestls[np]; // MS half of numerator
dividedouble(1, nestms[np-1], nestls[np-1], wms2, wls2);
nestms[np] = wms2; nestls[np] = wls2; // quotient delivered to N1
nestms[np-1] = wms; nestls[np-1] = wls; // "remainder" delivered to N2
// notyetimplemented(0064, "%R");
break;
/* --------------- */
case 065: // REV reverse, i.e. swap N1 and N2
if ( np < 1 ) illegal("00N");
wms = nestms[np-1]; wls = nestls[np-1];
nestms[np-1] = nestms[np]; nestls[np-1] = nestls[np];
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 066: // CAB permute top 3 nest cells, N3 becomes N1
if ( np < 2 ) illegal("00N");
wms = nestms[np-2]; wls = nestls[np-2];
nestms[np-2] = nestms[np-1]; nestls[np-2] = nestls[np-1];
nestms[np-1] = nestms[np]; nestls[np-1] = nestls[np];
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 067: // FRB convert binary to characters, radix in N2
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wms2 = nestms[np-1];
wls = nestls[np]; wls2 = nestls[np-1];
{ char nn[8];
int i = 8;;
wls += wms<<24;
nn[0] = wms2>>18; nn[1] = (wms2>>12) & 077; nn[2] = (wms2>>6) & 077; nn[3] = wms2 & 077;
nn[4] = wls2>>18; nn[5] = (wls2>>12) & 077; nn[6] = (wls2>>6) & 077; nn[7] = wls2 & 077;
while ( --i >= 0 )
{ wms2 = nn[i]; // radix
wls += (wms % wms2) << 24;
wms = wms / wms2;
nn[i] = wls % wms2; // digit
wls = wls / wms2;
}
nestms[--np] = (nn[0]<<18) + (nn[1]<<12) + (nn[2]<<6) + nn[3];
nestls[np] = (nn[4]<<18) + (nn[5]<<12) + (nn[6]<<6) + nn[7];
if ( wls != 0 || wms != 0 )
vr = 1; // number was too big to fit the radix pattern given
}
break;
/* --------------- */
case 070: // STAND standardise floating-point number
if ( np < 0 ) illegal("00N");
notyetimplemented(0070, "STAND");
break;
/* --------------- */
case 071: // NEGDF negate double-length floating-point
if ( np < 1 ) illegal("00N");
notyetimplemented(0071, "NEGDF");
break;
/* --------------- */
case 072: // MAXF swap N1 N2 so that N1 is larger floating-point
if ( np < 1 ) illegal("00N");
notyetimplemented(0072, "MAXF");
break;
/* --------------- */
case 0073: // Illegal
illegal("No instruction 073");
break;
/* --------------- */
case 074: // +F add floating-point
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls2 = nestls[np--];
q2 = fix39(); wms2 = wms; // q2 holds the exponent.
wms = nestms[np]; wls = nestls[np];
q1 = fix39(); // exponent of other operand
// printf("N1 = %08o %08o / %d\n", wms2, wls2, q2);
// printf("N2 = %08o %08o / %d\n", wms, wls, q1);
if ( q1 < q2 )
q1 = scaleup(q1, q2);
else if ( q2 < q1 )
scaleup2(q2, q1);
add48(wms2, wls2);
float39(q1);
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 030: // ABSF absolute value floating-point
if ( np < 0 ) illegal("00N");
if ( (nestms[np]&040000000) == 0 ) // if N1 >= 0
break; // operand is not negative, so do nothing
// break; // fall through onto NEGF
/* --------------- */
case 031: // NEGF negate floating-point
if ( np < 0 ) illegal("00N");
nestms[np+1] = nestms[np]; nestls[np+1] = nestls[np]; // REV: -- half thereof
nestms[np] = 0; nestls[np++] = 0; // ZERO;
// break; // fall through onto -F
/* --------------- */
case 077: // SIGNF like SIGN but floating-point
case 075: // -F subtract floating-point
if ( np < 1 ) illegal("00N");
wms = nestms[np]; wls2 = nestls[np--];
q2 = fix39(); wms2 = wms; // q2 holds the exponent of 1st operand, i.e. N2
wms = nestms[np]; wls = nestls[np];
q1 = fix39(); // exponent of 2nd operand, i.e. N1
// printf("N1 = %08o %08o / %d\n", wms, wls, q1);
// printf("N2 = %08o %08o / %d\n", wms2, wls2, q2);
if ( q1 < q2 )
q1 = scaleup(q1, q2);
else if ( q2 < q1 )
scaleup2(q2, q1);
sub48(wms2, wls2);
float39(q1);
if ( f == 077 ) // if SIGNF
{ if ( (wms & 040000000) != 0 ) // -ve result
wms = (wls = 077777777);
else if ( wms != 0 || wls != 0 ) // +ve result
{ wms = 0;
wls = 1;
} // or just leave the zero
}
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 0076: // Illegal
illegal("No instruction 076");
break;
/* --------------- */
case 0100: // MqMq fetch 48-bit value in address q + q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
get48(qm[q1] + qm[q2]);
break;
/* --------------- */
case 0101: // =MqMq store 48-bit value in address q + q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
put48(qm[q1] + qm[q2]);
break;
/* --------------- */
case 0102: // MqMqQ fetch 48-bit value in address q + q and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
get48(qm[q1] + qm[q2]);
qm[q1] = (qm[q1] + qi[q1]) & 0177777;
if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777;
break;
/* --------------- */
case 0103: // =MqMqQ fetch 48-bit value in address q + q and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
put48(qm[q1] + qm[q2]);
qm[q1] = (qm[q1] + qi[q1]) & 0177777;
if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777;
break;
/* --------------- */
case 0104: // MqMqH fetch 24-bit value in address hq + q to N1 top half and zeroise bottom half
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
get24(qm[q1], qm[q2]);
break;
/* --------------- */
case 0105: // =MqMqH store 24-bit value in address hq + q N.B. top half of N1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
put24(qm[q1], qm[q2]);
break;
/* --------------- */
case 0106: // MqMqQH fetch 24-bit value in address hq + q and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0106, "MqMqQH");
break;
/* --------------- */
case 0107: // =MqMqQH store 24-bit value in address hq + q and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0107, "=MqMqQH");
break;
/* --------------- */
case 0110: // MqMqN fetch 48-bit value in address q + q + 1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
get48(qm[q1] + qm[q2] + 1);
break;
/* --------------- */
case 0111: // =MqMqN store 48-bit value in address q + q + 1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
put48(qm[q1] + qm[q2] + 1);
break;
/* --------------- */
case 0112: // MqMqQN fetch 48-bit value in address q + q + 1 and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
get48(qm[q1] + qm[q2] + 1);
qm[q1] = (qm[q1] + qi[q1]) & 0177777;
if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777;
break;
/* --------------- */
case 0113: // =MqMqQN store 48-bit value in address q + q + 1 and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
put48(qm[q1] + qm[q2] + 1);
qm[q1] = (qm[q1] + qi[q1]) & 0177777;
if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777;
break;
/* --------------- */
case 0114: // MqMqHN fetch 24-bit value in address hq + q + 1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
get24(qm[q1], qm[q2] + 1);
break;
/* --------------- */
case 0115: // =MqMqHN store 24-bit value in address hq + q + 1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
put24(qm[q1], qm[q2] + 1);
break;
/* --------------- */
case 0116: // MqMqQHN fetch 24-bit value in address hq + q + 1 and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0116, "MqMqQHN");
break;
/* --------------- */
case 0117: // =MqMqQHN store 24-bit value in address hq + q + 1 and increment Qq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0117, "=MqMqQHN");
break;
/* --------------- */
case 0151: // MqTOQq copy Mq to modifier of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qm[q2] = qm[q1];
break;
/* --------------- */
case 0152: // IqTOQq copy Iq to increment of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qi[q2] = qi[q1];
break;
/* --------------- */
case 0153: // IMqTOQq copy Iq and Mq to increment and modifier of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qi[q2] = qi[q1]; qm[q2] = qm[q1];
break;
/* --------------- */
case 0154: // CqTOQq copy Cq to counter of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qc[q2] = qc[q1];
break;
/* --------------- */
case 0155: // CMqTOQq copy Cq and Mq to counter and modifier of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qc[q2] = qc[q1]; qm[q2] = qm[q1];
break;
/* --------------- */
case 0156: // CIqTOQq copy Cq and Iq to counter and increment of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qc[q2] = qc[q1]; qi[q2] = qi[q1];
break;
/* --------------- */
case 0157: // QqTOQq copy Qq to all of Q
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qc[q2] = qc[q1]; qi[q2] = qi[q1]; qm[q2] = qm[q1];
break;
/* --------------- */
case 0140: // 020 M+Iq modifier of Mq increased by value in Iq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qm[q1] = (qm[q1] + qi[q1]) & 0177777;
break;
/* --------------- */
case 0141: // 020 M-Iq modifier of Mq decreased by value in Iq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
if ( q2 != 0 ) illegal("00 L - Illegal instruction");
qm[q1] = (qm[q1] - qi[q1]) & 0177777;
break;
/* --------------- */
case 0142: // 020 NCq negate Cq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qc[q1] = (-qc[q1]) & 0177777;
break;
/* --------------- */
case 0143: // 020 DCq decrement Cq
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777;
break;
/* --------------- */
case 0144: // 020 Iq=+1 Iq = +1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qi[q1] = 1;
break;
/* --------------- */
case 0145: // 020 Iq=-1 Iq = -1
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qi[q1] = 0177777;
break;
/* --------------- */
case 0146: // 020 Iq=+2 Iq = +2
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qi[q1] = 2;
break;
/* --------------- */
case 0147: // 020 Iq=-2 Iq = -2
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
qi[q1] = 0177776;
break;
/* --------------- */
case 0161: // 020 SHACq shift arithmetic by number of bits in Cq
if ( np < 0 ) illegal("00N");
q2 = shiftvalue(); // shift value in q2 and N1 loaded into wms, wls
wms2 = 0; wls2 = 0;
shift95(q2);
if ( (wms2 & 020000000) != 0 ) // rounding up needed
if ( ++wls == 0100000000 ) // carry from lower half
{ wms ++; wls = 0; // N.B. cannot overflow
wms &= 077777777; // incase rounding up -1 to 0
}
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 0162: // 020 SHADCq shift arithmetic double-length by number of bits in Cq
if ( np < 1 ) illegal("00N");
q2 = shiftvalue(); // shift value in q2 and N1 loaded into wms, wls
wms2 = nestms[np-1]; wls2 = nestls[np-1];
shift95(q2);
nestms[np-1] = wms2; nestls[np-1] = wls2;
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
// case 0163: // 020 *+Cq equivalent to *D; SHADCq; +D; -- with +D
/* --------------- */
case 0164: // 020 SHLCq shift logical by number of bits in Cq
if ( np < 0 ) illegal("00N");
q2 = shiftvalue(); // shift value in q2 and N1 loaded into wms, wls
{ int w, shval;
shval = MAXSHIFT; // maximum that can be shifted in one word
if ( q2 < 0 ) // shift right
{ if ( (q2 = -q2) < shval )
shval = q2;
while ( q2 > 0 )
{ wls |= (wms<<24); wls = wls >> shval; wls &= 077777777;
wms = wms >> shval;
if ( (q2 -= shval) < shval )
shval = q2;
}
}
else // shift left or not at all
{ if ( q2 < shval )
shval = q2;
while ( q2 > 0 )
{ wls = wls << shval; w = wls >> 24; wls &= 077777777;
wms = ((wms << shval) | w) & 077777777;
if ( (q2 -= shval) < shval )
shval = q2;
}
}
}
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 0166: // 020 SHLDCq shift logical double-length by number of bits in Cq
if ( np < 1 ) illegal("00N");
q2 = shiftvalue(); // shift value in q2 and N1 loaded into wms, wls
{ int sh2, sh3, w, shval;
sh2 = nestms[np-1]; sh3 = nestls[np-1];
shval = MAXSHIFT; // maximum that can be shifted in one word
if ( q2 < 0 ) // shift right
{ if ( (q2 = -q2) < shval )
shval = q2;
while ( q2 > 0 )
{ sh3 |= (sh2<<24); sh3 = sh3 >> shval; sh3 &= 077777777;
sh2 |= (wls<<24); sh2 = sh2 >> shval; sh2 &= 077777777;
wls |= (wms<<24); wls = wls >> shval; wls &= 077777777;
wms = wms >> shval;
if ( (q2 -= shval) < shval )
shval = q2;
}
}
else // shift left or not at all
{ if ( q2 < shval )
shval = q2;
while ( q2 > 0 )
{ sh3 = sh3 << shval; w = sh3 >> 24; sh3 &= 077777777;
sh2 = (sh2 << shval) | w; w = sh2 >> 24; sh2 &= 077777777;
wls = (wls << shval) | w; w = wls >> 24; wls &= 077777777;
wms = ((wms << shval) | w) & 077777777;
if ( (q2 -= shval) < shval )
shval = q2;
}
}
nestms[np] = wms; nestls[np] = wls; nestms[np-1] = sh2; nestls[np-1] = sh3;
}
break;
/* --------------- */
case 0167: // 020 SHCCq shift cyclic by number of bits in Cq
if ( np < 0 ) illegal("00N");
q2 = shiftvalue(); // shift value in q2 and N1 loaded into wms, wls
{ int w, shval;
shval = MAXSHIFT; // maximum that can be shifted in one word
if ( q2 < 0 ) // shift right
{ if ( (q2 = -q2) < shval )
shval = q2;
while ( q2 > 0 )
{ wms |= (wls<<24); // put tail end round onto the top
wls |= (wms<<24); wls = wls >> shval; wls &= 077777777;
wms = wms >> shval; wms &= 077777777;
if ( (q2 -= shval) < shval )
shval = q2;
}
}
else // shift left or not at all
{ if ( q2 < shval )
shval = q2;
while ( q2 > 0 )
{ wls = wls << shval; wms = wms << shval;
wms |= wls >> 24; wls &= 077777777;
wls |= wms >> 24; wms &= 077777777;
if ( (q2 -= shval) < shval )
shval = q2;
}
}
}
nestms[np] = wms; nestls[np] = wls;
break;
/* --------------- */
case 0170: // =Mq, =RMq, etc
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
if ( np < 0 ) illegal("00N");
switch(q2)
{ case 002: // =Mq bottom 16 bits of N1 put in Mq
qm[q1] = nestls[np--] & 0177777;
break;
case 003: // =RMq reset Qq to 0/1/0 then store N1 in Mq
qm[q1] = nestls[np--] & 0177777;
qi[q1] = 1; qc[q1] = 0;
break;
case 004: // =Iq bottom 16 bits of N1 put in Iq
qi[q1] = nestls[np--] & 0177777;
break;
case 005: // =RIq reset Qq to 0/1/0 then store N1 in Iq
qi[q1] = nestls[np--] & 0177777;
qc[q1] = 0; qm[q1] = 0;
break;
case 010: // =Cq bottom 16 bits of N1 put in Cq
qc[q1] = nestls[np--] & 0177777;
break;
case 011: // =RCq reset Qq to 0/1/0 then store N1 in Cq
qc[q1] = nestls[np--] & 0177777;
qi[q1] = 1; qm[q1] = 0;
break;
case 016: // =Qq all of N1 put in Mq
wms = nestms[np];
wls = nestls[np--];
qm[q1] = wls & 0177777;
qi[q1] = ((wms&0377)<<8) + (wls>>16);
qc[q1] = (wms >> 8) & 0177777;
break;
default:
illegal("00 L - Bad 170 order");
}
break;
/* --------------- */
case 0171:
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
if ( np > 15 ) illegal("00N");
wms = 0;
switch(q2)
{ case 002: // 022 Mq fetch Mq into N1
if ( ((nestls[++np] = qm[q1]) & 0100000) != 0 ) // negative value
{ wms = 077777777; nestls[np] |= 077600000; }
break;
case 004: // 024 Iq fetch Iq into N1
if ( ((nestls[++np] = qi[q1]) & 0100000) != 0 ) // negative value
{ wms = 077777777; nestls[np] |= 077600000; }
break;
case 010: // 030 Cq fetch Cq into N1
if ( ((nestls[++np] = qc[q1]) & 0100000) != 0 ) // negative value
{ wms = 077777777; nestls[np] |= 077600000; }
break;
case 016: // 036 Qq fetch Qq into N1
wms = (qc[q1]<<8) + ((wls = qi[q1])>>8);
nestls[++np] = qm[q1] + ((wls&0377)<<16);
break;
default:
illegal("Bad 171 order");
}
nestms[np] = wms;
break;
/* --------------- */
case 0172: // 022 =+Mq add value in N1 to Mq, etc
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
if ( np < 0 ) illegal("00N");
switch(q2)
{ case 002: // =+Mq add value in N1 to Mq
qm[q1] = (qm[q1] + nestls[np--]) & 0177777;
break;
case 004: // =+Iq add value in N1 to Iq
qi[q1] = (qi[q1] + nestls[np--]) & 0177777;
break;
case 010: // =+Cq add value in N1 to Cq
qc[q1] = (qc[q1] + nestls[np--]) & 0177777;
break;
case 016: // =+Qq add value in N1 to Qq
wms = (qc[q1]<<8) | (qi[q1]>>8);
wls = ((qi[q1]<<16) | qm[q1]) & 077777777;
wms += nestms[np];
if ( ((wls += nestls[np--]) & 0100000000) != 0 ) // carry set
wms ++;
qm[q1] = wls & 0177777; // Do we ignore overflow ???
qi[q1] = ((wms&0377)<<8) + ((wls>>16)&0377);
qc[q1] = (wms >> 8) & 0177777;
// printf("Q%d = %06o / %06o / %06o N1 = %08o %08o\n", q1, qc[q1], qi[q1], qm[q1], wms, wls);
break;
default:
illegal("00 L - Bad 172 order");
}
break;
/* --------------- */
case 0177: // 020 JCqNZS jump to start of previous word if Cq is non-zero
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
if ( qc[q1] != 0 ) // we need to jump
jump(0, 0, (pc-8)/6); // to start of previous word
break;
/* --------------- */
case 0120: // 020 CTQq etc clear transfer - director-mode only???
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
printf("%05o/%o Peripheral test PM?Q%d 120,%o\n", (pc-2)/6, (pc-2)%6, q1, q2);
if ( q2 == 010 ) // test for 5-hole paper tape
tr = 1; // set TR to indicate 8-hole tape
break; // only MLBQ = PMBQ sets TR to indicate 8-hole tape
// case 0120: // 021 MANUALQq set peripheral unready
// case 0120: // 022 BUSYQq test if peripheral is busy
// case 0120: // 024 MLBQq set test register if previous read was a last block
// case 0120: // 030 MBTQq set test register if at beginning of tape
/* --------------- */
case 0121: // 020 PARQq test if peripheral has parity fail set
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
break; // All our peripherals are perfect !!!
/* --------------- */
case 0122: // 020 METQq test if peripheral has end tape set (tape deck)
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0122, "METQq");
break;
/* --------------- */
case 0124: // 020 MFRQq, PRQq forward read
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0124, "MFRQq, PRQq");
break;
/* --------------- */
// case 0124: // 022 CLOQq clear lock-outs over area specified by Iq-Mq - director-mode only
illegal("CLOQq only allowed in director mode");
break;
// case 0124: // 024 TLOQq test for lock-out over area specified by Iq-Mq
// case 0124: // 030 PRCQq read paper tape, all 8 holes to each 48-bit word
/* --------------- */
case 0125: // 020 PREQq forward read to end message character
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
readptr(q1, 1);
break;
// case 0125: // 030 PRCEQq read paper tape to end message character, all 8 holes to each 48-bit word
/* --------------- */
case 0126: // 020 MBRQq backward read
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0126, "MBRQq");
break;
/* --------------- */
case 0127: // 020 MBREQq backward read to end message character
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0127, "MBREQq");
break;
/* --------------- */
case 0130: // 020 PWQq, MWQq write
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0130, "PWQq, MWQq");
break;
// case 0130: // 030 MLWQq write followed by tape mark, i.e. write a last block
// case 0130: // 034 PGAPQq punch blank paper tape tape
// case 0130: // 024 MWIPEQq leave a really big clear gap on mag tape
/* --------------- */
case 0131: // 020 MWEQq, PWEQq write to end message character
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0131, "MWEQq, PWEQq");
break;
// case 0131: // 030 MLWEQq write to end message character followed by tape mark, i.e. write a last block
/* --------------- */
case 0134: // 020 MFSKQq forward skip one block
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0134, "MFSKQq");
break;
/* --------------- */
// case 0134: // 022 INTQq if thie device is busy suspend execution of this process until any peripheral transfer finishes
notyetimplemented(0134, "INTQq");
break;
/* --------------- */
case 0136: // 020 MBSKQq backward skip one block
q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017;
notyetimplemented(0136, "MBSKQq");
break;
// case 0136: // 030 MRWDQq, PRWDQq rewind
// case 0120: // 030 PMBQq test MBT
// case 0120: // 024 PMCQq test MLB
// case 0124: // 026 PMHQq SET lock outs
// case 0134: // 024 PMKQq not known
// case 0136: // 024 PMLQq not known
/* --------------- */
case 0173: // LINK fetch top call of SJNS into N1
if ( sjnsp < 0 ) illegal("00N - SJNS empty");
if ( np >= 15 ) illegal("00N");
wms = sjns[sjnsp--];
wls = wms/6 + ((wms%6)<<13);
nestms[++np] = 0; nestls[np] = wls;
pc ++; // skip over zero 2nd syllable
break;
/* --------------- */
case 0174: // =LINK store N1 into top call of SJNS
if ( sjnsp >= 15 ) illegal("00N - SJNS full");
if ( np < 0 ) illegal("00N");
wls = nestls[np--];
sjns[++sjnsp] = (wls&017777)*6 + ((wls>>13)&07);
pc ++; // skip over zero 2nd syllable
break;
/* --------------- */
default:
illegal("00 L - Illegal instruction - 1- or 2-syllable");
}
// if ( verbose >= 4) // alternate location for main diagnostic
// { if ( np < 0 )
// printf("%05o/%o code = %03o %03o %03o NEST empty Q%d %06o/%06o/%06o\n",
// (lastpc)/6, (lastpc)%6, f, store[lastpc+1], store[lastpc+2], qmon, qc[qmon], qi[qmon], qm[qmon]);
// else
// printf("%05o/%o code = %03o %03o %03o N1 = %08o %08o Q%d %06o/%06o/%06o\n",
// (lastpc)/6, (lastpc)%6, f, store[lastpc+1], store[lastpc+2],
// nestms[np], nestls[np], qmon, qc[qmon], qi[qmon], qm[qmon]);
// }
if ( trfile != NULL )
hashState(lastpc);
}
}
void setpapertapechars()
{ int i;
for ( i = 0; i<256; i++ )
ptkdf9[i] = 0377; // KDF9 delete
for ( i = 0; i<64; i++ )
if ( nptchar[i] == sptchar[i] ) // both cases are the same
ptkdf9[nptchar[i]] = i;
else // cases are diferent
{ ptkdf9[nptchar[i]] = i + 0100;
ptkdf9[sptchar[i]] = i + 0200;
}
ptkdf9['»'&255] = 075; // Bill Findlay's end-message
ptkdf9['|'&255] = 075; // Bill Findlay's other end-message
ptkdf9['±'&255] = ptkdf9['#']; // Bill Findlay's not-equals
ptkdf9['º'&255] = ptkdf9['~']; // Bill Findlay's subscript-10
ptkdf9['÷'&255] = ptkdf9['%']; // Bill Findlay's integer divide
ptkdf9['×'&255] = ptkdf9['!']; // Bill Findlay's multiply
// for ( i = 16; i<128; i++ )
// printf("ASCII %c %02X %03o => %3o\n", i, i, i, ptkdf9[i]);
}
int readKDF9pc(char *p)
// p points at a KDF9 address %o/%o (null string gives 0)
{ char c;
int res = 0;
while ( isdigit(c = *(p++)) )
res = (res<<3) + c - '0';
res *= 6;
if ( c == '/' )
res += *p - '0';
return res;
}
int main(int argc, char **argv)
{ while ( argc >= 2 && *(argv[1]) == '-' ) // process switches
{ if ( argv[1][1] == 't' ) // trace
if ( argv[1][2] == 'c' ) // trace starts on instructions counter
trStartic = atoi(argv[1]+3);
else // trace starts on program address
trStartpc = readKDF9pc(argv[1]+2);
argc --;
argv ++;
}
if ( argc < 2 )
fprintf(stderr, "Usage: %s binary_file", *argv);
else
{ loadprogram(argv[1]);
if ( store[9] == 0 && store[10] == 0 && store[11] == 0 )
{ store[10] = 100; // changed from 127 for KAL4 experiments // Bill has E1 = 0031740000077777
store[11] = 255; // I had E1 = ???00077400
store[42] = 0115; // bogus date 31/03/68
store[43] = 0023; // bogus date
store[44] = 0320; // bogus date
store[45] = 0114; // bogus date
store[46] = 0365; // bogus date
store[47] = 0230; // bogus date
}
printf("Program store limit = %d words\n", store[9]*65536 + store[10]*256 + store[11]);
}
if ( argc >= 3 )
verbose = atoi(argv[2]);
if ( argc >= 4 )
{ char *p = argv[3];
char c;
if ( *p == 'c' )
diagStartic = atoi(p+1);
else
maxdiag = readKDF9pc(p);
printf("Initial verbosity = %d Max diagnostics start at %05o/%o\n", verbose, maxdiag/6, maxdiag%6);
}
if ( argc >= 5 )
qmon = atoi(argv[4]);
setpapertapechars();
punchdv = fopen("punch.txt", "w"); // temp ??? OUT 8 output to any non-zero stream
interpret();
}
void setprinterchars()
// probably will not use this routine
{ int i;
for ( i = '0'; i<='9'; i++ )
{ lpchar[i] = i - '0' + 020; // decimal digits
nptchar[i] = i - '0' + 0140; // decimal digits as repeat counts
}
for ( i = 'A'; i<='Z'; i++ )
lpchar[i] = i + 041 - 'A'; // uppercase letters
lpchar['%'] = 06;
lpchar['\''] = 07; // 07 '
lpchar[':'] = 010;
lpchar['='] = 011;
lpchar['('] = 012;
lpchar[')'] = 013;
nptchar['['] = '['; // for switching between sets
lpchar[']'] = ']';
lpchar['*'] = 015;
lpchar[','] = 016;
lpchar['/'] = 017;
lpchar['#'] = 033; // subscript 10 - what is this in Hans's code
lpchar['+'] = 035;
lpchar['-'] = 036;
lpchar['.'] = 037;
lpchar['$'] = 014; // 14 dd £
lpchar['#'] = 000; // space
lpchar[' '] = 65; // space is ignored in the printer constant
// 75 dd EM
// 76 dd start message
// 77 dd ignored
}
// ==================================================================================
// Simplistic emulation of a text file in the Eldon2/PROMPT filestore
// Assumed that the filename is in the nest under the OUT32 parameters (OK for KAL4)
int fileid0, fileid1, fileid2, fileid3;
void storeid(int loc)
// stores the file ID at the location given (byte address)
{ int w = fileid0; // top half of top half of desired file name
store[loc++] = w>>16;
store[loc++] = (w>>8) & 255;
store[loc++] = w & 255;
w = fileid1; // bottom half of top half of desired file name
store[loc++] = w>>16;
store[loc++] = (w>>8) & 255;
store[loc++] = w & 255;
w = fileid2; // top half of bottom half of desired file name
store[loc++] = w>>16;
store[loc++] = (w>>8) & 255;
store[loc++] = w & 255;
w = fileid3; // bottom half of bottom half of desired file name
store[loc++] = w>>16;
store[loc++] = (w>>8) & 255;
store[loc++] = w & 255;
}
char* fndata = "disc.txt"; // data file opened in eumlation mode
FILE *diskdata = NULL; // file holding text of emulated text file
char discbuff[201]; // next line due to go in the file block
char abs8tab[256] = // Algol basic symbols indexed by ASCII character - generated by mkabs.c
{-1,-1,-1,-1,-1,-1,-1,-1,-1,-82,-96,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-98,-100,-1,-46,-1,-111,-1,-1,-124,-108,-114,-63,-90,-47,11,-95,0,1,2,3,4,5,6,7,8,9,-71,-104,
-126,-94,-62,-1,10,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,
37,-119,-1,-103,-127,-1,-1,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,
61,62,63,-115,-66,-99,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-79,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,-1,
-1,-1,-1,-1,-1,-1,-1,-111,-1,-1,-1,-1,-1,-1,-1,-1
};
// code for compound basic symbols - genereated by mkabs.c
int nsyms = 47;
int endstr = 268;
unsigned char compstr[268] =
{33,1,33,65,76,71,79,76,6,33,69,88,73,84,5,33,75,68,70,57,5,33,61,2,33,97,110,100,
4,33,97,114,114,97,121,6,33,98,101,103,105,110,6,33,98,111,111,108,101,97,110,8,33,99,111,109,
109,101,110,116,8,33,100,105,118,4,33,100,111,3,33,101,108,115,101,5,33,101,110,100,4,33,101,113,
118,4,33,102,97,108,115,101,6,33,102,111,114,4,33,103,101,3,33,103,111,116,111,5,33,103,116,3,
33,105,102,3,33,105,109,112,4,33,105,110,116,101,103,101,114,8,33,108,97,98,101,108,6,33,108,101,
3,33,108,105,98,114,97,114,121,8,33,108,116,3,33,110,101,3,33,110,111,116,4,33,111,114,3,33,
111,119,110,4,33,112,114,111,99,101,100,117,114,101,10,33,113,2,33,114,101,97,108,5,33,115,101,103,
109,101,110,116,8,33,115,116,101,112,5,33,115,116,114,105,110,103,7,33,115,119,105,116,99,104,7,33,
116,104,101,110,5,33,116,114,117,101,5,33,117,2,33,117,110,116,105,108,6,33,117,112,3,33,118,97,
108,117,101,6,33,119,104,105,108,101,6,58,1,58,61,2
};
unsigned char compval[47] =
{255,192,240,176,210,147,72,140,67,128,145,214,165,156,195,205,134,178,136,194,133,179,66,121,146,208,130,210,
131,163,143,80,141,65,224,182,122,88,149,221,157,198,129,159,150,185,181};
unsigned char ixlet[26] = {36,52,61,70,86,98,112,2,130,2,2,154,2,163,172,183,186,192,223,235,249,0,7,2,2,2};
unsigned char symstart[26] = {7,9,10,12,15,17,20,1,23,1,1,27,1,29,31,32,33,34,38,40,43,44,45,1,1,1};
char taster[] = // initial text file for testing
{ 0, 2, 0, 2, 0, 2, // next chained block will be rejected
0, 0, 0, 0, 0, 11, // no of words of data
2,021,030,030,0,0241, 0,0230,0377,0377,0377,0240, // FMM0/0;
2,036,020,037,0322,05, 07,0230,0377,0377,0377,0240, // SET#57;
1,021,013,0,0230,0240, // F.0;
1,021,024,0,0230,0240, // FI0;
1,032,040,037,0230,0240, // OUT;
1,0234,255,255,255,0240, // !end
1,0377,0377,0377,0377,0240, 1,0377,0377,0377,0377,0240,
1,021,024,0,0230,0240 };
void readFileBlock(int tr, int sect, int loc)
// read a filestore block of 640 KDF9 words
{ int bp, i, j;
int start;
int top;
unsigned char wc;
static int blk = 1; // counting blocks for simulated N.O.C. - unnecessary??
static char *dataline;
for ( bp = 0; bp<3840; bp++ )
store[loc+bp] = 0; // clear all to zeroes for simplicity before putting in the data - temp???
storeid(top = loc + 3840 - 24); // prog ID at end of every block
if ( tr == 1 ) // alpha block -- claim input file
{ storeid(loc); // prog ID at start of alpha block
if ( diskdata != NULL )
fclose(diskdata); // notyetimplemented(tr, "OUT 32 reading multiple files");
diskdata = fopen(fndata, "r");
if ( diskdata == NULL ) // no data file found
{ printf("No data file porovided -- using taster\n");
memcpy(store + loc + 480, taster, sizeof(taster));
return;
}
dataline = fgets(discbuff, 200, diskdata);// first line to go in the file block
start = loc + 480; // leave 80 words of header info (not emulated)
}
else // not an alpha-block
{ if ( diskdata == NULL )
notyetimplemented(tr, "OUT 32 not an alpha block");
start = loc;
}
store[start] = 0; store[start+1] = ++blk; // Next On Chain disk address N.O.C.
store[start+2] = 0; store[start+3] = blk;
store[start+4] = 0; store[start+5] = blk;
bp = start + 12; // leave one word for the count of data words
while ( dataline != NULL &&
strlen(dataline) + bp + 2 < top ) // no of ABSs created never more than number of characters
{ j = bp; // counter along the output line
i = 0; // counter along the input line
while ( (wc = dataline[i++]) != 0 )
{ if ( (wc = abs8tab[wc]) == 156 ) // compound ABS -- ! char value given as -100 (= !end)
{ int j = endstr;
int ii = nsyms;
int cmp = dataline[i];
char *s = dataline + i - 1;
int l;
if ( cmp >= 'a' && cmp < 'z' )
{ j = ixlet[cmp -'a'];
ii = symstart[cmp -'a'];
}
while ( cmp != 0 && j > 0 )
{ l = compstr[--j]; // length of last symbol
j -= l;
ii --;
cmp = memcmp(compstr+j, s, l);
// printf("Tested %c%c%c etc length %d result %d [%03o:%d]\n",
// compstr[j], compstr[j+1], compstr[j+2], l, cmp, compval[ii], ii);
}
if ( cmp != 0 ) // should never happen
printf("Failed to match %s\n", s);
wc = compval[ii];
i += l - 1;
}
if ( wc < 255 )
store[++j] = wc;
// printf("recognised %03o\n", wc&255);
}
// printf("Data: %s\n", dataline);
if ( store[j] != 0240 ) // last char not \n
notyetimplemented(store[j], "OUT 32 over length line");
while ( j%6 != 5 )
store[j++] = 0377; // pad last word with dummies
store[j++] = 0240;
store[bp] = (j-bp) / 6; // number of words in the line
bp = j;
dataline = fgets(discbuff, 200, diskdata);// next line to go in the file block
}
j = (bp - start) / 6 - 2; // number of words in the block
store[start+6] = 0; store[start+7] = 0; // vague recollection that this is a filler word
store[start+8] = 0; store[start+9] = 0;
store[start+10] = j>>8; store[start+11] = j&255; // KAL4 uses this as a count of the number of words in the block
return;
printf("Start at %d\n", start); j = start;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
j += 12;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
j += 12;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
j += 12;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
j += 12;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
j += 12;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
j += 12;
printf(" %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o %03o\n",
store[j], store[j+1], store[j+2], store[j+3], store[j+4], store[j+5],
store[j+6], store[j+7], store[j+8], store[j+9], store[j+10], store[j+11] );
}
void out32eldon2()
// OUT 32 as used on Eldon2 and probably also works with other PROMPT filestores
// reads the system disk area
// N1 holds holds the last 16 bits of the disk address, but now shifted up to the counter position D0-15
// N2 holds a Q-store format sector / lo / hi, where sector is the top 16 bits of the disk address (probably sector no)
// This emulation is designed to cater for reading a text file from disk
// The data file lives in disk.txt
{ int track = nestms[np--] >> 8; // top 16 bits of N1 as an integer
int sector = nestms[np] >> 8; // top 16 bits of N2 as an integer
int lo = ( (nestms[np]<<8) + (nestls[np]>>16) ) & 0177777;
int hi = nestls[np--] & 0177777; // transfer addresses in KDF9 words
int size = (hi - lo + 1) * 6;
int bp = 0; // block pointer as a byte address
printf("Read %d byte disk block, disk track %d sector %d into store %o to %o\n", size, track, sector, lo, hi);
lo *= 6; // convert to bytes
if ( size != 3840 ) // not a normal 640 word filestore read
notyetimplemented(size, "OUT 32 non-standard read");
if ( track != 0 || sector != 0 )
readFileBlock(track, sector, lo);
else
{ printf("Simulating an index with just the desired entry\n");
store[lo + bp++] = 0; // Q-store to scan free entries in this block -- from memory !!!
store[lo + bp++] = 211; // counter part = 211
store[lo + bp++] = 0;
store[lo + bp++] = 3; // increment part = 3
store[lo + bp++] = 0;
store[lo + bp++] = 1; // increment part = 1
fileid0 = nestms[np];
fileid1 = nestls[np];
fileid2 = nestms[np-1];
fileid3 = nestls[np-1];
storeid(lo + bp);
bp += 12; // identifier occupies 12 bytes
store[lo + bp++] = 0;
store[lo + bp++] = 1; // fictitious disc address of 1 / 1 / 1
store[lo + bp++] = 0;
store[lo + bp++] = 1; // fictitious disc address of 1 / 1 / 1
store[lo + bp++] = 0;
store[lo + bp++] = 1; // fictitious disc address of 1 / 1 / 1
while ( bp < size )
store[lo + bp++] = 0;
}
}