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