--
--  TRANSPUTER INSTRUCTION SET
--
--  based on: Transputer Spec - September 27, 1988 - Roger Shepherd
--  Microcomputer Division Confidential
--  Restricted Document
--
--  Note: This occam source file is not working but compile-able. So there are
--        less typing errors and really valuable for searching!
--
--  Michael Br"ustle, Vienna (AT)
--

VAL Range  IS #10000000 (INT) : -- #100000000 not possible
VAL MaxInt IS  #7FFFFFFF (INT) :
VAL MinInt IS  #80000000 (INT) :

VAL GotoSNPBit      IS  #00000002 (INT) :
VAL IOBit           IS  #00000004 (INT) :
VAL MoveBit         IS  #00000008 (INT) :
VAL TimeDelBit      IS  #00000010 (INT) :
VAL TimeInsBit      IS  #00000020 (INT) :
VAL DistAndInsBit   IS  #00000040 (INT) :
VAL HaltOnErrorBit  IS  #00000080 (INT) :
VAL ErrorFlag       IS  #80000000 (INT) :

VAL Iptr.s          IS  -1 (INT) :
VAL Link.s          IS  -2 (INT) :
VAL State.s         IS  -3 (INT) :
VAL Pointer.s       IS  -3 (INT) :
VAL TLink.s         IS  -4 (INT) :
VAL Time.s          IS  -5 (INT) :

VAL NotProcess.p    IS  MinInt     :
VAL Enabling.p      IS  MinInt + 1 :
VAL Waiting.p       IS  MinInt + 2 :
VAL Ready.p         IS  MinInt + 3 :
VAL TimeSet.p       IS  MinInt + 1 :
VAL TimeNotSet.p    IS  MinInt + 2 :

VAL MachineTRUE     IS  1 (INT) :
VAL MachineFALSE    IS  0 (INT) :
VAL NoneSelected.o  IS -1 (INT) :

VAL PortBase        IS #80000000 (INT) :
VAL TimerBase       IS #80000024 (INT) :
VAL SaveBase        IS #8000002C (INT) :
VAL WdescIntSave    IS  0 :
VAL IptrIntSave     IS  1 :
VAL AregIntSave     IS  2 :
VAL BregIntSave     IS  3 :
VAL CregIntSave     IS  4 :
VAL STATUSIntSave   IS  5 :
VAL EregIntSave     IS  6 :

VAL PerformIO       IS  1 :
VAL Enable          IS  2 :
VAL StatusEnquiry   IS  3 :
VAL ResetRequest    IS  4 :
VAL AckReady        IS  5 :
VAL AckRun          IS  6 :

VAL RunRequest      IS  1 :
VAL ReadyRequest    IS  2 :
VAL ReadyFALSE      IS  3 :
VAL AckReset        IS  4 :

VAL AckData         IS 41 :

VAL BitsInWord      IS 32 :
VAL BytesPerWord    IS  4 :
VAL BselMask        IS  3 :
VAL BselLength      IS  2 :

VAL f.opr           IS #0F :
VAL f.ldl           IS #07 :
VAL f.stl           IS #0D :
VAL f.ldlp          IS #01 :
VAL f.ldnl          IS #03 :
VAL f.stnl          IS #0E :
VAL f.ldnlp         IS #05 :
VAL f.eqc           IS #0C :
VAL f.ldc           IS #04 :
VAL f.adc           IS #08 :
VAL f.j             IS #00 :
VAL f.cj            IS #0A :
VAL f.call          IS #09 :
VAL f.ajw           IS #0B :
VAL f.pfix          IS #02 :
VAL f.nfix          IS #06 :

VAL o.rev           IS #00 :
VAL o.ret           IS #20 :
VAL o.ldpi          IS #1B :
VAL o.gajw          IS #3C :
VAL o.gcall         IS #06 :
VAL o.mint          IS #42 :
VAL o.lend          IS #21 :
VAL o.csub0         IS #13 :
VAL o.ccnt1         IS #4D :
VAL o.testerr       IS #29 :
VAL o.seterr        IS #10 :
VAL o.stoperr       IS #55 :
VAL o.clrhalterr    IS #57 :
VAL o.sethalterr    IS #58 :
VAL o.testhalterr   IS #59 :
VAL o.bsub          IS #02 :
VAL o.wsub          IS #0A :
VAL o.bcnt          IS #34 :
VAL o.wcnt          IS #3F :
VAL o.lb            IS #01 :
VAL o.sb            IS #3B :
VAL o.move          IS #4A :
VAL o.and           IS #46 :
VAL o.or            IS #4B :
VAL o.xor           IS #33 :
VAL o.not           IS #32 :
VAL o.shl           IS #41 :
VAL o.shr           IS #40 :
VAL o.add           IS #05 :
VAL o.sub           IS #0C :
VAL o.mul           IS #53 :
VAL o.div           IS #2C :
VAL o.rem           IS #1F :
VAL o.gt            IS #09 :
VAL o.diff          IS #04 :
VAL o.sum           IS #52 :
VAL o.prod          IS #08 :
VAL o.startp        IS #0D :
VAL o.endp          IS #03 :
VAL o.runp          IS #39 :
VAL o.stopp         IS #15 :
VAL o.ldpri         IS #1E :
VAL o.in            IS #07 :
VAL o.out           IS #0B :
VAL o.outword       IS #0F :
VAL o.outbyte       IS #0E :
VAL o.resetch       IS #12 :
VAL o.alt           IS #43 :
VAL o.altwt         IS #44 :
VAL o.altend        IS #45 :
VAL o.enbs          IS #49 :
VAL o.diss          IS #30 :
VAL o.enbc          IS #48 :
VAL o.disc          IS #2F :
VAL o.ldtimer       IS #22 :
VAL o.tin           IS #2B :
VAL o.talt          IS #4E :
VAL o.taltwt        IS #51 :
VAL o.enbt          IS #47 :
VAL o.dist          IS #2E :
VAL o.xword         IS #3A :
VAL o.cword         IS #56 :
VAL o.xdble         IS #1D :
VAL o.csngl         IS #4C :
VAL o.ladd          IS #16 :
VAL o.lsub          IS #38 :
VAL o.lsum          IS #37 :
VAL o.ldiff         IS #4F :
VAL o.lmul          IS #31 :
VAL o.ldiv          IS #1A :
VAL o.lshl          IS #36 :
VAL o.lshr          IS #35 :
VAL o.norm          IS #19 :
VAL o.testpranal    IS #2A :
VAL o.saveh         IS #3E :
VAL o.savel         IS #3D :
VAL o.sthf          IS #18 :
VAL o.sthb          IS #50 :
VAL o.stlf          IS #1C :
VAL o.stlb          IS #17 :
VAL o.sttimer       IS #54 :
VAL o.unpacksn      IS #63 :
VAL o.roundsn       IS #6D :
VAL o.postnormsn    IS #6C :
VAL o.ldinf         IS #71 :
VAL o.cflerr        IS #73 :
VAL o.fmul          IS #72 :
VAL o.teststd       IS #28 :
VAL o.testste       IS #27 :
VAL o.teststs       IS #26 :
VAL o.testldd       IS #25 :
VAL o.testlde       IS #24 :
VAL o.testlds       IS #23 :
VAL o.testhardchan  IS #2D :


VAL Memory.Size IS 1024 :
VAL LinkChans IS 8 :

-- The following constants are used in the floating point support instructions: 

VAL BitsInFrac IS 24 : -- number of bits in fraction
VAL PackedLSB  IS 1 :
VAL RealExp    IS #FF :
VAL RealInf    IS #7F800000 : -- +Inf
VAL RealRBit   IS #80 :
VAL RealShift  IS 8 :
VAL RealXcess  IS #7F :


