DataMuseum.dk

Presents historical artifacts from the history of:

RC4000/8000/9000

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about RC4000/8000/9000

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download

⟦ecfcb46ef⟧ TextFile

    Length: 99840 (0x18600)
    Types: TextFile
    Names: »monfpaline«

Derivation

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦84635a524⟧ »kkmon4filer« 
            └─⟦this⟧ 

TextFile

\f


m.                monfpaline - fpa-main, -transmitter and -receiver drivers

b.i30 w.
i0=80 01 24, i1=15 40 00

; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
c.i0-a133
  c.i0-a133-1, a133=i0, a134=i1, z.
  c.i1-a134-1,          a134=i1, z.
z.

i10=i0, i20=i1

i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 
i14=i10/10000  , i10=i10-i14*10000  , i24=i20/10000  , i20=i20-i24*10000 
i13=i10/1000   , i10=i10-i13*1000   , i23=i20/1000   , i20=i20-i23*1000
i12=i10/100    , i10=i10-i12*100    , i22=i20/100    , i20=i20-i22*100
i11=i10/10     , i10=i10-i11*10     , i21=i20/10     , i20=i20-i21*10

i2:  <:                              date  :>
     (:i15+48:)<16+(:i14+48:)<8+46
     (:i13+48:)<16+(:i12+48:)<8+46
     (:i11+48:)<16+(:i10+48:)<8+32

     (:i25+48:)<16+(:i24+48:)<8+46
     (:i23+48:)<16+(:i22+48:)<8+46
     (:i21+48:)<16+(:i20+48:)<8+ 0

i3:  al. w0  i2.       ; write date:
     rs  w0  x2+0      ;   first free:=start(text);
     al  w2  0         ;
     jl      x3        ;   return to slang(status ok);

     jl.     i3.       ;
e.
j.
\f



; fpa 801 driver complex.
;  the fpa 801 driver complex consists of a number of drivers --
;      mainprocess driver
;      line-process drivers: receiver driver
;                            transmitter driver
;      subprocess drivers:   hostprocess driver
;                            general driver
;                            terminal driver
;                            magtape driver
;                            disc driver
;

; block including all drivers.

b.f12,p340,v120 w.

; block including main- and line-drivers.

b.e12 w.

; block including main-process driver.

b.m20,n20,s20 w.

m.                fpa mainprocess



; the following define global formats and constants

v0   =     8               ; highest number of buffers at the same time transmitted to a device
v1   =     12              ; number of bytes in private part of subproc description
v2   =     1<16-1          ; maximum buffer size for datanet
v3   =     16              ; max number of operations at the same time transmitted from a hostproc

; function codes for mainproc
; bit 1<0 should be added if data follows

v31  =     0<2      ;   0  ; create
v32  =     v31+1<1  ;   2  ; answer create
v37  =     1<2      ;   4  ; remove
v38  =     v37+1<1  ;   6  ; answer remove
v35  =     2<2      ;   8  ; release
v36  =     v35+1<1  ;  10  ; answer release
v33  =     3<2      ;  12  ; lookup
v34  =     v33+1<1  ;  14  ; answer lookup

v22  =     10<2     ;  40  ; operator output-input
v23  =     v22+1<1  ;  42  ; answer operator output-input
v24  =     11<2     ;  44  ; operator output
v25  =     v24+1<1  ;  46  ; answer operator output

; smallest function value for the subprocs

v40  = 1<7+0<2      ;  128 ; min subproc func value

; function codes for subprocs
; bit 1<0 should be added, if data follows

v50  = 1<7+3<2      ;  140 ; input
v51  =     v50+1<1  ;  142 ; answer input
v52  = 1<7+4<2      ;  144 ; output
v53  =     v52+1<1  ;  146 ; answer output
v54  = 1<7+5<2      ;  148 ; message
v55  =     v54+1<1  ;  150 ; answer message
v56  = 1<7+6<2      ;  152 ; user name
v57  =     v56+1<1  ;  154 ; answer user name
v58  = 1<7+7<2      ;  156 ; attention
v59  =     v58+1<1  ;  158 ; answer attention

; definition of bitpatterns in state-field of subprocs (p12)

v70  =     2.0001 <8       ; subproc blocked
v71  =     2.0010 <8       ; answer attention pending
v72  =     2.0100 <8       ; messages pending

; bit 0 - 7 are reserved for bufno (used in answer attention)
\f



; process description of subprocess:
;
; monitor part:
; a48:                     ;  interval 
; a49:                     ;  interval 
; a10:                     ;  kind 
; a11:                     ;  name 
; a50:                     ;  mainproc 
; a52:                     ;  reserver 
; a53:                     ;  users 
; a54:                     ;  first message 
; a55:                     ;  last message 
; a56:                     ;  external state 

; specific part:
p0 =a56+2                  ; first(specific part)
p1 =p0+v1                  ; top(specific part)

; mainprocess part:
p11=p1     , p9=p11+1      ;  devhost linkno, jobhost linkno
p10=p11+2  , p8=p10+1      ;  subkind, data quality
p12=p10+2                  ;  state(sub) 
p14=p12+2                  ;  next subprocess 
p15=p14+2                  ;  last subprocess 
p16=p15+2  , p17=p16+1     ;  buffers free  ,  current bufno 
p18=p16+2                  ;  max bufsize(in bytes) 
p7=p18+2   , p6=p7+1       ;  devhost net-id, devhost home-reg
p5=p7+2                    ;  devhost host-id
p13=p5+2                   ;  current message 
p19=p13+2                  ; start(mess buf table):
a79=p19+v0<1               ; top(mess buf table)

c.(:a63-p10:)*(:a63-p10:)-1, m. name error a63
z.
c.(:a64-p12:)*(:a64-p12:)-1, m. name error a64
z.

; process description of mainprocess:
;
; monitor part:
; a48:                      ;  interval 
; a49:                      ;  interval 
; a10:                      ;  kind 
; a11:                      ;  name 
; a50:                      ;
; a52:                      ;  reserver 
; a53:                      ;  users 
; a54:                      ;  first message 
; a55:                      ;  last message 
; a56:                      ; 

; p0                        ; start of spec part:
s0=p0                       ;  start(ne t record) 
s1=s0+2                     ;  top(test buffer) 
s4=s1+2                     ;  start(testbuffer)
s5=s4+2                     ;  top(testbuffer)
                            ;  mask0(00:23) 
s2=s5+4                     ;  mask0(24:47) 
                            ;  mask1(48:71) 
s3=s2+4                     ;  mask1(72:95) 

; subprocess queue:
;                           ; not used
; p14                       ;  next subprocess
; p15                       ;  last subprocess
s16=p15+2     , s17=s16+1   ;  ready flag (operation,mode)
s6=s16+2                    ;  counter
s7=s6+2                    ;  home-reg<16+host-id
\f


; transmit parameters:
; ********************

b. i0 w.
i0=s7+2

; line parameters
p66=i0            , i0=i0+2;  size
p60=i0 ,          , i0=i0+2;  internal status, unused
p65=i0            , i0=i0+2;  first data
p72=i0            , i0=i0+2;  address code, unused
p71=i0            , i0=i0+2;  message buffer

; intermediate control parameters

p79=i0            , i0=i0+2; local function

; packet control parameters

p301=i0 , p302=i0 , i0=i0+2;  rec net-id, rec home-reg
p303=i0           , i0=i0+2;  rec host-id
p304=i0           , i0=i0+2;  packet-id
p305=i0           , i0=i0+2;  facility mask
p306=i0           , i0=i0+2;  priority

; device control parameters

p69=i0 , p78=i0+1 , i0=i0+2;  rec linkno, sender linkno
p64=i0            , i0=i0+2;  size
p61=i0 , p68=i0+1 , i0=i0+2;  function, bufno
p62=i0 , p308=i0+1, i0=i0+2;  state, data quality
p63=i0            , i0=i0+2;  mode

; internal mainproc parameters

p67=i0 ,          , i0=i0+2;  error count, unused
p70=i0            , i0=i0+2;  proc. description
p73=i0 , p76=i0+1 , i0=i0+2;  operation, blockcontrol
p77=i0 , p74=i0+1 , i0=i0+2;  contents, result
p75=i0            , i0=i0+16; header transmit area
\f


; receive parameters
; ******************

; line parameters

p86=i0            , i0=i0+2;  size
p80=i0 ,          , i0=i0+2;  internal status, unused
p85=i0            , i0=i0+2;  first data
p92=i0 ,          , i0=i0+2;  address code, unused
p91=i0            , i0=i0+2;  message buffer

; intermediate control parameters

p99=i0 ,          , i0=i0+2;  local function, unused

; packet control parameters

p321=i0, p322=i0+1, i0=i0+2;  sender net-id, sender home-reg
p323=i0           , i0=i0+2;  sender host-id
p324=i0           , i0=i0+2;  packet-id
p325=i0           , i0=i0+2;  facility mask
p326=i0, p327=i0+1, i0=i0+2;  packets in unit, packetno in unit

; device control parameters

p89=i0 , p98=i0+1 , i0=i0+2;  rec linkno, sender linkno
p84=i0            , i0=i0+2;  size
p81=i0 , p88=i0+1 , i0=i0+2;  function, bufno
p82=i0 , p328=i0+1, i0=i0+2;  result, data quality
p83=i0            , i0=i0+2;  status

; internal mainproc parameters

p87=i0 ,          , i0=i0+2;  error count, unused
p90=i0            , i0=i0+2;  proc. description
p93=i0 , p96=i0+1 , i0=i0+2;  operation, blockcontrol
p97=i0 , p94=i0+1 , i0=i0+2;  contents, result
p95=i0            , i0=i0+16;  header rec. area

p100=i0                    ;  top of std process description

e.                         ;
\f



; definition of internal constants.

p101=(:a84>2a.1:)-1    ; test switch, on: 0, off: -1
p102=(:a82>2a.1:)-1    ; statistics , on: 0, off: -1
p103=1                 ; rc4000: 0, rc8000: 1

a65=p100               ; top of process description

p109=100               ; monitor procedure number of start-io

p110=80                ; kind of mainproc
p111=82                ; kind of hostproc
p112=84                ; kind of local subproc
p113=85                ; kind of free or remote subproc
p114=86                ; kind of receiver
p115=88                ; kind of transmitter

p120=2.0000            ; state:=ready
p121=2.0001            ; state:=waiting for buffers
p122=2.0010            ; state:=waiting for poll

p140=5                 ; max number of errors
p141=50                ; max number of errors using short timer under initiation

p160=0                 ; internal status:=ok
p161=1                 ; internal status:=wait
p162=2                 ; internal status:=skip
p163=3                 ; internal status:=reject
p164=-1                ; internal status:=regret

p210=p0+42+7*6         ; rel top of proc desc(rec)
p211=p0+58+7*6         ; rel top of proc desc(trm)

p200=p100-a220         ; start(receiver proc) - start (mainproc)
p201=p200+p210-a220    ; start(transmitter proc) - start(mainproc)
p202=p201+p211-a250    ; start(hostproc) - start(mainproc)


; format of startbyte:
;  (0:0)  blocknumber mod 2
;  (1:3)  not used
;  (4:4)  data bit
;  (5:5)  header bit
;  (6:6)  data flag
;  (7:7)  special function bit

; format of header block:
;  line control:
;   word0   (00:15)  size of succeeding text block
;  host control:
;           (16:23)  local function
;   word1   (08:15)  net-id
;           (16:23)  home-reg
;   word2   (00:15)  host-id
;  message control:
;   word4   (15:23)  format
;   word5   (00:23)  depends on format
;   word6   (00:23)  depends on format
;   word7   (00:23)  depends on format
;
; if device control protocol (format=0) then
;  device control:
;           (15:23)  sender linkno
;   word5   (00:05)  data quality
;           (06:15)  receiver linkno
;   word5,6 (16:07)  size
;   word6   (08:15)  bufferno
;           (16:23)  function
;   word7   (00:02)  state/result
;           (03:15)  mode/status

; format of statusbyte:
;  (0:0)  blocknumber mod 2
;  (1:3)  not used
;  (4:5)  blockcontrol
;  (6:6)  blocklength flag
;  (7:7)  parity flag

; the value of operation should be interpreted in this way:
;    value= 2.00xxxxxx1x : the block contains a data area
;           2.00xxxxx1xx : the block contains a header area
;           2.00xxxx11xx : the header implies a data block
;           2.xxxx01xxxx : short delay (wait delay, reset delay)
;           2.xxxx10xxxx : long delay (poll delay)
;           2.xxxxxxxxx1 : error actions off
;           2.xxx1xxxxxx : initiate
;           2.xx1xxxxxxx : reset
;           2.01xxxxxxxx : master clear
;           2.10xxxxxxxx : accept master clear
\f



; log and test facility.

