// DLSDriverB.bcpl -- Alto DLS driver

// Last modified June 20, 1982  10:54 AM by Taft
// Last modified November 16, 1983  10:12 AM

get "DLSDriver.decl"


external
[
// outgoing procedures
DLSInput; DLSOutput; DLSInput7; DLSOutput7; DLSOutputTI;
DLSResetInput; DLSResetOutput; ControlIn; ControlOut;
SetDLSLineSpeed; DetermineDLSLineSpeed; UpdateCarrierOn

// incoming procedures -- DLSDriverA
TurnOnDLS; TurnOffDLS; StartDLSOutput; DLSInputEmpty; DLSOutputFull;
AndMemory; OrMemory
SendXon

// incoming procedures -- OS and packages
ResetRingBuffer; RingBufferEmpty; RingBufferFull; ReadRingBuffer; WriteRingBuffer;
Block; Dismiss; SetTimer; TimerHasExpired;
MoveBlock; Errors; DefaultArgs; FalsePredicate; Min; CallSwat

// incoming statics
@lbTable; @baseIGCB; parityTable; oneBits
]

// DetermineDLSLineSpeed argument limitations
manifest maxSpeeds = 8

// ---------------------------------------------------------------------------
let DLSInput(dlb) = valof
// ---------------------------------------------------------------------------
// Raw 8-bit binary input
[ // repeat
let timer = nil; SetTimer(lv timer, dlb>>DLB.timeout)
   [ // repeat
   if dlb>>DLB.carrierOff then Errors(dlb, ecGetsCarrierOff)
   let char = ReadRingBuffer(lv dlb>>DLB.iRBD)
   test char eq -1
      ifso
        if dlb>>DLB.flowControl then
           if dlb>>DLB.fcXoffSent then
              [ SendXon(dlb); until dlb>>DLB.fcXoffSent eq 0 do Block() ]
      ifnot
         [
         test dlb>>DLB.flowControl
            ifso
               [
               switchon (char & 177b) into
                  [
                  case Xon:
                     unless dlb>>DLB.outActive do StartDLSOutput(dlb)
                     endcase
   
                  case Xoff:
                     SetTimer(lv dlb>>DLB.fcTimer, fcTimeoutTime)
                     dlb>>DLB.fcTimerGoing = 1
                     endcase
   
                  default:
                     resultis char
                  ]
               ]
            ifnot resultis char
         ]
   if dlb>>DLB.timeout ne -1 & TimerHasExpired(lv timer) then break
   Block()
   ] repeat
Errors(dlb, ecDLSGetsTimeout)
] repeat

// ---------------------------------------------------------------------------
and DLSOutput(dlb, char) be
// ---------------------------------------------------------------------------
// Raw 8-bit binary output
[
if dlb>>DLB.carrierOff then
   [ DLSResetOutput(dlb); Errors(dlb, ecPutsCarrierOff); return ]
unless dlb>>DLB.flowControl & (dlb>>DLB.fcStop eq 1) then
   if WriteRingBuffer(lv dlb>>DLB.oRBD, char) then
      [
      unless dlb>>DLB.outActive do StartDLSOutput(dlb)
      return
      ]
Dismiss(1)
] repeat

// ---------------------------------------------------------------------------
and DLSInput7(dlb) = DLSInput(dlb) & 177B
// ---------------------------------------------------------------------------
// 7-bit Ascii input, with parity stripped off

// ---------------------------------------------------------------------------
and DLSOutput7(dlb, char) be DLSOutput(dlb, parityTable!(char&177B))
// ---------------------------------------------------------------------------
// 7-bit Ascii output, with parity generated

// ---------------------------------------------------------------------------
and DLSOutputTI(dlb, char) be
// ---------------------------------------------------------------------------
// 7-bit Ascii output to TI terminal (pad carriage returns).
// Return is padded with Position/9 extra returns, where Position
// is the starting position and the division rounds up.
[
char = char & 177B
DLSOutput(dlb, parityTable!char)
test char ge 40B & char ls 177B  // Spacing character?
   ifso dlb>>DLB.position = dlb>>DLB.position+1  // Yes
   ifnot if char eq $*n then  // No, see if carriage return
      [  // Pad with nulls in proportion to position on line
      for i = 1 to (dlb>>DLB.position+8)/9 do DLSOutput(dlb, 0)
      dlb>>DLB.position = 0
      ]
]

