home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
kermit.columbia.edu
/
kermit.columbia.edu.tar
/
kermit.columbia.edu
/
test
/
pdp11
/
krtpk.mac
< prev
next >
Wrap
Text File
|
1996-10-17
|
36KB
|
1,377 lines
.title $runjob run a job on a psuedo for RSTS/E
.ident /V04.64/
; /E64/ 10-May-96 John Santos
;
; From K11PK.MAC
; use wrtall instead of various print routines
.if ndf, KRTINC
.ift
.include /IN:KRTMAC.MAC/
.endc
.include /SY:[1,2]COMMON.MAC/
.title $runjo
.psect $code
; Brian Nelson
; Computer Services
; University of Toledo
; 2801 West Bancroft
; Toledo, Ohio 43606
; (419) 537-2511
;
;
; E D I T H I S T O R Y
;
; date time edit who why
;
; 12-jun-80 0 BDN initial coding
; 01-dec-82 1 BDN expand arg list, add f4/bp2 entry points
; 20-Apr-83 13:40:31 2 BDN add disk logging for terminal output
; 09-May-83 14:38:57 3 BDN check for detaching via modem disconnect
; 31-May-83 15:27:40 4 BDN add code to check for spawning from a pk
; 11-Jul-83 15:02:16 5 BDN add code to check if version 8.0 and if
; so use the new uu.sys features
; 12-Jul-83 12:48:04 5 BDN fixed '$runjo' entry point up to work.
;
; **************************************
.sbttl entry points
; $RUNJOB
;
; start a job on a psuedo keyboard and run it
;
;
; entry points:
;
; $RUNJOB (for compatibilty with previous versions)
;
; parameters:
;
; 0(r5) = address of command string address block
; 2(r5) = job termination flag word
; 4(r5) = lowest channel number to use
; 6(r5) = elapsed time limit
;
;
;
; $$RUNJ (new format)
;
; parameters:
;
; 0(r5) = address of command string address block
; 2(r5) = job termination flag word
; 4(r5) = lowest channel number to use
; 6(r5) = elapsed time limit
; 10(r5) = binary of account to log into
; 12(r5) = input file address (zero if none)
; 14(r5) = output file address (zero if none)
;
;
; RUNJOB (fortran/bp2/f77 callable)
;
; parameters:
;
; @r5 = dec standard arg count (fortran/bp2)
; 2(r5) = address of command string address block
; @4(r5) = job termination flag word
; @6(r5) = lowest channel number to use
; @10(r5) = elapsed time limit
; @12(r5) = binary of account to log into (optional)
; 14(r5) = address of a file to read input from
; 16(r5) = address of a file to put output to
;
;
; See sample fortran source code below for usage.
; Note that the channel number to start with must be low
; enough to accomidate the optional disk file for output
; if used. Ie, if you pass '11' (decimal) as the starting
; lun then channels 12, 13 and 14 must also be free for
; use.
.sbttl explanation of the second arguement
; for the parameter at 2(r5), ( @4(r5) for Fortran/Bp2 )
; which is the termination flag:
;
; if 2(r5) and 1 <> 0, exit on user typing a control D (^D)
; if 2(r5) and 2 <> 0, exit on control c (KMON) wait
; if 2(r5) and 4 <> 0, exit on end of commands (addr=0)
; if 2(r5) and 10<> 0, do not echo psuedo KB's output.
; if 2(r5) and 20<> 0, do not use binary mode
; if 2(r5) and 40<> 0, the ppn passed is real
; if 2(r5) and 100<>0, kill job if it logs out and return
; if 2(r5) and 200<>0, do not allow caller to be on a pk
; if 2(r5) < 0 , ignore errors (first char '?')
;
; error return:
;
; r0 = 0 no errors
; r0 > 0 r0 will have the RSTS error number in it
; r0 = -1 '?' found in first char of pk output line
; r0 = -2 PK job already running (calling job is on PK:)
; r0 = -3 elapsed time exceeded
;
;
; command address block format:
;
; example:
;
; ; run thru the 3 ccl commands
; ; exit on end of commands ('0' at end of cmdblk:)
; ; use rsts channel number 11 and 12 (decimal)
; ; no time limit
;
; cmdblk: .word 10$,20$,30$,0
; 10$: .asciz #PIP DB1:/L:S#<cr><lf>
; 20$: .asciz #FOR JUNK=JUNK#<cr><lf>
; 30$: .asciz #SY/N#<cr><lf>
; .even
;
; calls $runjob ,<#cmdblk,#4,#11.,#0>
; tst r0
;
;
; stack usage requirement:
;
; all internal vars and buffers need 170 decimal bytes
; of stack available
;
; internal register usage:
;
; r0 scratch, error return, single parameter passing
; r1 scratch, never saved on call/exit
; r2 address of next .asciz command
; r3 --> FIRQB+0 always
; r4 --> local data block (which is on the stack)
; r5 --> XRB+0 always
;
.sbttl local data definitions
.dsabl gbl
.globl wrtall
.iif ndf ,edrt ,edrt = 0
.if ne ,edrt ; .priv is a null macro
.ift ; for ted
.macro .priv ;
.endm
.iff
.globl .priv
.endc ; for ted
.macro $sleep t
mov t ,xrb+0
.priv
.sleep
.endm $sleep
; /E64/
; .macro .print a,l ; perhaps minitab is here
; .if b, l ; or we are using this from
; .ift ; fortran or bp2
; clr -(sp) ; no length, assume .asciz
; .iff ; length passed
; mov l ,-(sp) ; stuff it please
; .endc ; if b, len
; mov a ,-(sp) ; stuff string address
; call lprint ; and do it
; .endm
.macro callr0 name ,arg
mov arg ,r0
call name
.endm callr0
nodevc = 6
notavl = 10
eof = 13
daterr = 15
detkey = 33
corcom = 460
.asect ; define offsets from r4 for local vars
. = 0 ; offsets start at zerp
buflen = 150. ; size of the pk buffer
buffer: .blkb buflen ; the pk buffer, at 0(r4)
rcount: .blkw ; size of last kb or pk read
kbddb: .blkw ; address controlling job's ddb for KB:
pkddb: .blkw ; address of the pk's ddb
pkjob2: .blkw ; job number times two for the pk job
pkkbn: .blkw ; kb number of the PK: in use
urts: .blkw 2 ; the controlling job's default RTS
uppn: .blkw ; the controlling job's PPN
upriv: .blkw ; <> 0 if controlling job is in (1,*)
ujob2: .blkw ; the controlling job's job number * 2
cmds: .blkw ; copy of command block address
abortf: .blkw ; copy of the termination flag
pklun2: .blkw ; channel number times two for PK
kblun2: .blkw ; channel number times two for KB
timout: .blkw ; copy of elapsed time flag
newppn: .blkw ; if switching ppn's
inf: .blkw ; input file if given
inbfa: .blkw ; input file buffer address
outf: .blkw ; output file if given
outbfa: .blkw ; output file buffer address
influn: .blkw ; disk input file lun * 2
outflu: .blkw ; disk output file lun * 2
infpnt: .blkw ; disk input buffer pointer
outfpn: .blkw ; disk output buffer pointer
timini: .blkw ; initial time at entry here.
cyc: .blkw
lastch: .blkw ; last char of preceeding pk read
kbintf: .blkw ; interface type for controlling job
js.kb = 2 ; bit in JBWAIT for KB wait state
.if ne ,edrt
.ift
stim = 1
.iff
stim = 3 ; sleep time in main loop
.endc
swait = < << 60./stim >+1 > * stim> / 2
.iif le ,swait ,swait = 1
locsiz = . + 2 ; size of the local data
.assume buffer eq 0
.psect $code
; bits defined in abortf(r4)
f$ctld = 1
f$kmon = 2
f$eot = 4
f$nech = 10
f$nbin = 20
f$nppn = 40
f$nopr = 100
f$nopk = 200
str.cr: .byte 0,0
plogin: .rad50 /LOGIN /
.word -1
crfail: .asciz /?Can't start job/<cr><lf>
nopk: .asciz /?no PK's/ <cr> <lf>
fatbug: .asciz /?bug in openpk/ <cr> <lf>
.even
.sbttl fortran/bp2 entry point
.if eq ,edrt
.ift
; byte filnam(30)
; byte out(512)
; integer outf(2)
; byte buffer(84)
; outf(2) = iaddr(out)
; outf(1) = iaddr(filnam)
; read (5,1) filnam
; 1 format (30a1)
; filnam(30) = 0
; type *,'starting'
; 5 continue
; read (5,100) (buffer(i),i=1,80)
; mode = 5
; do 10 j = 80,1,-1
; if (buffer(j).ne.' ') go to 20
; 10 continue
; mode = "100001
; buffer(1) = 0
; go to 30
; 20 continue
; buffer(j+1) = 13
; buffer(j+2) = 10
; buffer(j+3) = 0
; 30 continue
; ierr = runjob(buffer,mode,11,0,0,,outf)
; type *,ierr
; goto 5
; 100 format (80a1)
; stop
; end
;
;
; Note: the 'infile' (not yet implemented) and the 'outfile' address
; actually are parameter blocks consisting of
;
; (1) a filename address
; (2) a buffer address of 1000 (8) bytes
;
; as in:
;
; integer outf(2)
; byte outbuf(512)
; byte outnam(30)
; read (5,100) outnam
; outnam(30) = 0
; outf(1) = iaddr(outnam)
; outf(2) = iaddr(outbuf)
.sbttl calling example from MINITAB's 'system' command
; subroutine syscmd(cmdlin)
; c
; c change 'cmdlin' to byte for version 82 of minitab
; c
; byte cmdlin(80)
; byte buffer(84)
; common /isc/ buffer
; integer runjob
; c
; integer irsts,irsxts,irsx,ivax,irt11,myexec,pkflag
; common /ostype/ irsts,irsxts,irsx,ivax,irt11,myexec,pkflag
; c
; if ((myexec.eq.irsts).or.(myexec.eq.irsxts)) go to 5
; write (5,220)
; return
; c
; 5 continue
; do 10 j = 1 , 80
; buffer(j) = ' '
; 10 continue
; c
; do 20 j = 1 , 80
; if (cmdlin(j).eq.' ') go to 30
; 20 continue
; j = 0
; 30 continue
; k = j + 1
; i = 1
; c
; do 40 j = k,80
; buffer(i) = cmdlin(j)
; i = i + 1
; 40 continue
; c
; mode = 5
; do 80 j = 80,1,-1
; if (buffer(j).ne.' ') go to 90
; 80 continue
; mode = "100001
; buffer(1) = 0
; write (5,200)
; go to 100
; 90 continue
; buffer(j+1) = 13
; buffer(j+2) = 0
; 100 continue
; mode = mode .or. "100
; ierr = runjob(buffer,mode,11,0)
; if (ierr.ne.0) write (5,210) ierr
; return
; c
; c
; 200 format (' Type control D (^D) to return to MINITAB'/)
; 210 format (' PK driver returned error code ',i5)
; 220 format (' %Minitab-W The SYSTEM command is not available')
; c
; end
.sbttl fortran/bp2 entry point continued
.psect $code
f4.out = 16 ; optional output fileblock
f4.inf = 14 ; optional input fileblock
f4.ppn = 12 ; optional ppn to log into
f4.tim = 10 ; timeout flag
f4.lun = 6 ; lowest channel number to use
f4.fla = 4 ; run flags
f4.buf = 2 ; command clock address
runjob::mov r5 ,-(sp) ; convert f4/bp2 call format
mov r4 ,-(sp)
clr -(sp) ; assume no address for outfile
cmpb @r5 ,#7 ; 7 args (last is output file)
blo 1$ ; no
cmp f4.out(r5),#-1 ; yes, is the arguement ommitted?
beq 1$ ; yes. leave a zero for the address
mov f4.out(r5),@sp ; no, copy the filename address
1$: clr -(sp) ; assume no address for infile
cmpb @r5 ,#6 ; 6 args (second to last)
blo 2$ ; no
cmp f4.inf(r5),#-1 ; yes, at least 6. was it ommitted?
beq 2$ ; yes, address of 177777 is dec's way
mov f4.inf(r5),@sp ; no, copy the address to the stack
2$: clr -(sp) ; assume no new ppn now
cmpb @r5 ,#5 ; passed another ppn to use?
blo 5$ ; no
cmp f4.ppn(r5),#-1 ; at least 5 parameters, is it real?
beq 5$ ; yep
mov @f4.ppn(r5),@sp ; yes, stuff it please
5$: mov @f4.tim(r5),-(sp) ; to that expected by the pk
mov @f4.lun(r5),-(sp) ; driver here
mov @f4.fla(r5),-(sp) ; job termination flag
clr -(sp) ; for now, no cmd blocks
mov sp ,r4 ; point to new parameter list
clr -(sp) ; create cmd block descriptor
mov f4.buf(r5),-(sp) ; buffer address
mov sp ,4(sp) ; stuff the block in now
mov r4 ,r5 ; saved address of new param
tstb @(sp) ; null command line passed?
bne 10$ ; no
clr (sp) ; yes, setup for nothing then
10$:
call $$runj ; do the work and exit
add #22 ,sp ; pop parameters
mov (sp)+ ,r4 ; pop saved r4
mov (sp)+ ,r5 ; pop saved r5
return ; and exit
100$: .asciz /starting - /
110$: .byte cr,lf
.even
.endc ; not included for ted
.sbttl main control loop
.psect $code
$runjo::clr -(sp)
clr -(sp)
clr -(sp)
mov 6(r5) ,-(sp)
mov 4(r5) ,-(sp)
mov 2(r5) ,-(sp)
mov @r5 ,-(sp)
mov sp ,r5
call $$runj
add #7*2 ,sp
return
$$runj: mov #jfsys ,xrb+0 ; get privs back if possible
.priv ; prefix, if required.
.set ; set keyword bit call to exec
save <r1,r2,r3,r4,r5> ; should do this.
sub #locsiz ,sp ; allocate space for us.
mov sp ,r4 ; r4 will point to work area
call init ; initial junk for startup
bcs 100$ ; oops !
call openfi
bcs 100$ ; oops !
call login ; login pk
bcs 100$ ; oops
call pkjobn ; get the pk job number * 2
call record ; record time-sharing session
100$:
die: call clsout
add #locsiz ,sp ; pop our work area from stack
mov #firqb+fqfil,r3 ; useful address
call $zapfqb
movb #clsfq ,firqb+fqfun ; close the channels we used
movb pklun2(r4),@r3 ; channels here
.priv ; prefix as usual
calfip
call $zapfqb
movb #clsfq ,firqb+fqfun ; close the channels we used
movb kblun2(r4),@r3 ; channels here
.priv ; prefix as usual
calfip
unsave <r5,r4,r3,r2,r1>
mov #jfsys ,xrb+0 ; drop privs at exit
.priv ;
.clear ; drop bits in keyword call
return
.sbttl initial stuff
.assume uppn eq <urts+4>
.assume upriv eq <uppn+2>
.assume ujob2 eq <upriv+2>
.assume cmds eq <ujob2+2>
.assume abortf eq <cmds +2>
.assume pklun2 eq <abortf+2>
.assume kblun2 eq <pklun2+2>
.assume timout eq <kblun2+2>
.assume newppn eq <timout+2>
.assume inf eq <newppn+2>
.assume inbfa eq <inf+2>
.assume outf eq <inbfa+2>
.assume outbfa eq <outf+2>
.assume influn eq <outbfa+2>
.assume outflu eq <influn+2>
init: call $zapfqb ; zap the firqb first please
mov r4 ,r1 ; clear out the local vars
mov #locsiz-2,r0 ; which we allocated on the
5$: clrb (r1)+ ; stack
sob r0 ,5$ ; all of it please
movb #uu.sys ,firqb+fqfun ; systat sys call with subfun
.priv ; zero to get default user
.uuo ; runtime system.
mov firqb+12,timini(r4) ; save user's connect
mov #swait ,cyc(r4) ; stuff control for time check
mov r4 ,r3 ; Base address of impure area.
add #urts ,r3 ; we will start here.
mov firqb+30,(r3)+ ; copy two rad50 words for
mov firqb+32,(r3)+ ; user's default rts
mov firqb+26,(r3)+ ; and the ppn for our user.
clr (r3)+ ; set the user is (1,*) flag
cmpb #1 ,<uppn+1>(r4) ; perm privs here ?
bne 10$ ; nop
mov sp ,-2(r3) ; yes, set a flag then
10$: movb firqb+fqjob,(r3)+ ; job number times 2
clrb (r3)+ ; to be sure, get high byte out
mov (r5)+ ,(r3)+ ; save command string address
mov (r5)+ ,(r3)+ ; save the abort flag
mov (r5)+ ,r0 ; starting lun to use for the
ble 100$ ; pk and for the kb. Must be
asl r0 ; > 0
mov r0 ,(r3)+ ; pk lun is the first one
add #2 ,r0 ; kblun2 = pklun2 + 2
mov r0 ,(r3)+ ; thats all
mov (r5)+ ,(r3)+ ; job elapsed time parameter.
mov (r5)+ ,(r3)+ ; alternate ppn
bit #f$nppn ,abortf(r4) ; really do this
bne 20$ ; yes
clr -2(r3) ; no
20$: mov (r5)+ ,r0 ; get input file block
beq 30$ ; a null parameter there
mov 2(r0) ,inbfa(r4) ; save input buffer address
mov @r0 ,r0 ; get filename address now.
tstb @r0 ; anything there ?
beq 30$ ; no, leave name address eq 0
mov r0 ,inf(r4) ; yes, save address
mov kblun2(r4),influn(r4) ; also allocate a channel
add #2 ,influn(r4)
30$: mov (r5)+ ,r0 ; get output file block
beq 40$ ; a null parameter there
mov 2(r0) ,outbfa(r4) ; save output buffer address
mov @r0 ,r0 ; get filename address now.
tstb @r0 ; anything there ?
beq 40$ ; no, leave name address eq 0
mov r0 ,outf(r4) ; yes, save address
mov kblun2(r4),outflu(r4) ; also allocate a channel
add #4 ,outflu(r4)
40$:
100$: clr r0
mov #520. ,xrb+0 ; get the controlling job's
.priv ; kbddb as:
.peek ; peek(peek(peek(520.)))
.priv ; and again
.peek ; .....
.priv ; one more time
.peek ; ah !
mov xrb+0 ,kbddb(r4) ; and pack it away
mov #firqb ,r3 ; r3 will always --> IOSTS
mov #xrb ,r5 ; r5 will always --> xrb+0
call $zapfqb ; clear firqb for getting interface
movb #uu.trm ,firqb+fqfun ; type. perhaps caller will not
movb #377 ,firqb+5 ; allow a pk to run a pk job.
.priv ; rt emulator perhaps?
.uuo ; get terminal characteristics
movb firqb+24,kbintf(r4) ; save the interface type
bit #f$nopk ,abortf(r4) ; allow caller to be on a pk?
beq 110$ ; yes
cmpb kbintf(r4),#10 ; no, is the caller running on
bne 110$ ; a psuedo keyboard already?
mov #-2 ,r0 ; yes
sec ; also set this error status
br 120$ ; and exit
110$: clc ; and away we go !
120$: return ; for now.
.sbttl open files up please
openfi: call openkb ; open 'kb:' mode 1
bcs 100$ ; oops !
call openpk ; open 'pk?:'
bcs 100$
callr0 getddb ,pkkbn(r4) ; we will need the pk's DDB.
bcs 100$ ; oops
mov r0 ,pkddb(r4) ; and save the kbddb
call opninp
bcs 100$
call opnout
100$: return
.sbttl open/close logging file if open
.if eq ,edrt ; save address space for TED
.ift
opnout: call $zapfqb ; open possible optional output
mov outf(r4),r2 ; get output filename
beq 100$ ; nothing to open
mov r2 ,r1 ; save it
10$: tstb (r1)+ ; get the length please
bne 10$ ; no nulls as of yet
sub r2 ,r1 ; length + 1
dec r1 ; length
mov #xrb ,r0 ; clear firqb for a .fss
mov r1 ,(r0)+ ; xrb.xrlen := len(filename)
mov r1 ,(r0)+ ; xrb.xrbc := len(filename)
mov r2 ,(r0)+ ; xrb.xrloc := address(filename)
.rept 4 ; the rest is unused
clr (r0)+ ;
.endr ;
.priv ; now do the filename string scan
.fss ; simple
movb @r3 ,r0 ; get error codes (r3 --> firqb+0)
bne 110$ ; oops
movb #crefq ,firqb+fqfun ; open a file function for fip
movb outflu(r4),firqb+fqfil ; channel number times 2
clr firqb+fqmode ; no modes please
.priv
calfip ; get rsts to open it up
movb @r3 ,r0 ; copy error codes from firqb+0
bne 110$ ; ok
clr outfpnt(r4) ; init output buffer pointer
mov outbfa(r4),r0 ; null fill the output buffer
mov #1000 ,r1 ; 1000 (8) bytes worth
50$: clrb (r0)+ ; clear a byte
sob r1 ,50$ ; and back for more
100$: clc ; no errors
return
110$: clr outf(r4) ; clear filename address out
movb firqb ,r0
sec ; error exit, error code in r0
return
clsout: tst outf(r4) ; output file there ?
beq 100$ ; no
call wrtout ; dump output buffer
call $zapfqb ; and close the file
movb #clsfq ,firqb+fqfun ; fip function to close it
movb outflu(r4),firqb+fqfil ; channel number times 2
.priv ; rt11.rts prefixes today ?
calfip ; close it
100$: return
.iff ; for TED, dummy fileopens out
opnout:
clsout: clc
return
.endc ; if eq, edrt
.sbttl open input file (not yet implemented)
opninp: clr inf(r4)
return
.sbttl openkb - open 'kb:' as file 1, mode 1
openkb: call $zapfqb ; zap firqb
movb kblun2(r4),@#firqb+fqfil ; channel 1
mov #"KB,@#firqb+fqdev ; 'kb:'
mov #buflen,@#firqb+fqbufl ; buffer length
mov #100001!40!20,@#firqb+fqmode ; mode 1+32+16
;; bis #100000,@#firqb+fqmode ; mode is real
movb #opnfq,@#firqb+fqfun ; open function
.priv ; have rsts/e
calfip ; open the file
tstb @r3 ; any problems ?
beq 10$ ; no, go return
movb @r3 ,r0
sec
10$: return ; back to work...
.sbttl get job number for PK job
pkjobn:
mov pkddb(r4),@r5 ; get the pk ddb and then we
add #2 ,@r5 ; can get the job number out
.priv ; ddjbno by a quick peek.
.peek ; peek at it
mov @r5 ,-(sp) ; save it for a moment
bic #^C126. ,(sp) ; junk high order stuff and
mov (sp)+ ,pkjob2(r4) ; save it
return
getddb: call $zapfqb ; get ddb of kb number passed
movb #uu.tb2 ,firqb+fqfun ; in r0. Get DEVOKB to get the
.priv ; disk count thus getting the
.uuo ; eventually the kb ddb's.
mov firqb+12,-(sp) ; save this for a moment.
movb #uu.tb1 ,firqb+fqfun ; get tables part 1 for the
.priv ; devptr
.uuo ; rsts does it again !
mov firqb+10,@r5 ; @r5 := devptr
add (sp)+ ,@r5 ; plus devokb
.priv ; now get devtbl as
.peek ; peek( devtbl+edvokb )
mov r0 ,-(sp) ; add in the kbnumber times 2
asl (sp) ; to get the ddb of the tty.
add (sp)+ ,@r5 ; all set now.
.priv ; prefix if needed.
.peek ; and peek at it.
mov @r5 ,r0 ; return kbddb in r0.
clc ; no errors
return
ccstate:call $zapfqb ; see if job is in KB ^C wait
movb #uu.sys ,firqb+fqfun ; do a job systat part 2
incb firqb+5 ;
movb pkjob2(r4),firqb+4 ; where the job number goes
asrb firqb+4 ; not times two for .uuo
.priv ; of course
.uuo ; get rsts
cmp firqb+14,#js.kb ; jbwait show a kb wait ?
clc ; restore possible c bit set
bne 10$ ; no, time to leave now.
mov firqb+32,@r5 ; stuff JDB address for a peek
add #6 ,@r5 ; we need address of jdwork
.priv ; of course
.peek ; sneak a look at the exec
add #10. ,@r5 ; finally where to look at in
.priv ; the job's work block.
.peek ; and so on .......
tst @r5 ; < 0
bpl 10$ ; no, exit with no wait
sec ; yes, flag as ^C(0) wait.
10$: return
.sbttl check out the pk's status
ttyou: mov r0 ,@r5 ; see if pk is doing tt output
add #10. ,@r5 ; check buffer chains
.priv ; you know
.peek ; only a privledged few can do
mov @r5 ,-(sp) ; this, you know.
mov r0 ,@r5 ; one more time please
add #12. ,@r5 ; and so on
.priv ;
.peek ; and get the peeker
cmp (sp)+ ,@r5 ; empty yet ?
bne 10$ ; no
clc ; yes
return
10$: sec
return
; note: following code from ATPK (with minor mods)
pksts: save <r0,r1>
call pkjobn ; get the job number for PKn:
clr r0 ; are we the same job number ?
mov pkjob2(r4),r1 ; save it here
cmpb r1 ,ujob2(r4) ; if so, then login is not done
bne 10$ ; ok
com r0 ; no, we are the same job.
10$: tstb r1 ; a real job there yet ?
beq 20$ ; no
call $zapfqb ; yes, get the job's ppn
movb #uu.sys ,firqb+fqfun ; use the uu.sys instead of
movb r1 ,firqb+4 ; of a bunch of peeking at
asrb firqb+4 ; rsts.
.priv ; you know
.uuo ; get job stats function 0
mov firqb+26,r1 ; and stuff ppn into r1.
20$: tst upriv(r4) ; running in (1,*) ?
bne 30$ ; yes, status is ok for now
tst r1 ; try ppn (or jobnun times 2)
bne 30$ ; real ppn or job number
mov #-2 ,r0 ; set bad status up
30$: tst r0 ; bad status by now ?
bne 100$ ; yes, time to go for now.
call $zapxrb ; ok so far, is the PK in a
mov #str.cr ,xrb+xrloc ; condition to accept stuff
inc xrb+xrlen ; buffer size of 1
inc xrb+xrbc ; same thing goes here
movb pklun2(r4),xrb+xrci ; channel number times 2
mov #6 ,xrb+xrmod ; basic+ 'record' modifier if kb
.priv ; once again
.write ; finally !
movb @r3 ,r0 ; errors ?
100$: tst r0 ; errors ?
beq 110$
sec ; tst does a clc,'mov' leaves it
110$: unsave <r1,r0> ; pop regs, retain status and
return ; exit
.sbttl openpk - open 'pk?:' as file 2
openpk: mov #-1,r1 ; init pk at -1
10$: inc r1 ; next pk
call $zapfqb ; clean firqb
movb pklun2(r4),@#firqb+fqfil ; channel 2
mov #buflen,@#firqb+fqbufl ; buffer length
mov #"PK,@#firqb+fqdev ; 'pk?:'
movb r1,@#firqb+fqdevn ; pk number
movb #-1,@#firqb+fqdevn+1 ; unit is real
movb #opnfq,@#firqb+fqfun ; open function
.priv ; have rsts
calfip ; open the pk
movb @r3 ,r0 ; any problems?
beq 30$ ; no, go return
cmpb #notavl,@r3 ; not available ?
beq 10$ ; yes, try for another
cmpb #nodevc,@r3 ; not valid device ?
bne 50$ ; unknown RSTS error happened
wrtall #nopk ; /E64/
br 50$ ; bye
30$: call $zapfqb ; zap firqb
movb #uu.fcb,@#firqb+fqfun ; fcb function
movb pklun2(r4),@#firqb+fqfil ; channel 2
asrb firqb+fqfil ; not times two here
.priv ; have rsts
.uuo ; return fcb info
movb @r3 ,r0 ; any problems ?
bne 40$ ; yes, fatal
movb @#firqb+fqext,r1 ; kb * 2
asrb r1 ; pk's kb#:
movb r1 ,pkkbn(r4) ; save it
call $zapfqb ; zap firqb again
movb #uu.trm,@#firqb+fqfun ; ttyset function
mov #-1,@#firqb+fqfil ; list attributes
.priv ; have rsts
.uuo ; return ttyset info
movb @r3 ,r0 ; any problems ?
bne 40$ ; yes, fatal
movb #uu.trm,@#firqb+fqfun ; ttyset function
movb #-1,@#firqb+fqfil ; chr$(255%)
movb r1,@#firqb+fqfil+1 ; pk device
.priv ; have rsts
.uuo ; do a ttyset
movb @r3 ,r0 ; any problems ?
bne 40$ ; yes, fatal
clc
return ; back to work...
40$: call errmsg ; say the error
wrtall #fatbug ; /E64/ say we have internal error
50$: sec
return
.sbttl log the job in
.iif ndf, uu.tb3,uu.tb3 = -29.
$pklog::
login: call $zapfqb ; clear out the firqb to set
movb #uu.tb3 ,firqb+fqfun ; do a uu.tb3 to see if the field
.priv ; for UNTLVL is zero or real. if
.uuo ; real then we haev version 8.0
tst firqb+12 ; if version 8 then we will try
beq 10$ ; the new uu.job format
call logv8 ; version 8.0
bcc 100$ ; it worked
10$: call logv7 ; either version 7 or new call failed
100$: return
logv8: call $zapfqb ; version 8, enter a run time system
mov #firqb+fqfun,r0 ; at the p.new entry point
movb #uu.job ,(r0)+ ; create a job function for fip
movb #20!100!200,(r0)+ ; create logged in @ defkbm always
movb pkkbn(r4),(r0)+ ; kb number to attach to job
clr (r0)+ ; unused field
mov <urts+0>(r4),(r0)+ ; user's default run time system
mov <urts+2>(r4),(r0)+ ; both rad50 words please
clr (r0)+ ; unused field
mov newppn(r4),@r0 ; try for the passed ppn
beq 10$ ; nothing
cmpb #1 ,uppn+1(r4) ; is our caller perm priv?
beq 20$ ; yes
cmpb #1 ,newppn+1(r4) ; no, is the caller trying
bne 20$ ; for a priv account ?
10$: mov uppn(r4),@r0 ; ppn to login job into.
20$: bisb #40 ,firqb+4 ; set flag for account to login to
movb corcom ,-(sp) ; save this please
clrb corcom ; core common is also passed
.priv ; get set to do it now
.uuo ; try to create the job now
movb (sp)+ ,corcom ; restore first byte of core common
movb firqb ,r0 ; did it work?
bne 110$ ; no
clc ; yes, flag success and exit
return ; bye
110$: sec ; job creation failed, exit
return ; set a flag and return
logv7: call $zapfqb
mov #firqb+fqfun,r0 ; up the spawn of LOGIN.
movb #uu.job ,(r0)+ ; create a job call to .uuo
movb #128. ,(r0)+ ; create if logins disabled.
clrb (r0)+ ; must be zero (?)
mov #402 ,(r0)+ ; the project programmer (1,2).
mov plogin ,(r0)+ ; first part of program to run
mov plogin+2,(r0)+ ; which is normally $LOGIN.*
mov plogin+4,(r0)+ ; extension
clr (r0)+ ; skip next (paramter data)
mov <urts+0>(r4),(r0)+ ; the new job's default run time
mov <urts+2>(r4),(r0)+ ; system (usaully BAS4F ! BASIC)
mov newppn(r4),@r0 ; try for the passed ppn
beq 10$ ; nothing
cmpb #1 ,uppn+1(r4) ; is our caller perm priv?
beq 15$ ; yes
cmpb #1 ,newppn+1(r4) ; no, is the caller trying
bne 15$ ; for a priv account ?
10$: mov uppn(r4),@r0 ; ppn to login job into.
15$: tst (r0)+ ; fix firqb pointer
movb pkkbn(r4),(r0)+ ; kb number for the job.
mov #29000. ,firqb+34 ; paramter word
.priv ; prefix ?
.uuo ; create the job please
movb @r3 ,r0 ; errors ???
bne 100$ ; yes, we will die then
$sleep #1
mov #20. ,r1 ; loop count for login wait
20$: call pksts ; pk is ready yet ?
bcc 30$ ; yep
$sleep #1 ; no keep trying for a while
sob r1 ,20$ ; ok ?
wrtall #crfail ; /E64/ die
br 110$
30$: clr r0
return
100$: call errmsg ; print the error and die
110$: sec ; set return code
return
.sbttl record - record the session
record:
mov cmds(r4),r2
call $zapfqb ; close the kb up for a moment.
movb #clsfq ,firqb+fqfun ; calfip function to close a
movb kblun2(r4),firqb+fqfil ; file.
.priv ; as usual
calfip ; thats all there is to it.
call openkb ; open it mode 1
10$: bit #f$nopr ,abortf(r4) ; kill on logout?
beq 15$ ; no
mov pkddb(r4),xrb+0 ; get ddb address
add #2 ,xrb+0 ; need to look at the jobnumber
.priv ; times 2
.peek ; if no job number then the
tstb xrb+0 ; pk has logged out
beq 60$ ; if so, abort and return
15$: call getkb ; get kb data
cmp #1,rcount(r4) ; recount = 1
bne 20$ ; no, continue
movb @r4,r0 ; take first byte
bicb #200,r0 ; trim parity
cmpb r0,#'D-100 ; is it term character ?
bne 20$ ; yes, go return
bit #f$ctld ,abortf(r4) ; really exit on control D ?
bne 60$ ; yep
20$: cmpb #daterr,@r3 ; nothing there ?
beq 30$ ; yes, try pk
cmpb #detkey ,@r3 ; controling job detach ?
beq 60$ ; no
callr0 putpk ,r4 ; put out to the pk
br 35$
30$: call pksts ; Is the job ready for a
bcs 35$ ; a command yet ?
callr0 ttyou ,pkddb(r4) ; currently printing on PK:
bcs 35$ ; yep
callr0 ttyou ,kbddb(r4) ; check tty out
bcs 35$ ; TTY is still busy then
tst (r2) ; next command ?
beq 31$ ; all done folks
call docmd ; do a command
br 35$
31$: call jstop ; End of comamnds, see if we
bcs 60$ ; should quit now.
35$: call getpk ; get pk data
cmpb #eof,@r3 ; pk say anything ?
bne 40$ ; yes, continue
$sleep #stim ; take a quick nap here
br 55$ ; and try later
40$:
call errchk ; scan for a '?' as first char
bcc 50$ ; no, all is well
tst abortf(r4) ; keep going on error (<0) ?
bmi 50$ ; yep
call putkb ; a problem, print error out
call putout
mov #-1 ,r0 ; and exit
br 70$
50$: call putkb ; tell the kb
call putout
55$: call timchk ; job elapsed time run out yet?
bcs 70$ ; yep, so exit now.
br 10$
60$: clr r0 ; a normal exit
70$: return
.sbttl stop check for termination yet
jstop: bit #f$eot ,abortf(r4) ; stop on end of the command
bne 100$ ; yes, bye
bit #f$kmon ,abortf(r4) ; stop on control c wait(0)
beq 90$ ; no
call ccstate ; check for ^C state
bcs 100$ ; exit if cc wait
90$: clc
return
100$: sec
return
docmd: mov @r2 ,r0 ; compute command line length
10$: tstb (r0)+ ; end of .asciz string ?
bne 10$ ; no
sub @r2 ,r0 ; yes, get length now
dec r0 ; off by one
mov r0 ,rcount(r4) ; put it there for putpk
callr0 putpk ,(r2)+ ; and do it
100$: return
.if eq ,edrt ; normal mode
.ift
timchk: dec cyc(r4) ; check job time yet ?
bgt 100$ ; no, just exit.
mov #swait ,cyc(r4) ; check, so reset cycle count.
tst timout(r4) ; but should we check at all ?
ble 100$ ; no, so just exit.
;- call $zapfqb ; clear out firqb for uu.sys
;- movb #uu.sys ,firqb+fqfun ; set uuo function (job systat)
;- movb pkjob2(r4),firqb+fqfun+1; insert job number here
;- asrb firqb+fqfun+1 ; not times two please.
;- .priv ; just in case (is global sym)
;- .uuo ; get job stats back in firqb
;- sub timini(r4),firqb+12 ; get total time controlling pk
;- cmp firqb+12,timout(r4) ; time to abort job yet ?
.priv ; the pk job stats only seem to
.time ; get updated whenever there is
sub timini(r4),xrb+2 ; some activity on the job's pk
cmp xrb+2 ,timout(r4) ; so use controlling jobs time.
blt 100$ ; If lt, do not kill pkjob yet.
mov #-3 ,r0 ; set return status code.
sec ; yes, also set carry. Now exit
return ; for job time exceeded.
100$: clc
return
.iff ; skip this for inclusion into
; ted.
timchk: clc ; return all is well for TED.
return
.endc ; .if eq, edrt
.sbttl getkb - get data from kb
getkb: call $zapxrb ; clean xrb
mov #buflen,@#xrb+xrlen ; buffer length
mov r4,@#xrb+xrloc ; buffer location
movb kblun2(r4),@#xrb+xrci ; channel 1
mov #8192.,@#xrb+xrmod ; record 8192%
.priv ; have rsts
.read ; read from kb
mov @#xrb+xrbc,rcount(r4) ; save rcount
return ; back to work...
.sbttl putkb - put data to kb
putkb: call $zapxrb ; clean xrb
mov #buflen,@#xrb+xrlen ; buffer length
mov r4,@#xrb+xrloc ; buffer location
mov rcount(r4),@#xrb+xrbc ; byte count
movb kblun2(r4),@#xrb+xrci ; channel 1
mov #1,@#xrb+xrmod ; record 1%
.priv ; have rsts
.write ; write on kb
return ; back to work...
.sbttl getpk - get data from pk
getpk: call $zapxrb ; clean zrb
mov #buflen,@#xrb+xrlen ; buffer length
mov r4,@#xrb+xrloc ; buffer location
movb pklun2(r4),@#xrb+xrci ; channel 2
.priv ; have rsts
.read ; read from pk
mov @#xrb+xrbc,rcount(r4) ; save rcount
beq 100$ ; nothing there
movb <lastch+1>(r4),lastch(r4);shuffle last char from prev
mov rcount(r4),-(sp) ; read and store the last char
add r4 ,(sp) ; from this read in there.
dec (sp)
movb @(sp)+ ,<lastch+1>(r4) ; finally !
100$: return ; back to work...
.sbttl putpk - put data to pk
putpk: call $zapxrb ; clean xrb
mov #buflen,@#xrb+xrlen ; buffer length
mov r0,@#xrb+xrloc ; buffer location
mov rcount(r4),@#xrb+xrbc ; byte count
movb pklun2(r4),@#xrb+xrci ; channel 2
mov #9.,@#xrb+xrmod ; record 9%
.priv ; have rsts
.write ; write to pk
return ; back to work...
.sbttl write to optional disk log
.if eq ,edrt ; save address space for ted
.ift
putout: save <r0,r1,r2>
tst outf(r4) ; a file open
beq 100$ ; no, just exit then
mov rcount(r4),r0 ; number of bytes to put out
beq 100$ ; nothing to do if zero
mov r4 ,r2 ; string to put into buffer
10$: mov outbfa(r4),r1 ; address of the output buffer
cmp outfpnt(r4),#1000 ; buffer full yet ?
blo 30$ ; no
call wrtout ; yes, dump buffer out to disk
clr outfpnt(r4) ; and init the buffer pointer
save <r0,r1> ; now clear the buffer out
mov #1000 ,r0 ; 1000 bytes to clear
20$: clrb (r1)+ ; r1 already had the buffer addres
sob r0 ,20$ ; next byte please
unsave <r1,r0> ; pop these back
30$: add outfpnt(r4),r1 ; point to next free byte in buffer
movb (r2)+ ,@r1 ; next byte please
inc outfpnt(r4) ; get set for next byte
sob r0 ,10$ ; next please
100$: unsave <r2,r1,r0>
return
wrtout: save <r0>
call $zapxrb
mov #xrb ,r0 ; pointer to xrb
mov #1000 ,(r0)+ ; xrb.xrlen := 1000 (8)
mov #1000 ,(r0)+ ; xrb.xrbc := 1000
mov outbfa(r4),(r0)+ ; xrb.xrloc := buffer_address
movb outflu(r4),@r0 ; channel number times 2
.priv ; rt11.rts prefix needed?
.write ; simple
unsave <r0>
return
.iff ; if edrt <> 1 then dummy call
putout:
wrtout: return
.endc ; if eq, edrt
.sbttl error checking on the PK
.if eq ,edrt ; leave out for ted, else in
.ift ; not ted
errchk: save <r0,r1,r2>
mov r4 ,r2 ; address of text to check
mov rcount(r4),r1 ; initial length
10$: clr r0 ; position in the string
mov r2 ,-(sp) ; replace instr call please
mov r1 ,-(sp) ; save pointer and length
ble 25$ ; no text in the string ?
20$: inc r0 ; pos := succ(pos)
cmpb (r2)+ ,#'? ; find a possible error msg?
beq 25$ ; perhaps
sob r1 ,20$ ; no, try the next one
clr r0 ; no match, set position to 0
25$: mov (sp)+ ,r1
mov (sp)+ ,r2
cmp r0 ,#1 ; by a line terminator like
blt 100$ ; a cr,lf or ff.
bgt 30$ ; Not at start of the line
cmp r2 ,r4 ; at the start of the record?
bne 30$ ; no, nothing special to do.
cmpb lastch(r4),#cr ; Was first char of record, look
bhi 40$ ; at the last char of prev rec.
br 110$ ; fatal error, exit with 'c'
30$: mov r2 ,-(sp) ; Check preceeding char for
add r0 ,(sp) ; a line terminator here.
dec (sp) ; peek at the previous char
dec (sp) ; peek at the previous char
cmpb @(sp)+ ,#cr ; well ?
blos 110$ ; bye
40$: add r0 ,r2 ; No error, skip past the '?'
sub r0 ,r1 ; and adjust the line length.
bgt 10$ ; and try once again
100$: clc ; no error, exit ok
br 120$ ; pop registers and leave.
110$: sec
120$: unsave <r2,r1,r0>
return
200$: .asciz /?/
.iff ; for ted, save the space
errchk: clc ; no error
return ; and exit
.endc
errmsg: movb firqb ,firqb+4 ; pass error number to fip
movb #errfq ,firqb+fqfun ; fip function
.priv ; rt emu perhaps ?
calfip ; simple to do
clrb firqb+37 ; insure .asciz please
wrtall #firqb+4 ; /E64/ print the .asciz string
return
.sbttl zero firqb out
.if eq ,edrt ; if not in TED, include this
.ift
$zapfqb:
mov r0 ,-(sp)
mov r1 ,-(sp)
mov #firqb ,r1
mov #40/2 ,r0
1$: clr (r1)+
sob r0 ,1$
mov (sp)+ ,r1
mov (sp)+ ,r0
return
.iff
global <$zapfqb>
.endc
$zapxrb:mov r0 ,-(sp)
mov #xrb ,r0
10$: clr (r0)+
cmp r0 ,#xrb+xrmod
ble 10$
mov (sp)+ ,r0
return
; /E64/
;lprint:mov r0 ,-(sp) ; .asciz string printer. put
; mov 6(sp) ,r0 ; it here to avoid global refs
; bne 20$ ; a real length was passed
; mov 4(sp) ,r0 ; zero length, assume .asciz
;10$: tstb (r0)+ ; and find the length of it
; bne 10$ ; no, keep going
; sub 4(sp) ,r0 ; subtract string address from
; dec r0 ; current pointer + 1.
;20$: call $zapxrb ; clear xrb out
; mov 4(sp) ,xrb+xrloc ; stuff buffer address for RSTS
; mov r0 ,xrb+xrlen ; and the length twice
; mov r0 ,xrb+xrbc ; again
; .priv ; rt perhaps?
; emt 4 ; do a .write
; mov (sp)+ ,r0 ; pop the register we used
; mov (sp) ,4(sp) ; bubble return address up
; cmp (sp)+ ,(sp)+ ; pop parameter list at last
; return ; bye
.end