selectoutput(sysprint)
// Now syntax analyse, translate and code-generate each section
+ param := 4000 // Nick, for cg-intcode.b
{ LET b = VEC 64/bytesperword+1
chbuf := b
FOR i = 0 TO 63 DO chbuf%i := 0
datat
proglength
linep
-param
+//param Nick, now defined in bcplfecg.h
maxgn
maxlab
}
ssp, state := 2, nil
ad_a, ad_k := 0, m_n
- datap, linep, param := 0, 0, 1000
+ datap, linep/*, param*/ := 0, 0/*, 1000*/
gencode()
//writef("before repeatuntil op=%n %s*n", op, opstr(op))
flt10 // Floating point 10.0 constructed by sys(Sys_flt, fl_mk, 10, 0)
nocomments // Added 03/09/2022
+param // Nick, for cg-intcode.b
lastintglobal // Used to check for global overlap with syng
}
//THEN sawritef("DLIB: findstream(%s, %n, %s)*n", name, id, path)
//ELSE sawritef("DLIB: findstream(%s, %n, 0)*n", name, id)
//sawritef("DLIB: currentdir=%n*n", currentdir)
-
+//sawritef("findstream: name=%s*n", name)
IF console DO
{ IF id=id_inscb & rootnode!rtn_keyboard RESULTIS rootnode!rtn_keyboard
IF id=id_outscb & rootnode!rtn_screen RESULTIS rootnode!rtn_screen
scb := getvec(scb_upb)
UNLESS scb RESULTIS 0
+//sawritef("findstream: task %i2 allocating scb =%i6 for %s*n",
+// taskid, scb, name)
+ // Clear all scb fields
FOR i = 0 TO scb_upb DO scb!i := 0
scb!scb_id := id // id_inscb, id_outscb, id_inoutscb or id_appendscb
- // Copy (truncated) stream name into the scb
+ // Copy (possibly truncated) stream name into the scb
{ LET len = name%0
LET scbname = @scb!scb_name
LET maxlen = scb_maxnamelen
scb!scb_type := scbt_console
scb!scb_buf := buf
scb!scb_bufend := 4096
+ scb!scb_endfn := cnslendfn
IF id=id_inscb DO
{ scb!scb_rdfn := cnslrdfn // fn to replenish current buffer
RESULTIS scb
}
IF id=id_outscb DO
- { scb!scb_wrfn := cnslwrfn // fn to output current buffer
+ { scb!scb_wrfn := cnslwrfn // fn to deplete current buffer
rootnode!rtn_screen := scb
RESULTIS scb
}
// Bad stream id
freevec(scb)
+ freevec(buf)
RESULTIS 0
}
splitname(prefix, ':', name, 1)
+
IF compstring(prefix, "NIL")=0 DO
{ // On reading always gives endstreamch
// On writing always throws away the data
- scb!scb_wrfn := nilrdfn
- scb!scb_endfn := nilwrfn
+ scb!scb_wrfn := nilwrfn
//sawritef("DLIB: Opening stream to/from NIL:*n")
RESULTIS scb
}
+ IF compstring(prefix, "RAM")=0 DO
+ { // Open a RAM stream.
+ // It is always a read/write stream.
+ // Its buffer is automatically extended as needed.
+ // All stream buffers are allocated using getvec and
+ // must be freed using freevec when the stream is closed.
+ // Note that rewindstream, note, point and record access
+ // all work with RAM streams.
+ LET buf = getvec(1024/bytesperword) // Initial allocation
+ UNLESS buf DO { freevec(scb); RESULTIS 0 }
+ scb!scb_type := scbt_ram
+ scb!scb_id := id_inoutscb
+ scb!scb_buf := buf
+ scb!scb_pos := 0 // Initial position
+ scb!scb_end := 0 // End of valid data
+ scb!scb_bufend := 1024 // Current size of buf
+
+ scb!scb_wrfn := ramwrfn // This automatically expands the buffer
+ // if needed.
+//sawritef("DLIB: Opening stream to/from RAM:*n")
+ RESULTIS scb
+ }
+
IF compstring(prefix, "TCP")=0 | compstring(prefix, "NET")=0 DO
- { sawritef("TCP connections not yet available*n")
+ { sawritef("TCP connections not yet available in cintsys*n")
freevec(scb)
RESULTIS 0
}
+
// Open a file stream
//sawritef("DLIB: %s must be a file*n", name)
RESULTIS 0
}
-AND nilrdfn(scb) = FALSE
-
AND nilwrfn(scb) = VALOF
{ scb!scb_pos := 0 // Throw away the buffer contents (if any)
RESULTIS TRUE
}
+AND ramwrfn(scb) = VALOF
+{ // Replace the buffer by one of twice the size
+ LET oldbufend = scb!scb_bufend
+ LET oldbufupb = oldbufend/bytesperword
+ LET oldbuf = scb!scb_buf
+ LET newbufend = oldbufend*2 // Double the buffer size
+ LET newbufupb = newbufend/bytesperword
+ LET newbuf = getvec(newbufupb)
+ UNLESS newbuf RESULTIS FALSE
+ FOR i = 0 TO oldbufupb DO newbuf!i := oldbuf!i
+ scb!scb_buf, scb!scb_bufend := newbuf, newbufend
+ freevec(oldbuf)
+ RESULTIS TRUE
+}
+
AND cnslrdfn(scb) = VALOF
{ LET buf, p = scb!scb_buf, 0
RESULTIS TRUE
}
+AND cnslendfn(scb) = VALOF
+{ //freevec(scb!scb_buf)
+ RESULTIS TRUE
+}
+
AND flush() = VALOF
{ IF cos=0 | cos!scb_id~=id_outscb DO abort(187)
RESULTIS fh0wrfn(cos)
// Returns TRUE if successful
// Returns FALSE, result2=100 Can't open file
// result2=101 Can't allocate buffer
-{ LET fp, buf = 0, 0
+{ LET fp, fp1 = 0, 0
+ LET buf = 0
LET filesize = 0
LET filename = VEC 50
trfilename(name, filename)
//sawritef("DLIB: fh0findinput calling sys_openread %s %s*n",
// filename, path->path,"null")
// Open the file for input
- fp := sys(Sys_openread, filename, path) // MR 8/5/03
- UNLESS fp DO
+ UNLESS sys(Sys_openread, filename, path, @fp) DO // MR 8/5/03
{
//sawritef("DLIB: fh0findinput sys_openread %s failed*n", filename)
result2 := 100
}
//sawritef("DLIB: %s opened*n", filename)
- filesize :=sys(Sys_filesize, fp)
+ filesize :=sys(Sys_filesize, @fp)
//sawritef("DLIB: filesize=%n*n", filesize)
// allocate a buffer
buf := getvec(buflen/bytesperword)
UNLESS buf DO
- { sys(Sys_close, fp) // First close the file
+ { sys(Sys_close, @fp) // First close the file
result2 := 101
RESULTIS 0
}
scb!scb_rdfn := fh0rdfn
scb!scb_wrfn := 0 // An input stream cannot be depleted
scb!scb_endfn := fh0endfn
- scb!scb_fd := fp
+ scb!scb_fd := fp // Allow for 64 bit file pointer
+ scb!scb_fd1 := fp1
scb!scb_bufend := buflen
scb!scb_write := FALSE // No data waiting to be written
scb!scb_blength := buflen // MR 15/3/02
// Returns TRUE if successful
// Returns FALSE, result2=100 Can't open file
// result2=101 Can't allocate buffer
-{ LET fp, buf = 0, 0
+{ LET fp, fp1 = 0, 0
+ LET buf = 0
LET sysop = scb!scb_id=id_appendscb -> Sys_openappend, Sys_openwrite
LET filename = VEC 50
trfilename(name, filename)
// Open the file for output
- fp := sys(sysop, filename)
- UNLESS fp DO
+ UNLESS sys(sysop, filename, @fp) DO
{ result2 := 100
RESULTIS FALSE
}
// allocate a buffer
buf := getvec(buflen/bytesperword)
UNLESS buf DO
- { sys(Sys_close, fp) // First close the file
+ { sys(Sys_close, @fp) // First close the file
result2 := 101
RESULTIS FALSE
}
-//sawritef("DLIB: fh0findoutput scb %n %n buf %n*n", scb, fp, buf)
+//sawritef("DLIB: fh0findoutput scb %n buf %n*n", scb, buf)
scb!scb_type := scbt_file
scb!scb_task := 0
scb!scb_wrfn := fh0wrfn
scb!scb_endfn := fh0endfn
scb!scb_fd := fp
+ scb!scb_fd1 := fp1
scb!scb_bufend := buflen
scb!scb_write := FALSE // No data waiting to be written
scb!scb_blength := buflen
// Returns TRUE if successful
// Returns FALSE, result2=100 Can't open file
// result2=101 Can't allocate buffer
-{ LET fp, buf, res1, res2 = 0, 0, 1, 0
+{ LET fp, fp1 = 0, 0
+ LET buf, res1, res2 = 0, 1, 0
LET filesize = 0
LET filename = VEC 50
trfilename(name, filename)
// open the file for input and output
- fp := sys(Sys_openreadwrite, filename)
-//sawritef("DLIB: open %s in inout mode => %n*n", filename, fp)
- UNLESS fp DO
+ UNLESS sys(Sys_openreadwrite, filename, @fp) DO
{ result2 := 100
RESULTIS FALSE
}
- filesize :=sys(Sys_filesize, fp)
+ filesize :=sys(Sys_filesize, @fp)
//sawritef("BLIB: filesize=%n*n", filesize)
// allocate a buffer
buf := getvec(buflen/bytesperword)
UNLESS buf DO
- { sys(Sys_close, fp) // First close the file
+ { sys(Sys_close, @fp) // First close the file
result2 := 101
RESULTIS FALSE
}
//sawritef("DLIB: buflen = %n*n", buflen)
-//sawritef("DLIB: fh0findinoutput scb %n %n buf %n*n", scb, fp, buf)
+//sawritef("DLIB: fh0findinoutput scb %n fp=(%n %n) buf %n*n", scb, fp, fp1, buf)
scb!scb_type := scbt_file
scb!scb_buf := buf
scb!scb_wrfn := fh0wrfn
scb!scb_endfn := fh0endfn
scb!scb_fd := fp
+ scb!scb_fd1 := fp1
scb!scb_bufend := buflen
scb!scb_write := FALSE // No data waiting to be written
scb!scb_blength := buflen // MR 15/3/02
scb!scb_block := 0 //1 MR 29/7/02
scb!scb_lblock := filesize/buflen //+ 1 // MR 16/4/02 MR 29/7/02
- scb!scb_ldata := filesize REM buflen // MR 16/4/02
+ scb!scb_ldata := filesize MOD buflen // MR 16/4/02
//sawritef("fh0findinoutput: lblock=%n*n", scb!scb_lblock)
// Initialise the buffer by reading the first block
//sawritef("DLIB: fh0endfn pos=%n end=%n*n", scb!scb_pos, scb!scb_end)
IF scb!scb_write UNLESS fh0putbuf(scb) RESULTIS FALSE
//sawritef("DLIB: fh0endfn freeing buf=%n*n", scb!scb_buf)
- freevec(scb!scb_buf)
- RESULTIS sys(Sys_close, scb!scb_fd)
+ ///freevec(scb!scb_buf)
+ ///scb!scb_buf := 0
+ RESULTIS sys(Sys_close, @scb!scb_fd)
}
// Result TRUE: posv contains the stream block and pos
//sawritef("DLIB: point block=%n lblock=%n blkno=%n pos=%n end=%n*n",
// block, lblock, blkno, pos, end)
- // The stream must be a readable disc or RAM file
- UNLESS (type=scbt_file | type=scbt_ram) &
- (id=id_inscb | id=id_inoutscb) RESULTIS FALSE
-
+ // The stream must be a disc or RAM file
+ UNLESS (type=scbt_file | type=scbt_ram)
+ { sawritef("DLIB: point can only used with file and ram streams*n")
+ abort(999)
+ RESULTIS FALSE
+ }
+
IF pos=0 & blkno=lblock+1 DO blkno, pos := lblock, buflen
//sawritef("DLIB: point block=%n lblock=%n blkno=%n pos=%n end=%n*n",
UNLESS fh0putbuf(scb) DO abort(5003)
}
+ // Reading a block from file or ram is only allowed if
+ // reading is permitted.
+
+ UNLESS id=id_inscb | id=id_inoutscb DO
+ { sawritef("DLIB: The stream did not permit reading*n")
+ abort(999)
+ RESULTIS FALSE
+ }
scb!scb_block := blkno // Set the new position
//sawritef("DLIB: point read block %n*n", blkno)
UNLESS fh0getbuf(scb) DO
{ sawritef("DLIB: point fh0getbuf failed block %n => %n*n", blkno, end)
- abort(5004)
+ abort(999)
RESULTIS FALSE
}
sawritef("DLIB point: end %n buflen %n*n", scb!scb_end, buflen)
sawritef("DLIB point: block %n lblock %n*n", blkno, lblock)
sawritef("DLIB point: end %n ldata %n*n", end, scb!scb_ldata)
- abort(5005)
+ abort(999)
}
scb!scb_pos := pos // Set the desired offset
// Returns FALSE, otherwise.
{ LET end = scb!scb_end // Number of bytes of valid data in buf
LET block = scb!scb_block
- LET fd = scb!scb_fd
+ LET fdptr = @scb!scb_fd
LET offset = buflen*block // File offset of buffer's first byte MR 29/7/02
IF end<=0 DO
IF block = scb!scb_lblock DO scb!scb_ldata := end
//sawritef("DLIB: putbuf seeking offset %n (block %n)*n", offset, block)
- UNLESS sys(Sys_seek, fd, offset) RESULTIS FALSE
+ UNLESS sys(Sys_seek, fdptr, offset) RESULTIS FALSE
//sawritef("DLIB: putbuf write %n bytes at offset %n*n", end, offset)
- IF sys(Sys_write, fd, scb!scb_buf, end) < 0
+ IF sys(Sys_write, fdptr, scb!scb_buf, end) < 0
RESULTIS FALSE
scb!scb_write := FALSE // The buffer has been written successfully
RESULTIS TRUE
// Returns FALSE, otherwise.
AND fh0getbuf(scb) = VALOF
-{ LET fd = scb!scb_fd
+{ LET fdptr = @scb!scb_fd
LET block = scb!scb_block // Block number (>=0)
LET offset = buflen*block // MR 29/7/02
LET end = ?
//sawritef("DLIB: fh0getbuf seeking start of block %n (offset %n)*n",
// block, offset)
- UNLESS sys(Sys_seek, fd, offset) RESULTIS FALSE
-//sawritef("DLIB: fh0getbuf file position now %n*n", sys(Sys_tell, fd))
+ UNLESS sys(Sys_seek, fdptr, offset) RESULTIS FALSE
+//sawritef("DLIB: fh0getbuf file position now %n*n", sys(Sys_tell, fdptr))
//sawritef("DLIB: fh0getbuf reading block %n offset=%n*n", block, offset)
- end := sys(Sys_read, fd, scb!scb_buf, buflen)
+ end := sys(Sys_read, fdptr, scb!scb_buf, buflen)
//sawritef("DLIB: fh0getbuf read => %n*n", end)
//sawritef("DLIB: fh0getbuf block=%n lblock=%n ldata=%n*n",
// block, scb!scb_lblock, scb!scb_ldata)
RESULTIS TRUE
}
-AND delay(ms) = sys(Sys_delay, ms)
-
-/*
-AND delay(ms) = VALOF
-{ LET days, msecs = ?, ?
- MANIFEST { msperday = 24*60*60*1000 }
- datstamp(@days)
-//sawritef("delay: time now days=%i5 msecs=%n*n", days, msecs)
- msecs := msecs+ms
- IF ms>msperday DO days, msecs := days+1, msecs-msperday
-//sawritef("delay: delaying until days=%i5 msecs=%n*n", days, msecs)
- RESULTIS delayuntil(days, msecs)
-}
-*/
+AND delay(msecs) = sys(Sys_delay, msecs)
AND delayuntil(days, msecs) BE
-{ LET ds, ms = 0, 0
+{ LET ds, ms, dummy = 0, 0, 0
datstamp(@ds)
IF ds<days RETURN
IF ds=days & ms<=msecs RETURN
sys(Sys_delay, 1) // Sleep for 1 msec
} REPEAT
+// Dummy definition of testflags
+AND testflags(flags) = FALSE
+
for a 16 bit EBCDIC machine. The original version was tested
in 1982 on the IBM 370(a 32 bit EBCDIC machine).
-This version is a modification of the program to run under 32-bit
-Cintcode BCPL. It is still under development.
+This version has been modified and extended to modern BCPL on the
+current 32-bit BCPL Cintcode system. It is still under development.
Implemented by Martin Richards (c) September 2012
To compile and run a BCPL program, type eg
-bcplint com/hello.b to hello.int
-type hello.int
-bcplint sysb/blib.b to blib.int
-bcplint sysb/dlib.b to dlib.int
-interp blib.int dlib.int hello.int
+bcplint com/cmpltest.b to cmpltest.int noselst
+type cmpltest.int
+interp cmpltest.int
-The above sequence is nowhere near working yet, given time who knows.
+Alternatively, use bcint
-30/09/12
-Initial modification of the original interp.b. At least it compiles.
+c bcint cmpltest
+interp cmpltest.int
+
+This is nearly working.
+
+History
+
+14/03/2021
+Made substantial changes to interp.b.
+
+30/09/2012
+Initial modification of the original interp.b.
*/
source
tofile
tostream
-progsize
etoa // EBCDIC -> ASCII table
atoe // ASCII -> EBCDIC table
+
progvec
+progupb
g
p
ch
cyclecount
labv
-cp
+cp // Number of characters assembled in word
+ // at location p. If cp>=4 the current word
+ // full and the next character require a new
+ // word to be allocated.
a
b
-c
-d
-w
+c // Program counter
+
+w // Current instruction
+d // Effective address of current instruction
}
MANIFEST {
-fshift=13
-ibit=#10000; pbit=#4000; gbit=#2000; dbit=#1000
-abits=dbit-1
-wordsize=16; bytesize=8
-lig1=0<<fshift | ibit | gbit | 1 //#012001
-k3 =6<<fshift | 3 //#140003
-x22 =7<<fshift | 22 //#160026
+// Intcode instruction format - Original version for 16-bit machines
+// fff ipgd aaaaaaaaa
+//fshift=13
+//ibit=#10000; pbit=#4000; gbit=#2000; dbit=#1000
+//abits=dbit-1 // Address bits
+//wordsize=16; bytesize=8
+
+// Intcode instruction format - Extended version for 32-bit machines
+// 0fff ipgd aaaa aaaa aaaa aaaa aaaa aaaa
+// fff Op code
+// i Indirection bit
+// p Add P pointer bit
+// g Add G pointer bit
+// d Double length bit
+// aaaa aaaa aaaa aaaa aaaa aaaa Address field
+fshift=28
+ibit=#x08000000; pbit=#x04000000; gbit=#x02000000; dbit=#x01000000
+abits=dbit-1 // Address bits
+wordsize=32; bytesize=8
+
+// Preloaded instruction words
+lig1= 0<<fshift | ibit | gbit | 1 //#x0_A_000001 LIG1
+k3 = 6<<fshift | 3 //#x3_0_000003 K3
+x22 = 7<<fshift | 22 //#x7_0_060016 FINISH
+x27 = 7<<fshift | 27 //#x7_0_06001B SYS
+x4 = 7<<fshift | 4 //#x7_0_060004 RTN
+
+labvupb = 4000 // Originally 2000
}
{ LET f = 0
LET oldin = input()
LET filestream = findinput(filename)
- LET v = VEC 2000
- writef("assemble %s*n", filename)
+ LET v = VEC labvupb
+ IF tracing DO writef("assemble %s*n", filename)
labv := v
UNLESS filestream DO
selectinput(filestream)
clear: // Start reading the next section, if any.
- FOR i = 0 TO 2000 DO labv!i := 0
+ FOR i = 0 TO labvupb DO labv!i := 0 // First clear the label vector.
cp := 4
next:
CASE '*n':
GOTO next
- CASE 'L': f := 0; ENDCASE
- CASE 'S': f := 1; ENDCASE
- CASE 'A': f := 2; ENDCASE
- CASE 'J': f := 3; ENDCASE
- CASE 'T': f := 4; ENDCASE
- CASE 'F': f := 5; ENDCASE
- CASE 'K': f := 6; ENDCASE
- CASE 'X': f := 7; ENDCASE
+ CASE 'L': f := 0; ENDCASE // B := A; A := EA
+ CASE 'S': f := 1; ENDCASE // Store A in memory address EA
+ CASE 'A': f := 2; ENDCASE // A := A + EA
+ CASE 'J': f := 3; ENDCASE // PC := EA
+ CASE 'T': f := 4; ENDCASE // PC := EA if A is non zero
+ CASE 'F': f := 5; ENDCASE // PC := EA if A is zero
+ CASE 'K': f := 6; ENDCASE // Call function at entry point A
+ // incrementing P by EA and saving the link
+ CASE 'X': f := 7; ENDCASE // Execute special operation EA
CASE 'C': rch(); stc(rdn()); GOTO sw // Cn assemble a character
- CASE 'D': rch()
+ CASE 'D': rch() // Assemble a word ofmemory
TEST ch='L'
THEN { rch() // DLn
stw(0)
{ LET gn, ln = ?,?
rch() // GgLn set global g to Ln
gn := rdn()
- a := gn + g
+ a := g + gn
TEST ch='L'
THEN rch()
ELSE writef("*nbad code at p = %n*n", p)
}
CASE 'Z': // End of section
- FOR i = 0 TO 500 IF labv!i>0 DO writef("L%n unset*n", i)
+ FOR i = 0 TO labvupb IF labv!i>0 DO writef("L%n unset*n", i)
GOTO clear
}
}
ELSE { LET a = rdn()
TEST (a&abits)=a
- THEN stw(w+a)
- ELSE { stw(w+dbit); stw(a) }
+ THEN stw(w+a) // a fits in the address field
+ ELSE { stw(w+dbit); stw(a) } // a is too large for the address field
}
GOTO sw
}
-AND stw(w) BE {
- writef("stw %8x %8x*n", p, w)
- !p := w
- p, cp := p+1, 4
+AND stw(w) BE { IF tracing DO writef("stw %8x %8x*n", p, w)
+ !p := w // Store a word of code
+ p, cp := p+1, 4
}
-AND stc(c) BE {
- writef("stc %8x %8x %8x*n", p, cp, c)
- IF cp>=4 DO { stw(0)
+AND stc(c) BE { IF tracing DO writef("stc %8x %8x %8x*n", p, cp, c)
+ IF cp>=4 DO { stw(0) // Store a byte of code
cp := 0
}
(p-1)%cp := c
AND rch() BE { ch := rdch()
UNLESS ch='/' RETURN // Comment character
- UNTIL ch='*n' DO {ch := rdch(); wrch(ch)}
+ UNTIL ch='*n' DO {ch := rdch(); IF tracing DO wrch(ch)}
} REPEAT
AND rdn() = VALOF
AND setlab(n) BE
{ LET k = labv!n
- writef("setlab: n=%x8 p=%x8*n", n, p)
+ IF tracing DO writef("setlab: n=%x8 p=%x8*n", n, p)
IF k<0 DO writef("L%n already set TO %n at p = %n*n",n,-k,p)
WHILE k>0 DO { LET n = !k
!k := p
- writef("fixup: %x8 %x8*n", k, p)
+ IF tracing DO writef("fixup: %x8 %x8*n", k, p)
k := n
}
labv!n := -p
AND labref(n, a) BE
{ LET k = labv!n
- writef("labref: n=%x8 a=%x8*n", n, a)
- TEST k<0 THEN {k := -k; writef("fixup: %x8 %x8*n", a, !a + k)} ELSE labv!n := a
+ IF tracing DO writef("labref: n=%x8 a=%x8*n", n, a)
+ TEST k<0 THEN {k := -k; IF tracing DO writef("fixup: %x8 %x8*n", a, !a + k)}
+ ELSE labv!n := a
!a := !a + k
}
{ // Start of main loop
IF tracing DO
- { LET w = !c
+ { LET w = !c // c is the address of the next instruction
LET op = w>>fshift
LET opstr = fstr(op)
writef("a=%x8 b=%x8 p=%x8 c=%x8 w=%x8(%s",a, b, p, c, w, opstr)
IF (w & gbit) ~= 0 DO wrch('G')
IF (w & dbit) ~= 0 DO wrch('D')
writef("%n)", w&abits)
+ IF (w & dbit) ~= 0 DO writef(",%x8", c!1)
+ //abort(3456)
}
cyclecount := cyclecount + 1
w := !c
c := c + 1
- TEST (w&dbit)=0 THEN d := w&abits
+ TEST (w&dbit)=0 THEN { d := w&abits }
ELSE { d := !c; c := c+1 }
IF (w & pbit) ~= 0 DO d := d + p
CASE 5: UNLESS a DO c := d; LOOP // F
CASE 6: d := p + d // K
- d!0, d!1, d!2 := p, c, a
+ d!0, d!1, d!2 := p, c, a // old P, old C, entry point
p, c := d, a
LOOP
{ DEFAULT: GOTO error
- CASE 1: a := !a; LOOP
- CASE 2: a := -a; LOOP
- CASE 3: a := NOT a; LOOP
- CASE 4: c := p!1 // FNRN
+ CASE 1: a := !a; LOOP // RV
+ CASE 2: a := -a; LOOP // NEG
+ CASE 3: a := NOT a; LOOP // NOT
+ CASE 4: c := p!1 // FNRN
p := p!0
LOOP
- CASE 5: a := b * a; LOOP
- CASE 6: a := b / a; LOOP
- CASE 7: a := b MOD a; LOOP
- CASE 8: a := b + a; LOOP
- CASE 9: a := b - a; LOOP
- CASE 10: a := b = a; LOOP
- CASE 11: a := b ~= a; LOOP
- CASE 12: a := b < a; LOOP
- CASE 13: a := b >= a; LOOP
- CASE 14: a := b > a; LOOP
- CASE 15: a := b <= a; LOOP
- CASE 16: a := b << a; LOOP
- CASE 17: a := b >> a; LOOP
- CASE 18: a := b & a; LOOP
- CASE 19: a := b | a; LOOP
- CASE 20: a := b XOR a; LOOP
- CASE 21: a := b EQV a; LOOP
-
- CASE 22: RESULTIS a // FINISH ie leave the interpreter
-
- CASE 23: b, d := c!0, c!1 // SWITCHON n dlab
+ CASE 5: a := b * a; LOOP // MUL
+ CASE 6: a := b / a; LOOP // DIV
+ CASE 7: a := b MOD a; LOOP // MOD
+ CASE 8: a := b + a; LOOP // ADD
+ CASE 9: a := b - a; LOOP // SUB
+ CASE 10: a := b = a; LOOP // EQ
+ CASE 11: a := b ~= a; LOOP // NE
+ CASE 12: a := b < a; LOOP // LT
+ CASE 13: a := b >= a; LOOP // GE
+ CASE 14: a := b > a; LOOP // GT
+ CASE 15: a := b <= a; LOOP // LE
+ CASE 16: a := b << a; LOOP // LSHIFT
+ CASE 17: a := b >> a; LOOP // RSHIFT
+ CASE 18: a := b & a; LOOP // AND
+ CASE 19: a := b | a; LOOP // OR
+ CASE 20: a := b XOR a; LOOP // XOR
+ CASE 21: a := b EQV a; LOOP // EQV
+
+ CASE 22: RESULTIS a // FINISH ie leave the interpreter
+
+ CASE 23: b, d := c!0, c!1 // SWITCHON n dlab
UNTIL b=0 DO
- { b, c := b-1, c+2 // case k and label
+ { b, c := b-1, c+2 // case k and label
IF a=c!0 DO
{ d := c!1
BREAK
}
}
- c := d // Jump to default
+ c := d // Jump to default
LOOP
- CASE 24: a := b % a; LOOP
- CASE 25: b % a := p!(c!0)
+ CASE 24: a := b % a; LOOP // GBYT
+ CASE 25: b % a := p!(c!0) // PBYT
c := c+1
LOOP
- CASE 26: a := ABS a; LOOP
+ CASE 26: a := ABS a; LOOP // ABS
- CASE 27: // The sys function
- //writef("SYS %n %n %n*n", p!3, p!4, p!5)
+ CASE 27: // The sys function // SYS
+ IF tracing DO writef(" SYS %x8 %x8 %x8 %x8 %x8*n", p!3, p!4, p!5, p!6, p!7)
+ //IF p!4=11 & p!5=118 DO abort(3478)
a := sys(p!3, p!4, p!5, p!6, p!7)
+ g!g_result2 := result2
LOOP
// cases 40 upwards are only called from the following
}
CASE 38: a := ABS a // abs
LOOP
+
+abort(1234)
}
}
} REPEAT
writes("intcode system entered*n")
- UNLESS rdargs(",,,,,,,,,,TO/K,SIZE/K/N,TRACE/S", argv, 100) DO
+ UNLESS rdargs(",,,,,,,,,,TO/K,SIZE/K/N,-t=TRACE/S", argv, 100) DO
{ writef("Bad arguments for interp*n")
RESULTIS 0
}
tofile := 0
IF argv!10 DO tofile := argv!10 // TO/K
- progsize := 1_000_000
- IF argv!11 DO progsize := !(argv!11) // SIZE/K/N
+ progupb := 1_000_000 // In words
+ IF argv!11 DO progupb := !(argv!11) // SIZE/K/N
tracing := argv!12 // TRACE/S
- g, progvec := getvec(1000), getvec(progsize)
+ g, progvec := getvec(1000), getvec(progupb)
FOR i = 0 TO 1000 DO g!i := 0
- FOR i = 0 TO progsize DO progvec!i := 0
+ FOR i = 0 TO progupb DO progvec!i := 0
// Initialise some globals
g!0 := 1000
introotnode := progvec+100
g!g_rootnode := introotnode
- // Initialise some rootnode elements
+ // Copy some rootnode elements
FOR n = 0 TO 49 DO introotnode!n := rootnode!n
// ... but force console to be reopened
introotnode!rtn_keyboard := 0
introotnode!rtn_screen := 0
// Leave space for the rootnode
- p := progvec+200
+ p := progvec+200 // Position of the first instructions
stdin := input()
stdout := output()
- c := p // Initial program counter
+ c := p // Initial program counter -- Execution starts here
p!0 := lig1 // Initial orders
p!1 := k3
p!2 := x22
- p := p+3
- // Load the Intcode programs
+ g!g_sys := p+3 // Initialise the sys global
+
+ p!3 := x27 // SYS Code for the sys function
+ p!4 := x4 // RTN
+
+ p := p+5 // Position of the first assembled intcode section
+
+ // Load up to 10 Intcode program files.
FOR i = 0 TO 9 IF argv!i DO assemble(argv!i)
IF FALSE
- IF tracing DO
+ //IF tracing DO
{ writef("Loaded program*n*n")
FOR i = 200 TO 220 DO
{ LET w = progvec!i
newline()
}
- //writef("*nGlobals*n*n")
- //FOR i = 0 TO 10 DO writef("G%i3: %x8 %n*n", i, g!i, g!i)
+ writef("*nGlobals*n*n")
+ FOR i = 0 TO 10 DO writef("G%i3: %x8 %n*n", i, g!i, g!i)
- //writef("*nRootnode*n*n")
- //FOR i = 0 TO 49 DO writef("Rootnode!%i2: %x8 %n*n",
- // i, introotnode!i, introotnode!i)
+ writef("*nRootnode*n*n")
+ FOR i = 0 TO 49 DO writef("Rootnode!%i2: %x8 %n*n",
+ i, introotnode!i, introotnode!i)
}
writef("*nProgram size = %n*n", p-progvec-200)
//c := TABLE lig1, k3, x22
cyclecount := 0
-
+//abort(2345)
a := interpret()
freevec(g)
freevec(progvec)
selectoutput(stdout)
- writef("*n*nExecution complete cycles = %n", cyclecount)
+ writef("*n*nExecution complete after executing %n intcode instruction%-%ps",
+ cyclecount)
IF a DO writef(" return code = %n", a)
newline()
}
--- /dev/null
+nick@jane:~/unix/bcpl/BCPL/cintcode$ cintsys -c c bc32 bcplint
+
+BCPL 32-bit Cintcode System (13 Dec 2023)
+Estimated 448780 Cintcode instructions per milli-second
+0.000> bcpl com/bcplint.b to cin/bcplint t32
+
+32 bit BCPL (18 Jul 2022) with pattern matching, 32 bit target
+Code size = 21844 bytes of 32-bit little ender Cintcode
+Code size = 20600 bytes of 32-bit little ender Cintcode
+Code size = 5680 bytes of 32-bit little ender Cintcode
+0.106>
+nick@jane:~/unix/bcpl/BCPL/cintcode$ cd ../intcode
+nick@jane:~/unix/bcpl/BCPL/intcode$ cintsys -c c b interp
+
+BCPL 32-bit Cintcode System (13 Dec 2023)
+Estimated 408888 Cintcode instructions per milli-second
+0.000> bcpl interp.b to interp
+
+32 bit BCPL (18 Jul 2022) with pattern matching, 32 bit target
+Code size = 5300 bytes of 32-bit little ender Cintcode
+0.015>
+nick@jane:~/unix/bcpl/BCPL/intcode$ cintsys -c c bint bcplint
+
+BCPL 32-bit Cintcode System (13 Dec 2023)
+Estimated 408888 Cintcode instructions per milli-second
+0.000> bcplint bcplint.b to bcplint.int hdrs BCPLHDRS
+
+32 bit BCPL (18 Jul 2022) with pattern matching, 32 bit target
+cg-intcode 28 Sept 2012
+Program size = 15892 words
+cg-intcode 28 Sept 2012
+Program size = 16161 words
+cg-intcode 28 Sept 2012
+Program size = 3957 words
+0.528>
+nick@jane:~/unix/bcpl/BCPL/intcode$ cintsys -- c xint bcplint
+
+BCPL 32-bit Cintcode System (13 Dec 2023)
+Estimated 418181 Cintcode instructions per milli-second
+0.000> interp syslib.int blib.int dlib.int bcplint.int
+intcode system entered
+
+Program size = 41393
+bcplint.b to bcplint_new.int hdrs BCPLHDRS
+
+32 bit BCPL (18 Jul 2022) with pattern matching, 32 bit target
+cg-intcode 28 Sept 2012
+Program size = 15892 words
+cg-intcode 28 Sept 2012
+Program size = 16161 words
+cg-intcode 28 Sept 2012
+Program size = 3957 words
+
+
+Execution complete after executing 88723310 intcode instructions
+7.658> logout
+
+nick@jane:~/unix/bcpl/BCPL/intcode$ diff bcplint.int bcplint_new.int
+nick@jane:~/unix/bcpl/BCPL/intcode$
public / BCPL.git / commitdiff