!!!!! 20-AUG-80

!!! Card reader spooler interfacing directly to CR demon

%begin
%constinteger  SUB = '?';   ! replaces untranslatable card codes
%conststring(1) snl = "
"

%recordformat  parmfm(%shortinteger  dsno, dact, ssno, sact,  %c
                      %integer  p1, p2, p3, p4, p5, p6)
%recordformat   buffm(%shortinteger  dsno, dact, ssno, sact,  %c
                       %byteintegerarray  b(1:24) )

%constinteger line limit = 161
%string(161)  line
%shortintegerarray  cardbuff(1:80)
%record(parmfm)  p, fdr
%record(buffm)   text
%integer  tp
%owninteger  binary = 0
%integer  job type
%string(23)  user process, file name, password
%string(23)  s
%integer  unit, user, pass
%byteintegerarray  buff(0:511);  %integer  bp

%integer  temp file, file key, error, skipping, delete flag
%integer  j, k, sym, term

%constinteger  LINK READ = 3;   ! input request to link demon
%constinteger  EOT = 4
%constinteger  INITIALISE = 1;   ! must be 1 for 'STARTUP' program (q.v.)
%constinteger  COMMAND  = 2
%constinteger  GET = 3
%switch  act(INITIALISE:GET)

! packed names:
%constinteger  BATCH = 2566987, SELF = 1253847, LP=604 , PP=608 , CR=669
%constinteger  OPER  = 1007883
! BEL control characters in strings
%conststring(1)  squeak = "";   ! one BEL
%conststring(3)  blast  = "";   ! three BEL's

%routine  report(%string(23) s)
%record(parmfm)  p
   string(addr(p_p1)) = s
   p_dsno = 0
   svc(120,p)
%end


%predicate  spooler(%integer  user name)
   %true %if user name = LP %or user name = PP
   %false
%end

%routine  pack(%string(31)  fd, %record(parmfm)%name  p)
   string(addr(p_sact)) = fd
   svc(17,p)
%end


%routine  transvest
%record(parmfm)  p
   p_p1 = unit
   p_p2 = user
   p_p3 = pass
   p_p6 = 0
   p_dact = 27;  svc(20,p);    ! become
   %if p_p6 < 0 %start
      report("tranvest:".string(addr(p_p1)))
      %signal 15,15
   %finish
%end

%routine  revert
%record(parmfm)  p
   p_dact = 27;  p_p2 = 0;  p_p6 = 0;  svc(20,p)
   %if p_p6 < 0 %start
      report("revert:".string(addr(p_p1)))
      %signal 15,15
   %finish
%end

%integerfn  opened output
%record(parmfm)  p
   p_dact = 25;  svc(20,p);   ! unique file
   temp file = p_p4
   p_p3 = 0;      ! packed CR
   p_dact = 5;  svc(20,p);      ! open output
   %if p_p6 < 0 %start
      report("open:".string(addr(p_p1)))
      p_p5 = 0
   %finish
   %result = p_p5
%end

%routine  write buffer
%record(parmfm)  p
   p_p4 = addr(buff(0))
   p_p5 = file key
   p_dact = 8;  svc(20,p);   ! sequential write
   %if p_p6 < 0 %start
      report("write:".string(addr(p_p1)))
      %signal 15,15
   %finish
%end

%routine  put(%integer  sym)
   buff(bp) = sym;  bp = (bp+1)&511
   write buffer %if bp = 0
%end

%routine  insert(%string(63)  s)
%integer  j
   put(charno(s,j)) %for j = 1,1,length(s)
   put(nl)
%end

%routine  close file
%record(parmfm) p
   put(EOT) %until bp = 0
   p_p5 = file key;  p_dact = 11;  svc(20,p);   ! close
   %if job type = 1 %and %not spooler(user) %start;   ! //FILE (to user file)
      %if delete flag # 0 %start
         p = fdr
         p_dact = 14;  svc(20,p);   ! delete
         delete flag = 0
      %finish
      p_p3 = 0;  p_p4 = temp file
      p_p5 = fdr_p3;  p_p6 = fdr_p4
      p_dact = 15;  svc(20,p);   ! rename
   %else
      p_dact = 1;                  ! normal offer
      p_p3 = fdr_p3;  p_p4 = fdr_p4
      p_p5 = 0;  p_p6 = temp file
      %if job type # 1 %start;      ! //JOB, //OS32
         p_p1 = BATCH
         %if user process # ":" %start
            p_dact = 14
            p_p1 = unit;  p_p2 = user;  p_p5 = pass
         %finish
      %else;                        ! //FILE (to output spooler)
         p_p1 = user
      %finish
      svc(22,p);                     ! offer
      %if p_p6 < 0 %start
         report("offer:".string(addr(p_p1)))
         %signal 15,15
      %finish
   %finish
   file key = 0;   ! to inhibit any further 'close' attempts
%end;   ! close file

