home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / pdp11 / k11pk.mac < prev    next >
Text File  |  2020-01-01  |  36KB  |  1,371 lines
  1.     .title    $runjob    run a job on a psuedo for RSTS/E
  2.     .ident    /8.0.05/
  3.  
  4.  
  5.  
  6.     .if ndf, K11INC
  7.     .ift
  8.     .include    /IN:K11MAC.MAC/
  9.     .endc
  10.  
  11.     .include    /SY:[1,2]COMMON.MAC/
  12.     .title    $runjo
  13.     .psect    $code
  14.  
  15.  
  16. ;    Brian Nelson
  17. ;    Computer Services
  18. ;    University of Toledo
  19. ;    2801 West Bancroft
  20. ;    Toledo, Ohio 43606
  21. ;    (419) 537-2511
  22. ;
  23. ;
  24. ;    E D I T       H I S T O R Y
  25. ;
  26. ;    date       time       edit  who    why
  27. ;
  28. ;    12-jun-80         0     BDN    initial coding
  29. ;    01-dec-82         1     BDN    expand arg list, add f4/bp2 entry points
  30. ;    20-Apr-83  13:40:31  2     BDN    add disk logging for terminal output
  31. ;    09-May-83  14:38:57  3     BDN    check for detaching via modem disconnect
  32. ;    31-May-83  15:27:40  4     BDN    add code to check for spawning from a pk
  33. ;    11-Jul-83  15:02:16  5     BDN    add code to check if version 8.0 and if
  34. ;                    so use the new uu.sys features
  35. ;    12-Jul-83  12:48:04  5     BDN    fixed '$runjo' entry point up to work.
  36. ;
  37. ;    **************************************
  38.  
  39.     .sbttl    entry points
  40.  
  41.  
  42. ;    $RUNJOB
  43. ;
  44. ;    start a job on a psuedo keyboard and run it
  45. ;
  46. ;
  47. ;    entry points:
  48. ;
  49. ;     $RUNJOB        (for compatibilty with previous versions)
  50. ;
  51. ;       parameters:
  52. ;
  53. ;        0(r5)    =    address of command string address block
  54. ;        2(r5)    =    job termination flag word
  55. ;        4(r5)    =    lowest channel number to use
  56. ;        6(r5)    =    elapsed time limit
  57. ;
  58. ;
  59. ;
  60. ;     $$RUNJ            (new format)
  61. ;
  62. ;       parameters:
  63. ;
  64. ;        0(r5)    =    address of command string address block
  65. ;        2(r5)    =    job termination flag word
  66. ;        4(r5)    =    lowest channel number to use
  67. ;        6(r5)    =    elapsed time limit
  68. ;       10(r5)    =    binary of account to log into
  69. ;       12(r5)    =    input file address  (zero if none)
  70. ;       14(r5)    =    output file address (zero if none)
  71. ;
  72. ;
  73. ;     RUNJOB            (fortran/bp2/f77 callable)
  74. ;
  75. ;       parameters:
  76. ;
  77. ;         @r5    =    dec standard arg count (fortran/bp2)
  78. ;        2(r5)    =    address of command string address block
  79. ;        @4(r5)    =    job termination flag word
  80. ;        @6(r5)    =    lowest channel number to use
  81. ;        @10(r5)    =    elapsed time limit
  82. ;        @12(r5)    =    binary of account to log into (optional)
  83. ;         14(r5)    =    address of a file to read input from
  84. ;         16(r5)    =    address of a file to put output to
  85. ;
  86. ;
  87. ;        See sample fortran source code below for usage.
  88. ;       Note that the channel number to start with must be low
  89. ;       enough  to accomidate the optional disk file for output
  90. ;       if used. Ie, if you pass '11' (decimal) as the starting
  91. ;       lun then  channels 12, 13 and  14 must also be free for
  92. ;       use.
  93.  
  94.     .sbttl    explanation of the second arguement
  95.  
  96.  
  97. ;    for the parameter at 2(r5), ( @4(r5) for Fortran/Bp2 )
  98. ;    which is the termination flag:
  99. ;
  100. ;       if 2(r5) and 1 <> 0, exit on user typing a control D (^D)
  101. ;       if 2(r5) and 2 <> 0, exit on control c (KMON) wait
  102. ;       if 2(r5) and 4 <> 0, exit on end of commands (addr=0)
  103. ;       if 2(r5) and 10<> 0, do not echo psuedo KB's output.
  104. ;       if 2(r5) and 20<> 0, do not use binary mode
  105. ;       if 2(r5) and 40<> 0, the ppn passed is real
  106. ;       if 2(r5) and 100<>0, kill job if it logs out and return
  107. ;       if 2(r5) and 200<>0, do not allow caller to be on a pk
  108. ;       if 2(r5) < 0       , ignore errors (first char '?')
  109. ;
  110. ;    error return:
  111. ;
  112. ;        r0 = 0     no errors
  113. ;        r0 > 0   r0 will have the RSTS error number in it
  114. ;        r0 = -1     '?' found in first char of pk output line
  115. ;        r0 = -2     PK job already running (calling job is on PK:)
  116. ;        r0 = -3  elapsed time exceeded
  117. ;
  118. ;
  119. ;    command address block format:
  120. ;
  121. ;    example:
  122. ;
  123. ;        ;    run thru the 3 ccl commands
  124. ;        ;    exit on end of commands ('0' at end of cmdblk:)
  125. ;        ;    use rsts channel number 11 and 12 (decimal)
  126. ;        ;    no time limit
  127. ;
  128. ;        cmdblk:    .word    10$,20$,30$,0
  129. ;        10$:    .asciz    #PIP DB1:/L:S#<cr><lf>
  130. ;        20$:    .asciz    #FOR JUNK=JUNK#<cr><lf>
  131. ;        30$:    .asciz    #SY/N#<cr><lf>
  132. ;            .even
  133. ;
  134. ;        calls    $runjob    ,<#cmdblk,#4,#11.,#0>
  135. ;        tst    r0
  136. ;
  137. ;
  138. ;    stack usage requirement:
  139. ;
  140. ;        all internal vars and buffers need 170 decimal bytes
  141. ;        of stack available
  142. ;
  143. ;    internal register usage:
  144. ;
  145. ;        r0    scratch, error return, single parameter passing
  146. ;        r1    scratch, never saved on call/exit
  147. ;        r2    address of next .asciz command
  148. ;        r3    --> FIRQB+0 always
  149. ;        r4    --> local data block (which is on the stack)
  150. ;        r5    --> XRB+0   always
  151. ;
  152.  
  153.     .sbttl    local data definitions
  154.  
  155.  
  156.  
  157.     .dsabl    gbl
  158.  
  159.  
  160.     .iif    ndf    ,edrt    ,edrt = 0
  161.  
  162.     .if ne    ,edrt            ; .priv is a null macro
  163.     .ift                ; for ted
  164.     .macro    .priv            ;
  165.     .endm
  166.     .iff
  167.     .globl    .priv
  168.     .endc                ; for ted
  169.  
  170.  
  171.     .macro    $sleep    t
  172.     mov    t    ,xrb+0
  173.     .priv
  174.     .sleep
  175.     .endm    $sleep
  176.  
  177.     .macro    .print    a,l        ; perhaps minitab is here
  178.     .if b, l            ; or we are using this from
  179.     .ift                ; fortran or bp2
  180.     clr    -(sp)            ; no length, assume .asciz
  181.     .iff                ; length passed
  182.     mov    l    ,-(sp)        ; stuff it please
  183.     .endc                ; if b, len
  184.     mov    a    ,-(sp)        ; stuff string address
  185.     call    lprint            ; and do it
  186.     .endm
  187.     
  188.     .macro    callr0    name    ,arg
  189.     mov    arg    ,r0
  190.     call    name
  191.     .endm    callr0
  192.  
  193.  
  194.     nodevc    =    6
  195.     notavl    =    10
  196.     eof    =    13
  197.     daterr    =    15
  198.     detkey    =    33
  199.     corcom    =    460
  200.  
  201.  
  202.     .asect            ; define offsets from r4 for local vars
  203.     .    =    0    ; offsets start at zerp
  204.     buflen    =    150.    ; size of the pk buffer
  205. buffer:    .blkb    buflen        ; the pk buffer, at 0(r4)
  206. rcount:    .blkw            ; size of last kb or pk read
  207. kbddb:    .blkw            ; address controlling job's ddb for KB:
  208. pkddb:    .blkw            ; address of the pk's ddb
  209. pkjob2:    .blkw            ; job number times two for the pk job
  210. pkkbn:    .blkw            ; kb number of the PK: in use
  211. urts:    .blkw 2            ; the controlling job's default RTS
  212. uppn:    .blkw            ; the controlling job's PPN
  213. upriv:    .blkw            ; <> 0 if controlling job is in (1,*)
  214. ujob2:    .blkw            ; the controlling job's job number * 2
  215. cmds:    .blkw            ; copy of command block address
  216. abortf:    .blkw            ; copy of the termination flag
  217. pklun2:    .blkw            ; channel number times two for PK
  218. kblun2:    .blkw            ; channel number times two for KB
  219. timout:    .blkw            ; copy of elapsed time flag
  220. newppn:    .blkw            ; if switching ppn's
  221.  
  222. inf:    .blkw            ; input file if given
  223. inbfa:    .blkw            ; input file buffer address
  224. outf:    .blkw            ; output file if given
  225. outbfa:    .blkw            ; output file buffer address
  226.  
  227. influn:    .blkw            ; disk input  file lun * 2
  228. outflu:    .blkw            ; disk output file lun * 2
  229.  
  230. infpnt:    .blkw            ; disk input  buffer pointer
  231. outfpn:    .blkw            ; disk output buffer pointer
  232.  
  233. timini:    .blkw            ; initial time at entry here.
  234. cyc:    .blkw
  235. lastch:    .blkw            ; last char of preceeding pk read
  236. kbintf:    .blkw            ; interface type for controlling job
  237.  
  238.     js.kb    =    2    ; bit in JBWAIT for KB wait state
  239.     
  240.     .if ne    ,edrt
  241.     .ift
  242.     stim    =    1
  243.     .iff
  244.     stim    =    3    ; sleep time in main loop
  245.     .endc
  246.  
  247.     swait    =    < << 60./stim >+1 > * stim> / 2
  248.     .iif    le    ,swait ,swait = 1
  249.  
  250.     locsiz    =    . + 2    ; size of the local data
  251.     .assume    buffer eq 0
  252.  
  253.         .psect    $code
  254.  
  255.  
  256. ;    bits defined in abortf(r4)
  257.  
  258.     f$ctld    =    1
  259.     f$kmon    =    2
  260.     f$eot    =    4
  261.     f$nech    =    10
  262.     f$nbin    =    20
  263.     f$nppn    =    40
  264.     f$nopr    =    100
  265.     f$nopk    =    200
  266.  
  267.  
  268. str.cr:    .byte    0,0
  269. plogin:    .rad50    /LOGIN /
  270.     .word    -1
  271. crfail:    .asciz    /?Can't start job/<cr><lf>
  272. nopk:    .asciz    /?no PK's/ <cr> <lf>
  273. fatbug:    .asciz    /?bug in openpk/ <cr> <lf>
  274.     .even
  275.  
  276.  
  277.     .sbttl    fortran/bp2 entry point
  278.  
  279.     .if eq    ,edrt
  280.     .ift
  281.  
  282. ;        byte filnam(30)
  283. ;        byte out(512)
  284. ;        integer outf(2)
  285. ;        byte buffer(84)
  286. ;        outf(2) = iaddr(out)
  287. ;        outf(1) = iaddr(filnam)
  288. ;        read (5,1) filnam
  289. ;    1    format (30a1)
  290. ;        filnam(30) = 0
  291. ;        type *,'starting'
  292. ;    5    continue
  293. ;        read (5,100) (buffer(i),i=1,80)
  294. ;        mode = 5
  295. ;        do 10 j = 80,1,-1
  296. ;         if (buffer(j).ne.' ') go to 20
  297. ;    10    continue
  298. ;        mode = "100001
  299. ;        buffer(1) = 0
  300. ;        go to 30
  301. ;    20    continue
  302. ;        buffer(j+1) = 13
  303. ;        buffer(j+2) = 10
  304. ;        buffer(j+3) = 0
  305. ;    30    continue
  306. ;        ierr = runjob(buffer,mode,11,0,0,,outf)
  307. ;        type *,ierr
  308. ;        goto 5
  309. ;    100    format (80a1)
  310. ;        stop
  311. ;        end
  312. ;
  313. ;
  314. ; Note:    the 'infile' (not yet implemented) and the 'outfile' address
  315. ;    actually are parameter blocks consisting of
  316. ;
  317. ;      (1)  a filename address
  318. ;      (2)  a buffer address of 1000 (8) bytes
  319. ;
  320. ;      as in:
  321. ;
  322. ;        integer outf(2)
  323. ;        byte outbuf(512)
  324. ;        byte outnam(30)
  325. ;        read (5,100) outnam
  326. ;        outnam(30) = 0
  327. ;        outf(1) = iaddr(outnam)
  328. ;        outf(2) = iaddr(outbuf)
  329.  
  330.  
  331.     .sbttl    calling example from MINITAB's 'system' command
  332.  
  333. ;        subroutine syscmd(cmdlin)
  334. ;    c
  335. ;    c    change 'cmdlin' to byte for version 82 of minitab
  336. ;    c
  337. ;        byte cmdlin(80)
  338. ;        byte buffer(84)
  339. ;        common /isc/ buffer
  340. ;        integer runjob
  341. ;    c
  342. ;        integer irsts,irsxts,irsx,ivax,irt11,myexec,pkflag
  343. ;        common /ostype/ irsts,irsxts,irsx,ivax,irt11,myexec,pkflag
  344. ;    c
  345. ;        if ((myexec.eq.irsts).or.(myexec.eq.irsxts)) go to 5
  346. ;         write (5,220)
  347. ;         return
  348. ;    c
  349. ;    5    continue
  350. ;        do 10 j = 1 , 80
  351. ;         buffer(j) = ' '
  352. ;    10    continue
  353. ;    c
  354. ;        do 20 j = 1 , 80
  355. ;         if (cmdlin(j).eq.' ') go to 30
  356. ;    20    continue
  357. ;        j = 0
  358. ;    30    continue
  359. ;        k = j + 1
  360. ;        i = 1
  361. ;    c
  362. ;        do 40 j = k,80
  363. ;         buffer(i) = cmdlin(j)
  364. ;         i = i + 1
  365. ;    40    continue
  366. ;    c
  367. ;        mode = 5
  368. ;        do 80 j = 80,1,-1
  369. ;         if (buffer(j).ne.' ') go to 90
  370. ;    80    continue
  371. ;        mode = "100001
  372. ;        buffer(1) = 0
  373. ;        write (5,200)
  374. ;        go to 100
  375. ;    90    continue
  376. ;        buffer(j+1) = 13
  377. ;        buffer(j+2) = 0
  378. ;    100    continue
  379. ;        mode = mode .or. "100
  380. ;        ierr = runjob(buffer,mode,11,0)
  381. ;        if (ierr.ne.0) write (5,210) ierr
  382. ;        return
  383. ;    c
  384. ;    c
  385. ;    200    format (' Type control D (^D) to return to MINITAB'/)
  386. ;    210    format (' PK driver returned error code ',i5)
  387. ;    220    format (' %Minitab-W  The SYSTEM command is not available')
  388. ;    c
  389. ;        end
  390.  
  391.  
  392.  
  393.     .sbttl    fortran/bp2 entry point continued
  394.  
  395.     .psect    $code
  396.  
  397.     f4.out    =    16        ; optional output fileblock
  398.     f4.inf    =    14        ; optional input  fileblock
  399.     f4.ppn    =    12        ; optional ppn to log into
  400.     f4.tim    =    10        ; timeout flag
  401.     f4.lun    =    6        ; lowest channel number to use
  402.     f4.fla    =    4        ; run flags
  403.     f4.buf    =    2        ; command clock address
  404.  
  405.  
  406. runjob::mov    r5    ,-(sp)        ; convert f4/bp2 call format
  407.     mov    r4    ,-(sp)
  408.  
  409.     clr    -(sp)            ; assume no address for outfile
  410.     cmpb    @r5    ,#7        ; 7 args (last is output file)
  411.     blo    1$            ; no
  412.     cmp    f4.out(r5),#-1        ; yes, is the arguement ommitted?
  413.     beq    1$            ; yes. leave a zero for the address
  414.     mov    f4.out(r5),@sp        ; no, copy the filename address
  415.  
  416. 1$:    clr    -(sp)            ; assume no address for infile
  417.     cmpb    @r5    ,#6        ; 6 args (second to last)
  418.     blo    2$            ; no
  419.     cmp    f4.inf(r5),#-1        ; yes, at least 6. was it ommitted?
  420.     beq    2$            ; yes, address of 177777 is dec's way
  421.     mov    f4.inf(r5),@sp        ; no, copy the address to the stack
  422.  
  423. 2$:    clr    -(sp)            ; assume no new ppn now
  424.     cmpb    @r5    ,#5        ; passed another ppn to use?
  425.     blo    5$            ; no
  426.     cmp    f4.ppn(r5),#-1        ; at least 5 parameters, is it real?
  427.     beq    5$            ; yep
  428.     mov    @f4.ppn(r5),@sp        ; yes, stuff it please
  429.  
  430. 5$:    mov    @f4.tim(r5),-(sp)    ; to that expected by the pk
  431.     mov    @f4.lun(r5),-(sp)    ; driver here
  432.     mov    @f4.fla(r5),-(sp)    ; job termination flag
  433.     clr    -(sp)            ; for now, no cmd blocks
  434.     mov    sp    ,r4        ; point to new parameter list
  435.     clr    -(sp)            ; create cmd block descriptor
  436.     mov    f4.buf(r5),-(sp)    ; buffer address
  437.     mov    sp    ,4(sp)        ; stuff the block in now
  438.     mov    r4    ,r5        ; saved address of new param
  439.     tstb    @(sp)            ; null command line passed?
  440.     bne    10$            ; no
  441.     clr    (sp)            ; yes, setup for nothing then
  442. 10$:
  443.     call    $$runj            ; do the work and exit
  444.     add    #22    ,sp        ; pop parameters
  445.     mov    (sp)+    ,r4        ; pop saved r4
  446.     mov    (sp)+    ,r5        ; pop saved r5
  447.     return                ; and exit
  448.  
  449. 100$:    .asciz    /starting - /
  450. 110$:    .byte    cr,lf
  451.     .even
  452.     .endc                ; not included for ted
  453.  
  454.  
  455.  
  456.     .sbttl    main control loop
  457.  
  458.         .psect    $code
  459.  
  460.  
  461.  
  462. $runjo::clr    -(sp)
  463.     clr    -(sp)
  464.     clr    -(sp)
  465.     mov    6(r5)    ,-(sp)
  466.     mov    4(r5)    ,-(sp)
  467.     mov    2(r5)    ,-(sp)
  468.     mov    @r5    ,-(sp)
  469.     mov    sp    ,r5
  470.     call    $$runj
  471.     add    #7*2    ,sp
  472.     return
  473.  
  474.  
  475. $$runj:    mov    #jfsys    ,xrb+0        ; get privs back if possible
  476.     .priv                ; prefix, if required.
  477.     .set                ; set keyword bit call to exec
  478.     save    <r1,r2,r3,r4,r5>    ; should do this.
  479.     sub    #locsiz    ,sp        ; allocate space for us.
  480.     mov    sp    ,r4        ; r4 will point to work area
  481.     call    init            ; initial junk for startup
  482.     bcs    100$            ; oops !
  483.     call    openfi
  484.     bcs    100$            ; oops !
  485.     call    login            ; login pk
  486.     bcs    100$            ; oops
  487.     call    pkjobn            ; get the pk job number * 2
  488.     call    record            ; record time-sharing session
  489. 100$:
  490. die:    call    clsout
  491.     add    #locsiz    ,sp        ; pop our work area from stack
  492.     mov    #firqb+fqfil,r3        ; useful address
  493.     call    $zapfqb
  494.     movb    #clsfq    ,firqb+fqfun    ; close the channels we used
  495.     movb    pklun2(r4),@r3        ; channels here
  496.     .priv                ; prefix as usual
  497.     calfip
  498.     call    $zapfqb
  499.     movb    #clsfq    ,firqb+fqfun    ; close the channels we used
  500.     movb    kblun2(r4),@r3        ; channels here
  501.     .priv                ; prefix as usual
  502.     calfip
  503.     unsave    <r5,r4,r3,r2,r1>
  504.     mov    #jfsys    ,xrb+0        ; drop privs at exit
  505.     .priv                ;
  506.     .clear                ; drop bits in keyword call
  507.     return
  508.  
  509.  
  510.  
  511.     .sbttl    initial stuff
  512.  
  513.  
  514.     .assume    uppn    eq    <urts+4>
  515.     .assume upriv    eq    <uppn+2>
  516.     .assume    ujob2    eq    <upriv+2>
  517.     .assume    cmds    eq    <ujob2+2>
  518.     .assume    abortf    eq    <cmds +2>
  519.     .assume    pklun2    eq    <abortf+2>
  520.     .assume    kblun2    eq    <pklun2+2>
  521.     .assume    timout    eq    <kblun2+2>
  522.     .assume    newppn    eq    <timout+2>
  523.     .assume    inf    eq    <newppn+2>
  524.     .assume    inbfa    eq    <inf+2>
  525.     .assume    outf    eq    <inbfa+2>
  526.     .assume    outbfa    eq    <outf+2>
  527.     .assume    influn    eq    <outbfa+2>
  528.     .assume    outflu    eq    <influn+2>
  529.  
  530.  
  531. init:    call    $zapfqb            ; zap the firqb first please
  532.     mov    r4    ,r1        ; clear out the local vars
  533.     mov    #locsiz-2,r0        ; which we allocated on the
  534. 5$:    clrb    (r1)+            ; stack
  535.     sob    r0    ,5$        ; all of it please
  536.     movb    #uu.sys    ,firqb+fqfun    ; systat sys call with subfun
  537.     .priv                ; zero to get default user
  538.     .uuo                ; runtime system.
  539.     mov    firqb+12,timini(r4)    ; save user's connect
  540.     mov    #swait    ,cyc(r4)    ; stuff control for time check
  541.     mov    r4    ,r3        ; Base address of impure area.
  542.     add    #urts    ,r3        ; we will start here.
  543.     mov    firqb+30,(r3)+        ; copy two rad50 words for
  544.     mov    firqb+32,(r3)+        ; user's default rts
  545.     mov    firqb+26,(r3)+        ; and the ppn for our user.
  546.     clr    (r3)+            ; set the user is (1,*) flag
  547.     cmpb    #1    ,<uppn+1>(r4)    ; perm privs here ?
  548.     bne    10$            ; nop
  549.      mov    sp    ,-2(r3)        ; yes, set a flag then
  550. 10$:    movb    firqb+fqjob,(r3)+    ; job number times 2
  551.     clrb    (r3)+            ; to be sure, get high byte out
  552.     mov    (r5)+    ,(r3)+        ; save command string address
  553.     mov    (r5)+    ,(r3)+        ; save the abort flag
  554.     mov    (r5)+    ,r0        ; starting lun to use for the
  555.     ble    100$            ; pk and for the kb. Must be
  556.     asl    r0            ; > 0
  557.     mov    r0    ,(r3)+        ; pk lun is the first one
  558.     add    #2    ,r0        ; kblun2 = pklun2 + 2
  559.     mov    r0    ,(r3)+        ; thats all
  560.     mov    (r5)+    ,(r3)+        ; job elapsed time parameter.
  561.     mov    (r5)+    ,(r3)+        ; alternate ppn
  562.     bit    #f$nppn    ,abortf(r4)    ; really do this
  563.     bne    20$            ; yes
  564.     clr    -2(r3)            ; no
  565. 20$:    mov    (r5)+    ,r0        ; get input file block
  566.     beq    30$            ; a null parameter there
  567.      mov    2(r0)    ,inbfa(r4)    ; save input buffer address
  568.      mov    @r0    ,r0        ; get filename address now.
  569.      tstb    @r0            ; anything there ?
  570.      beq    30$            ; no, leave name address eq 0
  571.      mov    r0    ,inf(r4)    ; yes, save address
  572.      mov    kblun2(r4),influn(r4)    ; also allocate a channel
  573.      add    #2    ,influn(r4)
  574.  
  575. 30$:    mov    (r5)+    ,r0        ; get output file block
  576.     beq    40$            ; a null parameter there
  577.      mov    2(r0)    ,outbfa(r4)    ; save output buffer address
  578.      mov    @r0    ,r0        ; get filename address now.
  579.      tstb    @r0            ; anything there ?
  580.      beq    40$            ; no, leave name address eq 0
  581.      mov    r0    ,outf(r4)    ; yes, save address
  582.      mov    kblun2(r4),outflu(r4)    ; also allocate a channel
  583.      add    #4    ,outflu(r4)
  584. 40$:
  585.  
  586. 100$:    clr    r0
  587.     mov    #520.    ,xrb+0        ; get the controlling job's
  588.     .priv                ; kbddb as:
  589.     .peek                ; peek(peek(peek(520.)))
  590.     .priv                ; and again
  591.     .peek                ; .....
  592.     .priv                ; one more time
  593.     .peek                ; ah !
  594.     mov    xrb+0    ,kbddb(r4)    ; and pack it away
  595.     mov    #firqb    ,r3        ; r3 will always --> IOSTS
  596.     mov    #xrb    ,r5        ; r5 will always --> xrb+0
  597.  
  598.     call    $zapfqb            ; clear firqb for getting interface
  599.     movb    #uu.trm    ,firqb+fqfun    ; type. perhaps caller will not
  600.     movb    #377    ,firqb+5    ; allow a pk to run a pk job.
  601.     .priv                ; rt emulator perhaps?
  602.     .uuo                ; get terminal characteristics
  603.     movb    firqb+24,kbintf(r4)    ; save the interface type
  604.     bit    #f$nopk    ,abortf(r4)    ; allow caller to be on a pk?
  605.     beq    110$            ; yes
  606.     cmpb    kbintf(r4),#10        ; no, is the caller running on
  607.     bne    110$            ; a psuedo keyboard already?
  608.     mov    #-2    ,r0        ; yes
  609.     sec                ; also set this error status
  610.     br    120$            ; and exit
  611.  
  612. 110$:    clc                ; and away we go !
  613. 120$:    return                ; for now.
  614.  
  615.  
  616.     .sbttl    open files up please
  617.  
  618.  
  619.  
  620. openfi:    call    openkb            ; open 'kb:' mode 1
  621.     bcs    100$            ; oops !
  622.     call    openpk            ; open 'pk?:'
  623.     bcs    100$
  624.     callr0    getddb    ,pkkbn(r4)    ; we will need the pk's DDB.
  625.     bcs    100$            ; oops
  626.     mov    r0    ,pkddb(r4)    ; and save the kbddb
  627.     call    opninp
  628.     bcs    100$
  629.     call    opnout
  630.  
  631. 100$:    return
  632.  
  633.  
  634.  
  635.     .sbttl    open/close logging file if open
  636.  
  637.     .if eq    ,edrt            ; save address space for TED
  638.     .ift
  639.  
  640. opnout:    call    $zapfqb            ; open possible optional output
  641.     mov    outf(r4),r2        ; get output filename
  642.     beq    100$            ; nothing to open
  643.     mov    r2    ,r1        ; save it
  644. 10$:    tstb    (r1)+            ; get the length please
  645.     bne    10$            ; no nulls as of yet
  646.     sub    r2    ,r1        ; length + 1
  647.     dec    r1            ; length
  648.     mov    #xrb    ,r0        ; clear firqb for a .fss
  649.     mov    r1    ,(r0)+        ; xrb.xrlen := len(filename)
  650.     mov    r1    ,(r0)+        ; xrb.xrbc  := len(filename)
  651.     mov    r2    ,(r0)+        ; xrb.xrloc := address(filename)
  652.     .rept    4            ; the rest is unused
  653.     clr    (r0)+            ;
  654.     .endr                ;
  655.     .priv                ; now do the filename string scan
  656.     .fss                ; simple
  657.     movb    @r3    ,r0        ; get error codes (r3 --> firqb+0)
  658.     bne    110$            ; oops
  659.     movb    #crefq    ,firqb+fqfun    ; open a file function for fip
  660.     movb    outflu(r4),firqb+fqfil    ; channel number times 2
  661.     clr    firqb+fqmode        ; no modes please
  662.     .priv
  663.     calfip                ; get rsts to open it up
  664.     movb    @r3    ,r0        ; copy error codes from firqb+0
  665.     bne    110$            ; ok
  666.     clr    outfpnt(r4)        ; init output buffer pointer
  667.     mov    outbfa(r4),r0        ; null fill the output buffer
  668.     mov    #1000    ,r1        ; 1000 (8) bytes worth
  669. 50$:    clrb    (r0)+            ; clear a byte
  670.     sob    r1    ,50$        ; and back for more
  671.  
  672. 100$:    clc                ; no errors
  673.     return
  674.  
  675. 110$:    clr    outf(r4)        ; clear filename address out
  676.     movb    firqb    ,r0
  677.     sec                ; error exit, error code in r0
  678.     return
  679.  
  680.  
  681.  
  682. clsout:    tst    outf(r4)        ; output file there ?
  683.     beq    100$            ; no
  684.     call    wrtout            ; dump output buffer
  685.     call    $zapfqb            ; and close the file
  686.     movb    #clsfq    ,firqb+fqfun    ; fip function to close it
  687.     movb    outflu(r4),firqb+fqfil    ; channel number times 2
  688.     .priv                ; rt11.rts prefixes today ?
  689.     calfip                ; close it
  690. 100$:    return
  691.  
  692.     .iff                ; for TED, dummy fileopens out
  693.  
  694. opnout:
  695. clsout:    clc
  696.     return
  697.  
  698.     .endc                ; if eq, edrt
  699.  
  700.     .sbttl    open input file (not yet implemented)
  701.  
  702. opninp:    clr    inf(r4)
  703.     return
  704.  
  705.  
  706.     
  707.  
  708.     .sbttl    openkb    - open 'kb:' as file 1, mode 1
  709.  
  710. openkb:    call    $zapfqb            ; zap firqb
  711.     movb    kblun2(r4),@#firqb+fqfil ; channel 1
  712.     mov    #"KB,@#firqb+fqdev    ; 'kb:'
  713.     mov    #buflen,@#firqb+fqbufl    ; buffer length
  714.     mov    #100001!40!20,@#firqb+fqmode ; mode 1+32+16
  715. ;;    bis    #100000,@#firqb+fqmode    ; mode is real
  716.     movb    #opnfq,@#firqb+fqfun    ; open function
  717.     .priv                ; have rsts/e
  718.     calfip                ; open the file
  719.     tstb    @r3            ; any problems ?
  720.     beq    10$            ; no, go return
  721.      movb    @r3    ,r0
  722.      sec
  723.  
  724. 10$:    return                ; back to work...
  725.  
  726.  
  727.  
  728.     .sbttl    get job number for PK job
  729.  
  730.  
  731. pkjobn:    
  732.     mov    pkddb(r4),@r5        ; get the pk ddb and then we
  733.     add    #2    ,@r5        ; can get the job number out
  734.     .priv                ; ddjbno by a quick peek.
  735.     .peek                ; peek at it
  736.     mov    @r5    ,-(sp)        ; save it for a moment
  737.     bic    #^C126.    ,(sp)        ; junk high order stuff and
  738.     mov    (sp)+    ,pkjob2(r4)    ; save it
  739.     return
  740.  
  741.  
  742. getddb:    call    $zapfqb            ; get ddb of kb number passed
  743.     movb    #uu.tb2    ,firqb+fqfun    ; in r0. Get DEVOKB to get the
  744.     .priv                ; disk count thus getting the
  745.     .uuo                ; eventually the kb ddb's.
  746.     mov    firqb+12,-(sp)        ; save this for a moment.
  747.     movb    #uu.tb1    ,firqb+fqfun    ; get tables part 1 for the
  748.     .priv                ; devptr
  749.     .uuo                ; rsts does it again !
  750.     mov    firqb+10,@r5        ; @r5 := devptr
  751.     add    (sp)+    ,@r5        ; plus devokb
  752.     .priv                ; now get devtbl as
  753.     .peek                ; peek( devtbl+edvokb )
  754.     mov    r0    ,-(sp)        ; add in the kbnumber times 2
  755.     asl    (sp)            ; to get the ddb of the tty.
  756.     add    (sp)+    ,@r5        ; all set now.
  757.     .priv                ; prefix if needed.
  758.     .peek                ; and peek at it.
  759.     mov    @r5    ,r0        ; return kbddb in r0.
  760.     clc                ; no errors
  761.     return
  762.  
  763. ccstate:call    $zapfqb            ; see if job is in KB ^C wait
  764.     movb    #uu.sys    ,firqb+fqfun    ; do a job systat part 2
  765.     incb    firqb+5            ; 
  766.     movb    pkjob2(r4),firqb+4    ; where the job number goes
  767.     asrb    firqb+4            ; not times two for .uuo
  768.     .priv                ; of course
  769.     .uuo                ; get rsts
  770.     cmp    firqb+14,#js.kb        ; jbwait show a kb wait ?
  771.     clc                ; restore possible c bit set
  772.     bne    10$            ; no, time to leave now.
  773.     mov    firqb+32,@r5        ; stuff JDB address for a peek
  774.     add    #6    ,@r5        ; we need address of jdwork
  775.     .priv                ; of course
  776.     .peek                ; sneak a look at the exec
  777.     add    #10.    ,@r5        ; finally where to look at in
  778.     .priv                ; the job's work block.
  779.     .peek                ; and so on .......
  780.     tst    @r5            ; < 0
  781.     bpl    10$            ; no, exit with no wait
  782.      sec                ; yes, flag as ^C(0) wait.
  783. 10$:    return
  784.  
  785.  
  786.     .sbttl    check out the pk's status
  787.  
  788.  
  789. ttyou:    mov    r0    ,@r5        ; see if pk is doing tt output
  790.     add    #10.    ,@r5        ; check buffer chains
  791.     .priv                ; you know
  792.     .peek                ; only a privledged few can do
  793.     mov    @r5    ,-(sp)        ; this, you know.
  794.     mov    r0    ,@r5        ; one more time please
  795.     add    #12.    ,@r5        ; and so on
  796.     .priv                ; 
  797.     .peek                ; and get the peeker
  798.     cmp    (sp)+    ,@r5        ; empty yet ?
  799.     bne    10$            ; no
  800.     clc                ; yes
  801.     return
  802.  
  803. 10$:    sec
  804.     return
  805.  
  806.  
  807. ;    note: following code from ATPK (with minor mods)
  808.  
  809. pksts:    save    <r0,r1>
  810.     call    pkjobn            ; get the job number for PKn:
  811.     clr    r0            ; are we the same job number ?
  812.     mov    pkjob2(r4),r1        ; save it here
  813.     cmpb    r1    ,ujob2(r4)    ; if so, then login is not done
  814.     bne    10$            ; ok
  815.      com    r0            ; no, we are the same job.
  816. 10$:    tstb    r1            ; a real job there yet ?
  817.     beq    20$            ; no
  818.      call    $zapfqb            ; yes, get the job's ppn
  819.      movb    #uu.sys    ,firqb+fqfun    ; use the uu.sys instead of
  820.      movb    r1    ,firqb+4    ; of a bunch of peeking at
  821.      asrb    firqb+4            ; rsts.
  822.      .priv                ; you know
  823.      .uuo                ; get job stats function 0
  824.      mov    firqb+26,r1        ; and stuff ppn into r1.
  825. 20$:    tst    upriv(r4)        ; running in (1,*) ?
  826.     bne    30$            ; yes, status is ok for now
  827.     tst    r1            ; try ppn (or jobnun times 2)
  828.     bne    30$            ; real ppn or job number
  829.      mov    #-2    ,r0        ; set bad status up
  830.  
  831. 30$:    tst    r0            ; bad status by now ?
  832.     bne    100$            ; yes, time to go for now.
  833.  
  834.      call    $zapxrb            ; ok so far, is the PK in a
  835.      mov    #str.cr    ,xrb+xrloc    ; condition to accept stuff
  836.      inc    xrb+xrlen        ; buffer size of 1
  837.      inc    xrb+xrbc        ; same thing goes here
  838.      movb    pklun2(r4),xrb+xrci    ; channel number times 2
  839.      mov    #6    ,xrb+xrmod    ; basic+ 'record' modifier if kb
  840.      .priv                ; once again
  841.      .write                ; finally !
  842.      movb    @r3    ,r0        ; errors ?
  843.  
  844. 100$:    tst    r0            ; errors ?
  845.     beq    110$
  846.      sec                ; tst does a clc,'mov' leaves it
  847. 110$:     unsave    <r1,r0>            ; pop regs, retain status and
  848.      return                ; exit
  849.  
  850.  
  851.     .sbttl    openpk    - open 'pk?:' as file 2
  852.  
  853. openpk:    mov    #-1,r1            ; init pk at -1
  854.  
  855. 10$:    inc    r1            ; next pk
  856.     call    $zapfqb            ; clean firqb
  857.     movb    pklun2(r4),@#firqb+fqfil ; channel 2
  858.     mov    #buflen,@#firqb+fqbufl    ; buffer length
  859.     mov    #"PK,@#firqb+fqdev    ; 'pk?:'
  860.     movb    r1,@#firqb+fqdevn    ; pk number
  861.     movb    #-1,@#firqb+fqdevn+1    ; unit is real
  862.     movb    #opnfq,@#firqb+fqfun    ; open function
  863.     .priv                ; have rsts
  864.     calfip                ; open the pk
  865.     movb    @r3    ,r0        ; any problems?
  866.     beq    30$            ; no, go return
  867.     cmpb    #notavl,@r3        ; not available ?
  868.     beq    10$            ; yes, try for another
  869.     cmpb    #nodevc,@r3        ; not valid device ?
  870.     bne    50$            ; unknown RSTS error happened
  871.     .print    #nopk
  872.     br    50$            ; bye
  873.  
  874. 30$:    call    $zapfqb            ; zap firqb
  875.     movb    #uu.fcb,@#firqb+fqfun    ; fcb function
  876.     movb    pklun2(r4),@#firqb+fqfil ; channel 2
  877.     asrb    firqb+fqfil        ; not times two here
  878.     .priv                ; have rsts
  879.     .uuo                ; return fcb info
  880.     movb    @r3    ,r0        ; any problems ?
  881.     bne    40$            ; yes, fatal
  882.     movb    @#firqb+fqext,r1    ; kb * 2
  883.     asrb    r1            ; pk's kb#:
  884.     movb    r1    ,pkkbn(r4)    ; save it
  885.     call    $zapfqb            ; zap firqb again
  886.     movb    #uu.trm,@#firqb+fqfun    ; ttyset function
  887.     mov    #-1,@#firqb+fqfil    ; list attributes
  888.     .priv                ; have rsts
  889.     .uuo                ; return ttyset info
  890.     movb    @r3    ,r0        ; any problems ?
  891.     bne    40$            ; yes, fatal
  892.     movb    #uu.trm,@#firqb+fqfun    ; ttyset function
  893.     movb    #-1,@#firqb+fqfil    ; chr$(255%)
  894.     movb    r1,@#firqb+fqfil+1    ; pk device
  895.     .priv                ; have rsts
  896.     .uuo                ; do a ttyset
  897.     movb    @r3    ,r0        ; any problems ?
  898.     bne    40$            ; yes, fatal
  899.     clc
  900.     return                ; back to work...
  901.  
  902. 40$:    call    errmsg            ; say the error
  903.     .print    #fatbug            ; say we have internal error
  904. 50$:    sec
  905.     return
  906.  
  907.     .sbttl    log the job in
  908.  
  909.     .iif ndf, uu.tb3,uu.tb3 = -29.
  910.  
  911. $pklog::
  912. login:    call    $zapfqb            ; clear out the firqb to set
  913.     movb    #uu.tb3    ,firqb+fqfun    ; do a uu.tb3 to see if the field
  914.     .priv                ; for UNTLVL is zero or real. if
  915.     .uuo                ; real then we haev version 8.0
  916.     tst    firqb+12        ; if version 8 then we will try
  917.     beq    10$            ; the new uu.job format
  918.     call    logv8            ; version 8.0
  919.     bcc    100$            ; it worked
  920. 10$:    call    logv7            ; either version 7 or new call failed
  921. 100$:    return
  922.  
  923.  
  924. logv8:    call    $zapfqb            ; version 8, enter a run time system
  925.     mov    #firqb+fqfun,r0        ; at the p.new entry point
  926.     movb    #uu.job    ,(r0)+        ; create a job function for fip
  927.     movb    #20!100!200,(r0)+    ; create logged in @ defkbm always
  928.     movb    pkkbn(r4),(r0)+        ; kb number to attach to job
  929.     clr    (r0)+            ; unused field
  930.     mov    <urts+0>(r4),(r0)+    ; user's default run time system
  931.     mov    <urts+2>(r4),(r0)+    ; both rad50 words please
  932.     clr    (r0)+            ; unused field
  933.  
  934.     mov    newppn(r4),@r0        ; try for the passed ppn
  935.     beq    10$            ; nothing
  936.     cmpb    #1    ,uppn+1(r4)    ; is our caller perm priv?
  937.     beq    20$            ; yes
  938.      cmpb    #1    ,newppn+1(r4)    ; no, is the caller trying
  939.      bne    20$            ; for a priv account ?
  940. 10$:     mov    uppn(r4),@r0        ; ppn to login job into.
  941. 20$:    bisb    #40    ,firqb+4    ; set flag for account to login to
  942.     movb    corcom    ,-(sp)        ; save this please
  943.     clrb    corcom            ; core common is also passed
  944.     .priv                ; get set to do it now
  945.     .uuo                ; try to create the job now
  946.     movb    (sp)+    ,corcom        ; restore first byte of core common
  947.     movb    firqb    ,r0        ; did it work?
  948.     bne    110$            ; no
  949.     clc                ; yes, flag success and exit
  950.     return                ; bye
  951.  
  952. 110$:    sec                ; job creation failed, exit
  953.     return                ; set a flag and return
  954.  
  955.     
  956.  
  957. logv7:    call    $zapfqb
  958.     mov    #firqb+fqfun,r0        ; up the spawn of LOGIN.
  959.     movb    #uu.job    ,(r0)+        ; create a job call to .uuo
  960.     movb    #128.    ,(r0)+        ; create if logins disabled.
  961.     clrb    (r0)+            ; must be zero (?)
  962.     mov    #402    ,(r0)+        ; the project programmer (1,2).
  963.     mov    plogin    ,(r0)+        ; first part of program to run
  964.     mov    plogin+2,(r0)+        ; which is normally $LOGIN.*
  965.     mov    plogin+4,(r0)+        ; extension
  966.     clr    (r0)+            ; skip next (paramter data)
  967.     mov    <urts+0>(r4),(r0)+    ; the new job's default run time
  968.     mov    <urts+2>(r4),(r0)+    ; system (usaully BAS4F ! BASIC)
  969.     mov    newppn(r4),@r0        ; try for the passed ppn
  970.     beq    10$            ; nothing
  971.     cmpb    #1    ,uppn+1(r4)    ; is our caller perm priv?
  972.     beq    15$            ; yes
  973.      cmpb    #1    ,newppn+1(r4)    ; no, is the caller trying
  974.      bne    15$            ; for a priv account ?
  975. 10$:     mov    uppn(r4),@r0        ; ppn to login job into.
  976. 15$:    tst    (r0)+            ; fix firqb pointer
  977.     movb    pkkbn(r4),(r0)+        ; kb number for the job.
  978.     mov    #29000.    ,firqb+34    ; paramter word
  979.     .priv                ; prefix ?
  980.     .uuo                ; create the job please
  981.     movb    @r3    ,r0        ; errors ???
  982.     bne    100$            ; yes, we will die then
  983.     $sleep    #1
  984.     mov    #20.    ,r1        ; loop count for login wait
  985. 20$:    call    pksts            ; pk is ready yet ?
  986.     bcc    30$            ; yep
  987.      $sleep    #1            ; no keep trying for a while
  988.     sob    r1    ,20$        ; ok ?
  989.     .print    #crfail            ; die
  990.     br    110$
  991.  
  992. 30$:    clr    r0
  993.     return
  994.  
  995. 100$:    call    errmsg            ; print the error and die
  996. 110$:    sec                ; set return code
  997.     return
  998.  
  999.  
  1000.     .sbttl    record    - record the session
  1001.  
  1002. record:
  1003.     mov    cmds(r4),r2
  1004.     call    $zapfqb            ; close the kb up for a moment.
  1005.     movb    #clsfq    ,firqb+fqfun    ; calfip function to close a
  1006.     movb    kblun2(r4),firqb+fqfil    ; file.
  1007.     .priv                ; as usual
  1008.     calfip                ; thats all there is to it.
  1009.     call    openkb            ; open it mode 1
  1010.  
  1011.  
  1012. 10$:    bit    #f$nopr    ,abortf(r4)    ; kill on logout?
  1013.     beq    15$            ; no
  1014.      mov    pkddb(r4),xrb+0        ; get ddb address
  1015.      add    #2    ,xrb+0        ; need to look at the jobnumber
  1016.      .priv                ; times 2
  1017.      .peek                ; if no job number then the
  1018.      tstb    xrb+0            ; pk has logged out
  1019.      beq    60$            ; if so, abort and return
  1020.  
  1021. 15$:    call    getkb            ; get kb data
  1022.     cmp    #1,rcount(r4)        ; recount = 1
  1023.     bne    20$            ; no, continue
  1024.     movb    @r4,r0            ; take first byte
  1025.     bicb    #200,r0            ; trim parity
  1026.     cmpb    r0,#'D-100        ; is it term character ?
  1027.     bne    20$            ; yes, go return
  1028.      bit    #f$ctld    ,abortf(r4)    ; really exit on control D ?
  1029.      bne    60$            ; yep
  1030.  
  1031. 20$:    cmpb    #daterr,@r3        ; nothing there ?
  1032.     beq    30$            ; yes, try pk
  1033.     cmpb    #detkey    ,@r3        ; controling job detach ?
  1034.     beq    60$            ; no
  1035.     callr0    putpk    ,r4        ; put out to the pk
  1036.     br    35$
  1037.  
  1038. 30$:    call    pksts            ; Is the job ready for a
  1039.     bcs    35$            ; a command yet ?
  1040.     callr0    ttyou    ,pkddb(r4)    ; currently printing on PK:
  1041.     bcs    35$            ; yep
  1042.     callr0    ttyou    ,kbddb(r4)    ; check tty out
  1043.     bcs    35$            ; TTY is still busy then
  1044.     tst    (r2)            ; next command ?
  1045.     beq    31$            ; all done folks
  1046.      call    docmd            ; do a command
  1047.      br    35$
  1048.  
  1049. 31$:     call    jstop            ; End of comamnds, see if we
  1050.      bcs    60$            ; should quit now.
  1051.  
  1052.  
  1053. 35$:    call    getpk            ; get pk data
  1054.     cmpb    #eof,@r3        ; pk say anything ?
  1055.     bne    40$            ; yes, continue
  1056.     $sleep    #stim            ; take a quick nap here
  1057.     br    55$            ; and try later
  1058.  
  1059. 40$:
  1060.     call    errchk            ; scan for a '?' as first char
  1061.     bcc    50$            ; no, all is well
  1062.      tst    abortf(r4)        ; keep going on error (<0) ?
  1063.      bmi    50$            ; yep
  1064.       call    putkb            ; a problem, print error out
  1065.       call    putout
  1066.       mov    #-1    ,r0        ; and exit
  1067.       br    70$
  1068.  
  1069. 50$:    call    putkb            ; tell the kb
  1070.     call    putout
  1071. 55$:    call    timchk            ; job elapsed time run out yet?
  1072.     bcs    70$            ; yep, so exit now.
  1073.     br    10$
  1074.  
  1075. 60$:    clr    r0            ; a normal exit
  1076. 70$:    return
  1077.  
  1078.  
  1079.     .sbttl    stop    check for termination yet
  1080.  
  1081. jstop:    bit    #f$eot    ,abortf(r4)    ; stop on end of the command
  1082.     bne    100$            ; yes, bye
  1083.     bit    #f$kmon    ,abortf(r4)    ; stop on control c wait(0)
  1084.     beq    90$            ; no
  1085.      call    ccstate            ; check for ^C state
  1086.      bcs    100$            ; exit if cc wait
  1087.  
  1088. 90$:    clc
  1089.     return
  1090.  
  1091. 100$:    sec
  1092.     return
  1093.  
  1094.  
  1095.  
  1096. docmd:    mov    @r2    ,r0        ; compute command line length
  1097. 10$:    tstb    (r0)+            ; end of .asciz string ?
  1098.     bne    10$            ; no
  1099.     sub    @r2    ,r0        ; yes, get length now
  1100.     dec    r0            ; off by one
  1101.     mov    r0    ,rcount(r4)    ; put it there for putpk
  1102.     callr0    putpk    ,(r2)+        ; and do it
  1103. 100$:    return
  1104.  
  1105.  
  1106.     .if    eq    ,edrt        ; normal mode
  1107.     .ift
  1108.  
  1109. timchk:    dec    cyc(r4)            ; check job time yet ?
  1110.     bgt    100$            ; no, just exit.
  1111.     mov    #swait    ,cyc(r4)    ; check, so reset cycle count.
  1112.     tst    timout(r4)        ; but should we check at all ?
  1113.     ble    100$            ; no, so just exit.
  1114. ;-    call    $zapfqb            ; clear out firqb for uu.sys
  1115. ;-    movb    #uu.sys    ,firqb+fqfun    ; set uuo function (job systat)
  1116. ;-    movb    pkjob2(r4),firqb+fqfun+1; insert job number here
  1117. ;-    asrb    firqb+fqfun+1        ; not times two please.
  1118. ;-    .priv                ; just in case (is global sym)
  1119. ;-    .uuo                ; get job stats back in firqb
  1120. ;-    sub    timini(r4),firqb+12    ; get total time controlling pk
  1121. ;-    cmp    firqb+12,timout(r4)    ; time to abort job yet ?
  1122.     .priv                ; the pk job stats only seem to
  1123.     .time                ; get updated whenever there is
  1124.     sub    timini(r4),xrb+2    ; some activity on the job's pk
  1125.     cmp    xrb+2    ,timout(r4)    ; so use controlling jobs time.
  1126.     blt    100$            ; If lt, do not kill pkjob yet.
  1127.     mov    #-3    ,r0        ; set return status code.
  1128.     sec                ; yes, also set carry. Now exit
  1129.     return                ; for job time exceeded.
  1130.  
  1131. 100$:    clc
  1132.     return
  1133.  
  1134.     .iff                ; skip this for inclusion into
  1135.                     ; ted.
  1136. timchk:    clc                ; return all is well for TED.
  1137.     return
  1138.  
  1139.     .endc                ; .if eq, edrt
  1140.  
  1141.  
  1142.     .sbttl    getkb    - get data from kb
  1143.  
  1144. getkb:    call    $zapxrb            ; clean xrb
  1145.     mov    #buflen,@#xrb+xrlen    ; buffer length
  1146.     mov    r4,@#xrb+xrloc        ; buffer location
  1147.     movb    kblun2(r4),@#xrb+xrci    ; channel 1
  1148.     mov    #8192.,@#xrb+xrmod    ; record 8192%
  1149.     .priv                ; have rsts
  1150.     .read                ; read from kb
  1151.     mov    @#xrb+xrbc,rcount(r4)    ; save rcount
  1152.     return                ; back to work...
  1153.  
  1154.     .sbttl    putkb    - put data to kb
  1155.  
  1156. putkb:    call    $zapxrb            ; clean xrb
  1157.     mov    #buflen,@#xrb+xrlen    ; buffer length
  1158.     mov    r4,@#xrb+xrloc        ; buffer location
  1159.     mov    rcount(r4),@#xrb+xrbc    ; byte count
  1160.     movb    kblun2(r4),@#xrb+xrci    ; channel 1
  1161.     mov    #1,@#xrb+xrmod        ; record 1%
  1162.     .priv                ; have rsts
  1163.     .write                ; write on kb
  1164.     return                ; back to work...
  1165.  
  1166.  
  1167.     .sbttl    getpk    - get data from pk
  1168.  
  1169. getpk:    call    $zapxrb            ; clean zrb
  1170.     mov    #buflen,@#xrb+xrlen    ; buffer length
  1171.     mov    r4,@#xrb+xrloc        ; buffer location
  1172.     movb    pklun2(r4),@#xrb+xrci    ; channel 2
  1173.     .priv                ; have rsts
  1174.     .read                ; read from pk
  1175.     mov    @#xrb+xrbc,rcount(r4)    ; save rcount
  1176.     beq    100$            ; nothing there
  1177.      movb    <lastch+1>(r4),lastch(r4);shuffle last char from prev
  1178.      mov    rcount(r4),-(sp)    ; read and store the last char
  1179.      add    r4    ,(sp)        ; from this read in there.
  1180.      dec    (sp)
  1181.      movb    @(sp)+    ,<lastch+1>(r4)    ; finally !
  1182.  
  1183. 100$:    return                ; back to work...
  1184.  
  1185.  
  1186.     .sbttl    putpk    - put data to pk
  1187.  
  1188. putpk:    call    $zapxrb            ; clean xrb
  1189.     mov    #buflen,@#xrb+xrlen    ; buffer length
  1190.     mov    r0,@#xrb+xrloc        ; buffer location
  1191.     mov    rcount(r4),@#xrb+xrbc    ; byte count
  1192.     movb    pklun2(r4),@#xrb+xrci    ; channel 2
  1193.     mov    #9.,@#xrb+xrmod        ; record 9%
  1194.     .priv                ; have rsts
  1195.     .write                ; write to pk
  1196.     return                ; back to work...
  1197.  
  1198.     .sbttl    write to optional disk log
  1199.  
  1200.  
  1201.     .if eq    ,edrt            ; save address space for ted
  1202.     .ift
  1203.  
  1204. putout:    save    <r0,r1,r2>
  1205.     tst    outf(r4)        ; a file open 
  1206.     beq    100$            ; no, just exit then
  1207.     mov    rcount(r4),r0        ; number of bytes to put out
  1208.     beq    100$            ; nothing to do if zero
  1209.     mov    r4    ,r2        ; string to put into buffer
  1210.  
  1211.  
  1212. 10$:    mov    outbfa(r4),r1        ; address of the output buffer
  1213.     cmp    outfpnt(r4),#1000    ; buffer full yet ?
  1214.     blo    30$            ; no
  1215.  
  1216.     call    wrtout            ; yes, dump buffer out to disk
  1217.     clr    outfpnt(r4)        ; and init the buffer pointer
  1218.     save    <r0,r1>            ; now clear the buffer out
  1219.     mov    #1000    ,r0        ; 1000 bytes to clear
  1220. 20$:    clrb    (r1)+            ; r1 already had the buffer addres
  1221.     sob    r0    ,20$        ; next byte please
  1222.     unsave    <r1,r0>            ; pop these back
  1223.  
  1224. 30$:    add    outfpnt(r4),r1        ; point to next free byte in buffer
  1225.     movb    (r2)+    ,@r1        ; next byte please
  1226.     inc    outfpnt(r4)        ; get set for next byte
  1227.     sob    r0    ,10$        ; next please
  1228.  
  1229. 100$:    unsave    <r2,r1,r0>
  1230.     return
  1231.  
  1232.  
  1233.  
  1234. wrtout:    save    <r0>
  1235.     call    $zapxrb
  1236.     mov    #xrb    ,r0        ; pointer to xrb
  1237.     mov    #1000    ,(r0)+        ; xrb.xrlen := 1000 (8)
  1238.     mov    #1000    ,(r0)+        ; xrb.xrbc  := 1000
  1239.     mov    outbfa(r4),(r0)+    ; xrb.xrloc := buffer_address
  1240.     movb    outflu(r4),@r0        ; channel number times 2
  1241.     .priv                ; rt11.rts prefix needed?
  1242.     .write                ; simple
  1243.     unsave    <r0>
  1244.     return
  1245.     
  1246.     .iff                ; if edrt <> 1 then dummy call
  1247.  
  1248. putout:
  1249. wrtout:    return
  1250.  
  1251.     .endc                ; if eq, edrt
  1252.  
  1253.  
  1254.     .sbttl    error checking on the PK
  1255.  
  1256.     .if    eq    ,edrt        ; leave out for ted, else in
  1257.     .ift                ; not ted
  1258.  
  1259. errchk:    save    <r0,r1,r2>
  1260.     mov    r4    ,r2        ; address of text to check
  1261.     mov    rcount(r4),r1        ; initial length 
  1262. 10$:    clr    r0            ; position in the string
  1263.     mov    r2    ,-(sp)        ; replace instr call please
  1264.     mov    r1    ,-(sp)        ; save pointer and length
  1265.     ble    25$            ; no text in the string ?
  1266. 20$:    inc    r0            ; pos := succ(pos)
  1267.     cmpb    (r2)+    ,#'?        ; find a possible error msg?
  1268.     beq    25$            ; perhaps
  1269.     sob    r1    ,20$        ; no, try the next one
  1270.     clr    r0            ; no match, set position to 0
  1271. 25$:    mov    (sp)+    ,r1
  1272.     mov    (sp)+    ,r2
  1273.     cmp    r0    ,#1        ; by a line terminator like
  1274.     blt    100$            ; a cr,lf or ff.
  1275.     bgt    30$            ; Not at start of the line
  1276.      cmp    r2    ,r4        ; at the start of the record?
  1277.      bne    30$            ; no, nothing special to do.
  1278.       cmpb    lastch(r4),#cr        ; Was first char of record, look
  1279.       bhi    40$            ; at the last char of prev rec.
  1280.       br    110$            ; fatal error, exit with 'c'
  1281. 30$:    mov    r2    ,-(sp)        ; Check preceeding char for 
  1282.     add    r0    ,(sp)        ; a line terminator here.
  1283.     dec    (sp)            ; peek at the previous char
  1284.     dec    (sp)            ; peek at the previous char
  1285.     cmpb    @(sp)+    ,#cr        ; well ?
  1286.     blos    110$            ; bye
  1287. 40$:    add    r0    ,r2        ; No error, skip past the '?'
  1288.     sub    r0    ,r1        ; and adjust the line length.
  1289.     bgt    10$            ; and try once again
  1290.  
  1291.  
  1292. 100$:    clc                ; no error, exit ok
  1293.     br    120$            ; pop registers and leave.
  1294. 110$:    sec
  1295. 120$:    unsave    <r2,r1,r0>
  1296.     return
  1297.  
  1298. 200$:    .asciz    /?/
  1299.  
  1300.     .iff                ; for ted, save the space
  1301.  
  1302. errchk:    clc                ; no error
  1303.     return                ; and exit
  1304.  
  1305.     .endc
  1306.  
  1307. errmsg:    movb    firqb    ,firqb+4    ; pass error number to fip
  1308.     movb    #errfq    ,firqb+fqfun    ; fip function
  1309.     .priv                ; rt emu perhaps ?
  1310.     calfip                ; simple to do
  1311.     clrb    firqb+37        ; insure .asciz please
  1312.     .print    #firqb+4        ; print the .asciz string
  1313.     return
  1314.  
  1315.  
  1316.     .sbttl    zero firqb out
  1317.  
  1318.     .if    eq    ,edrt        ; if not in TED, include this
  1319.     .ift
  1320.  
  1321. $zapfqb:
  1322.  
  1323.     mov    r0    ,-(sp)
  1324.     mov    r1    ,-(sp)
  1325.     mov    #firqb    ,r1
  1326.     mov    #40/2    ,r0
  1327. 1$:    clr    (r1)+
  1328.     sob    r0    ,1$
  1329.     mov    (sp)+    ,r1
  1330.     mov    (sp)+    ,r0
  1331.     return
  1332.  
  1333.     .iff
  1334.  
  1335.     global    <$zapfqb>
  1336.  
  1337.     .endc
  1338.  
  1339. $zapxrb:mov    r0    ,-(sp)
  1340.     mov    #xrb    ,r0
  1341. 10$:    clr    (r0)+
  1342.     cmp    r0    ,#xrb+xrmod
  1343.     ble    10$
  1344.     mov    (sp)+    ,r0
  1345.     return
  1346.  
  1347.  
  1348.  
  1349. lprint:    mov    r0    ,-(sp)        ; .asciz string printer. put
  1350.     mov    6(sp)    ,r0        ; it here to avoid global refs
  1351.     bne    20$            ; a real length was passed
  1352.     mov    4(sp)    ,r0        ; zero length, assume .asciz
  1353. 10$:    tstb    (r0)+            ; and find the length of it
  1354.     bne    10$            ; no, keep going
  1355.     sub    4(sp)    ,r0        ; subtract string address from
  1356.     dec    r0            ; current pointer + 1.
  1357. 20$:    call    $zapxrb            ; clear xrb out
  1358.     mov    4(sp)    ,xrb+xrloc    ; stuff buffer address for RSTS
  1359.     mov    r0    ,xrb+xrlen    ; and the length twice
  1360.     mov    r0    ,xrb+xrbc    ; again
  1361.     .priv                ; rt perhaps?
  1362.     emt    4            ; do a .write
  1363.     mov    (sp)+    ,r0        ; pop the register we used
  1364.     mov    (sp)    ,4(sp)        ; bubble return address up
  1365.     cmp    (sp)+    ,(sp)+        ; pop parameter list at last
  1366.     return                ; bye
  1367.  
  1368.  
  1369.  
  1370.     .end
  1371.