;  format of test record:
;   +0 :  type, length(record)
;   +2 :  time1
;   +4 :  time2
;   +6 :  test information
;   +8 :  ...
;   +10:  ...
;
;  the call of the test facility is performed like this:
; b.f1 w.              ;
;    rs. w3  f0.       ; save w3;
;    jl. w3  f4.       ; check condition(type,on/off);
;    <type>            ;  type of test point
; f0:<saved w3>        ;  saved w3
;                      ;  off: w0-w2: unchanged, w3: saved w3;
;    jl.     f1.       ;   goto end of test;
;    .....             ;  on:  w0-w2: unchanged, w3: start(internal test area);
;    .....             ;   pack testinformation;
;    al  w0  <first>   ;  first:=first(test area);
;    al  w1  <last>    ;  last:=last(test area);
;    jl. w3  f5.       ;  create test record;
; f1:                  ; end of test:
; e.                   ;

; the entry f6 may be used instead of f5 to
; generate the testrecord.
; additionally it will cause testoutput-generation to stop after
; the number of records specified in w2. 

c.p101

; saved w-registers:
f0:  0                 ;  w0
f1:  0                 ;  w1
f2:  0                 ;  w2
f3:  0                 ;  w3

; parameters:
f7:  0                 ;  proc
f8:  0                 ;  buffer
f9:  0                 ;  type, length

; internal test area:
f10: 0, r.12           ; start:
f11=k-f10              ;   size of test area


; check condition(type,on/off).
;  checks the type of the test point stored in link against the test mask.
;  if test is off then the procedure returns to link+4. test on implies
;  that the test record is initiated, the registers are saved and return is made to link+6.
;        call:         return:
; w0                   unchanged
; w1                   unchanged
; w2                   unchanged
; w3     link          saved w3 (off), start(internal test area) (on)
b.i0,j1 w.
f4:  ds. w1  f1.       ; check condition:
     rs. w2  f2.       ;
     rs. w3  i0.       ;   save link;
     rl  w0  x3+2      ;
     rs. w0  f3.       ;   save saved w3;
     gg  w0  8.61<1    ;   w0:=register select switches;
     so  w0  1<5<1     ;   if left bit off then
     jl.     j0.       ;     goto exit2;
     rl  w1  b19       ;   proc:=current proc;
     rl  w0  x1+a10    ;
     se  w0  p110      ;   if kind(proc)<>mainprockind then
     rl  w1  x1+a50    ;     proc:=mainproc(proc);
     rl  w0  x1+a10    ;
     se  w0  p110      ;   if kind(proc)<>mainprockind then
     jl.     j0.       ;     goto exit2;
     rs. w1  f7.       ;   save proc;
     rl  w3  x3        ;
     sl  w3  48        ;   if type>=48 then
     am      s3-s2     ;     mask:=mask1;
     dl  w1  x1+s2     ;     shift:=type-48;
     sl  w3  48        ;   else
     am      -48       ;     mask:=mask0;
     ld  w1  x3        ;     shift:=type;
     sl  w0  0         ;   if mask shifted shift>=0 then
     jl.     j0.       ;     goto exit2;
     hs. w3  f9.       ;   type:=type of test point;
     dl. w1  f1.       ;
     rl. w2  f2.       ;   restore w0-w2;
     al. w3  f10.      ;   w3:=start(test area);
     am.    (i0.)      ;
     jl      +6        ; exit1: return to link+6;

j0:  dl. w1  f1.       ; exit2:
     dl. w3  f3.       ;   restore w0-w3;
     am.    (i0.)      ;
     jl      +4        ;   return to link+4;

i0:  0                 ; saved link;
e.

; create test record.
;  creates a test record with the format shown above.
;        call:         return:
; w0     first         saved w0
; w1     last          saved w1
; w2                   saved w2
; w3     link          saved w3
b.i6,j6 w.
f5:  al  w1  x1+2      ; create test record:
     ds. w1  i1.       ;   top:=last+2;
     ds. w3  i3.       ;   save w0-w3;
     rl  w1  b19       ;
     rx. w1  f7.       ;   current proc:=mainproc;
     rs  w1  b19       ;   save old buffer;
j0:  rl. w2  i1.       ; start:
     ws. w2  i0.       ;   length(record):=
     al  w2  x2+6      ;     top-first+6;
     hs. w2  f9.+1     ;   save length;
     wa  w2  x1+s0     ;   start(next record):=
     sh  w2 (x1+s1)    ;     start(next record)+length;
     jl.     j2.       ;   if start(next record)>top(test buffer) then
                       ;     goto insert;
j1:  rl  w2  x1+s1     ; insert dummy end record:
     ws  w2  x1+s0     ;   length(dummy record):=top(test buffer)-start(next record);
     sl  w2  1         ;   if length(dummy record)>0 then
     rs  w2 (x1+s0)    ;     dummy record:=0,length;
j5:  al  w0  0         ; send answer:
     rs  w0  x1+s0     ;   start(next record):=0;
     dl  w0  x1+s5     ;
     ds  w0  x1+s1     ;
     jl.     j0.       ;   goto start;
                       ; insert:
j2:  rx  w2  x1+s0     ;
     rl. w0  f9.       ;   insert
     rs  w0  x2        ;     type, length;
     jd      1<11+36   ;   get clock;
     ds  w1  x2+4      ;   insert time in testrecord;
     al  w2  x2+4+2    ;
     rl. w3  i0.       ;
j3:  sl. w3 (i1.)      ;   transfer test information;
     jl.     j4.       ;
     rl  w0  x3        ;
     rs  w0  x2        ;
     al  w2  x2+2      ;
     al  w3  x3+2      ;
     jl.     j3.       ;
j4:  rl. w1  f7.       ; exit:
     rx  w1  b19       ;   restore current proc
     rl  w2  x1+s6     ;   if counter(main)<>0 then
     sn  w2  0         ;   begin comment: generation stopping;
     jl.     j6.       ;     counter(main):= counter(main)-1
     al  w2  x2-1      ;
     rs  w2  x1+s6     ;     if counter(main)=0 then
     se  w2  0         ;     testmask(main):= 0
     jl.     j6.       ;
     ld  w0  -100      ;
     ds  w0  x1+s2     ;
     ds  w0  x1+s3     ;
j6:  dl. w1  f1.       ;
     dl. w3  f3.       ;   restore w0-w3;
     jl.    (i3.)      ;   return to calling program;

i0:  0                 ;  first
i1:  0                 ;  last
i2:  0                 ;
i3:  0                 ;  link

e.

; procedure stop testoutput
;
; this procedure will generate a testrecord.
;
; additionally it will stop testoutput after generation
; of the number of records specified in w2 at call.
; 
; function: a counter in mainproc is set to the value
; specified in w2. when the counter is nonzero, it is decreased
; by one after generation of each testrecord. if this makes
; the counter zero, the testmask is set to zero.
; 
; after one call of f6, further calls will only change
; the counter, if the value specified in w2 is less than the
; current value of the counter (provided, the counter is
; nonzero).
;
;        call          return
; w0                   value before testpoint
; w1                   value before testpoint
; w2     counter       value before testpoint
; w3     link          value before testpoint

b. i0 w.               ;
f6:                    ;
     rs. w3  i0.       ;  save link
     rl. w3  f7.       ;  
     rx  w2  x3+s6     ;  if counter(main)=0 or
     se  w2  0         ;     counter(main)>counter then
     sl  w2  (x3+s6)   ;
     jl.     +4        ;
     rx  w2  x3+s6     ;  counter(main):= counter
     rl. w3  i0.       ;  link:= saved link
     jl.     f5.       ;  goto create testrecord
                       ;
i0:  0                 ; saved link
e.                     ;

z.
\f


; mainprocess.
;
; the mainprocess accepts messages of the following types:
;   start transmitter  0<12
;   start              2<12
;   reset              4<12
;   transfer block     5<12
;   autoload           6<12
;   master clear       8<12
;   set mask          12<12
;
;  mode in start transmit mess:
;   0  poll
;   1  accept master clear
;   2  reset, initiate, poll
;   3  reset, initiate, accept master clear
;
;
  
;  mode in reset mess:
;   0  remote subprocs are removed; local subprocs are cleaned i. e.
;      pending messages are returned with result 4 (malfunction).
; 
;   2  all subprocs are removed.
  
; to execute operations the sender must be
;  op: 0  ..
;      3  reserver of main or receiver
;      4  reserver of main
;      5  reserver of main or transmitter
;      6  reserver of main
;      8  reserver of main
;     12  neither reservation nor user inclusion is demanded
\f


b.i10,j10 w.

     a0=1<23           ;
     a0>0+a0>3+a0>4+a0>5+a0>6+a0>8+a0>12
i0:  a0>0+a0>1+a0>2+a0>3


h80: bz  w0  x2+8      ; start main:
     sn  w0  12        ;   if op=12 then
     jl.     j10.      ;     goto setmask;
     sz  w0  2.1       ;   if operation odd then
     am      g14-g15   ;     check user;
     jl  w3  g15       ;   else check reserver;
     dl. w1  i0.       ;
     jl  w3  g16       ;   check operation(0.3.4.6.8.12,0);
     rl  w1  b19       ;
     jl.     m10.      ;   goto supervise;

j10: rl  w1  b19       ; set mask:
     dl  w0  x2+12     ;
     ds  w0  x1+s2     ;   mask0:=mask(0:47);
     dl  w0  x2+16     ;
     ds  w0  x1+s3     ;   mask1:=mask(48:95);
     al  w0  0         ;
     rs  w0  g20       ;   status:=0;
     jl  w3  g18       ;   deliver result1;
     jl     (b20)      ; exit: return to sender;
e.
\f



; initiate part.

b.i10,j10 w.
i2:  0<12+2.00         ; message: start transmitter, poll
i6:  0<12+2.10         ; message: start transmitter, reset, initiate, poll
i7:  0<12+2.11         ; message: start transmitter, reset, initiate, accept master clear
i4:  0,r.7             ; answer: dummy
i5:  0                 ; saved message buffer


; entry from send message.

; w1: main, w2: addr(message buffer).

m10: rl  w3  x2+8      ; supervise:
     rs. w2  i5.       ; save mess buffer;
     rs  w3  x1+s16    ;   operation:=operation(message);
c.p101 b.f1 w.         ;*****test1*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     1                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2+8      ;   dump message(0:8);
     al  w1  x2+8+8    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test1*****
     bz  w3  6         ;
     am      x3        ;
     jl.    (x3+2)     ;   goto case operation of
     m11               ;    (0: start transmitter(mode),
     -1                ;     1: not allowed,
     -1                ;     2: not allowed,
     m12               ;     3: receive block,
     m13               ;     4: reset,
     m14               ;     5: transmit block,
     m14               ;     6: autoload,
     -1                ;     7: not allowed,
     m15               ;     8: master clear);

; reset.
m13: bz  w0  x1+s17    ; reset: function:= mode(mess);
     jl. w3  n14.      ;   clear subprocesses(main,function);
     rl. w2  i5.       ;   load mess buffer;
     al  w0  0         ;
     rs  w0  g20       ;   status(mess):=0;
     jl  w3  g18       ;   deliver result(status);
     jl     (b20)      ;   goto std waiting point;

; start transmitter.
m11: jl  w3  g18       ; start transmitter: deliver result1(dummy);
     al. w1  i4.       ;
     rl. w2  i5.       ;
     jd      1<11+18   ;   wait answer;
     rl  w1  b19       ;
     jl. w3  n5.       ;   set host-id;
     al  w0  0         ;
     hs  w0  x1+p67    ;   errorcount:=0;
j2:  al  w0  4         ; repeat: function:= clean;
     jl. w3  n14.      ;   clear subprocesses(main,function);
     bz  w0  x1+p67    ;
     ba. w0  1         ;   errorcount:=errorcount + 1;
     hs  w0  x1+p67    ;
     sl  w0  p141      ;   if errorcount>max errorcount then
     am      4.00200   ;     operation:=long delay;
     al  w3  4.00000   ;   else operation:=no delay;
     bz  w0  x1+s17    ;
     sz  w0  2.01      ;   if mode=accept master clear then
     am      4.20000   ;     operation:=operation and acc master clear,no test;
     al  w3  x3+4.00001;   else operation:=operation and dummy,no test;
     sz  w0  2.10      ;   if mode=initiate then
     al  w3  x3+4.03100;     operation:=operation and reset,short delay, initiate;
     hs  w3  x1+p73    ;   operation(trm):=operation;
     jl. w3  e11.      ;   call transmitter(operation);
c.p101 b.f1 w.         ;*****test4*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     4                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p73    ;
     al  w1  x1+p77    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test4*****
     bl  w0  x1+p74    ;
     se  w0  0         ;   if result<>0 then
     jl.     j2.       ;     goto repeat;
     rs  w0  x1+s16    ;   ready flag:=running;
     jl.     m2.       ;   goto continue transmit;