PROC T414B()

  INT Areg :
  INT Breg :
  INT Creg :
  INT Dreg :
  INT Ereg :
  INT Oreg :

  INT IptrReg :
  INT StatusReg :
  INT WdescReg :
  INT Wptr :
  INT Priority :
  INT BMbuffer :

  [2] INT ClockReg :
  [2] INT TNextReg :
  [2] BOOL TEnabled :
  INT SliceCount :

  [2] INT FptrReg :
  [2] INT BptrReg :

  [ Memory.Size ] INT Memory :
  [ Memory.Size * BytesPerWord ] BYTE Memory.b RETYPES Memory :
  [2] INT TptrLoc RETYPES [Memory FROM 9 FOR 2] :

  [4][2] CHAN OF ANY FromChan :
  [4]    CHAN OF ANY ToChan :

  [4] INT DataReg    : -- the data    registers of the link-channels
  [4] INT PointerReg : -- the pointer registers of the link-channels
  [4] INT CountReg   : -- the count   registers of the link-channels

  BOOL ResetNotAnalysed :


  PROC AtWord(VAL INT Base, N, INT A) -- sets A to point at the Nth word past Base
    A := Base + ( N * BytesPerWord )
  :

  PROC AtByte(VAL INT Base, N, INT A) -- sets A to point at the Nth byte past Base
    A := Base + N
  :

  PROC RIndexWord(VAL INT Base, N, INT X) --  sets X to the value of the Nth word past Base
    X := Memory[ (( Base - MinInt ) / BytesPerWord ) + N ]
  :

  PROC RIndexByte(VAL INT Base, N, INT X) -- sets X to the value of the Nth byte past Base
    X := (INT Memory.b[ ( Base - MinInt ) + N ])
  :

  PROC WIndexWord(VAL INT Base, N, X)  -- sets the value of the Nth word past Base to X
    Memory[ (( Base - MinInt ) / BytesPerWord ) + N ] := X
  :

  PROC WIndexByte(VAL INT Base, N, X) -- sets the value of the Nth byte past Base to X
    Memory.b[ ( Base - MinInt ) + N ] := (BYTE X)
  :

  PROC LinkOut(CHAN OF ANY LinkOutData, LinkOutAck,
               CHAN OF ANY FromProcessor, [2]CHAN OF ANY ToProcessor)
    INT priority, pointer, count :
    BOOL ready, requested :
    SEQ
      requested := FALSE -- transfer requested
      ready := TRUE -- ready to output a byte
      WHILE TRUE
        INT token :
        PRI ALT
          FromProcessor ? token
            SEQ
              FromProcessor ? priority
              IF
                token = PerformIO
                  SEQ
                    FromProcessor ? pointer; count
                    requested := TRUE
                token = ResetRequest
                  SEQ
                    ready   := TRUE
                    requested := FALSE
                    ToProcessor[priority] ! AckReset
          (ready AND requested) & SKIP
            IF
              count = 0   -- No more data to be output
                INT oldPriority :
                SEQ
                  requested := FALSE
                  oldPriority := priority
                  PAR
                    ToProcessor[oldPriority] ! RunRequest
                    INT interaction :
                    SEQ
                      FromProcessor ? interaction
                      IF
                        interaction = AckRun
                          SKIP
                        interaction = ResetRequest
                          FromProcessor ? priority
              TRUE -- Output a byte; set ready to FALSE
                INT data :
                SEQ
                  RIndexByte(pointer, 0, data)
                  AtByte(pointer, 1, pointer)
                  count := count - 1
                  LinkOutData ! (BYTE data)
                  ready := FALSE -- wait for acknowledgement
          LinkOutAck ? token -- AckData ????
            ready := TRUE
  :

  PROC LinkIn(CHAN OF ANY LinkInAck, LinkInData,
              CHAN OF ANY FromProcessor, [2]CHAN OF ANY ToProcessor)
    INT priority, pointer, count :
    BYTE byte :
    BOOL ready, requested, enabled :
    SEQ
      ready     := FALSE -- has a byte been input?
      requested := FALSE -- is transfer pending?
      enabled   := FALSE -- is link enabled ?
      WHILE TRUE
        INT token :
        PRI ALT
          LinkInData ? byte
            ready := TRUE

          FromProcessor ? token -- deal with processor request
            SEQ
              FromProcessor ? priority
              IF
                token = Enable
                  enabled := TRUE
                token = StatusEnquiry
                  SEQ
                    enabled := FALSE
                    IF
                      ready
                        ToProcessor[priority] ! ReadyRequest
                      TRUE
                        ToProcessor[priority] ! ReadyFALSE
                token = PerformIO
                  SEQ
                    FromProcessor ? pointer; count
                    requested := TRUE
                token = ResetRequest
                  SEQ
                    ready       := FALSE
                    enabled   := FALSE
                    requested := FALSE
                    ToProcessor[priority] ! AckReset

          (requested AND ready) & SKIP -- acknowledge and store byte
            SEQ
              LinkInAck ! AckData -- Acknowledge
              WIndexByte(pointer, 0, (INT byte))
              AtByte(pointer, 1, pointer)
              count := count - 1
              IF
                count = 0 -- Transfer completed
                  INT oldPriority :
                  SEQ
                    requested := FALSE
                    oldPriority := priority
                    PAR
                      ToProcessor[oldPriority] ! RunRequest
                      INT interaction :
                      SEQ
                        FromProcessor ? interaction
                        IF
                          interaction = AckRun
                            SKIP
                          interaction = ResetRequest
                            FromProcessor ? priority
                TRUE
                  SKIP
              ready := FALSE

          (enabled AND ready) & SKIP -- inform processor that link is ready
            INT oldPriority : 
            SEQ 
              enabled     := FALSE
              oldPriority := priority
              PAR
                ToProcessor[oldPriority] ! ReadyRequest
                INT interaction :
                SEQ
                  FromProcessor ? interaction
                  IF
                    interaction = AckReady
                      SKIP
                    interaction = StatusEnquiry
                      FromProcessor ? priority
                    interaction = ResetRequest
                      SEQ
                        FromProcessor ? priority
                        ready := FALSE
  :

  PROC UnSign(INT reg)
    IF
      reg < 0
        reg := reg + Range
      TRUE
        SKIP
  :

  PROC Sign(INT reg)
    IF
      reg > MaxInt
        reg := reg - Range
      TRUE
        SKIP
  :

  PROC RestoreToRange(INT register)
    IF
      register > MaxInt
        register := register - Range
      register < MinInt
        register := register + Range
      TRUE
        SKIP
  :

  PROC Later(VAL INT T1, T2, BOOL laterFlag)
    INT timeDiff :
    SEQ
      timeDiff := T1 - T2
      RestoreToRange(timeDiff)
      laterFlag := (timeDiff > 0)
  :

  PROC SetErrorFlag()
    StatusReg := StatusReg BITOR ErrorFlag
  :

  PROC ClearErrorFlag()
    StatusReg := StatusReg BITAND (BITNOT ErrorFlag)
  :

  PROC ReadErrorFlag( BOOL state )
    state := ((StatusReg BITAND ErrorFlag) <> 0)
  :

  PROC SetHaltOnErrorFlag()
    StatusReg := StatusReg BITOR HaltOnErrorBit
  :

  PROC ClearHaltOnErrorFlag()
    StatusReg := StatusReg BITAND (BITNOT HaltOnErrorBit)
  :

  PROC ReadHaltOnErrorFlag( BOOL state )
    state := ((StatusReg BITAND HaltOnErrorBit) <> 0)
  :

  PROC OverflowCheck(INT register)
    IF
      (register < MinInt) OR (register > MaxInt)
        SEQ
          SetErrorFlag()
          register := register REM Range
          RestoreToRange(register)
      TRUE
        SKIP
  :

  PROC UpdateWdescReg(VAL INT NewWdescReg)
    SEQ
      WdescReg := NewWdescReg
      Wptr     := WdescReg BITAND (-2)
      Priority := WdescReg BITAND 1
  :

  PROC SaveRegisters( VAL BOOL SaveEreg ) 
    -- Save processor registers for interrupt
    SEQ
      WIndexWord(SaveBase, WdescIntSave, WdescReg)
      IF
        WdescReg <> (NotProcess.p BITOR 1)    -- Low Priority
          SEQ
            WIndexWord(SaveBase, IptrIntSave, IptrReg)
            WIndexWord(SaveBase, AregIntSave, Areg)
            WIndexWord(SaveBase, BregIntSave, Breg)
            WIndexWord(SaveBase, CregIntSave, Creg)
            WIndexWord(SaveBase, STATUSIntSave, StatusReg)
        TRUE
          SKIP
      IF
        SaveEreg
          WIndexWord(SaveBase, EregIntSave, Ereg)
        TRUE
          SKIP
  :

  PROC RestoreRegisters()
    -- Restore processor registers after interrupt
    SEQ
      INT temp :
      SEQ
        RIndexWord(SaveBase, WdescIntSave, temp)
        UpdateWdescReg(temp)
      IF
        WdescReg <> (NotProcess.p BITOR 1)    -- Low Priority
          SEQ
            RIndexWord(SaveBase, IptrIntSave, IptrReg)
            RIndexWord(SaveBase, AregIntSave, Areg)
            RIndexWord(SaveBase, BregIntSave, Breg)
            RIndexWord(SaveBase, CregIntSave, Creg)
            RIndexWord(SaveBase, STATUSIntSave, StatusReg)
        TRUE
          SKIP
      IF
        (StatusReg BITAND MoveBit) <> 0
          RIndexWord(SaveBase, EregIntSave, Ereg)
        TRUE
          SKIP
  :

  PROC Enqueue(VAL INT ProcPtr, INT Fptr, Bptr) 
    -- add a process to a scheduling list
    SEQ
      IF
        Fptr = NotProcess.p
          Fptr := ProcPtr
        TRUE
          WIndexWord(Bptr, Link.s, ProcPtr)
      Bptr := ProcPtr
  :

  PROC Dequeue(VAL INT Level) 
    -- Take a process from a scheduling list
    SEQ
      UpdateWdescReg(FptrReg[Level] BITOR Level)
      IF
        FptrReg[Level] = BptrReg[Level]
          FptrReg[Level] := NotProcess.p
        TRUE
          RIndexWord(FptrReg[Level], Link.s, FptrReg[Level])
  :

  PROC ActivateProcess()
    -- Starts a process executing
    SEQ
      Oreg := 0
      RIndexWord(Wptr, Iptr.s, IptrReg)
  :

  PROC Wait()
    SEQ
      WIndexWord(Wptr, State.s, Waiting.p)
      WIndexWord(Wptr, Iptr.s, IptrReg)
      StatusReg := StatusReg BITOR GotoSNPBit
  :

  PROC Run(VAL INT ProcDesc)
    -- Schedule a process
    INT procPriority :
    INT procPtr :
    SEQ
      procPriority := ProcDesc BITAND 1
      procPtr   := ProcDesc BITAND (-2)
      IF
        Priority = 0 -- Machine at high priority; queue process
          Enqueue(procPtr, FptrReg[procPriority], BptrReg[procPriority])
        Priority = 1 -- Machine at low priority
          IF
            procPriority = 0 -- High priority process; execute it
              SEQ
                SaveRegisters((StatusReg BITAND MoveBit) <> 0)
                UpdateWdescReg(ProcDesc)
                StatusReg := StatusReg BITAND (ErrorFlag BITOR HaltOnErrorBit)
                ActivateProcess()
            procPriority = 1 -- Low priority process; queue it
              IF
                Wptr = NotProcess.p
                  SEQ
                    UpdateWdescReg(ProcDesc)
                    ActivateProcess()
                TRUE
                  Enqueue(procPtr, FptrReg[1], BptrReg[1])
  :

  PROC TimeSlice()
    SEQ
      IF
        Priority = 0
          SKIP
        SliceCount < 2
          SKIP
        TRUE
          SEQ
            WIndexWord(Wptr, Iptr.s, IptrReg)
            Enqueue(Wptr, FptrReg[1], BptrReg[1])
            StatusReg := StatusReg BITOR GotoSNPBit
  :

  PROC HandleTimerRequest(VAL INT QueueId)
    INT frontProcess :
    SEQ
      TEnabled[QueueId] := FALSE
      RIndexWord(TptrLoc[QueueId], 0, frontProcess)
      SEQ
        INT secondProcess : -- update queue
        SEQ
          RIndexWord(frontProcess, TLink.s, secondProcess)
          WIndexWord(frontProcess, TLink.s, TimeSet.p)
          WIndexWord(TptrLoc[QueueId], 0, secondProcess)
          IF
            secondProcess = NotProcess.p
              SKIP
            TRUE
              SEQ
                RIndexWord(secondProcess, Time.s, TNextReg[QueueId])
                TEnabled[QueueId] := TRUE
      INT status : -- schedule process as appropriate
      SEQ
        RIndexWord(frontProcess, Pointer.s, status)
        IF
          status = Ready.p
            SKIP
          status = Waiting.p
            SEQ
              WIndexWord(frontProcess, Pointer.s, Ready.p)
              Run(frontProcess BITOR QueueId)
  :

  PROC HandleChannelRequest(VAL INT Request, hc)
    -- handles a request from a channel to the processor
    -- hc is index of hard channel in(occam) channel array
    IF
      Request = RunRequest
        INT channelContent :
        SEQ
          ToChan[hc] ! AckRun
          RIndexWord(PortBase, hc, channelContent)
          IF
            channelContent = NotProcess.p -- after Reset
              SKIP
            TRUE
              SEQ
                WIndexWord(PortBase, hc, NotProcess.p)
                Run(channelContent)
      Request = ReadyRequest
        INT channelContent, procPtr, status :
        SEQ
          -- Needed to make the cancellable ReadyRequest work
          ToChan[hc] ! AckReady
          RIndexWord(PortBase, hc, channelContent)
          procPtr := channelContent BITAND (-2)
          RIndexWord(procPtr, Pointer.s, status)
          IF
            status = Enabling.p
              WIndexWord(procPtr, Pointer.s, Ready.p)
            status = Ready.p
              SKIP
            status = Waiting.p
              SEQ
                WIndexWord(procPtr, Pointer.s, Ready.p)
                Run(channelContent)
  :

  PROC InsertFinalStep(INT time, previous, subsequent)
    SEQ
      -- Enqueue new timer process
      WIndexWord(previous, 0, Wptr)
      WIndexWord(Wptr, TLink.s, subsequent)
      WIndexWord(Wptr, Iptr.s, IptrReg)
      -- Ensure the earliest time is in TNextReg
      RIndexWord(TimerBase, Priority, previous)
      RIndexWord(previous, Time.s, TNextReg[Priority])
      TEnabled[Priority] := TRUE
      -- Finished insertion, start next process
      StatusReg := StatusReg BITAND (BITNOT TimeInsBit)
      StatusReg := StatusReg BITOR GotoSNPBit
  :

  PROC InsertTest(INT time, previous, subsequent)
    -- Used by Insert Middle and First Steps
    SEQ
      RIndexWord(previous, 0, subsequent)
      IF
        subsequent = NotProcess.p
          InsertFinalStep(time, previous, subsequent)
        subsequent <> NotProcess.p
          INT subsequentTime :
          BOOL laterFlag :
          SEQ
            RIndexWord(subsequent, Time.s, subsequentTime)
            Later(time, subsequentTime, laterFlag)
            IF
              laterFlag
                SKIP
              TRUE
                InsertFinalStep(time, previous, subsequent)
  :

  PROC InsertMiddleStep(INT time, previous, subsequent)
    -- Test for Insertion before next process on timer queue
    SEQ
      AtWord(subsequent, TLink.s, previous)
      InsertTest(time, previous, subsequent)
  :

  PROC InsertFirstStep(INT time, previous, subsequent)
    -- "previous" points at the location to be updated if the current
    -- process is to be inserted before the process pointed to by
    -- "subsequent".
    SEQ
      -- Start insertion, set local registers
      StatusReg := StatusReg BITOR TimeInsBit
      WIndexWord(Wptr, State.s, Waiting.p)
      WIndexWord(Wptr, Time.s, time)
      -- Test for Insertion before first process on timer queue
      AtWord(TimerBase, Priority, previous)
      InsertTest(time, previous, subsequent)
  :

  PROC DeleteFinalStep(INT previous, subsequent)
    SEQ
      -- Delete the current process from the timer queue
      RIndexWord(Wptr, TLink.s, subsequent)
      WIndexWord(previous, 0, subsequent)
      WIndexWord(Wptr, TLink.s, TimeNotSet.p)
      -- Ensure the earliest time is stored in TNextReg
      RIndexWord(TptrLoc[Priority], 0, previous)
      IF
        previous = NotProcess.p
          SKIP
        TRUE
          SEQ
            RIndexWord(previous, Time.s, TNextReg[Priority])
            TEnabled[INT Priority] := TRUE
      -- Finish Deletion
      StatusReg := StatusReg BITAND (BITNOT TimeDelBit)
  :

  PROC DeleteTest(INT previous, subsequent)
    -- Used by Delete First and Middle Steps
    SEQ
      RIndexWord(previous, 0, subsequent)
      IF
        subsequent = Wptr
          DeleteFinalStep(previous, subsequent)
        TRUE
          SKIP
  :

  PROC DeleteMiddleStep(INT previous, subsequent)
    -- Test for Deletion before next process on timer queue
    SEQ
      AtWord(subsequent, TLink.s, previous)
      DeleteTest(previous, subsequent)
  :

  PROC DeleteFirstStep(INT previous, subsequent)
    SEQ
      -- Start deletion, set TEnabled to FALSE (pending completion)
      StatusReg := StatusReg BITOR TimeDelBit
      TEnabled[Priority] := FALSE

      -- Test for deletion before first process on timer queue
      previous := TptrLoc[Priority]
      DeleteTest(previous, subsequent)
  :

  PROC StartTimer()
    SKIP
  :

  PROC IsThisSelectedProcess()
    -- this is used by all the disable instructions
    INT disableStatus :
    SEQ
      RIndexWord(Wptr, 0, disableStatus)
      IF
        disableStatus = NoneSelected.o
          SEQ
            WIndexWord(Wptr, 0, Areg)
            Areg := MachineTRUE
        TRUE
          Areg := MachineFALSE
  :

  PROC WritePartWord(VAL INT Address, Word, StartByte, Length)
    -- insert bytes 'StartByte' through 'StartByte+Length-1' into
    -- the corresponding byte of the memory location 'Address'
    INT buffer, insert, keep :
    SEQ
      insert := 0
      SEQ byteIndex = StartByte FOR Length
        insert := insert BITOR (#FF << (byteIndex*8))
      keep := BITNOT insert
      RIndexWord(Address, 0, buffer)
      buffer := (buffer BITAND keep) BITOR (Word BITAND insert)
      RestoreToRange(buffer)
      WIndexWord(Address, 0, buffer)
  :

  PROC Min(VAL INT Arg1, Arg2, INT result)
    IF
      Arg1 < Arg2
        result := Arg1
      TRUE
        result := Arg2
  :

  PROC CalcShiftUp(VAL INT SB, DB, INT shift)
    -- Calculate the Byte shift for the source to match the destination.
    SEQ
      shift := (DB - SB) REM BytesPerWord
      IF
        shift < 0
          shift := shift + BytesPerWord
        TRUE
          SKIP
  :

  PROC Decode(VAL INT Dest, Source, INT DB, SB)
    -- Extract Byte-select component of source and destination addresses
    SEQ
      DB := Dest BITAND BselMask
      SB := Source BITAND BselMask
  :

  PROC Select(VAL INT P, C, ShiftUp, INT S)
    -- Forms a new word,
    -- with the ShiftUp-most-significant bytes from P at the
    -- least significant end, and the (BitsInWord/8) minus ShiftUp-
    -- least-significant bytes from C at the most significant end.
    -- Inserts 1's otherwise.
    INT lowWord, highWord :
    VAL ShiftUpBits IS ShiftUp * 8 :
    VAL Complement IS BitsInWord - ShiftUpBits :
    SEQ
      lowWord := (P >> Complement) BITOR ((-1) << ShiftUpBits)
      highWord := C   BITOR ((-1) << Complement)
      highWord := (highWord << ShiftUpBits) BITOR
                                    (BITNOT ((-1) << ShiftUpBits) )
      S := lowWord BITAND highWord
  :

  PROC BlockMoveFinalStep()
    -- NB Clear Flags BEFORE running Ereg !
    -- Run Ereg if IOBit set, clear IOBit and MoveBit
    IF
      (StatusReg BITAND IOBit) <> 0
        SEQ
          StatusReg := (StatusReg          BITAND
                         (BITNOT MoveBit)) BITAND
                         (BITNOT IOBit)
          Run(Ereg)
      TRUE
        StatusReg := (StatusReg          BITAND
                       (BITNOT MoveBit))
  :

  PROC BlockMoveFirstStep(INT source, dest, length)
    INT shiftUp :
    INT bytesToRead, bytesToWrite :
    INT DB, SB :
    INT current, selected :
    IF
      length = 0
        BlockMoveFinalStep()
      length > 0
        SEQ
          StatusReg := StatusReg BITOR MoveBit
          Decode(dest, source, DB, SB)
          CalcShiftUp(SB, DB, shiftUp)
          RIndexWord(source, 0, current)
          Min((BitsInWord/8) - SB, length, bytesToRead)
          Min((BitsInWord/8) - DB, length, bytesToWrite)
          IF
            bytesToRead >= bytesToWrite
              Select(current, current, shiftUp, selected)
            bytesToRead < bytesToWrite
              SEQ
                BMbuffer := current
                -- Must do another read before we write
                RIndexWord(source, 1, current)
                Select(BMbuffer, current, shiftUp, selected)
          -- Write
          WritePartWord(dest, selected, DB, bytesToWrite)
          -- Update pointers and buffer
          AtByte(dest, bytesToWrite, dest)
          length := length - bytesToWrite
          AtByte(source, bytesToWrite, source)
          -- Update buffer
          BMbuffer := current
  :

  PROC BlockMoveMiddleStep(INT source, dest, length)
    INT shiftUp :
    INT bytesToWrite :
    INT DB, SB :
    INT current, selected :
    IF
      length = 0
        BlockMoveFinalStep()
      length > 0
        SEQ
          -- Read word
          Decode(dest, source, DB, SB)
          CalcShiftUp(SB, DB, shiftUp)
          IF
            length > shiftUp
              -- First choose which word to read
              IF
                shiftUp = 0
                  RIndexWord(source, 0, current)
                TRUE
                  RIndexWord(source, 1, current)
            TRUE
              SKIP
          -- Write appropiate section
          -- Selection can be omitted in the ShiftUp = 0 case
          Select(BMbuffer, current, shiftUp, selected)
          Min((BitsInWord/8) - DB, length, bytesToWrite)
          WritePartWord(dest, selected, DB, bytesToWrite)
          -- Update pointers and buffer
          AtByte(dest, bytesToWrite, dest)
          length := length - bytesToWrite
          AtByte(source, bytesToWrite, source)
          BMbuffer := current
  :

  PROC StartNextProcess()
    -- This starts execution of the next runnable process (if one exists)
    SEQ
      StatusReg := StatusReg BITAND (BITNOT GotoSNPBit)
      IF
        Priority = 0
          IF
            FptrReg[0] <> NotProcess.p
              SEQ
                Dequeue(0)
                ActivateProcess()
            TRUE
              SEQ -- no further high priority processes
                RestoreRegisters()
                IF
                  -- no interrupted process
                  (Wptr = NotProcess.p) AND (FptrReg[1] <> NotProcess.p)
                    SEQ
                      Dequeue(1)
                      ActivateProcess()
                  -- no low priority processes at all
                  (Wptr = NotProcess.p) -- no processes
                    SKIP
                  -- interrupted process was doing block move
                  (StatusReg BITAND MoveBit) <> 0
                    BlockMoveFirstStep(Creg, Breg, Areg)
                  -- continue with block move
                  TRUE
                    SKIP
        Priority = 1
          IF
            FptrReg[1] <> NotProcess.p
              SEQ
                Dequeue(1)
                ActivateProcess()
            TRUE
              UpdateWdescReg(NotProcess.p BITOR 1)
  :

  PROC HandShake(VAL INT I, INT token) 
    -- Required for resetting a link which might be
    -- operating at high priority
    ALT pri = 0 FOR 2
      FromChan[I][pri] ? token
        SKIP
  :

  PROC SaveRegsPendingSoftIO()
    SEQ
      WIndexWord(Breg, 0, WdescReg)
      WIndexWord(Wptr, Iptr.s, IptrReg)
      WIndexWord(Wptr, Pointer.s, Creg)
  :

  PROC HardChannelInputOutputAction(VAL INT portNo)
    SEQ
      WIndexWord(Breg, 0, WdescReg)
      WIndexWord(Wptr, Iptr.s, IptrReg)
      ToChan[portNo] ! PerformIO; Priority; Creg; Areg
  :

  PROC ChanOffset(VAL INT reg, INT chanNum)
    -- Extract a "channel number", starting from MinInt = 0
    chanNum := (reg - MinInt) >> BselLength
  :

  PROC Input()
    -- Areg is count, Breg is channel, Creg is pointer.
    INT chanNum :
    SEQ
      ChanOffset(Breg, chanNum)
      IF
        chanNum >= LinkChans                -- soft(Breg)
          INT procDesc :
          SEQ
            RIndexWord(Breg, 0, procDesc)
            IF
              procDesc = NotProcess.p    -- Not ready; wait
                SEQ
                  SaveRegsPendingSoftIO()
                  StatusReg := StatusReg BITOR GotoSNPBit
              TRUE                       -- Ready; transfer
                INT sourcePtr, procPtr :
                SEQ
                  -- Reset channel -- NB ok to do this here
                  WIndexWord(Breg, 0, NotProcess.p)
                  procPtr := procDesc BITAND (-2)
                  RIndexWord(procPtr, Pointer.s, sourcePtr)
                  -- Set up the block move
                  Ereg := procDesc
                  Breg := Creg
                  Creg := sourcePtr
                  StatusReg := StatusReg BITOR (MoveBit BITOR IOBit)
                  BlockMoveFirstStep(Creg, Breg, Areg)
                  -- When completed, BlockMove will Run(Ereg)
        TRUE                      -- hard(Breg)
          SEQ
            HardChannelInputOutputAction(chanNum)
            StatusReg := StatusReg BITOR GotoSNPBit
  :

  PROC Output ()
    -- Areg is count, Breg is channel, Creg is pointer.
    INT chanNum :
    SEQ
      ChanOffset(Breg, chanNum)
      IF
        chanNum >= LinkChans                      -- Internal channel
          INT procDesc :
          SEQ
            RIndexWord(Breg, 0, procDesc)
            IF
              procDesc = NotProcess.p          -- Not ready; wait
                SEQ
                  SaveRegsPendingSoftIO()
                  StatusReg := StatusReg BITOR GotoSNPBit
              TRUE                             -- Ready
                INT destPtr, procPtr :
                SEQ
                  procPtr := procDesc BITAND (-2)
                  RIndexWord(procPtr, Pointer.s, destPtr)
                  IF              -- scheduler interlock for ALT
                    destPtr = Enabling.p
                      SEQ
                        WIndexWord(procPtr, Pointer.s, Ready.p)
                        SaveRegsPendingSoftIO()
                        StatusReg := StatusReg BITOR GotoSNPBit
                    destPtr = Waiting.p
                      SEQ
                        WIndexWord(procPtr, Pointer.s, Ready.p)
                        SaveRegsPendingSoftIO()
                        StatusReg := StatusReg BITOR GotoSNPBit
                        Run (procDesc)
                    destPtr = Ready.p
                      SEQ
                        SaveRegsPendingSoftIO()
                        StatusReg := StatusReg BITOR GotoSNPBit
                    TRUE                 -- valid pointer
                      SEQ
                        -- Reset channel
                        WIndexWord(Breg, 0, NotProcess.p)
                        -- Set up registers for the block move
                        Ereg := procDesc
                        Breg := destPtr
                        StatusReg := StatusReg BITOR
                                             (MoveBit BITOR IOBit)
                        BlockMoveFirstStep(Creg, Breg, Areg)
                        -- When completed, BlockMove will Run(Ereg)
        TRUE                              -- link-channel
          SEQ
            HardChannelInputOutputAction(chanNum)
            StatusReg := StatusReg BITOR GotoSNPBit
  :

  PROC ArithmeticRightShift(VAL INT Operand, Shift, INT result)
    IF
      Operand >= 0
        result := Operand >> Shift
      Operand < 0
        SEQ
          result := BITNOT Operand
          result := result >> Shift
          result := BITNOT result
  :

  PROC BuildNextInstruction(INT IptrReg, Oreg, code)
    BOOL build :
    SEQ
      build := TRUE
      WHILE build
        SEQ
          RIndexByte(IptrReg, 0, code)
          IptrReg := IptrReg + 1
          Oreg := Oreg BITOR ( code BITAND #0F )
          code := code >> 4
          IF
            code = f.pfix
              Oreg := Oreg << 4
            code = f.nfix
              Oreg := BITNOT ( Oreg << 4 )
            TRUE
              build := FALSE
  :

  PROC Primary(VAL INT code)
    CASE code

      f.ldl -- load local
        SEQ
          Creg := Breg
          Breg := Areg
          RIndexWord(Wptr, Oreg, Areg)

      f.stl -- store local
        SEQ
          WIndexWord(Wptr, Oreg, Areg)
          Areg := Breg
          Breg := Creg

      f.ldlp -- load local pointer
        SEQ
          Creg := Breg
          Breg := Areg
          AtWord(Wptr, Oreg, Areg)

      f.ldnl -- load non-local
        RIndexWord(Areg, Oreg, Areg)

      f.stnl -- store non-local
        SEQ
          WIndexWord(Areg, Oreg, Breg)
          Areg := Creg

      f.ldnlp -- load non-local pointer
        AtWord(Areg, Oreg, Areg)

      f.eqc -- equals constant
        IF
          Areg = Oreg
            Areg := MachineTRUE
          TRUE
            Areg := MachineFALSE

      f.ldc -- load constant
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := Oreg

      f.adc -- add constant
        SEQ
          Areg := Areg + Oreg
          OverflowCheck(Areg)

      f.j -- jump
        SEQ
          AtByte(IptrReg, Oreg, IptrReg)
          TimeSlice()

      f.cj -- conditional jump
        IF
          Areg = 0
            AtByte(IptrReg, Oreg, IptrReg)
          TRUE
            SEQ
              Areg := Breg
              Breg := Creg

      f.call -- call
        SEQ
          WIndexWord(Wptr, -1, Creg)
          WIndexWord(Wptr, -2, Breg)
          WIndexWord(Wptr, -3, Areg)
          WIndexWord(Wptr, -4, IptrReg)
          Areg := IptrReg
          INT temp :
          SEQ
            AtWord(Wptr, -4, temp)
            UpdateWdescReg(temp BITOR Priority)
          AtByte(IptrReg, Oreg, IptrReg)

      f.ajw -- adjust workspace
        INT temp :
        SEQ
          AtWord(Wptr, Oreg, temp)
          UpdateWdescReg(temp BITOR Priority)
  :

  PROC Secondary(VAL INT code)
    CASE code
      o.rev -- reverse
        SEQ
          Oreg := Areg
          Areg := Breg
          Breg := Oreg

      o.ret -- return 
        SEQ
          RIndexWord(Wptr, 0, IptrReg)
          INT temp :
          SEQ
            AtWord(Wptr, 4, temp)
            UpdateWdescReg(temp BITOR Priority)

      o.ldpi -- load pointer to Instruction 
        AtByte(IptrReg, Areg, Areg)

      o.gajw -- general adjust workspace 
        INT temp:
        SEQ
          temp := Wptr
          UpdateWdescReg(Areg BITOR Priority)
          Areg := temp

      o.gcall -- general call 
        INT temp:
        SEQ
          temp := IptrReg
          IptrReg := Areg
          Areg := temp

      o.mint -- minimum integer 
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := MinInt

      o.lend -- loop end 
        SEQ
          RIndexWord(Breg, 1, Creg)
          Creg := Creg - 1
          WIndexWord(Breg, 1, Creg)
          IF
            Creg > 0
              SEQ
                RIndexWord(Breg, 0, Creg)
                Creg := Creg + 1
                WIndexWord(Breg, 0, Creg)
                AtByte(IptrReg, -Areg, IptrReg)
            TRUE
              SKIP
          TimeSlice()

      o.csub0 -- check subscript from 0 
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          IF
            Breg >= Areg -- unsigned compare
              SetErrorFlag()
            TRUE
              SKIP
          Sign(Breg)
          Areg := Breg
          Breg := Creg

      o.ccnt1 -- check count from 1 
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          IF
            (Breg = 0) OR (Breg > Areg) -- unsigned comparison
              SetErrorFlag()
            TRUE
              SKIP
          Sign(Breg)
          Areg := Breg
          Breg := Creg

      o.testerr -- test error false and clear 
        BOOL errorSet :
        SEQ
          Creg := Breg
          Breg := Areg
          ReadErrorFlag(errorSet)
          IF
            errorSet
              Areg := MachineFALSE
            NOT errorSet
              Areg := MachineTRUE
          ClearErrorFlag()

      o.seterr -- set error
        SetErrorFlag()

      o.stoperr -- stop on error
        BOOL errorSet :
        SEQ
          ReadErrorFlag(errorSet)
          IF
            errorSet
              SEQ
                WIndexWord(Wptr, Iptr.s, IptrReg)
                StatusReg := StatusReg BITOR GotoSNPBit
            TRUE
              SKIP

      o.clrhalterr -- clear halt-on-error 
        ClearHaltOnErrorFlag()

      o.sethalterr -- set halt-on-error 
        SetHaltOnErrorFlag ()

      o.testhalterr -- test halt-on-error 
        BOOL flagSet :
        SEQ
          Creg := Breg
          Breg := Areg
          ReadHaltOnErrorFlag(flagSet)
          IF
            flagSet
              Areg := MachineTRUE
            TRUE
              Areg := MachineFALSE

      o.bsub -- byte subscript 
        SEQ
          AtByte (Areg, Breg, Areg)
          Breg := Creg

      o.wsub -- word subscript 
        SEQ
          AtWord(Areg, Breg, Areg)
          Breg := Creg

      o.bcnt -- byte count 
        Areg := Areg * BytesPerWord

      o.wcnt -- word count
        SEQ
          Creg := Breg
          Breg := Areg BITAND BselMask
          ArithmeticRightShift(Areg, BselLength, Areg)

      o.lb -- load byte 
        RIndexByte(Areg, 0, Areg)

      o.sb -- store byte 
        SEQ
          WIndexByte (Areg, 0, Breg)
          Areg := Creg

      o.move -- move message 
        BlockMoveFirstStep(Creg, Breg, Areg)

      o.and -- and
        SEQ
          Areg := Areg BITAND Breg
          Breg := Creg

      o.or -- or
        SEQ
          Areg := Breg BITOR Areg
          Breg := Creg

      o.xor -- xor
        SEQ
          Areg := Breg >< Areg
          Breg := Creg

      o.not -- not
        Areg := BITNOT Areg

      o.shl -- shift left
        SEQ
          UnSign(Areg)
          IF
            Areg <= BitsInWord
              SEQ
                UnSign(Breg)
                Areg := Breg << Areg
                Sign(Areg)
            TRUE
              Areg := 0
          Breg := Creg

      o.shr -- shift right
        SEQ
          UnSign(Breg)
          IF
            Areg <= BitsInWord
              SEQ
                Areg := Breg >> Areg
                Sign(Areg)
                Breg := Creg
            TRUE
              Areg := 0
          Breg := Creg

      o.add -- add
        SEQ
          Areg := Breg + Areg
          OverflowCheck(Areg)
          Breg := Creg

      o.sub -- subtract 
        SEQ
          Areg := Breg - Areg
          OverflowCheck (Areg)
          Breg := Creg

      o.mul -- multiply 
        -- Signed multiply, Areg := Areg * Breg MOD Range.
        -- OverflowCheck now handles ANY signed integer !
        SEQ
          Areg := Breg * Areg
          OverflowCheck(Areg)
          Breg := Creg

      o.div -- divide 
        SEQ
          IF
            ((Breg = MinInt) AND (Areg = (-1))) OR (Areg = 0)
              SetErrorFlag()
            TRUE
              Areg := Breg / Areg
          Breg := Creg

      o.rem -- remainder 
        SEQ
          IF
            ((Breg = MinInt) AND (Areg = (-1))) OR (Areg = 0)
              SetErrorFlag()
            TRUE
              Areg := Breg REM Areg
          Breg := Creg

      o.gt -- greater than 
        SEQ
          IF
            Breg > Areg
              Areg := MachineTRUE
            TRUE
              Areg := MachineFALSE
          Breg := Creg

      o.diff -- difference
        SEQ
          Areg := Breg - Areg
          RestoreToRange(Areg)
          Breg := Creg

      o.sum -- sum
        SEQ
          Areg := Breg + Areg
          RestoreToRange(Areg)
          Breg := Creg

      o.prod -- product 
        SEQ -- quick unchecked multiply
          UnSign(Areg) -- short operand in Areg
          UnSign(Breg)
          Areg := Breg * Areg
          Areg := Areg REM Range
          Sign(Areg)
          Breg := Creg

      o.startp -- start process 
        INT temp :
        SEQ
          AtByte(IptrReg, Breg, temp)
          WIndexWord(Areg, Iptr.s, temp)
          Run(Areg BITOR Priority)

      o.endp -- end process 
        INT temp :
        SEQ
          RIndexWord(Areg, 1, temp)
          IF
            temp = 1
              SEQ
                RIndexWord(Areg, 0, IptrReg)
                UpdateWdescReg(Areg BITOR Priority)
            TRUE
              SEQ
                WIndexWord(Areg, 1, temp-1)
                StatusReg := StatusReg BITOR GotoSNPBit

      o.runp -- run process 
        Run(Areg)

      o.stopp -- stop process 
        SEQ
          WIndexWord(Wptr, Iptr.s, IptrReg)
          StatusReg := StatusReg BITOR GotoSNPBit

      o.ldpri -- load current priority 
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := Priority

      o.in -- input message 
        Input()

      o.out -- output message 
        Output()

      o.outword -- output word 
        SEQ
          WIndexWord(Wptr, 0, Areg)
          Areg := BytesPerWord
          Creg := Wptr
          Output()

      o.outbyte -- output byte 
        SEQ
          WIndexWord(Wptr, 0, Areg)
          Areg := 1
          Creg := Wptr
          Output()

      o.resetch -- reset channel 
        INT temp :
        INT chanNum :
        SEQ                       -- Channel ID in Areg
          RIndexWord(Areg, 0, temp)
          WIndexWord(Areg, 0, NotProcess.p)
          ChanOffset(Areg, chanNum)
          IF
            chanNum < LinkChans   -- Hard Channel
              INT token :
              PAR
                ToChan[chanNum] ! ResetRequest; Priority
                HandShake(chanNum, token)
            TRUE
              SKIP                -- no other action needed for soft channel
          Areg := temp            -- old process pointer

      o.ldtimer -- load timer 
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := ClockReg[Priority]

      o.tin -- timer input 
        BOOL laterFlag :
        SEQ
          Later(ClockReg[Priority], Areg, laterFlag)
          IF
            laterFlag
              SKIP
            TRUE
              SEQ
                Areg := Areg + 1
                RestoreToRange (Areg)
                InsertFirstStep(Areg, Breg, Creg)

      o.alt -- alt start 
        WIndexWord(Wptr, State.s, Enabling.p)

      o.altwt -- alt wait 
        SEQ
          -- set up "NoneSelected.o" in local 0 to signify
          -- that the no ready process has been selected                             <<<---???
          WIndexWord(Wptr, 0, NoneSelected.o)
          -- Is any channel or skip guard ready?
          RIndexWord (Wptr, State.s, Areg)
          IF
            Areg = Ready.p
              SKIP
            TRUE
              Wait()

      o.altend -- alt end 
        INT temp :
        SEQ
          RIndexWord(Wptr, 0, temp)
          AtByte(IptrReg, temp, IptrReg)

      o.enbs -- enable skip 
        IF
          Areg <> MachineFALSE
            WIndexWord(Wptr, State.s, Ready.p)
          TRUE
            SKIP

      o.diss -- disable skip 
        SEQ
          IF
            Breg <> MachineFALSE
              IsThisSelectedProcess()
            TRUE
              Areg := MachineFALSE
          Breg := Creg

      o.enbc -- enable channel 
        SEQ
          IF
            Areg <> MachineFALSE
              INT chanNum :
              SEQ
                ChanOffset(Breg, chanNum)
                IF
                  chanNum >= LinkChans -- internal channel
                    INT temp :
                    SEQ
                      RIndexWord(Breg, 0, temp)
                      IF
                        temp = NotProcess.p
                          WIndexWord(Breg, 0, WdescReg)
                        temp = WdescReg
                          SKIP
                        TRUE
                          WIndexWord(Wptr, State.s, Ready.p)
                  TRUE -- link-channel
                    INT token :
                    SEQ -- is channel ready ?
                      PAR
                        ToChan[chanNum] ! StatusEnquiry; Priority
                        FromChan[chanNum][Priority] ? token
                        IF
                          token = ReadyRequest
                            WIndexWord(Wptr, State.s, Ready.p)
                          token = ReadyFALSE
                            SEQ
                              ToChan[chanNum] ! Enable; Priority
                              WIndexWord(Breg, 0, WdescReg)
            TRUE
              SKIP
          Breg := Creg


      o.disc -- disable channel
        IF
          Breg <> MachineFALSE
            INT chanNum :
            SEQ
              ChanOffset(Creg, chanNum)
              IF
                chanNum >= LinkChans --  Internal channel
                  SEQ
                    RIndexWord(Creg, 0, Breg)
                    IF
                      Breg = NotProcess.p
                        Areg := MachineFALSE
                      Breg = WdescReg
                        SEQ
                          WIndexWord(Creg, 0, NotProcess.p)
                          Areg := MachineFALSE
                      TRUE
                        IsThisSelectedProcess()
                TRUE      -- Hard Channel
                  INT token :
                  SEQ
                    WIndexWord(Creg, 0, NotProcess.p)
                    -- Ask if channel is ready and hence switch off channel
                    PAR
                      ToChan[chanNum] ! StatusEnquiry; Priority
                      FromChan[chanNum][Priority] ? token
                    IF
                      token = ReadyRequest
                        IsThisSelectedProcess()
                      token = ReadyFALSE
                        Areg := MachineFALSE
          TRUE
            Areg := MachineFALSE

      o.talt -- timer alt start
        SEQ
          WIndexWord(Wptr, TLink.s, TimeNotSet.p)
          WIndexWord(Wptr, State.s, Enabling.p)

      o.taltwt -- timer alt wait
        SEQ
          -- NoneSelected.o in local 0 signifies that
          -- no process has yet been selected
          WIndexWord(Wptr, 0, NoneSelected.o)
          RIndexWord(Wptr, State.s, Creg)
          IF
            Creg = Ready.p   -- a channel is ready
              WIndexWord(Wptr, Time.s, ClockReg[Priority])
            TRUE
              SEQ
                RIndexWord(Wptr, TLink.s, Breg)
                IF
                  Breg = TimeNotSet.p
                    Wait()   -- all timer guards FALSE
                  Breg = TimeSet.p
                    -- Either a timer guard is ready, or wait
                    BOOL laterFlag :
                    SEQ
                      RIndexWord(Wptr, Time.s, Areg)
                      Later(ClockReg[Priority], Areg, laterFlag)
                      IF
                        laterFlag
                          -- clock makes process ready
                          SEQ
                            WIndexWord(Wptr, State.s, Ready.p)
                            WIndexWord(Wptr, Time.s, ClockReg[Priority])
                        TRUE
                          -- clock does not make process ready
                          SEQ
                            -- set Areg to time AT which process is ready
                            Areg := Areg + 1
                            RestoreToRange(Areg)
                            InsertFirstStep(Areg, Breg, Creg)

      o.enbt -- enable timer 
        SEQ
          IF
            Areg <> MachineFALSE
              INT temp :
              SEQ
                RIndexWord(Wptr, TLink.s, temp)
                IF
                  temp = TimeNotSet.p
                    -- This is first timer guard encountered
                    SEQ
                      WIndexWord(Wptr, TLink.s, TimeSet.p)
                      WIndexWord(Wptr, Time.s, Breg)
                  temp = TimeSet.p
                    -- Update earliest time if this guard is earlier
                    BOOL laterFlag :
                    SEQ
                      RIndexWord(Wptr, Time.s, temp)
                      Later(temp, Breg, laterFlag)
                      IF
                        laterFlag
                          WIndexWord(Wptr, Time.s, Breg)
                        TRUE
                          SKIP
            TRUE
              SKIP
          Breg := Creg

      o.dist -- disable timer
        IF
          Breg <> MachineFALSE
            SEQ
              RIndexWord(Wptr, TLink.s, Oreg)
              IF
                Oreg = TimeNotSet.p
                  Areg := MachineFALSE
                Oreg = TimeSet.p
                  -- See if this timer guard is ready
                  BOOL laterFlag :
                  SEQ
                    RIndexWord(Wptr, Time.s, Oreg)
                    Later(Oreg, Creg, laterFlag)
                    IF
                      laterFlag
                        IsThisSelectedProcess()
                      TRUE
                        Areg := MachineFALSE
                TRUE
                  SEQ
                    -- process must be removed from timer queue
                    DeleteFirstStep(Breg, Creg)
                    Areg := MachineFALSE
          TRUE
            Areg := MachineFALSE

      o.xword -- extend to word 
        SEQ
          UnSign(Areg)
          IF
            (Breg < Areg)
              Areg := Breg
            TRUE
              Areg := Breg - (2*Areg)
          Breg := Creg

      o.cword -- check word 
        SEQ
          UnSign(Areg)
          IF
            (Breg >= Areg) OR (Breg < (-Areg))
              SetErrorFlag()
            TRUE
              SKIP
          Areg := Breg
          Breg := Creg

      o.xdble -- extend to double
        SEQ
          Creg := Breg
          IF
            Areg < 0
              Breg := -1
            Areg >=0
              Breg := 0

      o.csngl -- check single
        SEQ
          IF
            ((Areg < 0) AND (Breg <> (-1))) OR ((Areg >= 0) AND (Breg <> 0))
              SetErrorFlag()
            TRUE
              SKIP
          Breg := Creg

      o.ladd -- long add
        SEQ
          Areg := (Breg + Areg) + (Creg BITAND 1)
          OverflowCheck(Areg)

      o.lsub -- long subtract
        SEQ
          Areg := (Breg - Areg) - (Creg BITAND 1)
          OverflowCheck(Areg)

      o.lsum -- long sum
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          Areg := (Breg + Areg) + (Creg BITAND 1)
          IF
            (Areg > Range)
              SEQ
                Breg := 1
                Areg := Areg - Range
            TRUE
              Breg := 0
          Sign(Areg)

      o.ldiff -- long diff
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          Areg := (Breg - Areg) - (Creg BITAND 1)
          IF
            Areg >= 0
              Breg := 0
            Areg < 0
              SEQ
                Areg := Areg + Range
                Breg := 1
          Sign(Areg)

      o.lmul -- long multiply 
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          UnSign(Creg)
          Areg := (Breg * Areg) + Creg
          Breg := Areg / Range
          Areg := Areg REM Range
          Sign(Areg)
          Sign(Breg)

      o.ldiv -- long divide 
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          UnSign(Creg)
          IF
            Creg >= Areg
              SetErrorFlag()
            Creg < Areg
              INT temp :
              SEQ
                temp := (Creg << BitsInWord) + Breg
                Breg := temp REM Areg
                Areg := temp / Areg
                Sign(Areg)
                Sign(Breg)

      o.norm -- normalise
        IF
          (Breg = 0) AND (Areg = 0)
            Creg := 2*BitsInWord
          TRUE
            VAL MsbOfDoubleWord IS 1 << ((2*BitsInWord)-1) :
            SEQ
              UnSign(Areg)
              UnSign(Breg)
              Areg := (Breg << BitsInWord) + Areg
              Creg := 0
              WHILE (Areg BITAND MsbOfDoubleWord) = 0
                SEQ
                  Areg := Areg << 1
                  Creg := Creg + 1
              Breg := Areg / Range
              Areg := Areg REM Range
              Sign(Areg)
              Sign(Breg)

      o.lshl -- long shift left 
        SEQ
          UnSign(Areg)
          IF
            Areg <= (2*BitsInWord)
              SEQ
                UnSign(Breg)
                UnSign(Creg)
                Breg := (Creg << BitsInWord) + Breg
                Breg := Breg << Areg
                Areg := Breg REM Range
                Breg := (Breg / Range) REM Range
                Sign(Areg)
                Sign(Breg)

      o.lshr -- long shift right 
        SEQ
          UnSign(Areg)
          IF
            Areg <= (2*BitsInWord)
              SEQ
                UnSign(Breg)
                UnSign(Creg)
                Breg := (Creg << BitsInWord) + Breg
                Breg := Breg >> Areg
                Areg := Breg / Range
                Breg := Breg REM Range
                Sign(Areg)
                Sign(Breg)


      o.testpranal -- test processor analysing 
        SEQ
          Creg := Breg
          Breg := Areg
          IF
            ResetNotAnalysed
              -- This flag indicates that the links were last reset,
              -- as opposed to analysed.
              Areg := MachineFALSE
            TRUE
              Areg := MachineTRUE

      o.saveh -- save high priority queue registers 
        SEQ
          WIndexWord(Areg, 0, FptrReg[0])
          WIndexWord(Areg, 1, BptrReg[0])
          Areg := Breg
          Breg := Creg

      o.savel -- save low priority queue registers 
        SEQ
          WIndexWord(Areg, 0, FptrReg[1])
          WIndexWord(Areg, 1, BptrReg[1])
          Areg := Breg
          Breg := Creg

      o.sthf -- store high priority front pointer 
        SEQ
          FptrReg[0] := Areg
          Areg := Breg
          Breg := Creg

      o.sthb -- store high priority back pointer 
        SEQ
          BptrReg[0] := Areg
          Areg := Breg
          Breg := Creg

      o.stlf -- store low priority front pointer 
        SEQ
          FptrReg[1] := Areg
          Areg := Breg
          Breg := Creg

      o.stlb -- store low priority back pointer
        SEQ
          BptrReg[1] := Areg
          Areg := Breg
          Breg := Creg

      o.sttimer -- store timer 
        SEQ
          ClockReg[0] := Areg
          ClockReg[1] := Areg
          Areg := Breg
          Breg := Creg
          StartTimer()

      o.unpacksn -- unpack single length floating point number 
        SEQ
          UnSign(Areg)
          Creg := Breg * 4
          Areg := ( ( Areg BITAND (BITNOT MinInt)) << (RealShift + 1) )
          Breg := Areg / Range
          Areg := ( Areg REM Range )
          Breg := Breg >> 1
          IF
            Breg = 0
              IF
                Areg = 0
                  SKIP
                TRUE
                  SEQ
                    Creg := Creg + 1
                    Breg := 1
            TRUE
              IF
                Breg = RealExp
                  IF
                    Areg = 0
                      Creg := Creg + 2
                    TRUE
                      Creg := Creg + 3
                TRUE
                  SEQ
                    Creg := Creg + 1
                    Areg := Areg BITOR MinInt
                    Sign(Areg)

      o.roundsn -- round single length fp number
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          IF
            Creg < RealExp
              INT temp :
              SEQ
                temp := Breg
                Breg := (Creg * Range) + ((Breg << 1) BITAND (Range - 1))
                Breg := Breg >> (RealShift + 1)
                IF
                  (temp BITAND RealRBit) = 0
                    SKIP
                  (Areg BITOR ((temp BITAND RealXcess) BITOR (Breg BITAND PackedLSB))) = 0
                    SKIP
                  TRUE
                    Breg := Breg + 1
                Areg := Breg
            TRUE
              Areg := RealInf
          Sign(Areg)

      o.postnormsn -- post-normalise correction of single length fp number
        SEQ
          UnSign(Areg)
          UnSign(Breg)
          Breg := (Breg * Range) + Areg
          INT temp :
          SEQ
            RIndexWord(Wptr, 0, temp)
            Creg := temp - Creg
          IF
            Creg < (-(BitsInFrac - 1))
              SEQ
                Areg := 0
                Breg := 0
                Creg := 0
            Creg < 1
              SEQ
                Breg := Breg >> (1 - Creg)
                Creg := 0
            Creg < RealExp
              SEQ
                SKIP -- ??????????????????????????

            TRUE
              Creg := RealExp
          Areg := (Breg REM Range) BITOR Areg
          Breg := Breg / Range
          Sign(Areg)
          Sign(Breg)

      o.ldinf -- load Infinity
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := RealInf

      o.cflerr -- check single length fp infinity or NaN 
        IF
          (Areg BITAND RealInf) = RealInf
            SetErrorFlag()
          TRUE
            SKIP

      o.fmul  -- fractional multiply

        VAL TwoToThe31 IS 1 << (31-1) :
        VAL TwoToThe30 IS 1 << (30-1) :
        INT P, L :
        SEQ
          P := (Areg * Breg) / TwoToThe31
          UnSign(Areg)
          UnSign(Breg)
          L := (Areg * Breg) \ TwoToThe31
          IF
            L < TwoToThe30
              SKIP
            L = TwoToThe30
              IF
                (P BITAND 1) = 0
                  SKIP
                (P BITAND 1) = 1
                  P := P + 1
            L > TwoToThe30
              P := P + 1
          OverflowCheck(P)
          Areg := P
          Breg := Creg

      o.teststd -- store to D register for testing 
        SEQ
          Dreg := Areg
          Areg := Breg
          Breg := Creg

      o.testste -- store to E register for testing 
        SEQ
          Ereg := Areg
          Areg := Breg
          Breg := Creg

      o.teststs -- store to StatusReg for testing 
        SEQ
          StatusReg := Areg
          Areg := Breg
          Breg := Creg

      o.testldd -- load D register for testing 
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := Dreg

      o.testlde -- load E register for testing 
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := Ereg

      o.testlds -- load StatusReg for testing 
        SEQ
          Creg := Breg
          Breg := Areg
          Areg := StatusReg

      o.testhardchan -- test hard channel stack
        INT chanNum :
        SEQ
          ChanOffset(Areg, chanNum)
          Areg := DataReg[chanNum]
          DataReg[chanNum] := PointerReg[chanNum]
          PointerReg[chanNum] := CountReg[chanNum]
          CountReg[chanNum] := Breg
          Breg := Creg

  :


  SEQ

    StatusReg := 0
    Oreg := 0

    WHILE TRUE

      VAL INT interruptable IS GotoSNPBit BITOR (IOBit BITOR (MoveBit BITOR (TimeInsBit BITOR TimeDelBit))) :
      BOOL validProcess, completed :
      INT token :
      SEQ
        -- completed indicates if current instruction has terminated
        completed := (StatusReg BITAND interruptable) = 0
        validProcess := Wptr <> NotProcess.p

        PRI ALT
          (StatusReg BITAND GotoSNPBit) <> 0 & SKIP
            StartNextProcess()

          (Priority = 0) AND (NOT (TNextReg[0] AFTER ClockReg[0])) AND completed & SKIP
            HandleTimerRequest(0)

          ALT hc = 0 FOR LinkChans
            (Priority = 0) AND completed & FromChan[hc][0] ? token
              HandleChannelRequest(token, hc)

          (Priority = 1) AND (NOT (TNextReg[0] AFTER ClockReg[0])) & SKIP
            HandleTimerRequest(0)

          ALT hc = 0 FOR LinkChans
            (Priority = 1) & FromChan[hc][0] ? token
              HandleChannelRequest(token, hc)

          (Priority = 1) AND (NOT (TNextReg[1] AFTER ClockReg[1])) AND completed & SKIP
            HandleTimerRequest(1)

          ALT hc = 0 FOR LinkChans
            (Priority = 1) AND completed & FromChan[hc][1] ? token
              HandleChannelRequest(token, hc)

          validProcess & SKIP
            IF
              (StatusReg BITAND TimeDelBit) <> 0
                DeleteMiddleStep(Breg, Creg)
              (StatusReg BITAND TimeInsBit) <> 0
                InsertMiddleStep(Areg, Breg, Creg)
              (StatusReg BITAND MoveBit) <> 0
                BlockMoveMiddleStep(Creg, Breg, Areg)
              TRUE
                INT code :
                SEQ
                  BuildNextInstruction(IptrReg, Oreg, code)
                  IF
                    code <> f.opr
                      Primary(code)
                    TRUE
                      Secondary(Oreg)
                  Oreg := 0
: