// SCI1.bcpl -- companion to SCI.bcpl
// Last modified April 28, 1983 7:34 PM by Boggs
get "SCI.decl"
get "Streams.d"
external
[
// outgoing procedures
WLFile; OtherFile
ReadToken; OutPut; FlushBlock
// incoming procedure -- SCI
TSP
// incoming procedures -- packages
ConcatenateStrings; StringCompare
PutTemplate; ExtractSubstring
// incoming procedures -- OS
OpenFile; Closes; Gets; Puts; Endofs
EraseBits; CharWidth; Wss
Allocate; Free; CallSwat
// incoming statics -- OS
sysZone; dsp; keys
// incoming statics -- SCI
lf; in; out; cpuType
token; board; numBlocks
block; blockCnt; record; recordCnt
]
static termChar
//----------------------------------------------------------------------------------------
let WLFile() be
//----------------------------------------------------------------------------------------
// Reads 'Board.wl', the wirelist produced by Route,
// and generates the PARTS & NETLIST subfiles for SCI.
[
let wlName = ConcatenateStrings(board, ".wl")
let wl = OpenFile(wlName, ksTypeReadOnly, charItem)
Free(sysZone, wlName)
test wl
ifso [ PutTemplate(dsp, "*NReading $S.wl", board); in = wl ]
ifnot [ PutTemplate(dsp, "*NFailed to open $S.wl", board); return ]
Wss(dsp, "*NMultibus or Dandelion board (M or D): ")
let boardType = Gets(keys) & 137b; Puts(dsp, boardType)
ReadToken() //board type. discard.
// Make parts list
Wss(out, "*NPARTS")
let width, length, pins = nil, nil, nil
[
ReadToken() //part designator
if token>>String.length eq 0 %
(token>>String.length eq 1 & token>>String.char↑1 eq $@) break
let desig = ExtractSubstring(token, (token>>String.char↑1 eq $#? 2, 1))
ReadToken()
let firstSlash, lastSlash, len = 0, 0, token>>String.length
for i = 1 to len if token>>String.char↑i eq $/ test firstSlash eq 0
ifso firstSlash = i
ifnot lastSlash = i
width = 3; for i = lastSlash+1 to len do
if IsNumber(i, i) then width = token>>String.char↑i - $0
pins = 0; for i = firstSlash+1 to lastSlash-1 do
pins = pins*10 + (token>>String.char↑i - $0)
length = width eq 1? pins, pins/2
PutTemplate(out, "*NHOLE MODULE HM$2F0D$2F0D$2F0D $S", width, length, pins, desig)
Free(sysZone, desig)
] repeat
Wss(out, "*NEOS*N")
// Make net list
Wss(out, "*NNET LIST CONTINUE")
let flush, nodeCnt, netName = false, 0, 0
[ //main loop
manifest //token types
[
calibrate = 1; signal = 2; boardLoc = 3
gnd = 4; gndNet = 5; gndNub = 6
vcc = 7; vccNet = 8; vccNub = 9
pointyBracket = 10; parenthesis = 11; curlyBracket = 12
edgePin = 13; connPin = 14
]
ReadToken()
let len = token>>String.length; if len eq 0 break
let tokenType = signal
if StringCompare("CALIBRATE", token) eq 0 then tokenType = calibrate
if StringCompare("GND", token) eq 0 then tokenType = gnd
if StringCompare("GND", token) eq -2 test token>>String.char↑4 eq $-
ifso if IsNumber(5, len) then tokenType = gndNet
ifnot if IsNumber(4, len) then tokenType = termChar eq $:? gndNet, gndNub
if StringCompare("VCC", token) eq 0 then tokenType = vcc
if StringCompare("VCC", token) eq -2 test token>>String.char↑4 eq $-
ifso if IsNumber(5, len) then tokenType = vccNet
ifnot if IsNumber(4, len) then tokenType = termChar eq $:? vccNet, vccNub
let firstChar, lastChar = token>>String.char↑1, token>>String.char↑len
if firstChar eq $( & lastChar eq $) then tokenType = parenthesis
if firstChar eq ${ & lastChar eq $} then tokenType = curlyBracket
if firstChar eq $< & lastChar eq $> then tokenType = pointyBracket
if (firstChar eq $E % firstChar eq $C) & IsNumber(2, len) then
tokenType = firstChar eq $E? edgePin, connPin
if tokenType eq signal & (termChar eq $*S % firstChar eq $#) then tokenType = boardLoc
// NetList (cont'd)
if tokenType eq edgePin % tokenType eq connPin % tokenType eq boardLoc then
[
if flush loop
if nodeCnt rem 5 eq 0 test nodeCnt ne 0 & nodeCnt rem 50 ne 0
ifso Wss(out, "$*N ")
ifnot PutTemplate(out, "*NNN $S ", netName)
nodeCnt = nodeCnt +1
]
switchon tokenType into
[
case calibrate: [ flush = true; endcase ]
case signal:
[
if netName ne 0 then Free(sysZone, netName)
netName = ExtractSubstring(token)
flush, nodeCnt = false, 0
endcase
]
case gndNet: token>>String.length = 3
case gnd: test StringCompare("GND", netName) ifso docase signal ifnot endcase
case vccNet: token>>String.length = 3
case vcc: test StringCompare("VCC", netName) ifso docase signal ifnot endcase
case edgePin: case connPin:
[
switchon boardType into
[
case $M: [ Multibus(); endcase ]
case $D: test tokenType eq edgePin
ifso [ DandelionE(); endcase ]
ifnot [ DandelionC(); endcase ]
default: [ Universal(); endcase ]
]
endcase
]
case boardLoc:
[
let dot = 0; for i = 1 to len do
if token>>String.char↑i eq $. then [ dot = i; break ]
let firstChar = token>>String.char↑1 eq $#? 2, 1
for i = firstChar to dot-1 do Puts(out, token>>String.char↑i)
Puts(out, $*S)
for i = dot+1 to len-1 do Puts(out, token>>String.char↑i)
Puts(out, $*S)
endcase
]
]
] repeat
Wss(out, "*NEOS*N")
Closes(wl)
]
//----------------------------------------------------------------------------------------
and Universal() be
//----------------------------------------------------------------------------------------
[
Puts(out, token>>String.char↑1)
Puts(out, $*S)
for i = 2 to token>>String.length do
Puts(out, token>>String.char↑i)
Puts(out, $*S)
]
//----------------------------------------------------------------------------------------
and DandelionE() be
//----------------------------------------------------------------------------------------
[
let number = 0
for i = 2 to token>>String.length do
number = number*10 + token>>String.char↑i -$0
let conn, side, pin = nil, nil, nil
if number ge 1 & number le 50 then
[ conn = $2; side = $T; pin = 51-number ]
if number ge 51 & number le 100 then
[ conn = $1; side = $T; pin = 101-number ]
if number ge 101 & number le 150 then
[ conn = $2; side = $B; pin = 151-number ]
if number ge 151 & number le 200 then
[ conn = $1; side = $B; pin = 201-number ]
PutTemplate(out, "P$C-$C $D ", conn, side, pin)
]
//----------------------------------------------------------------------------------------
and DandelionC() be
//----------------------------------------------------------------------------------------
[
let number = 0
for i = 2 to token>>String.length do
number = number*10 + token>>String.char↑i -$0
let conn, pin = nil, nil
if number ge 1 & number le 50 then
[ conn = $1; pin = number ]
if number ge 51 & number le 100 then
[ conn = $2; pin = number-50 ]
// this assumes two DB37 connectors are plugged in...
if pin ge 1 & pin le 19 then pin = 20-pin
if pin ge 20 & pin le 37 then pin = 57-pin
PutTemplate(out, "J$C $D ", conn, pin)
]
//----------------------------------------------------------------------------------------
and Multibus() be
//----------------------------------------------------------------------------------------
[
test token>>String.char↑1 eq $C
ifso [ Puts(out, $J); Puts(out, token>>String.char↑2 -2) ]
ifnot [ Puts(out, $P); Puts(out, token>>String.char↑2) ]
Wss(out, (token>>String.char↑4 & 1) ne 0? "-T ", "-B ")
let n = ((10*(token>>String.char↑3 -$0)) + (token>>String.char↑4 -$0) +1)/2
Puts(out, $0 + n/10)
Puts(out, $0 + n rem 10)
Puts(out, $*S)
]
//----------------------------------------------------------------------------------------
and OtherFile() be
//----------------------------------------------------------------------------------------
// Reads Board.other and writes it unmodified to tape.
// Records are delimited by bare carriage returns.
[
let otherName = ConcatenateStrings(board, ".other")
let other = OpenFile(otherName, ksTypeReadOnly, charItem)
Free(sysZone, otherName)
test other
ifso [ PutTemplate(dsp, "*NReading $S.other", board); in = other ]
ifnot [ PutTemplate(dsp, "*NFailed to open $S.other", board); return ]
until Endofs(other) do Puts(out, Gets(other))
Puts(out, $*N)
Closes(other)
]
//----------------------------------------------------------------------------------------
and OutPut(st, char) be
//----------------------------------------------------------------------------------------
// ST.puts operation for the stream 'out'.
// It feeds characters to a plain text listing file and to the tape.
// Carriage returns are replaced by record boundaries on the tape.
[
Puts(lf, char)
Puts(dsp, char)
if char ne $*N then
[
record>>Byte↑recordCnt = char
recordCnt = recordCnt +1
if recordCnt eq (cpuType eq $V? 80, 81) then CallSwat("Record too long")
return
]
// end of record
test cpuType eq $V
ifso //RecLen = var, max 74, BlkLen = 2048, Fortran carriage control
[
if recordCnt eq 5 then recordCnt = 4
if 2048-blockCnt ls recordCnt then FlushBlock()
record>>Byte↑0 = $0
record>>Byte↑1 = $0
record>>Byte↑2 = $0 + recordCnt/10
record>>Byte↑3 = $0 + recordCnt rem 10
record>>Byte↑4 = $*S //Fortran carriage control!
for i = 0 to recordCnt-1 do
block>>Byte↑(blockCnt+i) = record>>Byte↑i
blockCnt = blockCnt + recordCnt
recordCnt = 5
]
ifnot //RecLen = 80, BlkLen = 800 (Prime computer system)
[
if blockCnt eq 800 then FlushBlock()
for i = 0 to recordCnt-1 do
block>>Byte↑(blockCnt+i) = record>>Byte↑i
for i = recordCnt to 79 do
block>>Byte↑(blockCnt+i) = $*S //pad record with $*S
blockCnt = blockCnt + 80
recordCnt = 0
]
]
//----------------------------------------------------------------------------------------
and FlushBlock() be
//----------------------------------------------------------------------------------------
// Flushes the current block to tape
[
if blockCnt eq 0 return
test cpuType eq $V
ifso
[
for i = blockCnt to 2047 do block>>Byte↑i = 136b //pad block with $*136
TSP(cmdWriteRecord, block, 0, 2048)
]
ifnot
[
for i = blockCnt to 799 do block>>Byte↑i = $*S //pad block with $*S
TSP(cmdWriteRecord, block, 0, 800)
]
numBlocks = numBlocks +1
blockCnt = 0
]
//----------------------------------------------------------------------------------------
and ReadToken() be
//----------------------------------------------------------------------------------------
// Reads a token from the 'in' stream and puts it in 'token'.
// Note that it may have 0 characters if EOF (disk stream) or <Del> (key stream).
// Terminating character is left in static 'termChar'.
[
let count = 0
until Endofs(in) & in ne keys do
[
termChar = Gets(in)
switchon termChar into
[
case $*001: case $*010:
[
if count ne 0 & in eq keys then
[
EraseBits(dsp, -CharWidth(dsp, token>>String.char↑count))
count = count -1
]
endcase
]
case $;: //flush input stream until CR
until Endofs(in) % Gets(in) eq $*N loop //fall through
case $*N: case $*S: case $*T: case $::
[
if count ne 0 break
endcase
]
case $*177:
if in eq keys then
[ Wss(dsp, " XXX "); count = 0; break ]
default:
[
count = count +1
if termChar ge $a & termChar le $z then termChar = termChar & 137b
if termChar eq $← then termChar = $<
token>>String.char↑count = termChar
if in eq keys then Puts(dsp, termChar)
endcase
]
]
]
token>>String.length = count
]
//----------------------------------------------------------------------------------------
and IsNumber(first, last) = valof
//----------------------------------------------------------------------------------------
[
if last ls first resultis false
for i = first to last do
if token>>String.char↑i ls $0 % token>>String.char↑i gr $9 resultis false
resultis true
]