%routine read card and convert
%record(parmfm)  p;  %integer  bytes
   %routine  convert
   ! implied (global) parameters:
   !   %shortintegerarray  cardbuff(1:80)    : input card image
   !   %integer  bytes                        : byte length of input
   !   %string(160) line                      : output string
      %integer  conv1, conv2, char
      %integer  j,k,n
   ! Hollerith 'zone' table
   %constbyteintegerarray HZTAB(0:7) =
                               x'00',x'01',x'04',x'FF',x'05',x'FF',x'FF',x'FF'
   ! Digit Table
   %constshortintegerarray  DTAB(0:8) =
         x'0000',x'0100',x'0080',x'0040',x'0020',x'0010',x'0008',x'0004',x'0001'
   ! Ascii Table
   %constbyteintegerarray  ATAB(0:71) =
         X'20',X'30',X'38',X'59',X'2D',X'26',X'51',X'48',
         X'31',X'2F', SUB , SUB ,X'4A',X'41',X'5C', SUB ,
         X'32',X'53',X'3A',X'20',X'4B',X'42',X'21',X'5B',
         X'33',X'54',X'23',X'2C',X'4C',X'43',X'24',X'2E',
         X'34',X'55',X'40',X'25',X'4D',X'44',X'2A',X'3C',
         X'35',X'56',X'27',X'5F',X'4E',X'45',X'29',X'28',
         X'36',X'57',X'3D',X'3E',X'4F',X'46',X'3B',X'2B',
         X'37',X'58',X'22',X'3F',X'50',X'47',X'5E',X'5D',
         X'39',X'5A', SUB , SUB ,X'52',X'49', SUB , SUB 
   
      %if (binary = 0 %and bytes # 160) %or bytes&1 # 0 %start
         report("card columns??")
      %finish
      n = bytes>>1
      %if binary = 0 %start
         n = n-1 %until n = 0 %or cardbuff(n) = 0
         %for j = 1,1,n %cycle
            char = cardbuff(j)
            %if char = 0 %start
               char = ' '
            %else
               conv2 = hztab(char>>9)
               char = sub %and -> DUMP CHAR %if conv2 = 255
               conv2 = conv2 ! (char&2);      ! insert row 8 into zone
               char = char & x'01FD';         ! strip zone bits and row 8
               conv1 = 9
               %cycle
                  conv1 = conv1-1;   char = sub %and -> DUMP CHAR %if conv1 < 0
                  %exit %if char = dtab(conv1)
               %repeat
               conv1 = conv1*8
               char = atab(conv1+conv2)
            %finish
   DUMP CHAR:                        ! jump to here on error
            length(line) = length(line)+1;  charno(line,length(line)) = char
         %repeat
         line = line.snl
      %else;                  ! binary mode
         k = 0
         %for j = 1,1,n %cycle
            char = cardbuff(j)
            charno(line,k+1) = (char>>8)&63 + '!'
            charno(line,k+2) = char&63 + '!'
            k = k+2
         %repeat
         length(line) = k
      %finish
   %end;         ! convert
!********* read binary card image into CARDBUFF(1:80)***********
   convert
%end;            ! read card and convert

%integerfn  code for(%string(5)  s)
%conststring(5)%array job type(0:3) =
      "END ", "FILE", "JOB ", "OS32"
%integer  j
   %for j = 0,1,3 %cycle
      %result = j %if s = job type(j)
   %repeat
   %result = -1
%end

%routine  decode params
%integer  t
   %string(63)%fn  item
   %string(63)  s
      s = ""
      %cycle
         t = t+1
         %exit %if t >= length(line);   ! can ignore last character
         sym = charno(line,t)
         %exit %if sym = ':' %or sym = ','
         s = s.tostring(sym) %if sym # ' '
      %repeat
      %result = s
   %end
   user process = "";  filename = "";  password = ""
   error = 0
   t = 7-1;               ! past job type word
   user process = item.":";   ! **** the logic here needs checking ****
   %if sym = ',' %start
      file name = ""
   %else
      file name = item
   %finish
   error = 0
   password = item
   delete flag = 0;  delete flag = 1 %if item = "DELETE"
   pack(user process.filename,fdr)
   error = 1 %and %return %if fdr_p2 < 0
   pack(password.":",p);  pass = p_p2
   pack(user process.password,p);  unit = p_p1;  user = p_p2
   %return %if spooler(user)
   %if password # "" %start
      p_dact = 21;  svc(20,p);   ! find user
      %if p_p6 < 0 %or p_p3 # pass %start
         %if p_p6 < 0 %start
            report(blast."no user ".user process)
         %else
            report(blast."password for ".user process)
         %finish
         error = 1
      %finish
   %finish
%end

!      ======= start here ==========
act(INITIALISE):   ! ***** a frig up meantime *****
   p_p1 = 19;  svc(122,p);   ! uninhibit link
act(COMMAND):
      -> startup

WAIT:
   %cycle
      p_sact = 0;  svc(16,p);   ! poff(0,p)
      -> act(p_dact) %if 0 < p_dact <= GET
      report("bad dact")
   %repeat

STARTUP:
   skipping = 1
   file key = 0
   delete flag = 0
   job type = 0
   bp = 0
   tp = 25
   term = nl
   report("CR initialised")

   %cycle
      %cycle
         read card and convert
         %if binary # 0 %start
            %exit %if charno(line,1) = '/' = charno(line,2)   %c
                                          %and charno(line,3) # nl
         %finish
         %if skipping = 0 %start
            put(charno(line,j)) %for j = 1,1,length(line)
         %finish
      %repeat
      skipping = 1
      close file %if file key # 0
      revert;      ! N.B. may not actually do anything
      bp = 0;         !  --- initialise output buffer pointer ---
      charno(line,length(line)) = ' ';      ! splat NL
      line = line." " %while length(line) < 6
      report(squeak.line);   ! * for operator's edification
      job type = code for(substring(line,3,6))
      %if job type <= 0 %start;      ! error, //END
         report(blast.substring(line,1,6)) %if job type < 0
         %continue;      ! skip this job
      %finish
      decode params
      %continue %if error # 0
      skipping = 0
      %if job type # 1 %start;      ! //JOB, //OS32
         transvest %if user process # ":"
         file key = opened output
         insert("OS32MT") %if job type = 3
      %else;                        ! //FILE
         transvest %if %not spooler(user)
         file key = opened output
      %finish
   %repeat
%endofprogram