; receive block.
m12: al  w1  x1+p200   ; receive block:
     rs  w1  b19       ;   curr:=receiver;
     jl.     h86.      ;   goto receiver;

; transmit block, autoload.
m14: al  w1  x1+p201   ; transmit block, autoload:
     rs  w1  b19       ;   curr:=transmitter;
     jl.     (h87.)    ;   goto transmitter;

; transmit master clear.
m15: al  w0  0         ; transmit master clear:
     rs  w0  g20       ;   status(mess):=0;
     jl  w3  g18       ;   deliver result1(status);
     rl  w1  b19       ;
m16: al  w0  0         ; break-down:
     hs  w0  x1+p67    ;   errorcount:=0;
c.p101 b.f1 w.         ;*****test7*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     7                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test7*****
     jl. w3  n5.       ;   set host-id;
j0:  al  w0  4         ; repeat: function:= clean;
     jl. w3  n14.      ;   clear subprocesses(main,function);
     bz  w0  x1+p67    ;
     ba. w0  1         ;   errorcount:=errorcount + 1;
     hs  w0  x1+p67    ;
     sl  w0  p141      ;   if errorcount>max errorcount then
     am      4.00100   ;     delay:=long delay;
     al  w0  4.13101   ;   else delay:=short delay;
     hs  w0  x1+p73    ;   operation(trm):=master clear,initiate,reset,delay,error action off;
     jl. w3  e11.      ;   call transmitter(operation);
     bl  w0  x1+p74    ;
c.p101 b.f1 w.         ;*****test5*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     5                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test5*****
     se  w0  0         ;   if result<>ok then
     jl.     j0.       ;     goto repeat;
j1:  al  w0  4.03111   ;   operation(rec):=initiate,reset,short delay,
     hs  w0  x1+p93    ;                   header,error actions off;
     jl. w3  e10.      ;   call receiver(operation);
     bl  w0  x1+p94    ;
c.p101 b.f1 w.         ;*****test6*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     6                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test6*****
     sn  w0  8         ;   if result=abnormal termination(reset rec) then
     jl.     j1.       ;     goto restart rec;
     se  w0  10        ;   if result<>accept master clear then
     jl.     j0.       ;     goto repeat;
     al. w2  i2.       ;   message:=start trm, poll;
     jl. w3  n4.       ;   send trm message(message);
     al  w0  4.01010   ;
     hs  w0  x1+p93    ;   operation:=initiate,header;
     jl.     m0.       ;   goto start receiver;


; master clear received from device controller.
m8:  al  w0  4         ; master clear received: function:= clean;
     jl. w3  n14.      ;   clear subprocesses(main,function);
c.p101 b.f1 w.         ;*****test2*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     2                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test2*****
     al. w2  i7.       ;   message:=start trm, reset, initiate, acc master clear;
     jl. w3  n4.       ;   send trm message(message);
     al  w0  4.01010   ;
     hs  w0  x1+p93    ;   operation:=initiate,header;
     jl.     m0.       ;   goto start receiver;

e.
h87:         h88       ; address of start transmit
\f


; receive part.

b.j10,i10 w.

m0:  jl. w3  e10.      ; start receive: call receiver;
m3:  bz  w3  x1+p94    ; continue receive:
c.p101 b.f1 w.         ;*****test8*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     8                 ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p86    ;
     al  w1  x1+p95+14 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test8*****
     se  w3  0         ;   if result<>ok then
     jl.     j8.       ;     goto check result;
     bz  w0  x1+p97    ;
     so  w0  4.00002   ;   if no dataflag then
     jl.     j0.       ;    goto header;
     hs  w3  x1+p80    ; data: internal status:=result(:=0);
     rl  w2  x1+p90    ;   sub:=sub(rec);
     jl. w3  e4.       ;   call entry4(sub);
     bz  w0  x1+p97    ;
j0:  so  w0  4.00010   ; header: if no headerbit then
     jl.     j4.       ;     goto ok;
     jl. w3  n0.       ;   packout(header);
     bz  w0  x1+p99    ;  if local function=
     sn  w0  1         ;     host disconnect then
     jl.     j9.       ;  goto clear up
     se  w0  0         ;
     sn  w0  3         ;  if local function<>0 and
     jl.     +4        ;     local function<>3 then
     jl.     j2.       ;  goto reject
     bl  w0  x1+p81    ;
     al  w2  x1+p202   ;   if func(header)>=min subproc func value then
     sh  w0  v40-1     ;     sub:=subproc(rec);
     rs  w2  x1+p90    ;   else
     rl  w2  x1+p90    ;     sub:=hostproc(main);
     se  w1 (x2+a50)   ;   if main(sub)<>main then
     jl.     j2.       ;     goto reject;
     bz  w0  x1+p97    ;   if no databit then
     so  w0  4.00020   ;     goto out;
     jl.     j1.       ;
     jl. w3  e3.       ;   call entry3(sub);
     bz  w0  x1+p80    ;
     al  w3  4.00012   ;  operation:= if internal status=ok then
     se  w0  p160      ;              data else header
     al  w3  4.00010   ;
     jl.     j6.       ;   goto setup1;
j1:  jl. w3  e4.       ; out:
     bz  w0  x1+p80    ;   call entry4(sub);
     jl.     j5.       ;   goto setup;

j2:  am      p163-p162 ; reject: blockcontrol:=reject;
j3:  am      p162-p160 ; skip:   blockcontrol:=skip;
j4:  al  w0  p160      ; ok:     blockcontrol:=ok;
j5:  al  w3  4.00010   ; setup: operation:=header;
j6:  hs  w0  x1+p96    ; setup1: blockcontrol(main):=blockcontrol;
     hs  w3  x1+p93    ;   operation(main):=operation;
     ld  w0  -100      ;
     ds  w0  x1+p95+2  ;   clear header rec area;
     ds  w0  x1+p95+6  ;
     ds  w0  x1+p95+10 ;
     ds  w0  x1+p95+14 ;
     jl.     m0.       ;   goto start receive;

j8:                    ; check result:
c.p101 b.f1 w.         ;*****test9*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     9                 ;
f0:  0                 ;
     jl.     f1.       ;
     al. w0  f0.       ;
     al. w1  f1.       ;
     al  w2  2         ;
     jl. w3  f6.       ;
f1:                    ;
e.z.                   ;*****test9*****
     sn  w3  9         ;   if result=master clear then
     jl.     m8.       ;     goto master clear;
     sl  w3  4         ;   i result>3 then
     jl.     m16.      ;     goto break-down;
     al  w3  x3+3      ;   internal status:=result+3;
     hs  w3  x1+p80    ;
     rl  w2  x1+p90    ;   sub:=sub(rec);
     jl. w3  e4.       ;   call entry4(sub);
     jl.     j3.       ;   goto skip;

; a host has been disconnected from the network.
; w1= main

j9:  rl  w0  x1+p323   ;  host:= sender host-id(rec)
     bz  w2  x1+p321   ;  net:= sender net-id(rec)
     jl. w3  n15.      ;  clear subprocces(host, net, main)
     jl.     j4.       ;  goto ok
e.
\f


; transmit part.

b.j10, i10 w.

m1:  jl. w3  e11.      ; start transmit: call transmitter;
m2:  bz  w3  x1+p74    ; continue transmit:
c.p101 b.f1 w.         ;*****test12*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     12                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p66    ;
     al  w1  x1+p75+14 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test12*****
     se  w3  0         ;   if result<>0 then
     jl.     j6.       ;     goto result-error;
     bz  w3  x1+p76    ;   status:=blockcontrol;
j2:  hs  w3  x1+p60    ; insert: internal status:=status;
     bz  w0  x1+p77    ;
     sn  w0  2.0000    ;   if contents=dummy then
     jl.     j1.       ;     goto get-next;
     sz  w0  2.1000    ;   if databit 
     se  w3  p160      ;   or result<>ok then
     jl.     j0.       ;     goto aftertrm;
     al  w0  4.00002   ;
     hs  w0  x1+p73    ;   operation:=data;
     jl.     m1.       ;   goto start transmit;
                       ; aftertrm:

j0:  rl  w2  x1+p70    ;   sub:=subproc(trm);
     jl. w3   n12.     ;   queue out(sub);
     rl  w0  x2+a50    ;   if main(sub)<>main then
     se  w0  x1        ;
     jl.     j1.       ;   goto get next subprocess
     jl. w3  e2.       ;   call entry2(sub);
                       ;   goto get next subprocess;
e7:                    ; entry-get next:
j1:  rl  w2  x1+p14    ; get next:
     sn  w2  x1+p14    ;    if queue is empty then
     jl.     j4.       ;     goto poll;
     al  w2  x2-p14    ;
     bz  w0  x1+p60    ;
     sn  w0  p161      ;   if internal status=wait and
     se  w2 (x1+p70)   ;   and new sub=proc desc then
     am      -4.00100  ;     operation:=short delay
     al  w0  4.00100   ;   else operation:=no delay;
     hs  w0  x1+p73    ;
     ld  w0  -100      ;
     ds  w0  x1+p60    ;
     ds  w0  x1+p72    ;
     ds  w0  x1+p79    ;
     ds  w0  x1+p303   ;
     ds  w0  x1+p64    ;
     ds  w0  x1+p62    ;
     rs  w0  x1+p63    ;
     rs  w2  x1+p70    ;   subproc(rec):=subproc(queue);
     jl. w3  e1.       ;   call entry1(sub);
     bz  w0  x1+p60    ;
     se  w0  p160      ;   if internal status<>ok then
     jl.     j3.       ;     goto regretted;
     jl. w3  n1.       ;   packin(header);
     rl  w0  x1+p66    ;
     bz  w3  x1+p73    ;
     se  w0  0         ;  if lineparam.size<>0 then
     am      4.00020   ;     operation:=header, data;
     al  w3  x3+4.00010;   else
     hs  w3  x1+p73    ;     operation:=transmit header;
     jl.     m1.       ;   goto start transmit;

j3:  jl. w3  n12.      ; regretted: queue out(sub);
     jl.     j1.       ;   goto get next;

j4:  al  w0  4.00200   ; poll:
     hs  w0  x1+p73    ;   operation:=long delay;
     jl.     m1.       ;   goto start transmit;

j5:                    ; special actions:

j6:                    ; result-error:
c.p101 b.f1 w.         ;*****test13*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     13                ;
f0:  0                 ;
     jl.     f1.       ;
     al. w0  f0.       ;
     al. w1  f0.       ;
     al  w2  4         ;
     sh. w2 (f0.)      ;
     am      f6-f5     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test13*****
     sl  w3  4         ;   if max errors exceeded then
     jl.     m16.      ;     goto break-down;
     al  w3  x3+3      ;   status:=result+3;
     jl.     j2.       ;   goto insert;

e.

\f


; main help procedures.
; packout.
;        call:        return:
; w0                  destroyed
; w1     main         unchanged
; w2                  unchanged
; w3     link         destroyed


b. i10 w.
n0:                    ; packout:
     ds. w3  i1.       ;  save link and w2
     dl  w0  x1+p95+2  ;  unpack
     al  w2  0         ;
     ld  w3  16        ;
     rs  w2  x1+p86    ;   line.size
     al  w2  0         ;
     ld  w3  8         ;
     hs  w2  x1+p99    ;   local function
                       ;
     ld  w0  16        ;
     la. w3  i2.       ;
     hs  w3  x1+p321   ;   sender net-id
     ld  w0  8         ;
     la. w3  i2.       ;   sender home-reg
     hs  w3  x1+p322   ;
                       ;
     rl  w0  x1+p95+4  ;
     ls  w0  -8        ;
     rs  w0  x1+p323   ;   sender host-id
                       ;
     dl  w3  x1+p95+10 ;
     ld  w3  8         ;
     la. w2  i3.       ;
     hs  w2  x1+p98    ;   sender linkno
     al  w2  0         ;
     ld  w3  6         ;   
     hs  w2  x1+p328   ;   data quality
     ls  w3  -14       ;
     bz  w0  x1+p99    ;
     se  w0  3         ;   if local function=3 (regretted) then
     jl.     i10.      ;     exchange sender linkno, receiver linkno;
     bz  w0  x1+p98    ;
     hs  w3  x1+p98    ;
     rl  w3  0         ;
