// Author David Holdsworth // KDF9 program mode emulator // Currently all rights are reserved, but this will be made available under the GNU Public License. // The most recent version of this program is on-line at: // http://sw.ccs.bcs.org/KDF9/kdf9.c // 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 // First parameter is the file containing the binary program as generated in file mt.out by kal3.c // Second parameter is the file of paper tape data (default ptr.txt). // Verbosity is controlled by -v switch // >= 1 -- EXITs, // >= 2 -- jumps taken, // & 2 -- store accesses (only if v&2 != 0) // >= 4 -- each instruction, // == 5 -- divide diagnostics // 6 or 7 -- each instruction and each store access // Switches are: // -v4 set verbosity to 4 // -t8888 turn on -v7 diagnostics after 8888 instructions // -t1234/5 when execution first reaches address 1234 (octal) syllable 5 set -v7 (N.B. must have / char) // -f1234/5 when execution first reaches address 1234/5 set -v7 and then abandon after 1000 instructions // -a9999 abandon execution after 9999 instructions // -d write the diagnostics to file log.txt rather than standard output (useful with gdb) // -o print direct memory addresses in octal not decimal // -m70 will monitor the contents of word 70 (decimal) for changes // -Q7 Q7 is printed on the -v4 log, otherwise, the most recently modified Q-store // -D run in director mode, i.e. start at word 4, not 0 // -T Findlay compatible tracing -- as for -t // -B234 Set octal value 0234 in LS half of word 0 (c.f. TINT B) // -I0 Do an even restart on failure (equivalent to TINT;I0 or REACT;.em on KDF9 console) // -I1 Ditto but odd restart // 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 name of the paper tape data file, default ptr.txt (end message is @, subten is ~, not-equals is #) // Param 3 is the name of a second paper tape data file, default data.txt // 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 // An OUT 70 has been introduced for emulation of POST PANACEA, which is invoked iwth a -DPOST on compilation // It used to be compiled alongside out70.c // 20 Feb 2017 -- bug discovered in FP addition and subtraction -- now fixed // July 2019 -- signal implemented to produce illegal("Operator abort") in response to control-C // November 2020 -- 2nd paper tape reader added // December 2020 -- Eldon2 disc outs and diagnotstic OUT70 included by default, can be suppressed by -DLITE // September 2021 -- Slight improvement to diagnostic output #include #include #include #include #include #include #include #include #include #include #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 = 0; // Q-store whose value is printed each instruction // 0 indicates to print last changed Q-store 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 pc = 0; // program counter // pc is a byte address, i.e. 6*word + syllable // There is a special case to deal with =LINK in which the syllable number > 5 int np = -1; // nesting store poiner int nestms[18], nestls[18]; // each cell is two halves, N1 is nestms[np] and nestls[np] (bogus extra cells for NEGF and NEGDF) int sjnsp = -1; // SJNS store poiner int sjns[17]; // SJNS cells 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 int ptp = -1; // paper tape punch char *ptr_fn = "ptr.txt"; // name of paper tape data file -- can be changed on command line char *ptr2_fn = "data.txt"; // name of 2nd paper tape data file -- can be changed on command line (maybe) FILE *printdv; // paper tape punch int tcpu = 0; // CPU time so far int tio = 0; // I/O time so far = paper tape reader time char *binprog; // program name int tintb = 0; // param to set in word 0 int tinti = -1; // set to 0 or 1 to indicate restart on failure int bufflen = 3000; // unsigned char buff[bufflen]; // handy workspace -- beware buffer overflow may not always be checked unsigned char *buff; // worksapce set up on entry char *sbuff; // synonym to avoid compiler warnings anout char * and unsigned char * 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 int abandon = -1; // value of instructionCount at which excution is to be abandoned int faband = -1; // abandon 1000 instructions after reaching this int monloc = -1; // byte address of location to be monitored for changes int nestEmpty = -1; // value of the instruction counter when the nest was last empty FILE *diag; #ifndef LITE void out70(); // diagnostic for kalgol development void out32eldon2(); // Eldon2 read disk void out34eldon2(); // Eldon2 read job queue entry #endif void out4(); // crude tape claiming temporarily implemented as part of // forward references void put48(int a); void interpret(); // --- 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 int neg16(int n) // takes the bottom 16 bits of n and treats // them as a signed integer { if ( (n&0100000) == 0 ) return n & 077777; // just bottom 15 bits else return n | -32768; // extend the sign digit } void illegal(String s) // report illegal instruction and end { int i, w; printf("FAILS %s\n", s); printf("LINK %05o/%o\n", pc/6, pc%6); if ( diag != stdout ) { fprintf(diag, "\nFAILS %s\n", s); fprintf(diag, "LINK %05o/%o\n", pc/6, pc%6); } sjnsp ++; while ( --sjnsp >= 0 ) fprintf(diag, "SJNS %05o/%o\n", sjns[sjnsp]/6, sjns[sjnsp]%6); if ( np < 0 ) fprintf(diag, "NEST EMPTY\n"); else if ( verbose < 4 ) // emulate KDF9 Flex if not very verbose { fprintf(diag, "N1 = %08o%08o\n", nestms[np], nestls[np]); if ( np > 0 ) fprintf(diag, "N2 = %08o%08o\nCELLS %d\n", nestms[np-1], nestls[np-1], np+1); } else // give more info than KDF9 Flex for verbose output { fprintf(diag, "\n"); for ( i = 0; i<=np; i++ ) { w = (nestls[np-i]>>16) | ((nestms[np-i]&255)<<8); fprintf(diag, "N%02d = %08o %08o B%06o / B%06o / B%06o %6d / %6d / %6d\n", i+1, nestms[np-i], nestls[np-i], nestms[np-i]>>8, w, nestls[np-i]&0177777, neg16(nestms[np-i]>>8), neg16(w), neg16(nestls[np-i]) ); } } if ( verbose < 4 ) // just print one Q-store if not verbose i = qmon - 1; else // print all Q-stores { i = -1; // print Q0 just in case the emulator has a bug qmon = 15; } fprintf(diag, "\n"); while ( ++i <= qmon ) fprintf(diag, "Q%2d = B%06o / B%06o / B%06o %6d / %6d / %6d\n", i, qc[i], qi[i], qm[i], neg16(qc[i]), neg16(qi[i]), neg16(qm[i])); fprintf(diag, "\nlast order = %03o\n", lastorder); fprintf(diag, "Word 0 = %03o %03o %03o %03o %03o %03o\n", store[0], store[1], store[2], store[3], store[4], store[5]); fprintf(diag, "monloc = %d = %03o %03o %03o %03o %03o %03o\n", monloc/6, store[monloc+0], store[monloc+1], store[monloc+2], store[monloc+3], store[monloc+4], store[monloc+5]); fprintf(diag, "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]); fprintf(diag, "%d instructions obeyed\n", instructionCount); if ( nestEmpty >= 0 ) // only available in diag mode fprintf(diag, "Nest was last empty at instruction count %d\n", nestEmpty); if ( tinti >= 0 ) // failure restart required { pc = 24 + (tinti&1)*3; // jump to word 4 tinti = -1; // stop failure loops if ( store[pc] == 0 ) // no restart code present fprintf(diag, "\nCannot restart\n"); else { fprintf(diag, "\nRestart at 4/%d\n", pc%6); interpret(); // This recursion is a bit messy, and might lead to ... } } // ... a rethink about exit from this routine exit(1); // but there are 125 calls to this routine (June 2016) } void catchint(int sig) { signal(SIGINT, SIG_DFL); // allow 2nd control-C to terminate normally illegal("Operator abort"); } void notyetimplemented(int i, char *s) // Instructions are only implemented when the need arises. { if ( diag != stdout ) printf("Instruction %03o %s not yet implemented\n", i, s); fprintf(diag, "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 void readptr(int q, int em) // read paper tape PRQ (em=0) or PREQ (em=1) { static int kase = 0100; // set current case to normal 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 = (unsigned char *)malloc(nchars*sizeof(char)); if ( verbose >= 1 ) fprintf(diag, "reading paper tape (q = %d buffer = %d words at %d, ic = %d)\n", q, addr1 + 1 - addr0, addr0, instructionCount); { if ( ptr == NULL ) // may be in director mode, so no OUT 5 { ptr = fopen(ptr_fn, "r"); if ( ptr == NULL ) { perror(ptr_fn); illegal("Cannot find paper tape reader"); } } } 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 kase = -1; // return to pre-Bill approach } // -- 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) == 0200 ) // change to case shift charbuff[i++] = 06; else if ( charbuff[i-1] != 02 ) // not immediately after CR charbuff[i++] = 07; // change to case normal else { charbuff[i-1] = 07; // change to case normal .... charbuff[i++] = 02; // ... before the carriage return } charbuff[i++] = c & 077; } c = fgetc(ptr); if ( c >= 0 ) // not end of file or end message on PREQq c = ptkdf9[c&255]; } } if ( verbose >= 1 ) fprintf(diag, "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>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; if ( verbose >= 1 ) { fprintf(diag, "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]); fprintf(diag, "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(binprog = fn, O_RDONLY + O_BINARY); int n, b; time_t now; struct tm *nowb; if ( dv < 0 ) { perror(fn); sprintf(sbuff, "Cannot load program file %s", fn); illegal(sbuff); exit(1); } n = read(dv, store, 48); if ( n != 48 || store[42] != 0 || store[43] != 0 ) fprintf(diag, "Cannot load this program - probably multiple C-blocks\n"); else { b = store[44]<<8 | store[45]; if ( verbose >= 1 ) fprintf(diag, "C-block starts at word %d (%o octal)\n", b, b); n = read(dv, store + b*6, (8192 - b)*6); if ( verbose >= 1 ) fprintf(diag, "%d bytes loaded from %s\n", n + 48, fn); } close(dv); time(&now); // sort out date nowb = localtime(&now); b = nowb->tm_year % 100; n = nowb->tm_mon + 1; b = ((b/10)<<6) + b%10 + ((n%10)<<18) + 020172020; store[45] = b>>16; store[46] = b>>8; store[47] = b; b = nowb->tm_mday; b = n/10 + 020201720 + ((b/10)<<18) + ((b%10)<<12); store[42] = b>>16; store[43] = b>>8; store[44] = b; } void out6ptr() // release the paper tape reader { if ( ptr != NULL ) { fclose(ptr); ptr = NULL; } ptr_fn = ptr2_fn; // next paper reader is second one } 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 if ( n == 2 ) // paper tape reader { if ( ptr == NULL ) { ptr = fopen(ptr_fn, "r"); if ( ptr == NULL ) { perror(ptr_fn); illegal("Cannot find paper tape reader"); } } } else if ( n == 1 ) // paper tape punch ptp = open("ptp.txt", O_CREAT + O_TRUNC + O_WRONLY, 0640); else if ( n == 9 ) // paper tape punch output in binary nestls[np] = open("ptp.bin", O_CREAT + O_TRUNC + O_WRONLY + O_BINARY, 0640) + 1024; // PTP 9 goes via MT routines else if ( n == 3 ) // printer ; // output goes on printdv else notyetimplemented(n, "Other types of peripheral"); fprintf(diag, "Claiming peripheral of type %o on device %d\n", n, nestls[np]); break; case 6: // OUT 6 release peripheral device n = nestls[np--]; // get parameter fprintf(diag, "deallocated device %d\n", n); if ( n >= 1024 ) // must be a UNIX file close(n-1024); // else if ( n == 2 ) kludge to make walgol work while we think about // out6ptr(); how best to deal with data in L+G environmant 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;// address of first byte beyond transfer if ( (s0 = store[n+5]) >= 030 ) // if line printer stream ptch = lpchar; // use the line printer character table if ( verbose >= 1 ) { fprintf(diag, "OUT 8 stream %o (ic=%d)\n %05o/%o", store[n+5], instructionCount, (pc-3)/6, (pc-3)%6); for ( i = sjnsp; i>=0; i -- ) fprintf(diag, " %05o/%o", sjns[i]/6, sjns[i]%6); fprintf(diag, "\n"); fprintf(diag, " %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>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 { fprintf(diag, "Walgol ends cleanly at address %05o/%o after %d instructions\n", (pc-3)/6, (pc-3)%6, instructionCount); exit(0); } 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; } } else if ( (s0&0770) == 030 ) // printer stream -- check last char - temp(?) { if ( verbose >= 1 ) fprintf(diag, "printer stream - last char = %02o\n", store[m-1]&077); } n = 0; for ( i = 0; i= 1 ) fprintf(diag, "OUT 8:%s\n", buff); else if ( s0 == 0 ) // ops console output with no diagnostics fprintf(diag, "Ops-cons(%d):%s\n", instructionCount, buff); if ( s0 != 0 ) { fprintf(printdv, "%s", buff); fflush(printdv); } else printf("**TTY:%s\n", buff); break; case 1: // OUT 1 -- call new program wls = nestls[np]; // bottom half of N1 = first 4 chars of program name wms = nestms[np-1]; // top half of 2nd word of program name fprintf(diag, "OUT 1: %08o %08o\n", wls, wms); memcpy(buff, store+6, 6); // store limit and time limit - need to keep word 1 across OUT 1 if ( (wls&077777400) == 053414000 ) // calling KALGOL brick or PT Usercode { strcpy(sbuff, "KABzz.bin"); // skeleton name of brick sbuff[3] = lpchar[wls&077]; // first char of brick number sbuff[4] = lpchar[wms>>18]; // second char of brick number sbuff[2] = lpchar[(wls>>6)&077]; // third char prog name } else if ( wls == 045445653 ) // calling KAL4 assembler { strcpy(sbuff, "EDNKAL4.bin"); // skeleton name of brick } else if ( wls != 053556720 ) // not calling WALGOL brick notyetimplemented(n, "OUT"); else if ( (wms >> 18) != 023 ) // not calling WALGOL controller - must be end of run { fprintf(diag, "Walgol ends cleanly at address %05o/%o after %d instructions\n", (pc-3)/6, (pc-3)%6, instructionCount); exit(0); } else { opsquery = 0; // Allow another OUT8 query strcpy(sbuff, binprog); // must be name of translator sbuff[strlen(sbuff)-5] = 'c'; // change to controller } loadprogram(strdup(sbuff)); pc = 0; memcpy(store+6, buff, 6); // kept it in local out8 buffer put48(2); put48(3); // remove N1, N2 and store in E2/E3 break; case 2: // OUT 2 -- enter new program already loaded into store fprintf(diag, "OUT 2: Enter load and go program after %d instructions\n", instructionCount); 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 out6ptr(); // what about other peripherals? 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 4: // OUT 4 emulation of claiming MT just for Kalgol out4(); break; #ifndef LITE // ignore most Eldon2 OUTs, job accounting and writes to disc filestore case 27: // OUT 27 new prog in PPPI -- needs to give <=Z response ?? np --; // discard prog ID from N1/2 nestms[np-1] = 077777777; // 24 bit all ones case 33: // OUT 33 write to system disc case 23: // OUT 23 not sure yet case 21: // OUT 21 not sure yet case 50: // OUT 50 job accounting info - ignore 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 // This out was used to initiate write access to the system area, and preceded writing of the binary prog to disc // This code uses the fact that the KAL4 assembler has the address of the binary program in M1 at this point // and writes the binary program to a file. Subsequent disc writes are ignored. dv = open("tmp.bin", O_WRONLY + O_BINARY + O_CREAT + O_TRUNC, 0640); if ( dv < 0 ) perror("Binary output file"); else // create a binary file using filler word in E7 { s0 = qm[1]*6; // start of binary program i = (store[s0+44]<<8) + store[s0+45]; // increment of filler word m = (store[s0+46]<<8) + store[s0+47]; // modifier of filler word if ( verbose >= 1 ) { fprintf(diag, "Filler word %d / %d / %d\n", (store[s0+42]<<8) + store[s0+43], i, m ); // fprintf(diag, "word %d: %03o %03o %03o %03o %03o %03o\n", qm[1], // store[s0], store[s0+1], store[s0+2], store[s0+3], store[s0+4], store[s0+5] ); } n = (int)write(dv, store + s0, 48); fprintf(diag, "Binary file tmp.bin written - B-block %d bytes - C-block %d bytes\n", n, (int)write(dv, store + s0 + i*6, (m-i+1)*6) ); close(dv); } // then drop through - OUT 12345 leaves out num in N1 - let it fail for now case 26: // OUT 26 claim new disc block np ++; // leave nonsense address in N1 break; case 32: // OUT 32 read Eldon2/PROMPT system area out32eldon2(); break; case 34: // OUT 34 read Eldon2 job queue entry out34eldon2(); break; case 70: // OUT 70 Kalgol amulation of PANACEA only diagnostic print implemented out70(); break; #endif default: notyetimplemented(n, "OUT"); } } int zseek(int dv, int pos, int where) // temporary diagnostic to monitor seeks { int r = lseek(dv, pos, where); if ( verbose >= 7 ) fprintf(diag, "%05o/%o lseek(%d, %d, %d) ends at posn %d ic = %d\n", (pc-3)/6, (pc-3)%6, dv, pos, where, r, instructionCount); return r; } int skipmt(int q, int n) // skip n blocks specified in Qq -- special for kAlgol // Iq must contain the block size // returns -ve if not implemented { int dv = qc[q]; if ( dv < 1024 ) return -1; if ( n < -32767 ) // rewind return zseek(dv-1024, 0, SEEK_SET); else return zseek(dv-1024, qi[q]*n*6, SEEK_CUR); } char *ptptch = nptchar; // global shift for paper tape punch to preserve shift across buffers void poapob(int instr, int v, int q) // implement output, i.e. POAQq and POBQq, etc // instr = 0130 & v = 020 PWQq, MWQq write // instr = 0131 & v = 020 MWEQq, PWEQq write to end message character // instr = 0130 & v = 030 MLWQq write followed by tape mark, i.e. write a last block // instr = 0130 & v = 034 PGAPQq punch blank paper tape tape // instr = 0130 & v = 024 MWIPEQq leave a really big clear gap on mag tape // instr = 0131 & v = 030 MLWEQq write to end message character followed by tape mark, i.e. write a last block { char *ptch = nptchar; int i, j, m, n, s0, s1, s2; n = qi[q]*6; // start of transfer m = qm[q]*6 + 6; // end of transfer if ( qc[q] >= 2048 ) // read-only MT illegal("Writing on read-only tape"); if ( qc[q] >= 1024 ) // crude MT emulation for Kalgol { i = qi[q]*6; n = qm[q]*6 - i + 6; if ( (v&7) == 0 ) // avoid writing for PGAP etc write(qc[q]-1024, store+i, n); return; // only works for fixed-length blocks and not MWEQq } if ( qc[q] == 1 ) // paper tape punch { if ( v != 0 ) // PGAP etc { if ( verbose >= 1 ) fprintf(diag, "Output on punch: %d chars run out\n", m); return; // temp !!! } if ( verbose >= 1 ) fprintf(diag, "Output on punch %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, "Punch output with more than 1024 words"); j = 0; for ( i = n; i>2; buff[j++] = ((s0&3)<<4) + ((s1>>4)&017); buff[j++] = ((s1&017)<<2) + ((s2>>6)&3); buff[j++] = s2&077; } n = 0; for ( i = 0; i= 1 ) { fprintf(diag, "Direct output %o\n %05o/%o (ic = %d)", qc[q], (pc-2)/6, (pc-2)%6, instructionCount); for ( i = sjnsp; i>=0; i -- ) fprintf(diag, " %05o/%o", sjns[i]/6, sjns[i]%6); fprintf(diag, "\n"); fprintf(diag, " %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, "Output with more than 1024 words"); j = 0; for ( i = n; i>2; buff[j++] = ((s0&3)<<4) + ((s1>>4)&017); buff[j++] = ((s1&017)<<2) + ((s2>>6)&3); buff[j++] = s2&077; } s1 = 512; // will never match any character if ( (s0 = qc[q]) == 0 // stream 0 is ops console || (instr&1) != 0 ) // or transfer to end message { i = -1; // need to look for EM or possibly semi-colon if ( s0 == 0 ) // typewriter output { s1 = 034; // assume director mode if ( ptr == NULL ) // kludge: TW commands in file ptr = fopen("dir.txt", "r"); } while ( ++i < j ) { if ( buff[i] == 075 ) // end message j = i + 1; else if ( buff[i] == s1 ) // semicolon if this is a typewriter output { s1 = 0; // indicates typewriter query j = j + 1; } } } n = 0; for ( i = 0; i= 1 ) fprintf(diag, "Output on device %02d::%s\n", qc[q], buff); if ( s1 == 0 && s0 == 0 ) notyetimplemented(0, "Typewriter query"); if ( s0 != 0 ) { fprintf(printdv, "%s", buff); fflush(printdv); } } void jump(int f, int a1, int 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 ) fprintf(diag, "%05o/%o Jump to %05o/%o ic = %d Nest EMPTY -- %s\n", (pc-3)/6, (pc-3)%6, w, s, instructionCount, binprog); else fprintf(diag, "%05o/%o Jump to %05o/%o ic = %d N1 = %08o %08o NEST cells %d -- %s\n", (pc-3)/6, (pc-3)%6, w, s, instructionCount, nestms[np], nestls[np], np+1, binprog); } pc = w*6 + s; if ( pc == 0 && verbose >= 7 ) // temp !!! ??? illegal("Jump to word 0"); } 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; // fprintf(diag, "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; // fprintf(diag, "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 ) fprintf(diag, "- 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 ) fprintf(diag, "- 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 ) { fprintf(diag, "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]); fprintf(diag, "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]); fprintf(diag, "a den = %04o %04o %04o %04o\n", den[3], den[2], den[1], den[0]); fprintf(diag, "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 ) fprintf(diag, "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 ) { fprintf(diag, "c Gone back to add in one or two more\n"); fprintf(diag, "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]); fprintf(diag, "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 ) { fprintf(diag, "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]); fprintf(diag, "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 | res[4]) << skip) & 077777777) | (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 // if ( verbose >= 5 ) // investigating duff overflows // { fprintf(diag, "v num = %04o %04o %04o %04o %04o %04o %04o %04o == wms %08o\n", // num[7], num[6], num[5], num[4], num[3], num[2], num[1], num[0], wms); // fprintf(diag, "v res = %04o %04o %04o %04o %04o %04o %04o %04o == wls %08o\n", // res[7], res[6], res[5], res[4], res[3], res[2], res[1], res[0], wls); // } } } 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 ) fprintf(diag, "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; } // fprintf(diag, "N1 = %08o %08o\n", wms, wls); // fprintf(diag, "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; // fprintf(diag, "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]); // fprintf(diag, "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 // fprintf(diag, "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; // fprintf(diag, "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 } // fprintf(diag, "Lost carry = %o\n", w); } } // fprintf(diag, "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]<>(12-skip))) & 077777777; wms = ((res[7]<<(skip+12)) | (res[6]<>(12-skip))) & 077777777; return; } int fix39(int p) // converts nestms[p] into the top half of a fixed point version of floating point and stores in wms // 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 = nestms[p]) >> 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, wls2 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; // top 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); if ( shift < 24 ) { wls = ((wms<<(24-shift)) + (wls>>shift)) & 077777777; wms = (((sign<<24) + wms)>>shift) & 077777777; } else if ( shift < 48 ) // must avoid shifts >= wordlength { wls = (((sign<<24) + wms)>>(shift-24)) & 077777777; wms = sign & 077777777; } else // underflow wls = wms = 0; 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); if ( shift < 24 ) { wls2 = ((wms2<<(24-shift)) + (wls2>>shift)) & 077777777; wms2 = (((sign<<24) + wms2)>>shift) & 077777777; } else if ( shift < 48 ) // must avoid shifts >= wordlength { wls2 = (((sign<<24) + wms2)>>(shift-24)) & 077777777; wms2 = sign & 077777777; } else // underflow wls2 = wms2 = 0; return e2; } void scaleup78(int e1, int e2) // shifts wms, wls, wms2, wls2 right to correspond with e2, rather than e1 { int shift = e2 - e1; int sign = -(wms>>23); if ( shift < 24 ) { wls2 = ((wms2<<(24-shift)) + (wls2>>shift)) & 077777777; wms2 = (((wls<<15) + wms2)>>shift) & 077777777; wls = ((wms<<(24-shift)) + (wls>>shift)) & 077777777; wms = (((sign<<15) + wms)>>shift) & 077777777; } else if ( shift < 39 ) // must avoid shifts >= wordlength { wls2 = (((wls<<15) + wms2)>>(shift-24)) & 077777777; wms2 = (((wms<<24) + wls)>>(shift-24)) & 077777777; wls = (((sign<<15) + wms)>>(shift-24)) & 077777777; wms = sign & 077777777; } else if ( shift < 63 ) // N.B. wms2 has only 15 bits { wls2 = (((wms<<24) + wls)>>(shift-39)) & 077777777; wms2 = (((sign<<15) + wms)>>(shift-39)) & 077777777; wls = sign & 077777777; wms = sign & 077777777; } else if ( shift < 78 ) { wls2 = (((sign<<15) + wms)>>(shift-63)) & 077777777; wms2 = sign & 077777; wls = sign & 077777777; wms = sign & 077777777; } else // underflow wls2 = wms2 = wls = wms = 0; } void put48(int a) { if ( np < 0 ) illegal("00N"); a &= 0177777; wms = nestms[np]; wls = nestls[np--]; if ( (verbose&2) != 0 ) fprintf(diag, "%05o/%o: Storing in word address %o(%d) = %08o %08o\n", (pc-3)/6, (pc-3)%6, a, 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 ) { fprintf(diag, "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) != 0 ) fprintf(diag, "%05o/%o: Fetching from word address %o(%d) = %08o %08o\n", (pc-3)/6, (pc-3)%6, a/6, a/6, nestms[np], nestls[np]); } void put24(int m1, int m2) // get 24 bit half word, M2M1H { int ah = (m1&0100000)<<1; // extend sign digit int a = ((ah + m1 + m2 + m2) & 0377777) * 3; if ( np < 0 ) illegal("00N"); wms = nestms[np--]; if ( a >= 32768*6 - 3 ) { fprintf(diag, "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) != 0 ) { if ( (m1&1) == 0 ) fprintf(diag, "%05o/%o: Storing in half-word address %o(%d) = %08o --------\n", (pc-3)/6, (pc-3)%6, a/6, a/6, wms); else fprintf(diag, "%05o/%o: Storing in half-word address %o(%d) = -------- %08o\n", (pc-3)/6, (pc-3)%6, a/6, a/6, wms); } } void get24(int m1, int m2) // get 24 bit half word, M2M1H { int ah = (m1&0100000)<<1; // extend sign digit int a = ((ah + m1 + m2 + m2) & 0377777) * 3; if ( np >= 15 ) illegal("00N"); if ( a >= 32768*6 - 3 ) { fprintf(diag, "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) != 0 ) fprintf(diag, "%05o/%o: Fetching from half-word address %o(%d) = %08o %08o\n", (pc-3)/6, (pc-3)%6, a/6, a/6, nestms[np], nestls[np]); } char *jmnem[] = {"???","J!=","JGEZ","???","JLEZ","???","J!=Z","???","JNV","OUT","JNEN","J","JNEJ","JS","JNTR","EXIT","???" ,"J=","JZ","???","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 *f2syll[] = {"M%dM%d (E%d)","=M%dM%d (E%d)","M%dM%dQ (E%d)","=M%dM%dQ (E%d)","M%dM%dH (E%d%c)","=M%dM%dH (E%d%c)", "M%dM%dQH (E%d%c)","=M%dM%dQH (E%d%c)","M%dM%dN (E%d)","=M%dM%dN (E%d)", "M%dM%dQN (E%d)","=M%dM%dQN (E%d)","M%dM%dHN (E%d%c)","=M%dM%dHN (E%d%c)","M%dM%dQHN (E%d%c)","=M%dM%dQHN (E%d%c)", "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 *memmnemdec[] = {"E%dM%d (E%d)", "=E%dM%d (E%d)", "E%dM%dQ (E%d)", "=E%dM%dQ (E%d)", "E%d", "=E%d", "E%d", "=E%d"}; char *memmnemoct[] = {"E#%oM%d (E%d)", "=E#%oM%d (E%d)", "E#%oM%dQ (E%d)", "=E#%oM%dQ (E%d)", "E#%o (E%d%d)", "=E#%o (E%d%d)", "E#%o (E%d%d)", "=E#%o (E%d%d)"}; char **memmnem = memmnemdec; char diagbuff[24]; // longest messages should be 23 including terminator, e.g. =E#ooooooMddQ (Eddddd) char *showmnemonic(int pc) // Shows the mnemonic at the given program counter // MqMq accesses have the address displayed { int f = store[pc++]; int a1 = store[pc++]; int a2 = store[pc++]; int q2 = a1>>4; int q1 = a1&017; char *fmt; char half = ' '; // initialised just in case compiler compalains about use ... // ... of uninitalised value in sprintf below if ( (f&0300) == 0 ) // single syllable instruction return smnem[f]; if ( (f&0300) == 0200 ) // jump instruction, or EXIT or OUT { fmt = jmnem[(f&0160) + (a1>>4)]; if ( fmt[0] == 'J' ) // Jump instruction sprintf(diagbuff, "%s.%os%o", fmt, (f&010)*512 + (a1&017)*256 + a2, f&7); // KAL4 format else if ( fmt[0] == 'E' ) // EXIT sprintf(diagbuff, "EXIT%d", a2 + a2 + 1 - ((f&2)>>1)); else // OUT return fmt; return diagbuff; } strcpy(diagbuff, "???"); if ( f == 0304 ) // SET instruction sprintf(diagbuff, "SET %d", neg16((a1<<8) + (a2&255))); else if ( (f&0304) == 0300 ) // main store fetch or store instruction { a1 = f&3; if ( q2 == 0 ) a1 = 4 | a1; fmt = memmnem[a1]; a1 = ((f&070)<<9) + (q1<<8) + a2; sprintf(diagbuff, fmt, a1, q2, (a1 + qm[q2]) & 32767); } 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; if ( (f&4) == 0 ) // not half-word addressing a2 = qm[q1] + qm[q2]; else // half-word addressing a2 = qm[q1]/2 + qm[q2]; if ( (f&8) != 0 ) // N for next word a2 ++; half = 'U' - 9*(qm[q1]&1); // U or L } else if ( f>=0170 && f<0173 ) // fancy Q-store instruction test was (f&0374) == 0170 { 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; } else if ( ((f-1)&0376) == 0174 ) // director instruction { strcpy(diagbuff+9, "=K%d"); q2 = 8; while ( (a1>>(8 - --q2)) != 0 ) ; // will still terminate if non-code fmt = diagbuff+9; if ( (f&1) == 0 ) // Kn not =Kn fmt ++; // remove the = sign } sprintf(diagbuff, fmt, q2, q1, a2&32767, half); } return diagbuff; } void interpret() // The main emulation routine { int qch = 1; // number of changed Q-store, or store to be printed unsigned char keepmon[6] = {0,0,0,0,0,0}; // keep previous value of monitored location int diagMode = 0; // diagnostic checks skipped if 0 if ( maxdiag >= 0 || abandon >= 0 || faband >= 0 || trStartpc >= 0 || trStartic >= 0 || monloc >= 0 || diagStartic >= 0 || verbose > 0 ) diagMode = 1; qc[0] = 0; qi[0] = 0; qm[0] = 0; // implement Q0 for ( ;; ) // loop forever { 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 int wi; // working integer location instructionCount ++; if ( diagMode ) { if ( pc == maxdiag // check for turn on point of max diagnostics ... || instructionCount == diagStartic ) // ... or instruction count verbose = 7; // panic stations == get all the gen if ( instructionCount == abandon ) // time to pack it in illegal("Execution abandonned"); if ( pc == faband ) // turn on idagnostics for 1000 then stop { abandon = instructionCount + 1000; verbose = 7; fprintf(diag, "%5d Diagnostic encountered\n", pc); } if ( pc == trStartpc // check for turn on point of trace output || instructionCount == trStartic ) trfile = fopen("DHtrace.txt", "w"); if ( monloc >= 0 && memcmp(keepmon, store + monloc, 6) != 0 ) { fprintf(diag, "%5o/%o Location %o = %d changed from %03o %03o %03o %03o %03o %03o to %03o %03o %03o %03o %03o %03o ic=%d\n", pc/6, pc%6, monloc/6, monloc/6, keepmon[0], keepmon[1], keepmon[2], keepmon[3], keepmon[4], keepmon[5], store[monloc], store[monloc+1], store[monloc+2], store[monloc+3], store[monloc+4], store[monloc+5], instructionCount ); memcpy(keepmon, store + monloc, 6); } if ( np < 0 ) // record instruction count at which the nest was last empty nestEmpty = instructionCount; if ( verbose >= 4) // tracing of every instruction { char *v = ""; f = store[pc]; if ( vr != 0 ) v = " V"; if ( qmon != 0 ) qch = qmon; if ( np < 0 ) fprintf(diag, "%5o/%o code = %03o %03o %03o NEST empty Q%2d %06o/%06o/%06o%s %s\n", (lastpc)/6, (lastpc)%6, f, store[lastpc+1], store[lastpc+2], qch, qc[qch], qi[qch], qm[qch], v, showmnemonic(lastpc)); else fprintf(diag, "%5o/%o code = %03o %03o %03o N1 = %08o %08o #%02d Q%2d %06o/%06o/%06o%s %s\n", (lastpc)/6, (lastpc)%6, f, store[lastpc+1], store[lastpc+2], nestms[np], nestls[np], np+1, qch, qc[qch], qi[qch], qm[qch], v, showmnemonic(lastpc)); } } f = store[pc++]; 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: // JZ 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 // fprintf(diag, "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 // fprintf(diag, "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 ) ) { fprintf(diag, "Program ends cleanly at address %05o/%o after %d instructions\n", (pc-3)/6, (pc-3)%6, instructionCount); exit(0); } else outinstr(); break; /* --------------- */ case 0217: // EXIT etc if ( sjnsp < 0 ) illegal("00N - EXIT with empty SJNS"); wls = sjns[sjnsp--]; f += wls>>16; // this will make f invalid if it was a funny address if ( f == 0200 ) // EXIT1 wls += 3; else if ( f != 0202 ) // EXIT illegal("00 L - Bad EXIT instruction"); // EXIT with extra bits in function code or syll >= 6 pc = wls + (((a1&017)<<8) + a2) * 6; // add on the address part if ( verbose > 0 ) fprintf(diag, "%05o/%o Exit to %05o/%o SJNS cells %d NEST cells %d ic=%d\n", lastpc/6, lastpc%6, pc/6, pc%6, sjnsp+1, np+1, instructionCount); 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[qch=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[qch=q2] = (qc[q2] - 1) & 0177777; } } else illegal("00 L - Main store reference??"); } else // 1- or 2-syllable instruction switch (f) { case 0000: // In the early design this was a dummy, and is occasionally used as such if ( verbose >= 1 ) fprintf(diag, "No instruction 000\n"); if ( store[pc] == 0 && store[pc+1] == 0 && store[pc+2] == 0 && store[pc+3] == 0 && store[pc+4] == 0 && store[pc+5] == 0 ) illegal("Seven consecutive 000 instructions must be wrong"); // but not in KAB60 !! 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 005: // *DF floating-point multiply - double-length result from 48-bit operands case 004: // *F floating-point multiply - like *DF but rounded case 007: // *+F like *DF but then followed by double-length addition if ( np < 1 ) illegal("00N"); // need 2 cells for *F and *DF -- *+F gets check later q2 = fix39(np); // q2 holds the exponent.of 2nd operand wms2 = wms; wls2 = nestls[np--]; q2 += fix39(np) - 128; // q2 = exponent of result wls = nestls[np]; timesdouble(9); if ( f == 004 ) // single length result float39(q2); else // double length result { np ++; // space for the extra 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"); q2 = fix39(np--); // q2 holds the exponent.of 2nd operand i.e. N1-2 q1 = fix39(--np); // q1 holds the exponent.of 1st operand i.e. N3-4 if ( q2 < q1 ) { wi = np; // index of other operand fix39(np+2); // MS half of original N1 loaded into wms with sign extension wls = nestls[np+2]; // LS half of original N1 wms2 = nestms[np+1] // MS half of original N2 & 077777; // discard exponsnt of LS half of the double number wls2 = nestls[np+1]; // LS half of original N2 scaleup78(q2, q1); } else if ( q1 < q2 ) { wi = np + 2; // index of other operand wls = nestls[np]; // LS half of original N3 wms2 = nestms[np-1] // MS half of original N4 & 077777; // discard exponsnt of LS half of the double number wls2 = nestls[np-1]; // LS half of original N4 scaleup78(q1, q2); // operand to align with larger one q1 = q2; // exponent of the result (before standardisation) } else // exponents are equal { wi = np + 2; // index of other operand wls = nestls[np]; // LS half of original N3 wms2 = nestms[np-1] // MS half of original N4 & 077777; // discard exponsnt of LS half of the double number wls2 = nestls[np-1]; // LS half of original N4 } wls2 += nestls[wi-1]; wms2 += nestms[wi-1] & 077777; // dispose of exponent wls += nestls[wi]; q2 = wms; // need to use wms in fix39 fix39(wi); // load wms with sign extension wms += q2; if ( (wls2 & 0100000000) != 0 ) // carry has occurred { wls2 &= 077777777; wms2 ++; } if ( (wms2 & 0100000) != 0 ) // carry has occurred { wms2 &= 077777; wls ++; } if ( (wls & 0100000000) != 0 ) // carry has occurred { wls &= 077777777; wms ++; } float78(q1); nestms[np] = wms; nestls[np] = wls; nestms[np-1] = wms2; nestls[np-1] = wls2; // notyetimplemented(0023, "+DF"); break; /* --------------- */ case 071: // NEGDF negate double-length floating-point if ( np < 1 ) illegal("00N"); // not yet seen so this implementation is tentative nestls[np-1] = (wls = - nestls[np-1]) & 077777777; nestms[np-1] = (wls = - nestls[np-1] - ((wls>>24)&1)) & 077777; nestls[np] = (wls = - nestls[np] - ((wls>>15)&1)) & 077777777; wms = (wls = (- (nestms[np]&037777) - ((wls>>24)&1)) & 037777) | (nestms[np]&077740000); if ( verbose >= 8 ) fprintf(diag, " --- wls = %08o wms = %08o\n", wls, wms); if ( wls != 0 ) // operand not zero or +|- 2**n wms ^= 040040000; // flip the sign digits else if ( (wms&040000000) != 0 ) // operand is - 2**n wms -= 037640000; // - 040140000 = 037640000 else if ( wms != 0 ) // operand is not zero, i.e. + 2**n wms += 037640000; // need to worry about overflow for -2**39 if ( verbose >= 8 ) fprintf(diag, " --- wms = %08o\n", wms); nestms[np] = wms; // notyetimplemented(0071, "NEGDF"); break; // can drop through to +DF if bracketted by if ( f != 007 ) /* --------------- */ case 022: // -DF subtract double-length floating-point notyetimplemented(0022, "-DF"); break; /* --------------- */ case 0006: // Illegal illegal("00 L - No instruction 006"); 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 // fprintf(diag, "2nd operand = %08o %08o\n", wms2, wls2); sub48(wms2, wls2); // fprintf(diag, "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 // fprintf(diag, "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 eight 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; // fprintf(diag, "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]); // fprintf(diag, "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 // fprintf(diag, "Nest EMPTY\n"); // else // fprintf(diag, "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 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 } if ( wls2 < 0 ) // underflow wls2 = wms = wls = 0; // result is zero 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? } // yes, but it would be horribly complicated ... break; // ... dealing with worst case carry /* --------------- */ 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 | wms2 | wls2) != 0 ) // if number was not exactly zero { int sigbit = (wms & 040000000) >> 1; // printf("initial q2 = %d\n", q2); 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 } if ( q2 < 0 ) // underflow q2 = wms = wls = 0; // result is zero q2 &= 0377; // printf(" final q2 = %d\n", q2); 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 if ( (q2 -= 39) < 0 ) // underflow in second half wms2 = wls = wls2 = q2 = 0; // exact zero result nestms[np-1] = (q2<<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 // fprintf(diag, "1st operand = %08o %08o\n", wms, wls); wls2 = nestls[np-1]; // N2 least sig wms2 = nestms[np-1] & 037777777; // N2 with sign digit cleared // fprintf(diag, "2nd operand = %08o %08o\n", wms2, wls2); sub48(wms2, wls2); // fprintf(diag, "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 // fprintf(diag, "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; // was this ever encountered in real life -- diagnostics not controlled by verbose ??? fprintf(diag, " 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; fprintf(diag, " After shift N1 = %08o %08o, N2 = %08o %08o %c\n", wms, wls, wms2, wls2, ' ' + ('V'-' ')*vr); fprintf(diag, " 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 // fprintf(diag, "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 // fprintf(diag, "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 // fprintf(diag, "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 // fprintf(diag, "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"); q2 = fix39(np); // q2 holds the exponent.of 2nd operand wms2 = wms; wls2 = nestls[np--]; q2 = fix39(np) + 128 - q2; // exponent of result wls = nestls[np]; if ( verbose == 5 ) fprintf(diag, "wms = %08o wls = %08o wms2 = %08o wls2 = %08o\n", wms, wls, wms2, wls2); dividedouble(9, 0, 0, wms2, wls2); if ( verbose == 5 ) fprintf(diag, "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; 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 ) // do all 8 digits { wms2 = nn[i]; // radix digit nn[i] = 0; // used if no more digits if ( wls != 0 || wms != 0 ) // still more digits to generate { if ( wms2 == 0 ) // zero radix digit - so avoid divide by 0 vr = 1; // attempt to use zero radix digit leave 0 result digit else { wls += (wms % wms2) << 24; // LS half has remainder from divisin of top half wms = wms / wms2; // MS half of quotient nn[i] = wls % wms2; // digit generated wls = wls / wms2; // LS half of new quotient } } } 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 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"); q2 = fix39(np); // q2 holds the exponent.of 2nd operand wms2 = wms; wls2 = nestls[np--]; q1 = fix39(np); // exponent of other operand wls = nestls[np]; // fprintf(diag, "N1 = %08o %08o / %d\n", wms2, wls2, q2); // fprintf(diag, "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"); q2 = fix39(np); // q2 holds the exponent of 1st operand, i.e. N2 wms2 = wms; wls2 = nestls[np--]; q1 = fix39(np); wls = nestls[np]; // 2nd operand, i.e. N1 // fprintf(diag, "N1 = %08o %08o / %d\n", wms, wls, q1); // fprintf(diag, "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[qch=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[qch=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; get24(qm[q1], qm[q2]); qm[qch=q1] = (qm[q1] + qi[q1]) & 0177777; if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777; break; /* --------------- */ case 0107: // =MqMqQH store 24-bit value in address hq + q and increment Qq q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; put24(qm[q1], qm[q2]); qm[qch=q1] = (qm[q1] + qi[q1]) & 0177777; if ( q1 != 0 ) qc[q1] = (qc[q1] - 1) & 0177777; 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[qch=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[qch=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; if ( q2 != 0 ) qm[qch=q2] = qm[q1]; break; /* --------------- */ case 0152: // IqTOQq copy Iq to increment of Q q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q2 != 0 ) qi[qch=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; if ( q2 != 0 ) { qi[qch=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; if ( q2 != 0 ) qc[qch=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; if ( q2 != 0 ) { qc[qch=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; if ( q2 != 0 ) { qc[qch=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; if ( q2 != 0 ) { qc[qch=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[qch=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[qch=q1] = (qm[q1] - qi[q1]) & 0177777; break; /* --------------- */ case 0142: // 020 NCq negate Cq q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; qc[qch=q1] = (-qc[q1]) & 0177777; break; /* --------------- */ case 0143: // 020 DCq decrement Cq q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q1 != 0 ) qc[qch=q1] = (qc[q1] - 1) & 0177777; break; /* --------------- */ case 0144: // 020 Iq=+1 Iq = +1 q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q1 != 0 ) qi[qch=q1] = 1; break; /* --------------- */ case 0145: // 020 Iq=-1 Iq = -1 q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q1 != 0 ) qi[qch=q1] = 0177777; break; /* --------------- */ case 0146: // 020 Iq=+2 Iq = +2 q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q1 != 0 ) qi[qch=q1] = 2; break; /* --------------- */ case 0147: // 020 Iq=-2 Iq = -2 q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q1 != 0 ) qi[qch=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"); } if ( q1 != 0 ) qch = q1; else // protect zero value of Q0 { qm[q1] = 0; qi[q1] = 0; qc[q1] = 0; } 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; // fprintf(diag, "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"); } if ( q1 != 0 ) qch = q1; else // protect zero value of Q0 { qm[q1] = 0; qi[q1] = 0; qc[q1] = 0; } 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; if ( verbose >= 1 ) fprintf(diag, "%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 0125: // 020 PREQq forward read to end message character q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( qc[q1] < 1024 ) // not mag tape { readptr(q1, 1); break; } // crude MT emulation for Kalgol drops through pc --; // back step program counter // case 0125: // 030 PRCEQq read paper tape to end message character, all 8 holes to each 48-bit word /* --------------- */ case 0124: // 020 MFRQq, PRQq forward read q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( qc[q1] >= 1024 && q2 == 0 ) // crude MT emulation for Kalgol { wls = qi[q1]*6; wms = qm[q1]*6 - wls + 6; if ( read(qc[q1]-1024, store+wls, wms) <= 0 ) { perror("MT read"); fprintf(diag, "start addr %o bytes length %o\n", wls, wms); illegal("MT read"); } break; // only works for fixed-length blocks and not MREQq } if ( q2 == 4 ) // TLOQq -- added Oct 1029 break; // lock-out never set in this emulation notyetimplemented(0124, "MFRQq, PRQq, etc"); 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 0126: // 020 MBRQq backward read q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( qc[q1] >= 1024 ) // crude MT emulation for Kalgol { int i, j; wls = qi[q1]*6; wms = qm[q1]*6 - wls + 6; if ( zseek(qc[q1]-1024, -256*6, SEEK_CUR) < 0 ) // skip back one block illegal("skip1 MBRQ"); if ( read(qc[q1]-1024, store+wls, wms) <= 0 ) // read it illegal("read MBRQ"); if ( zseek(qc[q1]-1024, -256*6, SEEK_CUR) < 0 ) // skip back over it again illegal("skip2 MBRQ"); // reorder the data j = qi[q1] - 1; // last low word swapped i = qm[q1] + 1; // last high word swapped while ( ++j < --i ) { memcpy(buff, store + 6*j, 6); memcpy(store + 6*j, store + 6*i, 6); memcpy(store + 6*i, buff, 6); } break; // only works for fixed-length blocks and not MWEQq } 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 case 0131: // 020 MWEQq, PWEQq write to end message character q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; poapob(f, q2, q1); // 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: // 030 MLWEQq write to end message character followed by tape mark, i.e. write a last block /* --------------- */ case 0134: // 020 MFSKQq forward skip Mq blocks q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( skipmt(q1, qm[q1]) < 0 ) 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 Mq blocks q2 = store[pc++]; q1 = q2 >> 4; q2 &= 017; if ( q2 == 010 ) // MRWDQq wls = -32768; else if ( q2 == 0 ) // MBSKQq wls = -qm[q1]; else notyetimplemented(0136, "PM?Qq"); if ( skipmt(q1, wls) < 0 ) 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--]; if ( (wms&0200000) != 0 ) // funny syllable count wls = wms & 0177777; // recover all 16 bits else 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--] & 0177777; // bottom 16 bits if ( (wls&0160000) >= 0140000) // syllable greater than 5 -- this cannot be used in EXIT sjns[++sjnsp] = wls | 0200000; // this can only be used in LINK instruction else sjns[++sjnsp] = (wls&017777)*6 + ((wls>>13)&07); pc ++; // skip over zero 2nd syllable break; /* --------------- Unrealistic director mode implementaiton for special tests */ case 0176: // K4 kludge implementation for director start up if ( store[pc] != 010 || store[pc+1] != 052 ) illegal("00 L - K4 not followed by ERASE"); pc ++; // skip over 2nd syllable pc ++; // skip over ERASE if ( store[pc] == 0201 ) illegal("Loop stop"); break; case 0175: // =Kn kludge implementation for director start up pc ++; // skip over 2nd syllable break; /* --------------- */ default: illegal("00 L - Illegal instruction - 1- or 2-syllable"); } // if ( verbose >= 4) // alternate location for main diagnostic // { if ( np < 0 ) // fprintf(diag, "%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 // fprintf(diag, "%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[0xBB] = 075; // Bill Findlay's end-message '»' ptkdf9['|'&255] = 075; // Bill Findlay's other end-message ptkdf9[0xB1] = ptkdf9['#']; // Bill Findlay's not-equals '±' ptkdf9[0xBA] = ptkdf9['~']; // Bill Findlay's subscript-10 'º' ptkdf9[0xF7] = ptkdf9['%']; // Bill Findlay's integer divide '÷' ptkdf9[0xD7] = ptkdf9['!']; // Bill Findlay's multiply '×' // for ( i = 16; i<128; i++ ) // fprintf(diag, "ASCII %c %02X %03o => %3o\n", i, i, i, ptkdf9[i]); // now insert some fancy ISO chars for multiply and divide and sub-ten for paper tape output sptchar[026] = 0xD7; // multiply sptchar[027] = 0xF7; // integer divide nptchar[033] = '@'; // supscript 10 } int readKDF9pc(char *p) // p points at a KDF9 address %o/%o (null string gives 0) { int c; int res = 0; while ( isdigit(c = *(p++)) ) res = (res<<3) + c - '0'; res *= 6; if ( c == '/' ) res += *p - '0'; return res; } int atoir(char *s) // read integer with radix if starting with 0 { int v = 0; if ( *s != '0' ) return atoi(s); while ( *++s != 0 ) v = (v<<3) + (*s&7); return v; } int main(int argc, char **argv) { int i; char *s; diag = stdout; buff = (unsigned char *)malloc(bufflen); buff[0] = 0; // null string sbuff = (char *)buff; i = 0; while ( ++i < argc && *(s = argv[i]) == '-' ) // process switches { strcat(sbuff, " "); strcat(sbuff, s); if ( *++s == 'd' ) diag = fopen("log.txt", "w"); // specify diagnostic file else if ( *s == 'v' ) // set verbosity verbose = atoi(s+1); else if ( *s == 't' ) // turn-on trace set verbosity = 9 at this instruction count { if ( s[strlen(s)-2] == '/' ) // check that it is a store address maxdiag = readKDF9pc(s+1); // set verbosity = 9 at this address else diagStartic = atoi(s+1); // set verbosity = 9 after this number of instructions } else if ( *s == 'f' ) // abandon execution 1000 after first passing this point, put -v7 faband = readKDF9pc(s+1); else if ( *s == 'a' ) // abandon execution after this many instructions abandon = atoi(s+1); else if ( *s == 'Q' ) // select Q-store for monitoring qmon = atoi(s+1); else if ( *s == 'T' ) // Findlay compatible trace { if ( s[strlen(s)-2] == '/' ) // trace starts on program address trStartpc = readKDF9pc(s+1); else // trace starts on instructions counter trStartic = atoi(s+1); } else if ( *s == 'B' ) // set 3 octal digits in LS half of word 0 (c.f. TINT B) { int i = 0; while ( *++s != 0 ) i = 8*i + (*s&7); tintb |= i; // remember until we have loaded the program } else if ( *s == 'I' ) // enables jump to word 4 on failure (c.f. TINT I) tinti = atoi(s+1); // remember until we have a failure else if ( *s == 'D' ) // director mode pc = 24; // execution starts on even restart else if ( *s == 'o' ) // choose octal printout for direct memory addresses memmnem = memmnemoct; // is this legal in all variants of C else if ( *s == 'm' ) // monitor address, print message whenever its value changes monloc = atoir(s+1) * 6; // else if ( *s == 'n' ) // number of locations to monitor // monnum = atoi(s+1); // else if ( *s == 'w' ) // turn-off diagnostics during a subroutine at this address // turnOff = atoi(s+1); } if ( i >= argc ) fprintf(stderr, "Usage: %s [-dvtfaQT] binary_file [paper tape reader file]", "kdf9"); else { fprintf(diag, "Switches are: %s\n", buff); loadprogram(argv[i]); 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 } if ( verbose >= 1 ) fprintf(diag, "Program store limit = %d words\n", store[9]*65536 + store[10]*256 + store[11]); if ( ++i < argc ) { ptr_fn = argv[i]; // data file for first claimed aper tape reader if ( ++i < argc ) ptr2_fn = argv[i]; // data file for second claimed aper tape reader } if ( tintb != 0 ) // TINT B needs to be emulated { store[5] = tintb & 0377; // leave unchanged if no TINT;B in case store[4] = (tintb>>8) & 0377; // the program has a built-in TINT;b value store[3] = (tintb>>16) & 0377; } setpapertapechars(); // set character translation for paper tape printdv = fopen("printer.txt", "w"); // temp ??? OUT 8 output to any non-zero stream also LPQq signal(SIGINT, catchint); // allow control-C to end cleanly 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[']'] = ']'; // surely an error 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 magnetic tape. // Tapes are claimed by OUT 4 // Tape I/O instructions are in the interpret() routins char mtlab[12] = { 0171, 04, 036, 0101, 04, 020, 0, 0, 0, 0, 0, 0 }; // -00-0000 zero label // 011 110 010 000 010 000 011 110 | 010 000 010 000 010 000 010 000 // 0111 1001 0000 0100 0001 1110 | 0100 0001 0000 0100 0001 0000 int labelsize = 0; // used by brick83() to know if there are tape labels to skip - obsolete? void out4() // crude tape claiming temporarily(?) implemented as part of // writing PANACEA in KAL4 { static int tapeno = 0; // ensures unique name for each tape file int dv; int w; // points at start of tape filename char *s; if ( nestls[np] == 0 ) // request for a work tape { mtlab[5] = 020 + tapeno; sprintf(sbuff, "tape%d.mt", tapeno++); dv = open(sbuff, O_RDWR + O_CREAT + O_BINARY, 0640); write(dv, mtlab, 12); // two word label block nestls[np] = dv + 1024; s = "ZERO"; w = 0; // fprintf(diag, "ZERO tape opened on file %s device %d\n", sbuff, dv+1024);); } else { w = 3; // pointer to tape label in sbuff sprintf(sbuff, "../tape%d.mt", nestls[np]&017); // crude mapping to files nestms[np] = 0; dv = open(sbuff+3, O_RDWR + O_BINARY); if ( dv >= 0 ) nestls[np] = dv + 1024; else { dv = open(sbuff, O_RDONLY + O_BINARY); // try the parent directory nestls[np] = dv + 1024; // set read-only (2048) if in parent directory w = 0; } s = "Labelled"; // fprintf(diag, "Labelled tape opened on file %s device %d\n", sbuff + tapeno, dv+1024); } if ( dv < 0 ) { perror(sbuff); illegal("MT error - cannot open tape"); } fprintf(diag, "%s tape opened on file %s device %d\n", s, sbuff + w, dv+1024); labelsize = 12; } #ifndef LITE // ================================================================================== // Simplistic emulation of a disc file in the Eldon2/PROMPT filestore // A file file.dsk has 640 word blocks // Track number is used as block number to read // Such a file can be created by mkchan.c int fileid0, fileid1, fileid2, fileid3; void out34eldon2() // read user's global disk -- just used for getting job queue entry // which a previous module puts in top of store { int n = nestls[np--] & 0177777; // get parameter - top address of buffer int m = (store[10]<<8) + store[11] - 40; // top 40 words of store n -= 39; // start of buffer memcpy(store+n*6, store+m*6, 240); // starter prog puts job queue entry in top of store // get48(n+12); get48(n+11); // prog ID in N1/2 // fileid0 = nestms[np]; // needed to emulate PROMPT file block check // fileid1 = nestls[np--]; // fileid2 = nestms[np]; // fileid3 = nestls[np--]; } // ================================================================================== // Simplistic emulation of the Eldon2/PROMPT filestore // 640-word blocks are read from file file.dsk // track no is block number int prompt_dv = -1; 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 reads from a binary file of 640-word blocks // The data file lives in file.dsk { 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 if ( verbose >= 1 ) fprintf(diag, "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 ( prompt_dv < 0 ) // filestore disk not yet opened prompt_dv = open("file.dsk", O_RDONLY + O_BINARY); if ( prompt_dv < 0 ) // filestore disk not yet opened { perror("file.dsk"); illegal("PROMPT error - cannot open filestore"); } zseek(prompt_dv, track*(640*6+4) + 4, SEEK_SET); // 4 bytes at head of each block read(prompt_dv, store + lo, 640*6); } // OUT 70 for emulation of POST PANACEA // this is OUT70 lite which only implements the diagnostic print function char *ABS[] = { // David Huxtable's table " 0"," 1"," 2"," 3"," 4"," 5"," 6"," 7", // 000 - 007 " 8"," 9"," 10"," ."," A"," B"," C"," D", // 010 - 017 " E"," F"," G"," H"," I"," J"," K"," L", // 020 - 027 " M"," N"," O"," P"," Q"," R"," S"," T", // 030 - 037 " U"," V"," W"," X"," Y"," Z"," a"," b", // 040 - 047 " c"," d"," e"," f"," g"," h"," i"," j", // 050 - 057 " k"," l"," m"," n"," o"," p"," q"," r", // 060 - 067 " s"," t"," u"," v"," w"," x"," y"," z", // 070 - 077 "100","real","integer","boolean","104","105","106","107", // 100 - 107 "array","realArrayDec","intArrayDec","boolArrayDec","114","115","116","117", // 110 - 117 "Proc","RlProc","InProc","BoProc","124","?125","126","127", // 120 - 127 "switch","label","132","133","134","135","136","137", // 130 - 137 "140","realFml","intFml","booFml","144","145","146","147", // 140 - 147 "150","realArrayFml","intArrayFml","booArrayFml","154","156","156","157", // 150 - 157 "procFml","realProcFml","intProcFml","booProcFml","164","165","166","167", // 160 - 167 "swFML","labelFML","stringFML","173","174","175","176","177", // 170 - 177 "comment","^","<","not","(","if","for","207", // 200 - 207 "goto","[","[p","(p","begin","{","*","own", // 210 - 217 "220","%","<=","and",")","then","while","227", // 220 - 227 ";","]","p]","p)","end","const","_","value", // 230 - 237 "NL","/","=","or","244","else",",","247", // 240 - 247 "250","251","252",",P","254","255","tab","257", // 250 - 257 "KDF9","x",">=","imp","264",":=","step","267", // 260 - 267 "270",":","272","273","274","true","->","277", // 270 - 277 "ALGOL","+",">","env","304","305","until","307", // 300 - 307 "310","311","312","313","begPbody","false","316","317", // 310 - 317 "library","-","<>","323","324","325","do","327", // 320 - 327 "330","331","332","333","endPBody","true","336","337", // 330 - 337 "segment","341","342","343","344","345","346","347", // 340 - 347 "350","351","352","353","begForBody","355","356","357", // 350 - 357 "exit","361","362","363","364","365","366","367", // 360 - 367 "370","371","372","373","endForBody","375","376","377" // 370 - 377 }; unsigned char zerowords[24] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 }; void memprint(int lo, int hi, int n1ls) // print memory to log.txt { int wms, wls, wc, wi, wm, i, i6; char c0 = ((n1ls>>16)&077) + 'A' - 041; // wrong !!! char c1 = ' '; int j = n1ls&0177777; // initial store number int inc = +1; // store increment, -1 for Z if ( (n1ls&020000000) != 0 ) // YA, YB etc c1 = 'Y'; else if ( c0 == 'Z' ) // Z stores go "backwards" inc = -1; i = lo; while ( hi>=i ) // avoid for loop as I is altered in the loop { i6 = 6*i; wc = (store[i6]<<8) | store[i6+1]; wi = (store[i6+2]<<8) | store[i6+3]; wm = (store[i6+4]<<8) | store[i6+5]; wms = (wc<<8) | store[i6+2]; wls = (store[i6+3]<<16) | wm; // abstoascii(i, i+1); // loads chars nto buff -- superseded by Hux table // fprintf(diag, "%c%c%2d %06o = %08o %08o Q %06o / %06o / %06o Q %5d/%5d/%5d %s\n", // c1, c0, j+(i-lo)*inc, i, wms, wls, wc, wi, wm, neg16(wc), neg16(wi), neg16(wm), fprintf(diag, "%c%c%2d %06o = %08o %08o Q %06o / %06o / %06o %03o %03o %03o %03o %03o %03o %s\n", c1, c0, j+(i-lo)*inc, i, wms, wls, wc, wi, wm, wc>>8, wc&255, wi>>8, wi&255, wm>>8, wm&255, ABS[store[i6+5]]); // was buff); before using David Hu's table if ( memcmp(store+i6, zerowords, 24) == 0 ) // four consecutive zero words { fprintf(diag, " .................. zeros\n"); while ( ++i < hi && memcmp(store+6*i, zerowords, 12) == 0 ) ; // skip to NZ or end i--; } i ++; } } void out70() // this is OUT70 lite which only implements the diagnostic print function // N1 is in Q-store format: Q lo / hi / 0 // and it prints store from lo to hi inclusive. // N2 is in Q-store format: Q ignored / lab / n // where lab is the label of the store section, e.g. YX, V, Y, Z, H // and n is the number within the section at which is starts. (Z-stores number backwards) { int par1 = nestls[np --] & 0177777; // parameter is modifier part of N1 int link = sjns[sjnsp]; int resms = 0; // These are the result most-sig asnd least-sig halves ... int resls = 0; // ... , but also used as flags to cause writes etc int w1ms, w1ls, w2ms, w2ls; // handy working locations analagous to W1 and W2 in KAB00 int i; // often the increment part of the parameter int w, j; // workspace *buff = 0; // start with an empty string w2ms = w1ms = nestms[np+1]; w2ls = w1ls = nestls[np+1]; i = ((w1ls>>16)&0377) | ((w1ms&0377)<<8); // increment of param word if ( par1 == 0 ) // diagnostic memory print sprintf(sbuff, "Store print %o to %o i.e. %d to %d", w1ms>>8, i, w1ms>>8, i); else illegal("Unimplemented OUT70"); if ( stdout != diag ) // diagnostics written to file fprintf(diag, "*** JSE70; %5o/%o %2d cells N1=%06o/%06o/%06o ic=%d %s\n", link/6, link%6, np+1, w1ms >> 8, i, par1, instructionCount, buff); // printf("*** JSE70; %5o/%o M=%03X %02o %2d cells ic=%d %s\n", // link/6, link%6, par1>>6, par1&077, np+1, instructionCount, buff); memprint(w1ms>>8, i, nestls[np--]); } #endif