// SCI1.bcpl -- companion to SCI.bcpl
// Last modified May 30, 1983  1:50 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 = number ls 100? $1, $2
let pin = number ls 100? number, number-100

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
]