i10: hs  w3  x1+p89    ;
     ls  w3  1         ;   index:=rec linkno*2 + name table start;
     wa  w3  b4        ;
     rl  w3  x3        ;  current proc(main):= proc(index)
     rs  w3  x1+p90    ;
                       ;
     dl  w0  x1+p95+14 ;
     al  w2  0         ;
     ld  w3  16        ;
     rs  w2  x1+p84    ;   header.size
     al  w2  0         ;
     ld  w3  8         ;
     hs  w2  x1+p88    ;   bufno
                       ;
     rl  w2  0         ;  
     la. w2  i4.       ;
     rs  w2  x1+p83    ;   status
     al  w3  0         ;
     ld  w0  8         ;
     hs  w3  x1+p81    ;   function
     al  w3  0         ;
     ld  w0  3         ;
     hs  w3  x1+p82    ;   result
                       ;
     dl. w3  i1.       ;  restore w2
     jl      x3        ;  goto link  

i0:  0                 ;  saved w2
i1:  0                 ;  saved w3
i2:  8.377             ;  last 8 bits
i3:  8.1777            ;  last 10 bits
i4:  8.177777          ;  last 16 bits

e.                     ; end of packout

; packin.
;        call:         return:
; w0                   destroyed
; w1     main          unchanged
; w2                   unchanged
; w3     link          unchanged
b. i10 w.
n1:                    ; packin:
     rs. w3  i0.       ;  save link
     rl  w2  x1+p66    ;  packin
     ls  w2  8         ;  size
     ba  w2  x1+p79    ;
     rs  w2  x1+p75+0  ;   local function
                       ;
     bz  w3  x1+p301   ;   format(packet):= 0
     ls  w3  8         ;   rec net-id
     ba  w3  x1+p302   ;
     ds  w3  x1+p75+2  ;   rec home-reg
                       ;
     rl  w2  x1+p303   ;   rec host-d
     rl  w3  x1+p304   ;   packet-id
     rl  w0  x1+p305   ;   facility mask
                       ;
     ls  w2  8         ;
     ls  w0  8         ;
     ld  w0  -8        ;
     wa  w2  6         ;
     rs  w2  x1+p75+4  ;
     rs  w0  x1+p75+6  ;
                       ;
     bz  w2  x1+p78    ;   format(mes):= 0, sender linkno
     al  w3  0         ;
     ld  w3  -8        ;
     rs  w2  x1+p75+8  ;   data quality
     bz  w2  x1+p308   ;
     ls  w2  10        ; 
     wa  w2  6         ;
     ba  w2  x1+p69    ;   receiver linkno
     rs  w2  x1+p75+10 ;
                       ;
     rl  w2  x1+p64    ;   size
     ls  w2  8         ;
     ba  w2  x1+p68    ;   bufferno
     rs  w2  x1+p75+12 ;
                       ;
     bz  w3  x1+p61    ;
     ls  w3  3         ;   function
     ba  w3  x1+p62    ;
     ls  w3  13        ;
     lo  w3  x1+p63    ;   mode
     rs  w3  x1+p75+14 ;
                       ;
     jl.     (i0.)     ;  goto return

i0:  0                 ; saved link

e.                     ; end of packin


; send trm message.
;        call:         return:
; w0                   destroyed
; w1     main          unchanged
; w2     addr(mess)    destroyed
; w3     link          destroyed
b.i4 w.
n4:  rs. w3  i0.       ; send trm message: save link;
     dl  w0  x1+a11+2  ;
     ds. w0  i2.       ;
     dl  w0  x1+a11+6  ;   transfer name of main proc;
     ds. w0  i3.       ;
     al  w1  x2        ;   message:=message;
     al. w3  i1.       ;   receiver:=main;
     jd      1<11+16   ;   send message;
     rl  w1  b19       ;
     jl.    (i0.)      ; exit: return to link;
i0:  0                 ;  saved link
i1:  0                 ;  name of mainproc
i2:  0                 ;
     0                 ;
i3:  0                 ;
     0                 ;  name table entry
e.


; set host-id.
;        call:         return:
; w0
; w1     main          unchanged
; w2
; w3     link          destroyed
b.i1 w.
n5:  rs. w3  i0.       ; set host-id: save link;
     rl  w0  x1+s7     ;
     la. w0  i1.       ;   host-id(main):=
     rs  w0  x1+p303   ;     host-id(main);
     rl  w0  x1+s7     ;
     ls  w0  -16       ;   home-reg(trm):= home-reg(main);
     hs  w0  x1+p302   ;
     al  w0  2         ;   local function(trm):= host-up;
     hs  w0  x1+p79    ;
     jl. w3  n1.       ;   packin;
     jl.    (i0.)      ; exit: return to link;
i0:  0                 ;  saved link
i1:  8.17 7777         ;  last 16 bits
e.


; queue out(sub).
; removes a subprocess from the process queue of the mainprocess.
;        call:         return:
; w0                   unchanged
; w1                   unchanged
; w2     subproc       unchanged
; w3     link          destroyed
b.i6 w.
v103:                  ;
n12: ds. w3  i1.       ; queue out:
     al  w2  x2+p14    ;
     jl  w3  d5        ;   remove element;
     rl. w2  i0.       ;
     jl.    (i1.)      ; exit: return;
i0:  0                 ; saved w2
i1:  0                 ; saved link
e.
; clear all subprocesses(main,function).
;         call:         return:
; w0      function      destr.
; w1      main          unchanged
; w2                    destr.
; w3      link          destr.
;
; function = 0: remote subprocs are removed ; local subprocs are cleaned
;               i. e. pending messages are returned with result 4.
;  
;            2: all subprocs are removed.
;
;            4: all subprocs are cleaned.
  
b.i10,j10 w.
n14: ds. w0  i8.       ; clear subprocesses:
     al  w2  x1+p202   ;   proc:=host;
     jl. w3  n16.      ;   clean subprocess(proc);
     al  w2  x2+p19    ;
     al  w0  0         ;
j4:  rs  w0  x2        ;   for bufno:=0,1,..,v3-1 do
     al  w2  x2+2      ;     message(bufno):=0;
     sh  w2  x1+p100-a48+p19+v3<1-2 ;
     jl.     j4.       ;
     al  w0  0         ;   host-id:=undefined;
     jl. w3  n15.      ;   clear subprocesses(host-id,main,net-id);
     al  w0  2         ; 
     rs. w0  i8.       ;   function:= 2(remove);
     jl.     (i7.)     ; exit: return
i7:  0                 ;   saved link
i8:  2                 ;   function


; clear subprocesses(host-id,main,net-id).
; the procedure clears all subprocesses that are connected to the device
; host in question. if the host-id has dummy value (=0) then all
; subprocesses connected to the main process are cleared.
;        call          return
; w0     host-id       destroyed
; w1     main          unchanged
; w2     net-id        destroyed
; w3     link          destroyed
n15: ds. w1  i1.       ; clear subprocesses:
     ds. w3  i3.       ;   save w0-w3;
     rl  w3  b4        ;   entry:=first entry in name table ;
     al  w3  x3-2      ;
j0:  al  w3  x3+2      ; next: entry:=next entry in name table;
     sl  w3 (b5)       ;   if entry>last dev entry then
     jl.    (i3.)      ; exit: return;
     rl  w2  x3        ;   proc:=proc(entry);
     se  w1 (x2+a50)   ;   if mainproc(proc)<>mainproc then
     jl.     j0.       ;     goto next;
     rl  w0  x2+a10    ;   kind:= kind(proc);
     se  w0  p112      ;   if kind <> remote subkind and
     sn  w0  p113      ;      kind <> local subkind
     jl.     j7.       ;      then goto next;
     jl.     j0.       ;
j7:
     rl. w0  i0.       ;
     sn  w0  0         ;   if host-id<>dummy then
     jl.     j1.       ;     if host-id<>host-id(sub)
     se  w0 (x2+p5)    ;     or net-id<>net-id(sub) then
     jl.     j0.       ;       goto next;
;    bz  w0  x2+p7     ;
;    se. w0 (i2.)      ;***fjernet indtil net-id er defineret
;    jl.     j0.       ;
j1:  rs. w3  i4.       ;
     rl. w3  i8.       ;
     jl.     (x3+2)    ;   goto case function of
             j5        ;   (0: remove temp,
             j6        ;    2: remove subproc,
             j2        ;    4: clean subproc)
j5:  rl  w0  x2+a10    ; remove temp:
     sn  w0  p112      ;   if proc = local subproc 
     jl.     j2.       ;      then goto clean subproc;
     se  w0  p113      ;   if proc = remote subproc
     jl.     j3.       ;      then goto remove subproc;
j6:  am      +2        ; remove subproc: remove subproc(proc);
j2:  jl. w3  (i5.)     ; clean subproc:  clean subproc(proc);
j3:  rl. w3  i4.       ;
     jl.     j0.       ;
i0:  0                 ;   saved host-id
i1:  0                 ;   saved main
i2:  0                 ;   saved net-id
i3:  0                 ;   saved link
i4:  0                 ;   name table address
i5:  v101              ;   address of clean subproc
i6:  v102              ;   address of remove remote subprocess
e.

; clean subproc(proc).
; cleans the sub process by returning all messages in the mess buffer queue with dummy answer.
;        call:         return:
; w0                   destroyed
; w1                   unchanged
; w2     sub           unchanged
; w3     link          destroyed
b.i3 w.
v101:                  ;
n16: rs. w3  i0.       ; clean subproc:
     rs. w1  i1.       ;   save w1;
     al  w1  x2        ;
     rx  w2  b19       ;   cur proc:=sub;
     rs. w2  i2.       ;   save old curr proc;
     jl. w3 (i3.)      ;   clear subproc message queue;
     dl. w2  i2.       ;
     rx  w2  b19       ;   curr proc:=old curr proc;
     jl. w3  n12.      ;   queue out;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
i1:  0                 ; saved w1
i2:  0                 ; saved old curr proc
i3:  v100              ;   address of clear subproc mess queue;
e.
\f


; each subdriver has six entry points with the functions:
;
; entry0 (deliver message):
;   used when send message delivers a message to the subexternal process.
;
; entry1 (set up operation):
;   used when the mainproc wants the subdriver to start an operation.
;
; entry2 (end transfer):
;   used when the operation - and the datablock - has been sent, and
;   the receipt received.
;
; entry3 (receive operation):
;   used when a header that includes a following datablock is received.
;
; entry4 (end receive):
;   used when the receive operations are finished.
;
; entry5 (initiate process):
;   used after creation of the subprocess.
;
; contents of registers entering the subprocess:
;   w0: , w1: subproc , w2: , w3: .
;  current process (b19) : subprocess.
; 
; standard return from the subprocess is:
;   jl    (b101)
;  w0-w3 undefined.
; return with initiation is:
;   am    (b101)
;   jl     -2
;  with w2: process description addr of the subprocess which shall be initiated.
;
; the adresses of the different entry points are defined in a table at
; top of the subprocess drivers:
;  h-name(driver start addr): addr(entry0)
;                             addr(entry1)
;                             ....
;
;        call:         return:
; w0                   destroyed
; w1                   mainproc
; w2     subproc       destroyed
; w3     link          destroyed

b.i10,j10 w.
e0:  am      0-2       ; call(entry0):
e1:  am      2-4       ; call(entry1):
e2:  am      4-6       ; call(entry2):
e3:  am      6-8       ; call(entry3):
e4:  am      8-10      ; call(entry4):
e5:  al  w0  10        ; call(entry5):
     se  w0  10        ;   if entry<>entry 5 then
     rs. w3  i0.       ;     return addr:=link;
     rs  w2  b19       ;   current proc:=subproc;
     bl  w3  x2+p10    ;
c.p101 b.f1 w.         ;*****test16*****
     rs. w0  i10.      ;
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     16                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  x3        ;
     rs  w1  x3+2      ;
     rs  w2  x3+4      ;
     rl. w0  f0.       ;
     rs  w0  x3+6      ;
     al  w0  x3        ;
     al  w1  x3+6      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test16*****
     al  w1  x2        ;
     rl  w2  0         ;
     am.    (x3+j0.)   ;
     jl     (x2)       ;

     h99               ; -2: hostprocess
j0:  h100              ;  0: general sequential device
     h102              ;  2: clock
     h104              ;  4: bs-area
     h106              ;  6: disc
     h108              ;  8: terminal
     h110              ; 10: reader
     h112              ; 12: punch
     h114              ; 14: printer
     h116              ; 16: cardreader
     h118              ; 18: magtape
     h120              ; 20: plotter
     h122              ; 22: discette
     h124              ; 24: character i-o


; return points from the subprocesses.

     jl.     e5.       ; return(init): (w2: subproc(init)) goto entry 5;
b89: rl  w2  b19       ; return(std):
     rl  w1  x2+a50    ;
     rs  w1  b19       ;   cur proc:=mainproc;
c.p101 b.f1,j6 w.      ;*****test17*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     17                ;
f0:  0                 ;
     jl.     f1.       ;
     rl. w2  i10.      ;
     jl.    (x2+2)     ;
     j0                ; 0
     j1                ; 1
     j2                ; 2
     j3                ; 3
     j3                ; 4
     j3                ; 5