// ---------------------------------------------------------------------------
and DLSResetInput(dlb) be
// ---------------------------------------------------------------------------
[
if dlb>>DLB.flowControl do
   [
   dlb>>DLB.fcStop = 0; dlb>>DLB.fcTimerGoing = 0
   if dlb>>DLB.fcXoffSent do
      [ SendXon(dlb); until dlb>>DLB.fcXoffSent eq 0 do Block() ]
   ]
ResetRingBuffer(lv dlb>>DLB.iRBD)
]

// ---------------------------------------------------------------------------
and DLSResetOutput(dlb) be
// ---------------------------------------------------------------------------
[
ResetRingBuffer(lv dlb>>DLB.oRBD)
if dlb>>DLB.flowControl then
   [ dlb>>DLB.fcStop = 0; dlb>>DLB.fcTimerGoing = 0 ]
dlb>>DLB.position = 79  // In case we flushed padding for TI
]

// ---------------------------------------------------------------------------
and SetDLSLineSpeed(dlb, baud) be
// ---------------------------------------------------------------------------
[
dlb>>DLB.baud = baud
// Note that the microcode wants interval-1 in all LCBs.
// When computing intervals, be careful to round rather than truncate.
let interval = (dlsTicksPerSecond + baud rshift 1)/baud -1  // time/bit -1
dlb>>DLB.iLCB.interval = interval  // Set input bit interval
dlb>>DLB.oLCB.interval = interval  // Set output bit interval
let stopTable = table [ 0; stop1; stop2 ]
stopTable!0 = baud eq 110? stop2, stop1
dlb>>DLB.oLCB.bitsPerChar = stopTable!(dlb>>DLB.stopBits)
dlb>>DLB.puts = baud eq 300 & dlb>>DLB.noPad eq 0? DLSOutputTI, DLSOutput7  // Padding
let group = dlb>>DLB.line & 360B  // Get first line # in group
for line = group to group+17B do  // Get rate of fastest line
   [
   let lb = lbTable!line
   if lb>>LBH.lineType ge ltData then
      interval = Min(interval, lb>>DLB.iLCB.interval)
   ]
(baseIGCB+group)>>IGCB.interval =
   (interval+(samplesPerBit/2+1))/samplesPerBit -1
]

// ---------------------------------------------------------------------------
and UpdateCarrierOn(proc) be
// ---------------------------------------------------------------------------
// Samples the state of all dataset control lines.  For any whose
// state has changed, updates the carrierOff bit in the DLB and calls
// proc(dlb, newState), where newState = true if carrier came on,
// false if it went off.
// This also test to see if an Xoff was issued more than fcTimeoutTime ago.
[
for line = 0 to numLines-1 do
   [
   let clb = lbTable!line
   if clb>>CLB.lineType eq ltControl then
      [
      let state = dlsInBase!line & oneBits!(line&17B)
      if state ne clb>>CLB.lastState then
         [  //state changed
         clb>>CLB.lastState = state
         let dlb = lbTable!(clb>>CLB.otherLine)
         dlb>>DLB.carrierOff = state eq 0
         proc(dlb, state ne 0)
         ]
      ]
   if clb>>CLB.lineType gr ltData then
      [
      if clb>>DLB.flowControl then
         [
         if clb>>DLB.fcXoffSent then
            if DLSInputEmpty(clb) then
               [ SendXon(clb); until clb>>DLB.fcXoffSent eq 0 do Block() ]
         if clb>>DLB.fcTimerGoing then
            if TimerHasExpired(lv clb>>DLB.fcTimer) do
               [ clb>>DLB.fcStop = 0; clb>>DLB.fcTimerGoing = 0 ]
         ]
      ]
   Block()
   ]
]

// ---------------------------------------------------------------------------
and ControlIn(line) = valof
// ---------------------------------------------------------------------------
// Returns the current value of input control line (true or false).
// Definition:  control true = EIA high = space = data 0 = 1 in Alto memory
[
let clb = lbTable!line
resultis (dlsInBase!line & oneBits!(line&17B)) ne 0
]

