!begin
      / KAB81 reads the paper tape and makes chennel 6 tape
      / the input paper tape must have been propared by mkchan.c
      / as a PT images of a POST mag tape
      / enhancement as of Jluy 2020
      /   Initial lines beginning with Z have the form
      /   Z38: 16 octal digits
      /   and set the specified Z-store to the value indicated

prog=0:      /form B-block
        J.main; =H 0;
        =H 11004; =H 0;
        =P *n *c M *c KAB8;
        =P 1DH99UPU;
prog=4: JS.crash;  JS.crash;   /restart
        =0;  =0;
        = Q 0/1600/chbuff;

prog=1600:

/ -------------------------------------------------------------------
Z0 = 11103:   / Z11 should be accessed as F.Z0-11
Z50 = Z0-50:
              / N.B. variable nextz is held in M8, and I8 = -1
/ -------------------------------------------------------------------

sprint:
/ prints a string embedded in code, call sequence must be
/ *JS.sprint; *= #30; =P 8 chars ending in 02
!begin
   FLINK; NOT; NEG; DUP; SRM15; M+I15; DUP; SI15; SLINK;
   FQ15; SET8; OUT; EXIT.2;
!end

/ -------------------------------------------------------------------

n1print:
/ prints a string embedded in code followed by bottom bits of n1
/ call sequence must be *JS.cwprint; *= #30; =P 8 chars; =0;
!begin
   FLINK; NOT; NEG; DUP; SRM15; M+I15; M+I15; DUP; SI15; SLINK;
   F.radix; REV; FRB; F.digits; OR; SMM15/0;
   FQ15; SET8; OUT; EXIT.3;
*radix: =#1010100104101001;
digits: =#2020200020202002;
!end
/ -------------------------------------------------------------------

crash:
/   // disaster
 *JS.sprint; *=#30;
 =P --crash*c;
 MRWDQ0;
/ -------------------------------------------------------------------
!begin !label readch;      / exorts label readch outside the block
rdch0: ERASE;
readch:
      JCNZ5.samewd;
      JCNZ2.noread;
      PREQ6; PARQ6;
      SET32; SRC2; SET.chbuff-1; SRM5;
noread:
      SET-48; SC5; M+I5; DC2;
samewd: FMM5/0; SET6; S+C5; SHLC5; SET#77; AND;
      DUP; NOT; NEG; SHL-4; J=Z.rdch0;      / ignore all characters before / :
      EXITH;
!end

!begin !label ch7open, ch7write, ch7close;  / output to channel 7
*V0: =Q opbuff/opbuff+31/#121107;
 V1: =Q opbuff+32/opbuff+63/0;

ch7write:
      SET#160007; JS.70; JS.crash; ERASE; EXITH;
ch7open:
      F.V1; F.V0;
      JS.70; JS.crash; ERASE; EXITH;
ch7close:
      SET.opbuff+31; SRI15; SET#60007; SM15;
      FQ15; JS.70; JS.crash; EXITH;
!end

!begin !label main;
main:                            /main(int argc, char **argv)
      JS.ch7open;                / claim output tape
      SET2; SET5; OUT; SRC6;     / paper tape reader
      SET.chbuff; SI6; M+I6;
      SET31; S+M6;
      QFRQ0/2;                   / word counter
      QFRQ0/5;                   / char counter
      SET.opbuff; SM4;
wz:   JS.readch;
      SET#72; JNE.opop; ERASE;   / J if not Z-store prefix
      JS.readch; SET#17; AND;    / first digit
      JS.readch; SET#17; J=.d1;  / J if colon or slash, i.e. just 1 digit
      SET#17; AND;               / second digit
      REV; SET10; MULTD; CONT; +;
      JS.readch;                 / should be another colon or slash - ignore
d1:   ERASE; NEG; SM15;          / Z-store number
      SET16; SC4; ZERO;          / for i := 1 step 1 until 16 do (approx)
f1:   SHL+3; JS.readch; SET#17; AND; OR;
      DC4; JCNZ4.f1;
      SM15.Z0; J.wz;             / multiple Z-store specs allowed

opop: F.Z0-38;                   / output options to LP and to TTY
      SET16; SRC15;
w3:   SHL+1; STR; NOT; FM15.z38tab; OR; SMQ15.opbuff+1; JCNZ15.w3; ERASE;
      SET#30; S.opbuff; SET#177702; SM15.opbuff+1;
      F.v11; FM15; +; DUP; SET8; OUT;
      ZERO; S.opbuff; NEG; NOT; SET8; OUT;  / remove last word with newline

w0:   SET#34; J=.stop;           / while ch != semi-colon
      SET64; SRC3;               / assemble 64 half words -- last 2 words are overwritten
w2:   SET7; SC4;
      SET#7; AND;
w1:   SHL+3; JS.readch; SET#7; AND; OR; DC4; JCNZ4.w1;
      SHL+24; SMMQH3/4;
      JS.readch; JCNZ3.w2;

      SET30; SRC1;        / block size - 2
      MFRQ4/1;            / address of data
      ZERO; ZERO;
s1:   FMMQ1/0; STR; +D; JCNZ1.s1;
      F.blk; NOT; NEG; DUP; S.blk;       / block number
      DUP; SI1;
      ZERO; +D;           / add in the block no
      SHL+16; FI1;        / and also put it in the top 16 bits
      SHLD-16; ERASE;
      SMM1/0; SMMN1/0;    / of the KDF9 checksum
      JS.ch7write;

   /  SET#55; SHL+16;
   /  FM4; DUP; SHL+16; OR; SET31; +; SHL+16; SET70; OUT;

      J.w0;

stop: ERASE; JS.ch7close;
      FC6; SET6; OUT;                / deallocate paper tape reader

      SET#3024;                      / to call brick 84 to simulate KAB60 exit to translate Usercode
      F.Z0-38; SHL+11; J<Z.usercode; / J if source is Usercode
      ERASE;                         / not Usercode, so discard brick number
      SET#162006; JS.70; JS.crash;   / interchange to produce channel 6
      SET#2021;                      / to call brick 01
usercode:                            / sumulate KAB60 exit to translate Usercode
      SI15; SET#157010; SM15;
      FQ15; J.70;

*z38tab:              / table of bits in Z38 (all these words are -ve)
    = P CM+LP*s;      / D1   TINT;B100
    = P TABLES*s;     / D2   TINT;B040
    = P ORIG-SW*s;    / D3   TINT;B020  indicates use of original software for assembly
    = P TEXT*s;       / D4   TINT;B010
    = P NO-OPT*s;     / D5   TINT;B004
    = P NO-TEST*s;    / D6   TINT;B002
    = P NO-WARN*s;    / D7   TINT;B001
    = P L+G*4d*s;     / D8   TINT;B200000
    = P KALGOL*s;     / D9   TINT;B100000
    = P WALGOL*s;     / D10  TINT;B40000
    = P USERCODE;     / D11  TINT;B20000
    = P FORTRAN*s;    / D12  TINT;B10000
    = P UC/RLB*s;     / D13  TINT;B4000
    = P KAL4*s;       / D14  TINT;B2000
    = P D15*s;        / D15  TINT;B1000
    = P D16*s;        / D16  TINT;B400

v11: = Q 0/opbuff/opbuff+1;


*blk: =0;
!end // of main

*chbuff:
prog=prog+32:
opbuff:

!end
!end