j0:  al  w0  x1+2      ;
     jl.     j6.       ;
j1:  al  w0  x1+p66    ;
     al  w1  x1+p63    ;
     jl.     j6.       ;
j2:  al  w0  x1+p60    ;
     al  w1  x1+p60    ;
     jl.     j6.       ;
j3:  al  w0  x1+p86    ;
     al  w1  x1+p83    ;
j6:  jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test17*****
     jl.    (i0.)      ; exit: return to link;

i0:  0                 ; return addr(subproc)
i10: 0                 ; saved entry no

a66=j0

e.
\f


; call of the receiver and the transmitter is carried out by use of
; these procedures.

; by entry in the trm/rec:
;   w1: rec/trm , w2: main

;        call:         return:
; w0                   destroyed
; w1                   main
; w2                   receiver/transmitter
; w3     link          destroyed

e10: rl  w2  b19       ; call receiver:
     al  w1  x2+p200   ;   proc:=receiver;
     rs  w1  b19       ;
     rs  w3  x1+p3     ;   link(rec):=link;
     jl.     e8.       ;   goto start-receiver;


e11: rl  w2  b19       ; call transmitter:
     al  w1  x2+p201   ;   proc:=transmitter;
     rs  w1  b19       ;
     rs  w3  x1+p3     ;   link(trm):=link;
     jl.     e9.       ;   goto start-transmitter;

e12: rl  w2  b19       ; return to main:
     rl  w1  x2+a50    ;   main:=main(proc);
     rs  w1  b19       ;   cur proc:=main;
     jl     (x2+p3)    ;   return to main;

\f


; dummy subprocess.

b.q5, i0 w.
h96: q0                ; addr(entry0)
     q1                ; addr(entry1)
     q2                ; addr(entry2)
     q3                ; addr(entry3)
     q4                ; addr(entry4)
     q5                ; addr(entry5)

q0:  jl      g3        ; entry 0: goto result 5;

q1:  al  w0  p163      ; entry 1:
     am     (x1+a50)   ;
     hs  w0  +p60      ;   internal status:=reject;
q2:  jl     (b101)     ; entry 2: return(std);

q3:  al  w0  p163      ; entry 3:
     am     (x1+a50)   ;
     hs  w0  +p80      ;   internal status:=reject;
q4:                    ; entry 4:
q5:  jl     (b101)     ; entry 5: return(std);

h102=h96 ,  h104=h96 
e.
\f


; subkind driver.
; all messages to subproces passes through this block.
; w3: subproc
h82:                   ; hostprocess:
h84: al  w2  x3        ; subprocess:
     rl  w1  x2+a50    ;   main:=mainproc(sub);
     sn  w1  0         ;  if main=0 then
     jl      g6        ;  goto result 2 (rejected)
     rl  w0  x1+s16    ;
     se  w0  0         ;   if ready flag(main)=running then
     jl      g4        ;     goto result4;
     jl. w3  e0.       ;   call entry0(sub);
                       ;   goto main-exit;

e6:                    ; main-exit:
     rl  w2  x1+p14    ;
     am      x1+p201   ;
     rl  w0  +p2       ;
     se  w2  x1+p14    ;   if proc queue(main) is empty 
     se  w0  1         ;   or state(trm)<>waiting before poll then
     jl     (b20)      ;     return to program;
     jl.     e7.       ;   goto get-next;

e.   ; end of mainproc

; stepping stones:

     jl.     f4.       ;
     f4=k-2            ;

     jl.     f5.       ;
     f5=k-2            ;    ; end of mainprocess driver (m,n and s-names).

     jl.     f6.       ;
     f6=k-2            ;

\f



; block including the receiver process.

b.c6,n5,s16 w.

; receiver.

m.                fpa receiver

; process description:

; a48:                           ; interval
; a49:                           ; interval
; a10:                           ; kind
; a11:                           ; name
; a50:                           ; mainproc
; a52:                           ; reserver
; a53:                           ; users
; a54:                           ; next message
; a55:                           ; last message
; a56:                           ; interrupt address

p2=p0                            ; state(rec)
p3=p2+2                          ; link
s0=p3+2                          ; transmit status, cur. ch. command
                                 ;                , rem. char count
                                 ;                , cur. status
                                 ;                , event status
s1=s0+8                          ; receive status , cur. ch. command
                                 ;                , rem. char count
                                 ;                , cur. status
                                 ;                , event status
s2=s1+8                          ; startbyte<16
s3=s2+2                          ; statusbyte<16
s4=s3+2                          ; expected blocknumber
s5=s4+2                          ; message buffer
s6=s5+2        ,                 ; errorbits      ,
s7=s6+2                          ; delay

; error parameters:
s10=s7+2       ,                 ; errorcount     , blocklength error
               ,                 ; parity error   , timeout(write)
               ,                 ; timeout(mon)   , abnormal termination
               ,                 ; master clear   , accept master clear
               ,                 ; blockno error  , 
s12=s10+10                       ; top of privat part proc desc
s13=s12                          ; start of channel program area
; s14                            ; top of channel program area

\f



; receiver channel program:
                       ; start1:
; transmit statusbyte.
c0:  4<12+3<8          ;  addr code:=devi desc    , op:=write
     +s3               ;  first addr:=addr(statusbyte)
     1                 ;  char count:=1
; sense status(trm).
c1:  4<12+0<8          ;  addr code:=devi desc    , op:=sense
     +s0               ;  first addr:=addr trm status
     12                ;  char count:=12
 
                       ; start2:
; receive startbyte.
c2:  4<12+1<8+1<7      ;  addr code:=devi desc    , op:=read, continue
     +s2               ;  first addr:=addr(startbyte)
     1                 ;  char count:=1
; receive header.
c3:  4<12+1<8+1<7      ;  addr code:=devi desc    , op:=read, continue
     +p95-p200         ;  first addr:=addr(header area in main)
     2+1+11+10         ;  char count
; receive data.
c4:       1<8          ;  addr code               , op:=read
     0                 ;  first addr
     0                 ;  char count
; sense status(rec).
c5:  4<12+0<8          ;  addr code:=devi desc    , op:=sense
     +s1               ;  first addr:=addr rec status
     12                ;  char count:=12
; stop.
c6:      15<8          ;             dummy        , op:=stop
     0                 ;  dummy
     600 000           ;  timeout (in 0.1 msec)

s14=s13+c6+6-c0

c.(:(:p210-s14:)a.8.37777777:)-1, m.***name error p210
z.

; channelprogram used when operating direct on the receiver.
; transmit statusbyte.
c10: 4<12+3<8          ;  addr code:=devi desc    , op:=write
     +s3               ;  first addr:=addr(statusbyte)
     1                 ;  char count:=1
; sense status.
     4<12+0<8          ;  addr code:=devi desc    , op:=sense
     +s0               ;  first addr:=sense area
     12                ;  char count:=12
; receive startbyte.
c11: 4<12+0            ;  addr code:=devi desc    , op:=command1
     +s2               ;  first addr:=addr(startbyte)
     1                 ;  char count:=1
; receive data.
c12: 0<12+0            ;  addr code:=sender(mess) , op:=command2
     0                 ;  first addr
     0                 ;  char count
; stop.
c13:      15<8          ;  addr code:=dummy        , op:=stop
     0                 ;  dummy
     600 000           ;  timeout:=60 sec (in units of 0.1 msec)
\f


b.i10,m20 w.

b.j10 w.
h86: am   (x1+a50)  ; receiver:
     rl  w0    +a52  ;
     rl  w2  b18       ;
     sn  w0  0         ;   if reserver(main)=0 then
     jl  w3  g15       ;     check reserver;
     jl  w3  g17       ;   link operation;

j0:  bz  w0  x2+9      ; execute:
c.p101 b.f1 w.         ;*****test40*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     40                ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w0  x2+8      ;   param0:=operation, mode;
     rs  w0  x3        ;
     al  w0  x3        ;
     al  w1  x3        ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test40*****
     so  w0  2.10      ;   if not mode.reset then
     jl.     j1.       ;     goto cont;
     al  w0  -2        ; reset:
     rs  w0  x1+p2     ;   state:=direct reset;
     rl  w3  x1+a235   ;   device:=device code(proc);
     rl  w1  x1+s7     ;   timeout:=short delay;
;    al  w0  2<2+1<1+1 ;   function:=reset, wait, exit;
;    al  w2  0         ;   mess buff:=dummy;
     al  w0  1<2+1<1+1 ;   function:=reset,start chpg, exit;
     al. w1  c13.      ;   start(chpg):=stop;
     jd      1<11+p109 ;   start io;

m18: rl  w0  x1+a56    ; after wait:
     se  w0  0         ;   if regret flag then
     jl.     j7.       ;     goto result1;
     rl  w2  b18       ;