// ---------------------------------------------------------------------------
and ControlOut(line, value) be dlsOutBase!line = not value
// ---------------------------------------------------------------------------
// Sets the output control line to the value given (true or false).
// Definition:  control true = EIA high = space = data 0 = 0 in Alto memory

// ---------------------------------------------------------------------------
and DetermineDLSLineSpeed(dlb, speedTable, charTable,
    AbortProc; numargs na)  =  valof
// ---------------------------------------------------------------------------
// Samples input at all speeds given in speedTable looking for
// one of the characters given in charTable.  If successful, sets
// the line's speed appropriately and returns the character that
// was input.  If failed (character not in charTable or carrier
// went off), returns zero.  Format of speedTable and charTable
// is a count followed by that number of entries (one word each);
// maximum length of speedTable is maxSpeeds.
// The speedTable must be ordered fastest line first.
// If AbortProc is provided, AbortProc(dlb) is called periodically, and the
// attempt to determine line speed is aborted if it ever returns true.
[
DefaultArgs(lv na, -3, FalsePredicate)
let line = dlb>>DLB.line  // Get this line number
let group = line & 177760B  // Get first line # in group
let mask = oneBits!(line-group)  // Make mask for line in group
let gcb = baseIGCB+group
let oldBaud = dlb>>DLB.baud

// Allocate some local storage for LCBs
if speedTable!0 gr maxSpeeds then CallSwat()
manifest roundedLenILCB = (lenILCB+1) & -2
let newLCB = vec (maxSpeeds-1)*roundedLenILCB  // "vec" extra word required!
newLCB = (newLCB+1) & -2  // Force LCBs to even word boundary

// Turn off line and make sure it is idle
AndMemory(not mask, lv gcb>>IGCB.active)
AndMemory(not mask, lv gcb>>IGCB.idle)
Dismiss(10)  // Wait 100 milliseconds to ensure input idle
DLSResetInput(dlb); DLSResetOutput(dlb)

// Build chain of input LCBs for line
let lcb = lv dlb>>DLB.iLCB  // Permanent LCB is first in chain
SetDLSLineSpeed(dlb, speedTable!1)  // Set line to fastest speed
lcb>>ILCB.sdMode = true  // LCB in speed determination mode
for i = 2 to speedTable!0 do  // For all remaining test speeds:
   [
   MoveBlock(newLCB, lcb, lenILCB)  // Initialize new LCB
   lcb>>ILCB.sdLink = newLCB+1  // Link into chain
   newLCB>>ILCB.interval = dlsTicksPerSecond/speedTable!i -1
   lcb = newLCB  // Make new be current
   newLCB = newLCB+roundedLenILCB  // Advance to next block
   ]

// DetermineDLSLineSpeed (cont'd)

// Turn on line and sample one character at all speeds.
// Leave the IGCB.active bit off so that the line will be turned off
// after the first character is received.
OrMemory(mask, lv gcb>>IGCB.idle)
let char = nil
let speed = valof
   [
   for i = 1 to speedTable!0 do
      [
      while DLSInputEmpty(dlb) do
         [
         Dismiss(1)
         if dlb>>DLB.carrierOff % AbortProc(dlb) then resultis 0
         ]
      char = DLSInput7(dlb)
      for j = 1 to charTable!0 do
         if char eq charTable!j then resultis speedTable!i
      ]
   resultis 0
   ]

// Put line back in reasonable state
AndMemory(not mask, lv gcb>>IGCB.idle)  // Disable line
Dismiss(10)  // Wait 100 milliseconds to ensure input idle
dlb>>DLB.iLCB.sdMode = false  // Turn off speed determination mode
dlb>>DLB.iLCB.sdLink = 0
OrMemory(mask, lv gcb>>IGCB.active)  // Enable line
OrMemory(mask, lv gcb>>IGCB.idle)
DLSResetInput(dlb)

// If found speed, set it and return the character that was typed;
// if not, restore original baud rate and return zero
test speed eq 0
   ifso [ SetDLSLineSpeed(dlb, oldBaud); resultis 0 ]
   ifnot [ SetDLSLineSpeed(dlb, speed); resultis char ]
]