j1:  rl  w0  x2+14     ;
     sh  w0  0         ;
     am      5<8-1<8   ;   if size=<0 then
     al  w3  1<8       ;     command1:=dummy;
     hs. w3  c12.+1    ;     command2:=dummy;
     al  w3  x3+1<7    ;   else
     hs. w3  c11.+1    ;     command1:=read, continue;
     ld  w0  -100      ;     command2:=read;
     ds  w0  x1+s0+2   ;
     ds  w0  x1+s0+6   ;   clear status area;
     al  w0  -1        ;
     rs  w0  x1+s2     ;   startchar:=-1;
     rs  w0  x1+p2     ;   state:=operate direct;


     rl  w0  x2+12     ; receive:
     ws  w0  x2+10     ;
     ls  w0  -1        ;   maxcharcount:=
     ba. w0  1         ;     ((last-first)//1-1)*3;
     wm  w0  g48       ;
     sl  w0 (x2+14)    ;   if charcount.mess>maxchar count then
     se  w3  0         ;     goto deliver result3;
     jl.     j6.       ;
     rl  w0  x2+16     ;
     ls  w0  4         ;
     hs  w0  x1+s3     ;   statuschar:=statuschar(mess);
     rl  w3  x2+10     ;   first addr:=mess.first;
     rl  w0  x2+14     ;   charcount:=mess.charcount;
     ds. w0  c12.+4    ;
     bz  w0  x2+9      ;   if mode=trm statusbyte then
     so  w0  2.1       ;     startchpg:=rec startbyte;
     am      c11-c10   ;   else
     al. w1  c10.      ;   startchpg:=trm statusbyte;
     al  w0  1<2+1     ;   io-function:=start chpg, exit;
     am     (b19)      ;
     rl  w3  +a235     ;   devno:=devno(proc);
c.p101 b.f1 w.         ;*****test25*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     25                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1        ;   dump channelpg;
     al. w1  c12.+6    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test25*****
     jd      1<11+p109 ;   start io;
     al  w2  1<8       ; error:
     rs  w2  g20       ;   if io-result=2 (2: sender stopped) then
     ld  w3  -100      ;     status:=1<8 (stopped);
     ds  w3  g22       ;     bytes,chars trf:=0,0;
     al  w2  -1        ;     startchar rec:=-1;
     rs  w2  g23       ;     goto result1;
     sn  w0  2         ;   else (1: buf regretted, 3: unintelligible)
     jl.     j7.       ;     goto result3;
     jl.     j6.       ;

m19: rl  w2  b18       ; after operation:
     rl  w3  x2+14     ;   chars:=mess.char count;
     ws  w3  x1+a231   ;   chars:=chars-remaining char count(std status);
     sl  w3 (x2+14)    ;   if chars>=mess.char count then
     rl  w3  x2+14     ;     chars:=mess.char count;
     se  w0  0         ;   if io-result<>0 then
     al  w3  0         ;     chars:=0;
     rs  w3  g22       ;   chars trf(answer):=chars;
     al  w2  0         ;
     al  w3  x3+2      ;
     wd  w3  g48       ;
     ls  w3  1         ;
     rs  w3  g21       ;   bytes trf(answer):=(chars+2)//3*2;
     rl  w3  x1+s2     ;   if no startchar received then
     se  w3  -1        ;     startchar(answer):=-1;
     ls  w3  -16       ;   else startchar(answer):=startchar received;
     rs  w3  g23       ;
     rl  w3  x1+a233   ;   status:=event status(std) or event status(proc);
     lo  w3  x1+s0+6   ;   if io-result=3 then (monitor timeout)
     sn  w0  3         ;     status:=execution timeout;
     al  w3  1<9       ;
     rs  w3  g20       ;   status(answer):=status;
     se  w0  3         ;   if io-result=3 (monitor timeout)
     sh  w3  -1        ;   or bit0(status)=1 then
     al  w0  0         ;     io-result:=0;
     sn  w0  0         ;   if io-result=0 then
     jl.     j7.       ;     goto result1;
j5:  am      4-3       ; result4: result:=4;
j6:  am      3-1       ; result3: result:=3;
j7:  al  w0  1         ; result1:   or  :=1;
c.p101 b.f1 w.         ;*****test41*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     41                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  g24       ;
     al  w0  g20       ;
     al  w1  g24       ;   dump answer (g20,21,22,23) and result (g24);
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test41*****
     jl  w3  g19       ; deliver: deliver result(result);
     al  w0  0         ;
     rs  w0  x1+p2     ;   state:=idle;
     jl  w3  g25       ;   next operation;
     jl.     j0.       ;   goto execute;
e.
\f


; start receive.
; w1: receiver
e8:  rl  w2  x1+a50    ; entry1: main:=main(rec);
     bz  w0  x2+p93    ;
     al  w3  2.0010    ;
     la  w3  0         ;   contents:=operation(6:6);
     hs  w3  x2+p97    ;
     sz  w0  4.01000   ;   if initiate then
     jl. w3  n3.       ;     initiate proc desc;
     sz  w0  4.00300   ;   if delay then
     jl.     m3.       ;     goto start wait;

m0:  jl. w3  n1.       ; start trm-rec: setup statusbyte;
     al  w3  1<2       ;   io-function:=start ch pg;
     al. w0  c0.       ;   start:=start1;
     jl.     m2.       ;   goto start operation;

m3:  al  w3  2         ; start wait:
     rs  w3  x1+p2     ;   state:=waiting;
     rl  w3  x1+a235   ;   dev desc:=dev desc(rec);
     sz  w0  4.00200   ;   if long delay then
     am      s7-s7     ;     delay:=long delay;
     rl  w1  x1+s7     ;   else delay:=short delay;
     sz  w0  4.02000   ;   if reset then
     am      1<1       ;     function:=reset and start waitpg;
     al  w0  2<2       ;   else function:=start wait pg;
     al  w2  0         ;   mess buffer:=0;
c.p101 b.f1 w.         ;*****test25*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     25                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test25*****
     jl.     m5.       ;   goto start io;

m6:  jl. w3  n1.       ; after waiting: setup startbyte;
     jl.     m1.       ;   goto rec;

m1:  al  w3  1<2       ; rec: io-function:=start ch pg;
     al. w0  c2.       ;   start:=start2;
                       ;   goto start operation;

m2:  ds. w0  i2.       ; start operation:
     jl. w3  n2.       ;   setup channel program;
     rl  w2  x1+s5     ;   mess buff:=mess buff(op);
     al  w3  3         ;
     rs  w3  x1+p2     ;   state(rec):=receiving;
     rl  w3  x1+a235   ;   dev desc:=dev desc(rec);
     dl. w1  i2.       ;   load io-function, start of ch pg;
c.p101 b.f1 w.         ;*****test24*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     24                ;
f0:  0                 ;
     jl.     f1.       ;
     al. w0  i1.       ;
     al. w1  i2.       ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test24*****
c. p101 b. f1 w.       ; ***test 26***
     rs. w3  f0.       ;*
     jl. w3  f4.       ;*
     26                ;*
f0:  0                 ;*
     jl.     f1.       ;*
     al. w0  c0.       ;*
     al. w1  c6.+4     ;*
     jl. w3  f5.       ;*
f1:                    ;*
e.z.                   ;* test 26***
m5:  jd      1<11+p109 ;   start io;
     rl  w1  b19       ;
     sn  w0  0         ;   if io-result=0 then
     jl.     m9.       ;     wait;
     rl  w2  x1+a50    ;
     hs  w0  x2+p94    ;   result:=io-result;
     jl.     m17.      ;   goto return;

m8:  jl     (b20)      ; return: wait;

m9:  rl  w1  x1+a50    ; wait:
     rs  w1  b19       ;   curr proc:=main(rec);
     jl.     e6.       ;   main-return;

\f



; after interrupt.
c43: rl  w2  x1+a50    ; interrupt entry:
c.p101 b.f1 w.         ;*****test42*****
     rs. w0  f0.       ;
     jl. w3  f4.       ;
     42                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w2  x3        ;
     dl  w0  x1+a231   ;
     ds  w0  x2+2      ;
     dl  w0  x1+a233   ;
     ds  w0  x2+6      ;   dump std status area
     rl  w0  x1+a244   ;   io-result;
     rs  w0  x2+8      ;
     al  w0  x2        ;
     al  w1  x2+8      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test42*****
c.p101 b.f1 w.         ;*****test28*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     28                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p2     ;
     al  w1  x1+s3     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test28*****
     rl  w3  x1+p2     ;
     am      x3        ;
     jl.    (x3+6)     ;   goto case state of
     m18               ;   ( -2: wait direct,
     m19               ;     -1: operate direct,
     m8                ;      0: idle,
     m9                ;      1: wating before poll(not possible),
     m6                ;      2: waiting,
     m10               ;      3: receiving);

m10: jl. w3  n0.       ; after receive: check state(rec,result);
     hs  w3  x2+p94    ;   result(main):=result;
c.p101 b.f2 w.         ;*****test30*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     30                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2+p95    ;
     al  w1  x2+p95+14 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test30*****
c.p101 b.f1 w.         ;*****test27*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     27                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+s13    ;
     al  w1  x1+s14-2  ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test27*****
     sn  w3  0         ;   if result=0 then
     jl.     m15.      ;     goto ok;
c.p101 b.f1 w.         ;*****test29*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     29                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w2  x3        ;
     dl  w0  x1+a231   ;
     ds  w0  x2+2      ;
     dl  w0  x1+a233   ;
     ds  w0  x2+6      ;
     rl  w3  x1+a244   ;
     rl. w0  f0.       ;
     ds  w0  x2+10     ;
     al  w0  x2        ;
     al  w1  x2+10     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test29*****
     al  w0  x2       ; save w3
     jl  w2  (b31)    ; call errorlog
     rl  w2  0        ; restore w3
     bz  w0  x2+p93    ;
     sz  w0  2.00000001;   if no error recovery then
     jl.     m13.      ;     goto check;
                       ; errors:
c.p102                 ;*****statistics begin*****
     al  w0  1         ;
     ba  w0  x1+s10    ;   errorcount:=errorcount+1;
     hs  w0  x1+s10    ;
     al  w0  1         ;
     am      x3-3      ;
     ba  w0  x1+s10    ;   errorcount(result):=errorcount(result)+1;
     am      x3-3      ;
     hs  w0  x1+s10    ;
z.                     ;*****statistics end*****
     am      x3-3      ;
     jl.    (x3-3)     ;   goto case result of
     m11               ;    ( 4: blocklength error,
     m12               ;      5: parity error,
     -1                ;      6: impossible,
     m1                ;      7: timeout(mon),
     m1                ;      8: abnormal termination,
     m16               ;      9: master clear,
     m16               ;     10: accept master clear,
     m0                ;     11: blocknumber error);

m11: am      2.10-2.01 ; blocklength error:
m12: al  w0  2.01      ; parity error: 
     hs  w0  x1+s6     ;   errorbits:=error cause;
     jl.     m0.       ;   goto start rec-trm;

m13: se  w3  9         ; check: if result<>master clear
     sn  w3  10        ;   or accept master clear then
     jl.     m16.      ;     goto return
     jl.     m17.      ;   goto countup;

m15: bz  w0  x1+s2     ; ok:
     ls  w0  -4        ;   contents:=startbyte(4:6);
     la. w0  i0.       ;
     hs  w0  x2+p97    ;   contents(main):=contents;
m16: al  w0  1         ; countup:
     wa  w0  x1+s4     ;   blockcount:=blockcount+1;
     rs  w0  x1+s4     ;
m17: al  w0  0         ; return:
     rs  w0  x1+p2     ;   state(rec):=ready;
     hs  w0  x1+s6     ;
c.p101 b.f1 w.         ;*****test31*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     31                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test31*****
     jl.     e12.      ;   return to main;

i0:  2.00001110        ;   mask
i1:  0                 ;   io-function
i2:  0                 ;   start of ch pg

e.

\f


; check state(proc,result).
; the procedure checks the result of the i/o operation by inspecting the timeout,
; the receive status area and the startbyte received.
;  result:   0  ok
;            4  blocklength error
;            5  parity error(write)
;            7  time-out(monitor)
;            8  abnormal termination, that is buserror, disconnected line,
;                  reset received, disconnected controller, power up, etc.
;            9  master clear
;           10  accept master clear
;           11  blocknumber error
;        call:         return:
; w0                   destroyed
; w1     proc          unchanged
; w2                   unchanged
; w3     link          result
b.i1,j20 w.
n0:  rs. w3  i0.       ; check state:
     rl  w0  x1+a244   ;
     se  w0  0         ;   if timeout<>0 then
     jl.     j1.       ;     goto timeout-error;
     rl  w0  x1+s1+6   ;   event status:=event status(rec) or event status(std);
     lo  w0  x1+a233   ;   if event status<>(0 or blocklength error) then
     sz. w0 (i1.)      ;     goto event-error;
     jl.     j0.       ;
     bl  w0  x1+s2     ; ok or blocklength:
     so  w0  2.1<4     ;   if special bit then
     jl.     j3.       ;    begin
     sn  w0  -1<4      ;     if startbyte=master clear then
     jl.     j16.      ;       goto master clear;
     sn  w0  -1<4-1<9  ;     if startbyte=accept master clear then
     jl.     j17.      ;       goto accept master clear;
     jl.     j12.      ;     goto parity error;
j3:  ld  w0  1         ;   if blockno expected mod 2 <>
     lx  w3  x1+s4     ;   blockno rec then
     sz  w3  2.1       ;     goto blocknumber error;
     jl.     j18.      ;
     rl  w3  x1+s1+2   ;   if rem char count<>0 then
     se  w3  0         ;     goto blocklenght error;
     jl.     j11.      ;   else
     jl.     j10.      ;     goto ok;
j0:  bz  w3  0         ; event-error:
     sz  w3  1<10      ;   if bit1 then
     jl.     j12.      ;     goto parity error;
     jl.     j15.      ;   goto abnormal termination;
j1:  sn  w0  3         ; timeout-error:
     jl.     j14.      ;   if timeout=3 then goto timeout(mon);
     jl.     j15.      ;   goto abnormal termination;

j18: am      11-10     ; blocknumber error:    result:=11;
j17: am      10-9      ; accept master clear:  result:=10;
j16: am      9-8       ; master clear:         result:=9;
j15: am      8-7       ; abnormal termination: result:=8;
j14: am      7-5       ; timeout(mon):         result:=7;
j12: am      5-4       ; parity error:         result:=5;
j11: am      4-0       ; blocklength error:    result:=4;
j10: al  w3  0         ; ok:                   result:=0;
     jl.    (i0.)      ;   return;
i0:  0                 ;  saved link;
i1:  8.7577 7777       ;   event status mask not including blocklenght error
e.

; setup statusbyte.
;        call:         return:
; w0                   destroyed
; w1     rec           unchanged
; w2     main          unchanged
; w3     link          destroyed
b.i0 w.
n1:  rs. w3  i0.       ; setup statusbyte:
     bz  w3  x2+p96    ;   statusbyte:=
     ls  w3  2         ;     blockcontrol<2
     bl  w0  x1+s2     ;     +(received blockno mod 2)<7
     sz  w0  -1<11     ;
     al  w3  x3+1<7    ;
     ba  w3  x1+s6     ;     +errorbits;
     ls  w3  4         ;
     hs  w3  x1+s3     ;   insert statusbyte;
     jl.    (i0.)      ;   return;
i0:  0                 ;  saved link
e.


; setup channelprogram.
;         call:         return:
; w0                    destroyed
; w1      rec           unchanged
; w2      main          unchanged
; w3      link          destroyed
b.i0,j1 w.
n2:  rs. w3  i0.       ; setup ch pg:
     al  w0  -1        ;  startbyte(rec):= dummy
     rs  w0  x1+s2     ;
     bz  w0  x2+p93    ;
     so  w0  4.00002   ;   if dataflag(operation)=off then
     jl.     j0.       ;     goto receive header;
     rl  w0  x2+p91    ; receive header-data:
     rs  w0  x1+s5     ;
     al  w0  -1        ;   op(header):= dummy in cnain
     hs. w0  c3.+1     ;
     bz  w0  x2+p92    ;
     hs. w0  c4.       ;   addr code:=addr code(main);
     al  w0  1<8       ;   op(data):=read;
     hs. w0  c4.+1     ;
     rl  w0  x2+p85    ;
     rs. w0  c4.+2     ;   first addr:=first data rec;
     rl  w0  x2+p86    ;
     rs. w0  c4.+4     ;   size:=size data rec;
     jl.    (i0.)      ; exit: return;
j0:  al  w0  0         ;  receive-header:
     rs  w0  x1+s5     ;   mess buff:=0;
     al  w0  1<8       ;
     hs. w0  c3.+1     ;   op(header):=read;
     al  w0  5<8       ;
     hs. w0  c4.+1     ;   op(data):=dummy;
j1:  jl.    (i0.)      ; exit: return;
i0:  0                 ;  saved link
e.

; initiate proc desc(rec).
; clear the tail of the proc desc except the reset delay and
; the testinformation.
;        call:         return:
; w0                   unchanged
; w1     rec           unchanged
; w2                   unchanged
; w3     link          destroyed
b.i1,j0 w.
n3:  ds. w0  i1.       ; initiate proc desc:
     al  w3  x1+s4     ;   clear proc desc from
     al  w0  0         ;   start of status area
j0:  rs  w0  x3        ;   to start of test information area;
     al  w3  x3+2      ;
     se  w3  x1+s7     ;
     jl.     j0.       ;
     rl. w0  i1.       ;
     jl.    (i0.)      ;
i0:  0                 ;
i1:  0                 ;
e.

e.  ; end of receiver
\f


; block including transmitter.

b.c16,n5,s16 w.

; transmitter.

m.                fpa transmitter

; process description:

; a48:                           ; interval
; a49:                           ; interval
; a10:                           ; kind
; a11:                           ; name
; a50:                           ; mainproc
; a52:                           ; reserver
; a53:                           ; users
; a54:                           ; next message
; a55:                           ; last message
; a56:                           ; interrupt address

p2=p0                            ; state(trm)
p3=p2+2                          ; link
s0=p3+2                          ; transmit status, cur. ch. command
                                 ;                , rem. char count
                                 ;                , cur. status
                                 ;                , event status
s1=s0+8                          ; receive status , cur. ch. command
                                 ;                , rem. char count
                                 ;                , cur. status
                                 ;                , event status
s2=s1+8                          ; startbyte<16
s3=s2+2                          ; statusbyte<16
s4=s3+2                          ; current blocknumber
s5=s4+2                          ; message buffer
s6=s5+2                          ; long delay(in 0.1 msec)
s7=s6+2                          ; short delay(in 0.1 msec)

; error parameters:
s10=s7+2       ,                 ; errorcount     , blocklength error
               ,                 ; parity error   , timeout(write)
               ,                 ; timeout(mon)   , abnormal termination
               ,                 ; blocklength -  , parity error(statusbyte)
               ,                 ; waitpg term    ,
s11=s10+10                       ; start time(io op)
                                 ;       -
s12=s11+4                        ;   0  <  execution time(io-op) =< 5 
                                 ;   5  <       -                =< 10
                                 ;   10 <       -                =< 20
                                 ;   20 <       -                =< 40
                                 ;   40 <       -                =< 80
                                 ;   80 <       -
s13=s12+12                       ; start of channel program area
; s14                            ; top of channel program area



\f



; transmitter channel program:

                       ; start1:
; transmit startbyte.
c0:  4<12+3<8+1<7      ;  addr code:=devi desc    , op:=write, continue
     +s2               ;  first addr:=addr(startbyte)
     1                 ;  char count:=1
; transmit header.
c1:  4<12+3<8+1<7      ;  addr code:=devi desc    , op:=write, continue
     +p75-p201         ;  first addr:=start header (in mainproc)
     2+1+11+10         ;  char count
; transmit data.
c2:       3<8          ;  addr code               , op:=write
     0                 ;  first addr
     0                 ;  char count
; sense status(trm).
c3:  4<12+0<8          ;  addr code:=devi desc    , op:=sense
     +s0               ;  first addr:=addr(trm status)
     12                ;  char count:=12
; receive statusbyte.
c4:  4<12+1<8          ;  addr code:=devi desc    , op:=read
     +s3               ;  first addr:=addr(statusbyte)
     1                 ;  char count:=1
; sense status(rec)
c5:  4<12+0<8          ;  addr code:=devi desc    , op:=sense
     +s1               ;  first addr:=addr(rec status)
     12                ;  char count:=12
; stop.
c6:      15<8          ;  dummy                   , op:=stop
     0                 ;  dummy
     10 000            ;  timeout:=1 sec(in units of 0.1 msec)

s14=s13+c6+6-c0

c.(:(:p211-s14:)a.8.37777777:)-1, m.***name error p211
z.


; channel program used of operations send directly 
; to the transmitter.
; transmit startbyte.
c10: 4<12+3<8+1<7      ;  addr code:=devi desc    , op:=write, continue
     +s2               ;  first addr:=addr(startbyte)
     1                 ;  char count:=1
; command1 (transmit data block, autoload or dummy).
c11: 0<12+0            ;  addr code:=sender(mess) , op:=command1
     0                 ;  first addr
     0                 ;  char count
; sense status.
     4<12+0<8          ;  addr code:=devi desc    , op:=sense
     +s0               ;  first addr:=sense area
     12                ;  char count:=12
; command2 (receive statusbyte or dummy).
c12: 4<12+0            ;  addr code:=devi desc    , op:=command2
     +s3               ;  first addr:=addr(startbyte)
     1                 ;  char count:=1
; stop.
         15<8          ;  addr code:=dummy        , op:=stop
     0                 ;  dummy
     10 000            ;  timeout:=1 sec (in units of 0.1 msec)
\f


b.i10,m20 w.

b.j10 w.
h88:  am (x1+a50)   ; reveiver
      rl w0   +a52  ;
     rl  w2  b18       ;
     sn  w0  0         ;   if reserver(main)=0 then
     jl  w3  g15       ;     check reserver;
     jl  w3  g17       ;   link operation;

j0:  bz  w0  x2+9      ; execute:
c.p101 b.f1 w.         ;*****test 32*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     32                ;
f0:  0                 ;
     jl.     f1.       ;
     rl  w0  x2+8      ;   param0:=operation, mode;
     rs  w0  x3        ;
     al  w0  x3        ;
     al  w1  x3        ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test 32*****
     so  w0  2.10      ;   if not mode.reset then
     jl.     j1.       ;     goto cont;
     al  w0  -2        ; reset:
     rs  w0  x1+p2     ;   state:=direct reset;
     rl  w3  x1+a235   ;   device:=device code(proc);
     rl  w1  x1+s7     ;   timeout:=short delay;
     al  w0  2<2+1<1+1 ;   function:=reset, wait, exit;
     al  w2  0         ;   mess buff:=dummy;
     jd      1<11+p109 ;   start io;

m15: rl  w0  x1+a56    ; after wait:
     se  w0  0         ;   if regret flag then
     jl.     j7.       ;     goto result1;
     rl  w2  b18       ;
     bz  w0  x2+9      ;

j1:  so  w0  2.01      ; cont: if mode.rec then
     am      5<8-1<8   ;     command2:=read
     al  w0  1<8       ;   else
     hs. w0  c12.+1    ;     command2:=dummy;
     ld  w0  -100      ;
     ds  w0  x1+s0+2   ;
     ds  w0  x1+s0+6   ;   clear status area;
     al  w0  -1        ;
     rs  w0  x1+s3     ;   statuschar:=-1;
     rs  w0  x1+p2     ;   state:=operate direct;
     bz  w0  x2+8      ;   if operation(buf)<>transmit then
     se  w0  5         ;     goto autoload;
     jl.     j3.       ;


j2:  rl  w0  x2+12     ; transmit:
     ws  w0  x2+10     ;
     ls  w0  -1        ;   maxcharcount:=
     ba. w0  1         ;     ((last-first)//1-1)*3;
     wm  w0  g48       ;
     sl  w0 (x2+14)    ;   if charcount.mess>maxchar count then
     se  w3  0         ;     goto deliver result3;
     jl.     j6.       ;
     al  w0  3<8       ;
     hs. w0  c11.+1    ;   command1:=write;
     rl  w3  x2+10     ;   first addr:=mess.first;
     rl  w0  x2+14     ;   charcount:=mess.charcount;
     sh  w0  0         ;   if charcount=<0 then
     jl.     j4.       ;     goto receive;
     ds. w0  c11.+4    ;
     rl  w0  x2+16     ;
     ls  w0  4         ;
     hs  w0  x1+s2     ;   startchar:=startchar(mess);
     al. w1  c10.      ;   startchpg:=trm startbyte;
     jl.     j5.       ;   goto startop;

j3:  al  w0  6<8       ; autoload:
     hs. w0  c11.+1    ;   command2:=autoload;
     am      c11-c12   ;   start(chpg):=start1;

j4:  al. w1  c12.      ; receive: start(chpg):=start2;
     al  w2  0         ; start-op:
j5:  al  w0  1<2+1     ;   io-function:=start chpg, exit;
     am     (b19)      ;
     rl  w3  +a235     ;   devno:=devno(proc);
c.p101 b.f1 w.         ;*****test47*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     47                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1        ;   dump channelpg;
     al. w1  c12.+6    ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test47*****
     jd      1<11+p109 ;   start io;
     ld  w3  -100      ; error:
     ds  w3  g21       ;   mess.status, mess.bytes trf:=0,0;
     al  w3  -1        ;
     ds  w3  g23       ;   mess.chars trf, statuschar:=0,-1;
     sn  w0  3         ;   if io-result=3 then
     jl.     j6.       ;     goto result3
     jl.     j7.       ;   else goto result1;

m16: rl  w2  b18       ; after operation:
     rl  w3  x1+a233   ;   status:=event status(std) or event status(proc);
     lo  w3  x1+s0+6   ;   if io-result=3 then (monitor timeout)
     sn  w0  3         ;     status:=execution timeout;
     al  w3  1<9       ;
     rs  w3  g20       ;   status(answer):=status;
     se  w0  3         ;   if io-result=3 (monitor timeout)
     sh  w3  -1        ;   or bit0(status)=1 then
     al  w0  0         ;     io-result:=0;
     rl  w3  x2+14     ;   chars:=mess.char count;
     se  w0  0         ;   if io-result<>0 then
     al  w3  0         ;     chars:=0;
     rs  w3  g22       ;   chars trf(answer):=chars;
     al  w2  0         ;
     al  w3  x3+2      ;
     wd  w3  g48       ;
     ls  w3  1         ;
     rs  w3  g21       ;   bytes trf(answer):=(chars+2)//3*2;
     rl  w3  x1+s3     ;   if no statuschar received then
     se  w3  -1        ;     statuschar(answer):=-1;
     ls  w3  -16       ;   else statuschar(answer):=statuschar received;
     rs  w3  g23       ;
     sn  w0  0         ;   if io-result=0 then
     jl.     j7.       ;     goto result1;
     am      4-3       ; result4: result:=4;
j6:  am      3-1       ; result3: result:=3;
j7:  al  w0  1         ; result1:   or  :=1;
c.p101 b.f1 w.         ;*****test46*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     46                ;
f0:  0                 ;
     jl.     f1.       ;
     rs  w0  g24       ;
     al  w0  g20       ;
     al  w1  g24       ;   dump answer (g20,21,22,23) and result (g24);
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test46*****
     jl  w3  g19       ; deliver: deliver result(result);
     al  w0  0         ;
     rs  w0  x1+p2     ;   state:=idle;
     jl  w3  g25       ;   next operation;
     jl.     j0.       ;   goto execute;
e.
\f


; start operation.

; w1: transmitter.
e9:  rl  w2  x1+a50    ; entry1: main:=main(trm);
     al  w0  0         ;
     hs  w0  x1+s10    ;   errorcount:=0;
     bz  w0  x2+p73    ;
     al  w3  2.1110    ;
     la  w3  0         ;   contents:=operation(4:6);
     hs  w3  x2+p77    ;
     sz  w0  4.01000   ;   if initiate then
     jl. w3  n3.       ;     initiate proc desc;
     sz  w0  4.00300   ;   if delay then
     jl.     m1.       ;     goto start wait;

m0:  al  w0  3         ; start trm-rec:
     rs  w0  x1+p2     ;   state:=transmitting;
     jl. w3  n1.       ;   setup startbyte;
     jl. w3  n2.       ;   setup channelprogram;
     al  w0  1<2       ;   function:=start channel pg;
     rl  w2  x1+s5     ;   mess buff:=mess buff(op);
     rl  w3  x1+a235   ;   dev desc:=dev desc(trm);
     al. w1  c0.       ;   start(ch pg):=start1;
c.p101 b.f1 w.         ;*****test33*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     33                ;
f0:  0                 ;
     jl.     f1.       ;
     al. w0  c0.       ;
     al. w1  c6.+4     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test33*****
c.p102                 ;*****statistics begin*****
     ds. w1  i1.       ;
     jd      1<11+36   ;   get clock;
     am      (b19)     ;
     ds  w1  +s11+2    ;   save start time(operation);
     dl. w1  i1.       ;
z.                     ;*****statistics end*****
     jd      1<11+p109 ;   start io;
     sn  w0  0         ;   if result=0 then
     jl     (b20)      ;     wait;
     rl  w1  b19       ;
     rl  w2  x1+a50    ;
     hs  w0  x2+p74    ;   result:=io-result;
     jl.     m12.      ;   goto return;

m4:  am      4.02000   ; reset and wait: operation:=reset, short delay;
m5:  al  w0  4.00133   ; wait: operation:=short delay;
m1:  sz  w0  4.00033   ; start wait:
     am      2-1       ;   if dummy header then
     al  w2  1         ;     state(trm):=waiting before poll;
     rs  w2  x1+p2     ;   else state(trm):=waiting;
     rl  w3  x1+a235   ;   dev desc:=dev desc(trm);
     so  w0  4.00200   ;   if short delay then
     am      s7-s6     ;     time:=short delay;
     rl  w1  x1+s6     ;   else time:=long delay;
     sz  w0  4.02000   ;   if reset bit then
     am      1<1       ;     function:=reset, start wait;
     al  w0  2<2       ;   else function:=start std wait;
     al  w2  0         ;   message buffer:=0;
c.p101 b.f1 w.         ;*****test34*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     34                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test34*****
     jd      1<11+p109 ;   start io;

m9:  jl     (b20)      ; wait: wait;

\f



; after interrupt.

; w1: transmitter
c44: rl  w2  x1+a50    ; interrupt entry:
c.p101 b.f1 w.         ;*****test49*****
     rs. w0  f0.       ;
     jl. w3  f4.       ;
     49                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w2  x3        ;
     dl  w0  x1+a231   ;
     ds  w0  x2+2      ;
     dl  w0  x1+a233   ;
     ds  w0  x2+6      ;   dump std status area
     rl  w0  x1+a244   ;   io-result;
     rs  w0  x2+8      ;
     al  w0  x2        ;
     al  w1  x2+8      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test49*****
c.p101 b.f1 w.         ;*****test36*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     36                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+p2     ;
     al  w1  x1+s3     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test36*****
     rl  w3  x1+p2     ;
     am      x3        ;
     jl.    (x3+6)     ;   goto case state of
     m15               ;   (-2: wait direct,
     m16               ;    -1: operate direct,
     m9                ;     0: idle,
     m0                ;     1: waiting before poll,
     m0                ;     2: waiting,
     m10               ;     3: transmitting);

m10:                   ; after transmission:
c.p102                 ;*****statistics begin*****
     ds. w1  i1.       ;
     ds. w3  i2.       ;
     jd      1<11+36   ;   get clock;
     rl  w2  b19       ;
     ss  w1  x2+s11+2  ;
     al  w2  x2+s12    ;
     sl  w1  800       ;   time>80.0;
     al  w2  x2+2      ;
     sl  w1  400       ;   time>40.0;
     al  w2  x2+2      ;
     sl  w1  200       ;   time>20.0;
     al  w2  x2+2      ;
     sl  w1  100       ;   time>10.0;
     al  w2  x2+2      ;
     sl  w1  50        ;   time>5.0;
     al  w2  x2+2      ;
     al  w0  1         ;
     wa  w0  x2        ;   number(time zone) increased 1;
     rs  w0  x2        ;
     dl. w1  i1.       ;
     dl. w3  i2.       ;
z.                     ;*****statistics end*****
     jl. w3  n0.       ;   check state(proc,result);
     hs  w3  x2+p74    ;   result(main):=result;
     bz  w0  x1+s3     ;
     ls  w0  -4-2      ;
     la. w0  i0.       ;
     hs  w0  x2+p76    ;   blockcontrol:=statusbyte(5:6);
c.p101 b.f2 w.         ;*****test38*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     38                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x2+p75    ;
     al  w1  x2+p75+14 ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test38*****
c.p101 b.f1 w.         ;*****test35*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     35                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+s13    ;
     al  w1  x1+s14-2  ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test35*****
     sn  w3  0         ;   if result=0 then
     jl.     m11.      ;     goto ok;
c.p101 b.f1 w.         ;*****test37*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     37                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w2  x3        ;
     dl  w0  x1+a231   ;
     ds  w0  x2+2      ;
     dl  w0  x1+a233   ;
     ds  w0  x2+6      ;
     rl  w3  x1+a244   ;
     rl. w0  f0.       ;
     ds  w0  x2+10     ;
     al  w0  x2        ;
     al  w1  x2+10     ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test37*****
     al  w0  x2       ; save w3
     jl  w2  (b31)     ; call errorlog
     rl  w2  0         ; restore w3
     bz  w0  x2+p73    ;
     sz  w0  4.00001   ;   if no error recovery then
     jl.     m12.      ;     goto return;
c.p102                 ;*****statistics begin*****
     al  w0  1         ;
     am      x3-3      ;
     ba  w0  x1+s10    ;   errorcount(result):=errorcount(result)+1;
     am      x3-3      ;
     hs  w0  x1+s10    ;
z.                     ;*****statistics end*****
     al  w0  1         ;
     ba  w0  x1+s10    ;   errorcount:=errorcount+1;
     hs  w0  x1+s10    ;
     sl  w0  p140      ;   if errorcount>=max errorcount then
     jl.     m12.      ;     goto return;
     am      x3-3      ;
     jl.    (x3-3)     ;   goto case result of
     m0                ;     4: blocklength error(read),
     m0                ;     5: parity error(read),
     m4                ;     6: timeout(write),
     m5                ;     7: timeout(mon),
     m4                ;     8: abnormal termination,
     m0                ;     9: blocklength error(statusbyte),
     m0                ;    10: parity error(statusbyte),
     m4                ;    11: waitpg term);

m11: al  w0  1         ; ok:
     wa  w0  x1+s4     ;   current blockno:=currentblockno+1;
     rs  w0  x1+s4     ;
m12: al  w0  0         ; return:
     rs  w0  x1+p2     ;   state:=ready;
c.p101 b.f1 w.         ;*****test39*****
     rs. w3  f0.       ;
     jl. w3  f4.       ;
     39                ;
f0:  0                 ;
     jl.     f1.       ;
     al  w0  x1+2      ;
     jl. w3  f5.       ;
f1:                    ;
e.z.                   ;*****test39*****
     jl.     e12.      ;   return to main;

i0:  2.11              ; mask

c.p102                 ;*****statistics begin*****
     0                 ;
i1:  0                 ;
     0                 ;
i2:  0                 ;
z.                     ;*****statistics end*****

e.

\f


; check state(proc,result).
; the procedure checks the result of the i/o operation by inspecting the timeout,
; the status area of the receive operation and the statusbyte received.
;  result:   0  ok
;            4  blocklength error
;            5  parity error(read)
;            6  time-out(write)
;            7  time-out(monitor)
;            8  abnormal termination, that is buserror, disconnected line,
;                                     disconnected controller, power up, etc.
;            9  parity error(statusbyte)
;           10  blocklength error(statusbyte)
;           11  waitpg termination
;
;        call:         return:
; w0                   destroyed
; w1     proc          unchanged
; w2                   unchanged
; w3     link          result
b.i0,j20 w.
n0:  rs. w3  i0.       ; check state:
     rl  w0  x1+a244   ;
     se  w0  0         ;   if timeout<>0 then
     jl.     j1.       ;     goto timeout-error;
     bz  w0  x1+s0+6   ;
     sz  w0  1<9       ;   if bit2(write event status)<>0 then
     jl.     j13.      ;     goto timeout(write);
     rl  w0  x1+s1+6   ;   if event status(rec)<>0 then
     se  w0  0         ;     goto event-error;
     jl.     j0.       ;
     rl  w0  x1+s1+2   ;   if rem.char count=0 then
     sn  w0  0         ;     goto check statusbyte;
     jl.     j2.       ;   else
     jl.     j11.      ;     goto blocklength error;
j0:  bz  w3  0         ; event-error:
     sz  w3  1<10      ;   if bit1 then
     jl.     j12.      ;     goto parity error;
     sz  w3  1<7       ;   if bit4 then
     jl.     j11.      ;     goto blocklength error;
     jl.     j15.      ;   goto abnormal termination;
j1:  sn  w0  3         ; timeout-error:
     jl.     j14.      ;   if timeout=3 then goto timeout(mon);
     sn  w0  5         ;   if timeout=5 then
     jl.     j18.      ;     goto waitpg term;
     jl.     j15.      ;   goto abnormal termination;
j2:  bz  w0  x1+s3     ; check statusbyte:
     sz  w0  2.01<4    ;   if statusbyte(7:7)=1 then
     jl.     j16.      ;     goto parity(statusbyte);
     sz  w0  2.10<4    ;   if statusbyte(6:6)=1 then
     jl.     j17.      ;     goto blocklength(statusbyte);
     jl.     j10.      ;   goto ok;

j18: am      11-10     ; waitpg term:          result:=11;
j17: am      10-9      ; blocklength(statusbyte): res:=10;
j16: am      9-8       ; parity(statusbyte):   result:=9;
j15: am      8-7       ; abnormal termination: result:=8;
j14: am      7-6       ; timeout(mon):         result:=7;
j13: am      6-5       ; timeout(write):       result:=6;
j12: am      5-4       ; parity error:         result:=5;
j11: am      4-0       ; blocklength error:    result:=4;
j10: al  w3  0         ; ok:                   result:=0;
     jl.    (i0.)      ;   return;
i0:  0                 ;  saved link;
e.


; setup startbyte.
;         call:        return:
; w0                   operation
; w1      proc         unchanged
; w2      main         unchanged
; w3      link         destroyed
b.i0,j1 w.
n1:  rs. w3  i0.       ; setup startbyte:
     bz  w0  x2+p73    ;
     sz  w0  4.30000   ;   if operation=special header then
     jl.     j0.       ;     goto special header;
     al  w3  4.00032   ;   startbyte:=
     la  w3  0         ;     databit<3+headerbit<2+dataflag<1
     rl  w0  x1+s4     ;
     sz  w0  2.1       ;     +blockcount mod 2<7;
     al  w3  x3+1<7    ;   return;
     jl.     j1.       ;
j0:  sz  w0  4.10000   ; special header:
     am      2.00100000;   if master clear then
     al  w3  2.11011111;     startbyte:=master clear;
j1:  ls  w3  4         ;   else
     hs  w3  x1+s2     ;     startbyte:=accept master clear;
     jl.    (i0.)      ;   return;
i0:  0                 ;  saved link
e.


; setup channelprogram(trm).
;        call:         return:
; w0                   destroyed
; w1     proc          unchanged
; w2     main          unchanged
; w3     link          destroyed
b.i0,j0 w.
n2:  rs. w3  i0.       ; setup ch pg:
     al  w0  -1        ;  statusbyte(trm):= dummy
     rs  w0  x1+s3     ;
     bz  w0  x2+p73    ;
     so  w0  4.00002   ;   if dataflag(operation)=off then
     jl.     j0.       ;     goto transmit header;
     rl  w0  x2+p71    ;
     rs  w0  x1+s5     ;   message buffer:=mess buff(main);
     al  w0  -1        ;   op(header):= dummy in chain
     hs. w0  c1.+1     ;
     bz  w0  x2+p72    ;
     hs. w0  c2.       ;   addr code:=addr code(data);
     al  w0  3<8       ;
     hs. w0  c2.+1     ;   op(data):=write;
     rl  w0  x2+p65    ;
     rs. w0  c2.+2     ;   first addr:=first data trm;
     rl  w0  x2+p66    ;
     rs. w0  c2.+4     ;   size:=size data;
     jl.    (i0.)      ; exit: return;
j0:  al  w0  0         ; transmit header:
     rs  w0  x1+s5     ;   message buffer:=0;
     al  w0  3<8       ;
     hs. w0  c1.+1     ;   op(header):=write;
     al  w0  5<8       ;
     hs. w0  c2.+1     ;   op(data):=dummy;
     jl.    (i0.)      ; exit: return;
i0:  0                 ; saved link
e.


; initiate proc desc(trm).
;        call:         return:
; w0                   unchanged
; w1     trm           unchanged
; w2                   unchanged
; w3     link          destroyed
b.i1,j0 w.
n3:  ds. w0  i1.       ; initiate proc desc:
     al  w3  x1+s0     ;
     al  w0  0         ;   clear privat part of
j0:  rs  w0  x3        ;   proc desc from
     al  w3  x3+2      ;   status area to reset delay;
     se  w3  x1+s6     ;
     jl.     j0.       ;
     al  w0  1         ;
     rs  w0  x1+s4     ;   current blockno:=1;
     rl. w0  i1.       ;
     jl.    (i0.)      ;
i0:  0                 ;
i1:  0                 ;
e.

e.  ; end of block including transmitter.


c.p101

; stepping stones:

     jl.     f4.       ;
     f4=k-2            ;

     jl.     f5.       ;
     f5=k-2            ;

     jl.     f6.       ;
     f6=k-2            ;

z.

e.  ; end of block including main- and line-drivers.
▶EOF◀