Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/ptycom.fai
There are no other files named ptycom.fai in the archive.
; MRC:<UTILITIES>PTYCOM.FAI.29, 15-Feb-83 19:45:00, Edit by ADMIN.MDP
; Change name to PTYCOM
;<SU-UTILITIES>PTYCON.FAI.28, 7-Feb-83 21:22:41, Edit by KRONJ
; Fix doubled ? in "Cannot run without ^C cap" message
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.27, 27-Dec-82 15:35:00, Edit by K.KRONJ
; Safeguard against attempt to multiply-define subjob name
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.26, 27-Dec-82 15:08:15, Edit by K.KRONJ
; Set default in NAME command parse
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.25, 23-Oct-82 15:45:26, Edit by K.KRONJ
; Don't save input while reading from a TAKE file
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.24, 19-Oct-82 17:55:51, Edit by K.KRONJ
; Re-initialize stack at top level (return from connect was losing slots)
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.23, 18-Oct-82 19:26:18, Edit by K.KRONJ
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.22, 18-Oct-82 18:01:53, Edit by K.KRONJ
; Fix bug in DOPI introduced in previous edit
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.21, 15-Oct-82 22:54:17, Edit by K.KRONJ
; Make it safe to close the PTY JFNs without telling PTYCON
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.20, 15-Oct-82 21:06:31, Edit by K.KRONJ
; Double stack size, flush compilation switches
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.19, 23-Sep-82 13:42:58, Edit by K.KRONJ
; Fix off-by-2 in test for TAKE file nesting depth
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.18, 21-Sep-82 22:35:48, Edit by K.KRONJ
; Simplify TAKE file nesting test
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.17, 16-Sep-82 00:03:25, Edit by K.KRONJ
; Clean up SETCMD a bit
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.16, 15-Sep-82 23:48:13, Edit by K.KRONJ
; Change some macros to OPDEFs, move PUTNAM to .COMND
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.14, 27-Jun-82 14:10:08, Edit by K.KRONJ
; Much cleaning up of command processing, macros, code etc. Lowercase.
; Add DDT, PRINT debug commands. CHCONF takes prompt as arg, uses COMND.
; Call INTON from top level if STIBUG is set. Add NOINT and OKINT routines.
; Add FMF's jsys error routine. Refresh command line after ^C.
; Process JCL on startup. Parse CR at top level so comments go in log file.
; Add SAVE command, hack to expand NO S<alt> to either SAVE or SILENCE.
; Add MAKE command. Allow nested TAKE files. Bump major version.
;<K.KRONJ>PTYCON.FAI.4, 11-May-82 23:06:36, Edit by K.KRONJ
; Make esc char a register, check parity of it.
; Miscellaneous code cleanups.
; Test if PTY logins are allowed before trying to create jobs.
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.12, 14-Apr-82 23:21:52, Edit by K.KRONJ
; New-job creation was returning from interrupt, should have
; been a jump back to CTILUP (caused typeahead hang)
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.10, 6-Apr-82 15:24:00, Edit by K.KRONJ
; Add RET at end of FILNAM. change HLPOTH depending on MINCMD.
; Add SKPRET opdef for AOS (P).
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.9, 5-Apr-82 20:30:39, Edit by K.KRONJ
; Add DBUGSW, FRKCMD, and MINCMD switches. Print more control escape-chars
; by name. Add RESET command. Print invalid escape chars.
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.8, 2-Apr-82 17:05:07, Edit by K.KRONJ
; Convert COMND% calls to PARSEX. Convert loops to new FORALL.
; Better error messages for guide words. In connection only
; worry about termination of connected subfork. Refresh command
; line after termination messages.
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.7, 31-Mar-82 16:48:19, Edit by K.KRONJ
; Fix bug in command-line-refresh after subjob output
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.6, 31-Mar-82 12:54:38, Edit by K.KRONJ
; Fix flag crash. add NOISE2 macro. allow uparrow in CHESC.
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.5, 30-Mar-82 21:44:44, Edit by K.KRONJ
; Print text conf barfed on. Refresh command line after subjob output.
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.4, 30-Mar-82 17:01:42, Edit by K.KRONJ
; Document changes to the SEND command
;ACCT:<UTILITIES.SUBSYS>PTYCON.FAI.2, 29-Mar-82 00:14:58, Edit by K.KRONJ
; Synchronize output in the SEND command (lock subjob while in DISMS)
;SX:<K.KRONJ>PTYCON.FAI.66, 28-Mar-82 22:48:44, Edit by K.KRONJ
; Don't worry if being-built forks trigger halt interrupt
;SX:<K.KRONJ>PTYCON.FAI.64, 28-Mar-82 22:30:09, Edit by K.KRONJ
; Implement "-" quickie send for Kirk. Change getbuf to add to
; an existing buffer if there is one (shouldn't be, but...).
; Make SEND (and "-") make new jobs if there isn't one there.
; Improve confirmation routine.
;SX:<K.KRONJ>PTYCON.FAI.29, 28-Mar-82 14:51:33, Edit by K.KRONJ
; Save subfork program names
;SX:<K.KRONJ>PTYCON.FAI.27, 28-Mar-82 14:03:28, Edit by K.KRONJ
; Take command help strings out of literals to appease MACRO
;SX:<K.KRONJ>PTYCON.FAI.26, 27-Mar-82 04:05:55, Edit by K.KRONJ
; Try to make MACRO like us. Something is still losing
; somewhere in the command table though.
;SX:<K.KRONJ>PTYCON.FAI.25, 25-Mar-82 20:39:48, Edit by K.KRONJ
; Call TERPRI in a few more places
;SX:<K.KRONJ>PTYCON.FAI.24, 25-Mar-82 20:08:31, Edit by K.KRONJ
; Search MONSYM
;SX:<K.KRONJ>PTYCON.FAI.23, 25-Mar-82 18:52:44, Edit by K.KRONJ
; Print atom buffer on command-parsing errors
;SX:<K.KRONJ>PTYCON.FAI.50, 10-Mar-82 21:06:44, Edit by K.KRONJ
; Clean up interrupt register saving. fix typeahead hang (hope).
;SX:<K.KRONJ>PTYCON.FAI.49, 8-Mar-82 17:43:25, Edit by K.KRONJ
; Switch help messages for CHANGE command. Add periods in STATUS.
;SX:<K.KRONJ>PTYCON.FAI.46, 7-Mar-82 15:56:00, Edit by K.KRONJ
; Synchronize popping from forks with subfork output
;SX:<K.KRONJ>PTYCON.FAI.45, 7-Mar-82 15:18:12, Edit by K.KRONJ
; Make various messages say subfork instead of subjob when it is
; a fork. Save registers in connection loop PTY output interrupt.
; Add help message for "?" in connection with no job.
;SX:<K.KRONJ>PTYCON.FAI.40, 7-Mar-82 00:04:04, Edit by K.KRONJ
; Make POP from subforks win again. add TERPRI routine.
;SX:<K.KRONJ>PTYCON.FAI.35, 6-Mar-82 20:36:21, Edit by K.KRONJ
; Make SILENCE command more like original PTYCON
;SX:<K.KRONJ>PTYCON.FAI.31, 6-Mar-82 02:50:28, Edit by K.KRONJ
; Completely rewrite connection loop. It now runs completely
; at interrupt level unless it is reading from a file.
; Several changes to utility subroutines.
;SX:<K.KRONJ>PTYCON.FAI.13, 26-Feb-82 21:51:28, Edit by K.KRONJ
; Fix subjob names - BLT was losing
;SX:<K.KRONJ>PTYCON.FAI.12, 26-Feb-82 20:58:33, Edit by K.KDO
; Try again at getting help right
;SX:<K.KRONJ>PTYCON.FAI.11, 26-Feb-82 19:18:29, Edit by K.KDO
; Fix HELP on DVORAK to tell the truth about the layout
;SX:<K.KRONJ>PTYCON.FAI.10, 21-Feb-82 23:56:33, Edit by K.KRONJ
; Check Dvorak translation of escape char
;SX:<K.KRONJ>PTYCON.FAI.7, 20-Feb-82 02:58:33, Edit by K.KRONJ
; Document subroutines, make esc-char checker more general
;SX:<K.KDO>PTYCON.FAI.25, 19-Feb-82 23:48:08, Edit by K.KRONJ
; Fix new-jobname parsing to not require a confirm
;SX:<K.KDO>PTYCON.FAI.12, 15-Feb-82 12:41:25, Edit by K.KRONJ
; Clean up KDO's hackery somewhat
;SX:<K.KDO>PTYCON.FAI.11, 14-Feb-82 23:37:06, Edit by K.KDO
; Add Dvorak simulation (inside DVORAK switch)
;<K.KRONJ>PTYCON.FAI.4, 5-Feb-82 17:33:44, Edit by K.KRONJ
; Clear input buffer when making new jobs
;<K.KRONJ>PTYCON.FAI.3, 4-Feb-82 23:24:56, Edit by K.KRONJ
; Speed up things inside connection loops
title PTYCOM - Controller for pseudo-terminal jobs
;; Written 1981 by David Eppstein
;; Based on a 1974 program by Peter M. Hurley
search monsym,macsym
asuppress
vmajor==2 ; Major version number
vminor==0 ; Minor version
vedit==63 ; Edit number
vwho==4 ; Who last edited (4=Stanford)
;******************** Definitions *********************************************
; Definitions for DDT and SYMOUT
extern .jbsym,.jbusy ; symbols needed by DDT
ddtloc==770000 ; where DDT starts
; Registers and constants
a=1 ; temporary registers used for system calls etc
b=2
c=3
d=4
lupadr=10 ; address of routine for DOFOR to run
nchrs=11 ; num of chars in new subjob name
pi=12 ; register for PTY interrupts
i=13 ; index into subjob tables
escchr=14 ; character (no parity!) to exit conn loop
f=15 ; flags (no, bell, etc.)
iop=16 ; TAKE file stack pointer
p=17 ; main stack pointer
chn.cc==0 ; interrupt channel for control-C
chn.ti==1 ; interrupt channel for terminal input
numpi==10 ; 8 PTY interrupts (must be power of two)
pdlen==100 ; max stack depth
ipdlen==10 ; max TAKE file nesting
bufsiz==100 ; size of pty output buffer
sjmax==^D31 ; allow sj numbers 0 through 30 (decimal)
namsiz==2 ; number of words per subjob name
nammax==namsiz*5-1 ; number of chars per subjob name
cmdsiz==400 ; words in command buffer
atmsiz==400 ; words in atom buffer (space is cheap)
opdef call [pushj p,]
opdef ret [popj p,]
opdef skpret [aos (p)]
rskp: skpret ; must be before opdef retskp
r: ret ; easy jump
opdef retskp [jrst rskp]
; Global and subjob flags
define FLGINI <..f==1>
define FLAG (name) <
name==..f
..f==..f*2
>
FLGINI
FLAG <f%no> ; if no was typed
FLAG <f%bell> ; whether to bell on pty output
FLAG <f%siln> ; if terminal output is silenced
FLAG <f%actv> ; if anything has happened this cycle
FLAG <f%pars> ; if in the middle of a command parse
FLAG <f%int> ; if in interrupt level
FLAG <f%tint> ; if terminal interrupts are off
FLAG <f%all> ; if ALL was typed
FLAG <f%conn> ; if in a pushed exec or a connect
FLAG <f%nint> ; if NOINT is set
FLAG <f%ctlc> ; if ^C happened while NOINT set
FLAG <f%iout> ; if interrupt-level output occurred
FLAG <f%err> ; if within JSYSER routine (for NUMOUT)
FLAG <f%nsin> ; whether to not save input on .cmcfm parse
FLAG <f%frst> ; if first time through
FLAG <f%rscn> ; if RSCAN input was processed
FLAG <f%pop> ; if current subfork has halted
FLAG <f%dvtr> ; if Dvorak key translation is enabled
FLAG <f%dbug> ; whether to print debugging messages
FLGINI
FLAG <s%disc> ; subjob flag: discard output
FLAG <s%refo> ; subjob flag: refuse output
FLAG <s%mark> ; subjob flag: mark for parser
FLAG <s%halt> ; subjob flag: fork is halted
; Macros
define ctrl (char) <"char" - 100>
define TMSG (msg) <
call [ hrroi b,[asciz/msg/]
jrst strout ] ; go to handler routine after getting string
>
define CMSG (chr) <
call [ movei b,"chr"
jrst chrout ] ; go to handler routine after getting char
>
define DBMSG (msg,rou) <
txne f,f%dbug ; debugging?
call [ call savacs ; yes, save registers
call terpri ; make sure we have a new line
TMSG <msg> ; print the message
ifnb <rou>,<call rou> ; maybe call auxiliary subr
CMSG <.> ; finish with a period
ret ]
>;define DBMSG
define ERRMSG (msg,addr) <
ifnb <addr>,<
jrst [ push p,b ; save register B
hrroi b,[asciz\?msg\] ; get error message in B
call doerr ; call error routine
pop p,b ; restore B
jrst addr ] ; go to specified location
>;ifnb
ifb <addr>,<
hrroi b,[asciz\?msg\] ; get error message in B
call doerr ; call error routine
>;ifb
>;define ERRMSG
define FATAL (msg) <ERRMSG (<msg>,die)>
define ERROR (msg) <ERRMSG (<msg>,enderr)>
define CMDERR (msg) <ERRMSG (<msg>,prtatm)>
; Looping macros
;
; call dofor
; lupadr/code to run
; iterates code with I set to all subjobs
dofor: setz i, ; start at the bottom
jrst @(p) ; run the code
dfnext: aos i ; go to next subjob
caige i,sjmax ; was that the last subjob?
jrst @(p) ; no, go back again
adjsp p,-1 ; pop routine from stack
ret ; return to caller
opdef lpnext [jrst dfnext] ; go to the next in an iteration
define LPEXIT (loc) <
jrst [ adjsp p,-2 ; pop loop address, call to DOFOR
jrst loc ] ; go to label
>
define FORALL (code) <
call [ push p,[[code
lpnext]] ; get location to loop on stack
jrst dofor ] ; go do loop handler
>
define FORMRK (code) < ;; This macro expands into more than 1 instr!!
FORALL <push p,a ; save register A
move a,sjflgs(i) ; get subjob flags
txnn a,s%mark ; was this one marked?
jrst [ pop p,a ; no, restore register A
lpnext ] ; and continue
pop p,a ; else restore register A
code ; and do whatever routine was given
>
>
; COMND JSYS macros
define NOISE (string) < ;; This macro expands into more than 1 instr!!
movei b,[flddb. .cmnoi,,<-1,,[asciz/string/]>]
call .comnd ; parse the guide word
ERRMSG <Invalid guide word>,prtlin
>
define NOISE2 (str1,str2) < ;; This macro expands to more than 1 instr!!
movei b,[flddb. .cmnoi,,<point 7,[asciz/str1/]>,,,<[
flddb. .cmnoi,,<point 7,[asciz/str2/]>]>]
call .comnd ; parse the guide word
ERRMSG <Invalid guide word>,prtlin
>
; Macros for making TBLUK tables
define TABTOP <
0 ; dummy word, will fill in later
..t== .
>
define TABBOT <
..u== . ; save current location
reloc ..t-1 ; go back to word for table
..u-..t,,..u-..t ; fill in first word of table
reloc ..u ; go back to where we should process
purge ..u,..t ; get rid of unneeded symbols
>
define KEY (name,val,flgs) <
[ifnb <flgs>,<cm%fw!flgs>
asciz/name/],,val
>
define ABBREV (name,expand) <KEY <name>,<expand>,<cm%abr!cm%inv>>
define CMD (name,addr,help) <KEY <name>,<[help,,addr]>>
define INVCMD (name,addr,help) <KEY <name>,<[help,,addr]>,<cm%inv>>
define SYN (name,expand,addr) <KEY <name>,<[[asciz/name is a synonym for expand
/],,addr]>,cm%inv>
;******************** Entry routines ******************************************
evec: jrst start ; starting location
jrst start ; re-entry location
byte (3)vwho (9)vmajor (6)vminor (18)vedit
start: RESET% ; clear all files etc.
move p,[iowd pdlen,pdl] ; initialize the stack
move iop,[iowd ipdlen,ipdl] ; and the TAKE file stack
movx f,f%frst ; clear flags, say this is first time through
setzm execfk ; forget EXEC fork handle
setzm logjfn ; forget log file
setzm savjfn ; forget save file
setzm modsav ; forget saved mode word
setom lstcon ; forget last connected subjob
setom lstfrk ; forget last connected exec fork
setom dedjob ; forget to-be-flushed subfork
setom consj ; forget connected subjob
setom lock ; forget locked subjob
move a,[KEY S,0,cm%nor] ; get no-recognition keyword
movem a,sno ; save it in NO command table
move a,[.priin,,.priou] ; get terminal JFNs
movem a,cmdblk+.cmioj ; put them in command block
move a,sjntab ; get subjob name table header
hrli a,0 ; clear number of entries
movem a,sjntab ; replace in table
movei a,4
movem a,sbkmsk ; set header word of saved break mask
movei escchr,ctrl <X> ; set escape char to Ctrl-X
movei a,.ptypar ; a/get # of PTYs,,# of first PTY
GETAB% ; get word from table in monitor
ercal jsyser ; couldn't, complain
hrrzm a,firpty ; store number of first PTY
hlrzm a,numpty ; store total number of PTYs
FORALL <hrrz a,sjnams(i) ; get name, set length to zero
setzm @a ; clear first word of name (in case restarted)
movem a,sjnams(i) ; put it back in name table
setzm sjpty(i) ; forget that we had any PTYs
setzm sjnpty(i) ; this one should also be zeroed
setzm sjflgs(i) ; clear all subjob flags
setzm sjexec(i) ; forget about any exec subfork
>
movei a,.fhslf
RPCAP% ; get user capabilities
txnn b,sc%ctc ; do we have control-C capability?
FATAL <Cannot run without Ctrl-C capability>
move c,b ; copy caps-we-have word to caps-to-enable word
EPCAP% ; enable all caps possible
move b,[levtab,,chntab] ; set up interrupt system
SIR%
EIR%
move a,[.ticcc,,chn.cc]
ATI% ; yes, put interrupt on ^C
movei a,.fhslf
move b,chnmsk ; get mask of channels to be activated
AIC% ; acticate interrupt channels
call rdtint ; read terminal interrupt word for toplvl
jrst toplvl ; start reading commands
;******************** Top level loop ******************************************
toplvl: move p,[iowd pdlen,pdl] ; re-initialize the stack
txz f,f%conn!f%pars ; no longer in a connection or parsing commands
txne f,f%tint ; STIW sets wrong tty interrupt word, so reset
call inton ; turn terminal interrupts back on
txne f,f%nint ; is NOINT set?
call okint ; yes, clear it
call log ; close log file in case of a crash
call clstak ; test if TAKE file needs closing
move a,['PTYCOM']
move b,['PTYCOM']
SETSN% ; set name of program back to PTYCOM
nop ; don't care if it fails
setom locsj ; remove any lock on subjob
setzm gtbptr ; clear getbuf pointer
call fktst ; see if any subforks have died recently
FORALL <call chkpty> ; see if there's output from any of the PTYs
skipe b,modsav ; is there a saved terminal mode word?
call fixmod ; yes, restore it
top1: txne f,f%frst ; first time through? (flag cleared by dojcl)
call dojcl ; yes, process jcl input (returns if none)
txze f,f%rscn ; was jcl processed?
call [ movei a,.priou ; yes, get normal output pointer
hrrm a,cmdblk+.cmioj ; and reset command block
jrst quit ] ; stop temporarily and return
call terpri ; get a new line (mostly for log file)
hrroi b,[asciz/PTYCOM> /] ; get prompt
call setcmd ; initialize CSB
skipe b,modsav ; is there a saved terminal mode word?
call fixmod ; yes, restore it (second check...)
skipl i,dedjob ; is there a to-be-flushed subfork?
call fldedj ; yes, flush it
txz f,f%no!f%int ; clear flags
setzm nchrs ; clear new subjob name length
skipe a,tmpjfn ; is there a temporary jfn lying around?
call rltjfn
movei a,cmdblk
movei b,cmdfdb
call .comnd ; parse command or maybe carriage return
jrst rdcsj ; if "-" sends, go try it
cain d,.cmcfm ; was carriage return parsed?
jrst toplvl ; yes, return to top level
hrrz b,(b) ; get command info (help address,,address)
hrrz b,(b) ; get address
jrst (b) ; and go do the command
; Auxiliary routines for TOPLVL
rltjfn: RLJFN% ; release temporary JFN in A
nop ; don't care if release fails
setzm tmpjfn ; don't try to release again
ret
fixmod: movei a,.priou ; on primary output
SFMOD% ; (mode word already in B)
STPAR% ; fix terminal mode
DBMSG <FIXMOD -- Terminal mode word restored>
setzm modsav ; clear saved mode to avoid this next time
ret
fldedj: setom dedjob ; clear t-b-f sf (to prevent loop on err)
setzm sjexec(i) ; forget partial exec fork (?)
call relpty ; and flush associated PTY
DBMSG <TOPLVL -- Dead subjob released>
ret
; Process JCL if any
dojcl: movei a,.rsini ; code to initialize RSCAN input
RSCAN% ; (returns num chars in a)
ERRMSG <Couldn't read JCL>,jswarn
jumpe a,r ; no characters, just return
txo f,f%rscn ; say RSCAN input exists
push p,a ; save count
movei b,.nulio ; get null output pointer
hrrm b,cmdblk+.cmioj ; set it in command block
hrroi b,[0] ; null prompt
call setcmd ; do .cmini, set reparse address
txzn f,f%frst ; is this the first time through?
jrst dojcl1 ; no, don't try getting RSCAN buffer twice
move a,cmdblk+.cmcnt ; get count of space left in command buffer
move c,(p) ; restore RSCAN count to C
subi a,(c) ; subtract number of chars coming in
jumpl a,[ERROR <JCL input exceeds command buffer size>]
movei a,.priin ; with input from terminal (RSCAN actually)
hrroi b,cmdbuf ; to command buffer
SIN% ; stuff that buffer
pop p,cmdblk+.cminc ; set number of unparsed chars
dojcl1: movei b,[flddb. .cmfld,cm%sdh,,<program name>]
call .comnd ; try to parse program name
jrst nojcl ; failed
movei b,[flddb. .cmcfm,cm%sdh,,,,<[
flddb. .cmkey,,jcltab,<PTYCOM command,>]>]
call .comnd ; try to parse command (from restricted set)
CMDERR <Invalid PTYCOM command>
cain d,.cmcfm ; was it confirmed?
jrst nojcl ; yes, no JCL to process
hrrz b,(b) ; get address of driver
jrst (b) ; and go to it
nojcl: movei b,.priou ; get normal output designator
hrrm b,cmdblk+.cmioj ; restore it
txz f,f%rscn ; say no RSCAN input
ret
; Quickie "-" send command (come here if command parse fails)
rdcsj: movei b,[flddb. .cmtok,,<-1,,[asciz/-/]>]
call .comnd ; parse a minus sign
jrst rdcsj0 ; failed, try a subjob
skipge i,lstcon ; get last connected job
skipl i,lstfrk ; or last fork
jrst sndnj ; if either of those were ok, go send
call fndjob ; else look for subjob with PTY on it
jrst sndnj ; go send the message
rdcsj0: call jpsubr ; try to parse a subjob name
jrst rdcsjn ; couldn't, might be number with immediate "-"
rdcsjm: movei b,[flddb. .cmtok,,<-1,,[asciz/-/]>]
call .comnd ; parse minus sign again
ERRMSG <Invalid PTYCOM command>,ptatm2
jrst sndnj ; go send the message
rdcsjn: ildb b,.cmptr(a) ; get next char in string
sos .cminc(a) ; tell COMND we took one
cain b,"+" ; is it a plus?
call [ ildb b,.cmptr(a) ; yes, get another char (minus never happens)
sos .cminc(a) ; tell COMND we took one
ret ]
cail b,"0" ; is it less than zero
caile b,"9" ; or greater than nine?
ERRMSG <Invalid PTYCOM command>,ptatm2
movei c,-"0"(b) ; else initialize building number
numlup: move d,.cmptr(a) ; get byte pointer
ildb b,d ; from which get next char in string
cail b,"0" ; is it less than zero
caile b,"9" ; or greater than nine?
jrst numext ; yes, finished
movem d,.cmptr(a) ; put pointer back in CSB
sos .cminc(a) ; tell COMND we took one
imuli c,^D10 ; multiply building number by ten
addi c,-"0"(b) ; and add current digit
jrst numlup ; go back for another digit
numext: skipl I,c ; move number to I. Is it less than zero,
cail I,sjmax ; or greater than or equal to the upper bound?
ERRMSG <Invalid PTYCOM command>,ptatm2
jrst rdcsjm ; continue parsing line
;******************** The ACCEPT command **************************************
.accep: txze f,f%no ; was NO typed?
jrst .refus ; yes, do REFUSE command instead
call sjpars ; parse "ALL" or subjob name
FORMRK <move a,sjflgs(I) ; get status word
txz a,s%disc!s%refo ; clear discard and refuse flags
movem a,sjflgs(I) ; replace status word
>
jrst toplvl ; return to top level
;******************** The BELL command ****************************************
.bell: NOISE <when output waiting> ; guide words
call conf ; finish command parsing
txo f,f%bell ; turn bell on
txze f,f%no ; was NO typed?
txz f,f%bell ; yes, turn bell off
jrst toplvl ; return to top level
;******************** The CHANGE (or REDEFINE) command ************************
.chang: NOISE <PTYCOM escape character to be> ; guide words
movei b,[flddb. .cmcfm,cm%sdh,,<single character>,,<[
flddb. .cmtxt,cm%sdh,,<carriage return to enter char on separate line>]>]
; (note switched help strings)
call .comnd ; parse escape char
CMDERR <Invalid PTYCOM escape char>
move c,d ; get fdb type parsed
move d,[point 7,atmbuf] ; get pointer to string (unused if null)
caie c,.cmcfm ; was return parsed?
jrst ch1 ; no, read it from string
push p,a ; yes, save CSB
TMSG <New escape char: > ; prompt for read-in of char
call gtchni ; get character with no tty interrupts
cain b,ctrl <J> ; was it a linefeed?
call [ movei b,ctrl <M>
call chrout ; yes, print a CR for prettiness
movei b,ctrl <J> ; get linefeed back
ret ]
call terpri ; make sure we're on a clean line
pop p,a ; restore CSB
jrst ch0 ; go set the escape
ch1: ildb b,d ; get the first char in the string
caie b," " ; while it's a space
cain b,ctrl <[> ; or an escape
jrst ch1 ; go back for another
cain b,"^" ; is it an uparrow?
jrst [ ildb b,d ; yes, get another char
jumpe b,[ movei b,"^" ; if null get uparrow back
jrst checnf ] ; and go on
cail b,"@" ; is it not a letter
caile b,"z" ; or is it a lower-case special char?
CMDERR <Not a single character> ; yes, complain
cain b,"`" ; is it the other possible lower-case special?
CMDERR <Not a single character> ; yes, complain
trz b,140 ; controlify
jrst .+1 ] ; and go on
ildb d,d ; get another character
jumpn d,[CMDERR <Not a single character>] ; it wasn't null
checnf: push p,b ; save character from COMND smashing
call conf ; finish command parsing
pop p,b ; restore character
ch0: call okesc ; is it an acceptable escape char?
movem b,escchr ; put it in the escape char
TMSG <The new escape character is >
call prtesc ; tell the user what he changed it to
jrst toplvl ; return to top level
; Make sure the escape character won't screw the user
okesc: call savacs ; don't mung any registers
push p,b ; save the char
call okesc1 ; is it OK?
jrst badesc ; no, complain
txne f,f%dvtr ; Dvorak enabled?
jrst okesc0 ; no, go return good news
move b,(p) ; else get char back from the stack
call okesc1 ; try again
jrst badesc ; failed, go complain
okesc0: pop p,b ; char is OK, restore char
ret ; and return to caller
okesc1: idivi b,^D32 ; find modulo 32
move b,eoktab(b) ; get bitstring for char
lsh b,(c) ; shift into b0
txne b,1b0 ; is the bit set?
skpret ; yes, set up for +2 return
ret ; no, return +1
badesc: ERRMSG <Invalid PTYCOM escape char - > ; start error msg
pop p,b ; restore the character
call pntchr ; print the character
jrst enderr ; go finish erroring
;******************** The CONNECT command *************************************
.conne: NOISE <to subjob> ; guide words
call jparse ; parse job number or name
call conf ; confirm
call maksur ; check if the JFN has been closed
nop ; but don't do anything special if it has
skipe sjexec(i) ; is this a subfork?
jrst frknp ; yes, do FORK stuff (comes back to CONNP)
skipn sjpty(i) ; does this job already have a PTY?
call getpty ; no, go get one
movem i,lstcon ; remember this as last connected subjob
; other commands come in here...
connp: call terpri ; get newline before tty munged, after all
; chances to lose fresh line before [Conn]
movem i,locsj ; lock PTY output
txo f,f%conn ; say we're in a connection (top level clears)
txz f,f%pop ; fork hasn't stopped yet
movem i,consj ; say we are connected to this subjob
call savmod ; read and save tty mode word
txz b,tt%dam!tt%pgm ; data mode, echoing off, paging off
SFMOD%
STPAR%
TMSG <[Connected to >
call prtsjb
TMSG <]
> ; tell user he is connected
call getbuf ; get a buffer to wake job up
skipa ; if nothing, skip
call strout ; else print it
call skptak ; is there a take file?
jrst contty ; no, set up input from terminal
setom locsj ; clear lock on subjob
conlup: txne f,f%pop ; did the fork terminate?
jrst conext ; yes, exit
call clstak ; make sure there is still input from file
call skptak ; and see whether it was closed
jrst contty ; no more input, go connect terminal
hlrz a,cmdblk+.cmioj ; get input JFN
BIN% ; get a char from it
caie b,ctrl <M> ; is it a return?
jrst cnlup2 ; no, go on
BIN% ; yes, read linefeed
movei b,ctrl <M> ; but send as return
cnlup2: caie b,(escchr) ; is it the escape char?
cain b,200(escchr) ; or the escape char with parity?
jrst conext ; yes, exit
move a,sjpty(i) ; get JFN for PTY
BOUT% ; send char (no Dvorak translation)
erjmp cnlerr ; error, go work on it
jrst conlup ; else go back for more
; What to do when the PTY doesn't want input
cnlerr: call cptjob ; check for PTY job
jrst conlup ; got one successfully, return
move a,sjnpty(i) ; get designator for terminal
DIBE% ; wait for it to get hungry
move a,sjpty(i) ; get JFN for PTY
BOUT% ; send the character
erjmp cnlerr ; error, try again
jrst conlup ; else return to loop
ctlerr: cain b,"?" ; is it a question mark?
jrst ctlerq ; yes, handle specially
call cptjob ; make sure there is a job for the PTY
jrst ctilup ; got one, return
ctlerb: movei a,ctrl <G> ; else get a control-G
PBOUT% ; beep
jrst ctilup ; return to loop
ctlerq: skipn sjexec(i) ; is there a fork on the PTY?
call getjob ; or is there a job for the PTY?
jrst ctlerb ; yes, go beep
TMSG <
You are connected to subjob > ; start help message
call prtjob ; print jobname
TMSG <.
To return to PTYCOM type > ; continue message
call prtesc ; print escape char
TMSG <.
To create a new job on this PTY type Ctrl-C.
> ; finish message
jrst ctilup ; return to main loop
cptjob: push p,b ; save the character
call maksur ; make sure the PTY hasn't gone away
jrst [ call skptak ; it has, check if we're still taking a file
jrst ctlext ; so we can take the appropriate loop exit
jrst conext ]
skipn sjexec(i) ; is there a fork on the PTY?
call getjob ; or is there a job for the PTY?
jrst cptjrs ; yes, return +2
movei a,.sfpty
TMON% ; test if PTY logins are allowed
jumpe b,cptjrs ; no, give up
move a,sjpty(i) ; get JFN for PTY
movei b,ctrl <C> ; and a control-C
BOUT% ; send it
erjmp .+1 ; don't worry if it can't be sent
movei a,^D500
DISMS% ; wait for half a second
call getjob ; is there a job now?
jrst cptj2 ; yes, go send character
cptjrs: pop p,b ; else, restore stack
retskp ; and return +2
cptj2: move a,sjpty(i) ; get JFN once more
pop p,b ; restore char into B
cain b,<ctrl <C>> ; was it a control-C?
ret ; yes, just return
BOUT% ; send it again
erjmp [retskp] ; failed, return +2
ret ; else return +1
; Exiting from connection loop
;
; ctlext - jump from tty input interrupt
; conext - jump from take file loop
ctlext: call clrbuf ; force out any partial subjob output
ctlx2: movem i,locsj ; lock subjob to avoid infinite output
movei a,.ticti
DTI% ; detach terminal input interrupt
call inton ; turn interrupts back on
setom locsj ; clear subjob lock
CIS% ; clear interrupt system
jrst cnext1 ; go finish exiting
conext: move a,sjnpty(i) ; get terminal designator for PTY
DOBE% ; wait for no more output
; falls through to...
cnext1: GETNM% ; get our program name before TOPLVL clears it
skipe sjexec(i) ; was this a subfork?
movem a,sjfnam(i) ; yes, save program name
setom consj ; clear connected subjob
call terpri ; on a new line
skipn sjpty(i) ; was there still a PTY when we stopped?
jrst [ TMSG <[PTY disappeared for >
jrst cnext2 ] ; no, must have been closed on us
TMSG <[Returning from > ; start return message
cnext2: call prtsjb ; print subjob name
TMSG <]
> ; finish message to tell user he's back
skipn sjpty(i) ; abnormally aborted?
call endtak ; yes, flush take file
txz f,f%conn!f%pop ; say we're out of connection, no popped subjob
jrst toplvl ; return to top level
; No more take-file input, so set up interrupts to read from terminal
contty: txne f,f%pop ; did the subfork pop?
jrst conext ; yes, don't continue
txne f,f%dbug ; debugging messages?
TMSG <CONTTY -- Connecting terminal to subjob.
>
call intoff ; turn off terminal interrupts
move a,[.ticti,,chn.ti]
ATI% ; activate terminal input interrupt
setom locsj ; unlock subjob
movei a,.fhslf
hrli b,(1b<chn.ti>)
IIC% ; call interrupt once in case input already
WAIT% ; until an interrupt exits
cti: call savint ; save registers
ctilup: call maksur ; has the PTY been closed on us?
jrst ctlext ; yes, stop now (ctlext will say why)
movei a,.priin
SIBE% ; is there input?
skipa
ret ; no, just return
BIN% ; read the character
skipe a,savjfn ; is there a save file?
jrst [ BOUT% ; yes, send the char to it
caie b,ctrl <M> ; was it a return?
jrst .+1 ; no, go on
movei b,ctrl <J> ; else get a LF too
BOUT% ; send it to make a CRLF
jrst .+1 ] ; return to in-line code
caie b,(escchr) ; is it the escape char
cain b,200(escchr) ; or the escape char with parity?
jrst ctlext ; yes, run away
txne f,f%dvtr ; is Dvorak enabled?
move b,dvtab(b) ; yes, translate char
move a,sjpty(i) ; get JFN of PTY
BOUT% ; try to send char
erjmp ctlerr ; couldn't, go to error routine
jrst ctilup ; else go back for more
;******************** The DDT command *****************************************
.ddt: NOISE <self> ; guide word
call conf ; finish command parsing
move a,[.fhslf,,ddtloc/1000]
RMAP% ; get status of DDT page
txne b,rm%pex ; does it exist?
jrst ddt0 ; yes, don't map twice
movei a,.fhslf ; for this process
GEVEC% ; get our entry vector
push p,b ; save it
movx a,gj%sht!gj%old ; short form, old file
hrroi b,[asciz/SYS:UDDT.EXE/]
GTJFN% ; get a JFN on ddt
ERROR <Couldn't find DDT>
hrli a,.fhslf ; on our own process
GET% ; map it in
hrrzs a ; get rid of process handle
RLJFN% ; so we can get rid of JFN
movei a,.fhslf ; on ourself again
pop p,b ; get old entry vector
SEVEC% ; set it back
move a,.jbsym ; get our symbol table
hrrz b,ddtloc+1 ; and place DDT wants it
movem a,(b) ; save it
move a,.jbusy ; same for this location
hrrz b,ddtloc+2 ; get DDTs place for it
movem a,(b) ; save it
ddt0: call ddtloc ; start up DDT
jrst toplvl ; return to top level
;******************** The DISCARD command *************************************
.disca: txze f,f%no ; was NO typed?
jrst .accep ; yes, turn into ACCEPT command
call sjpars ; parse "ALL" or subjob name
FORMRK <move a,sjflgs(i) ; get status word
txz a,s%refo ; clear refuses flag
txo a,s%disc ; and set discard flag
movem a,sjflgs(i) ; replace status word
>
jrst toplvl ; return to top level
;******************** The DVORAK command **************************************
.dvora: NOISE <simulation>
call conf ; finish command
txo f,f%dvtr ; set flag
txze f,f%no ; was NO typed?
txz f,f%dvtr ; yes, clear flag
jrst toplvl ; return to top level
;******************** The EXIT command ****************************************
.exit: NOISE <from PTYCOM> ; guide words
call conf ; finish parsing command
call quit ; stop the fork
jrst toplvl ; return to top level if continued
;******************** The FORK command ****************************************
.fork: NOISE <EXEC on subjob> ; guide words
call fparse ; get subjob
call conf ; confirm
movem i,locsj ; lock subjob
frknp: call fkstat ; make sure there is an EXEC
jrst fknew ; there isn't one -- go make a new one
cain b,.rfhlt ; is it stopped?
call wakeup ; yes, wake it up
jrst fkgo ; go do connection
fknew: call getjob ; is there a job?
ERROR <Not an inferior subfork> ; yes, complain
txne f,f%dbug ; debugging messages?
TMSG <FKNEW -- No existing fork on subjob.
>
skipn sjpty(i) ; does this job have a PTY?
call getpty ; no, get one
call getfrk ; get an EXEC on the subfork
fkgo: movem i,lstfrk ; remember this as last connected subfork
move a,sjfnam(i) ; get fork's jobname
SETNM% ; set system's idea of what we're running
DBMSG <FKGO -- Setting job name to >,<[ move a,sjfnam(i)
jrst sixout ]>
jrst connp ; go to CONNECT command at appropriate place
;******************** The HELP command ****************************************
.help: NOISE <on topic> ; guide words
movei b,hlpfdb
call .comnd ; parse help topic
CMDERR <Invalid PTYCOM command or HELP subtopic>
hrrz c,c ; get which fdb was used
cain c,cmdfdb ; was it a command?
jrst comhlp ; yes, get help on it
cain c,hstfdb ; was it help sub-topic fdb?
jrst sthlp ; yes, get help on it
hrroi b,hlpovw ; no, must have been .cmcfm
call strout ; print overview of PTYCOM
jrst toplvl ; return to top level
sthlp: push p,b ; save COMND results from confirm routine
call conf ; finish parsing command
pop p,b ; restore COMND results
hrro b,(b) ; turn into a string pointer
call strout ; print it
jrst toplvl ; return to top level
comhlp: push p,b ; save COMND results from confirm routine
call conf ; finish parsing command
pop p,b ; restore COMND results
hrrz b,(b) ; get command info (help,,address)
hlro b,(b) ; turn it into a string pointer
call strout ; print it
jrst toplvl ; return to top level
;******************** The KILL command ****************************************
.kill: NOISE <subjob> ; guide word
call sjpnn ; parse a list of subjobs
FORMRK <call maksur ; is there a PTY for this job?
lpnext ; no, go on
LPEXIT kilsum ; yes, found something to kill
>
ERROR <No active subjobs> ; nothing to kill, complain
kilsum: txnn f,f%all ; was ALL typed?
jrst dokill ; no, just go kill
hrroi b,[asciz/Confirm to kill all subjobs: /]
call chconf ; make sure he wants to do it
jrst abrtkl ; abort kill if not
dokill: FORMRK <call maksur ; is this one active?
lpnext ; no, go on
movem i,locsj ; lock this subjob
skipn a,sjexec(i) ; is this an inferior subfork?
jrst kiljob ; no, kill other job
KFORK% ; kill the fork
setzm sjexec(i) ; forget about it
DBMSG <DOKILL -- Killing fork >,prtjob
jrst knolog ; don't even look for a job on the pty
kiljob: call getjob ; get subjob number -- is there none
camn a,[-2] ; or is it just logging in?
jrst knolog ; yes, don't worry about it
DBMSG <DOKILL -- Logging out job >,prtjob
LGOUT% ; log it out
ERROR <Couldn't log out job> ; couldn't do it
knolog: call relpty ; release this job's PTY
camn i,lstcon ; was this the last connected subjob?
setom lstcon ; yes, forget it
camn i,lstfrk ; was it the last connected subfork?
setom lstfrk ; forget it again
call kilnam ; kill the job's name if any
setom locsj ; clear subjob lock
>
jrst toplvl ; return to top level
abrtkl: call terpri ; on a new line
TMSG <[KILL command aborted]
> ; say kill command was aborted
jrst toplvl ; return to top level
;******************** The LOG command *****************************************
.log: NOISE <output to file> ; guide words
txne f,f%no ; was no typed?
jrst nolog ; yes, just close the old one
skipe logjfn ; already logging?
jrst loglog ; yes, go complain
hrroi b,[asciz/LOG/]
movem b,gtjblk+.gjext ; set default extension to LOG
movx b,gj%fou!gj%msg!gj%xtn
movem b,gtjblk+.gjgen ; set flags for output file
movei b,[flddb. .cmfil,cm%sdh,,<file to log PTY output to>]
call .comnd ; parse log file
CMDERR <Invalid log file name>
movem b,tmpjfn ; save jfn, flush if not reparsed
call conf ; finish command parsing
move a,tmpjfn ; restore jfn from temp storage
setzm tmpjfn ; clear it so it won't get released
move b,[7b5!of%wr!of%app] ; open file as ASCII, appending
OPENF%
ERROR <Couldn't open log file>
hrroi b,[asciz/
[PTYCOM log file, started /]
setz c,
SOUT% ; send out header
seto b, ; current time
ODTIM% ; write date and time to file
hrroi b,[asciz/]
/]
SOUT% ; finish header
exch a,logjfn ; save JFN, get old one
caie a,0 ; was there an old one?
jrst logcls ; yes, close it
jrst toplvl ; return to top level
nolog: skipn logjfn ; was there a log file?
ERROR <No log file exists> ; no, complain
call conf ; finish command parsing
move a,logjfn ; get the jfn
setzm logjfn ; say there is no log file
logcls: CLOSF% ; close file
nop ; error closing file doesn't really matter
jrst toplvl ; return to top level
loglog: ERRMSG <Already logging output to file >
move b,logjfn
call filnam ; say where logging to
jrst enderr ; finish error and jump to top level
;******************** The MAKE command ****************************************
.make: NOISE <job for user> ; guide words
movei b,[flddb. .cmusr,,,,,<[flddb. .cmdir,cm%sdh]>]
call .comnd ; try to parse a user name
CMDERR <Invalid user name>
cain d,.cmdir ; was it a directory?
call dircnv ; yes, convert
hrroi a,unmbuf ; into user name buffer
DIRST% ; translate user number to name
ERRMSG <Couldn't translate user number>,jswarn
hrroi a,unmbuf ; get user name buffer again
movem a,crjblk+.cjnam ; save it for CRJOB
setzm crjblk+.cjpsw ; no password
setzm crjblk+.cjact ; say no account set
movx a,.sfavr ; is account validation enabled?
TMON% ; get system flag value
jumpn b,[ noise <account> ; if account validation enabled...
movei b,[flddb. .cmtok,cm%sdh,<point 7,[asciz/*/
]>,<"*" for default account>,<*>,<[
flddb. .cmfld,cm%sdh,,<account string>]>]
call .comnd ; parse account string
CMDERR <Invalid account string>
cain d,.cmtok ; was it token (*)?
jrst .+1 ; yes, return
move a,[atmbuf,,actbuf] ; else get source,,dest
blt a,actbuf+atmsiz-1 ; copy password into account buffer
hrroi a,actbuf ; get pointer to account string
movem a,crjblk+.cjact ; save it
jrst .+1 ]
NOISE <on subjob>
call fndfre ; default to first free subjob
call jpc1 ; parse a subjob
call maksur ; make sure the JFN hasn't been closed
nop
skipn sjexec(i) ; check for subfork
call getjob ; check job status
ERROR <Subjob is already active>
skipn sjpty(i) ; is there already a PTY?
call getpty ; no, make one
move a,sjnpty(i) ; get tty designator for the PTY
movem a,crjblk+.cjtty ; save it as new job's controlling tty
movem i,dedjob ; if error here, save the world
ASND% ; try to assign it
ERRMSG <Couldn't assign PTY>,jswarn
movx a,1b4 ; bits to simulate login
movem a,crjblk+.cjexf ; set it in flags for new EXEC
txne f,f%rscn ; JCL input?
jrst makcon ; no, just connect
NOISE <and> ; else allow STAY option -- give noise word
movei b,[flddb. .cmkey,,maktab,,CONNECT]
call .comnd ; parse STAY or CONNECT
CMDERR <Invalid subcommand>
hrrz b,(b) ; get data for keyword
jumpe b,[ NOISE <to subjob> ; CONNECT, give noise words
jrst makcon ] ; and go make connection
NOISE <in PTYCOM> ; noise words for STAY subcommand
call conf ; finish command parse
call mak1 ; make the job
jrst toplvl ; and return to top level
; Make the job
makcon: call conf ; finish command parse
movem i,locsj ; lock subjob output
call mak1 ; make the job
jrst connp ; go make the connection
dircnv: hlrz d,b ; get left half of directory number
caie d,540000 ; is it PS:?
ERROR <Directory not on public structure>
hrli b,500000 ; turn it into a username
ret
mak1: movx a,cj%log!cj%nam!cj%etf ; get flags for CRJOB
skipn crjblk+.cjpsw ; password set?
txo a,cj%npw ; no, don't try to validate it
skipn crjblk+.cjact ; account set?
txoa a,<fld(.cjuda,cj%act)> ; no, use default
txo a,<fld(.cjuaa,cj%act)> ; yes, use it instead
movei b,crjblk ; get address of argument block
CRJOB% ; do the creation
ercal makx ; failed, go see why
setom dedjob ; job is safe to keep
ret
makx: cain a,lginx4 ; did it fail for invalid password
skipn crjblk+.cjpsw ; and was there a password set?
ERRMSG <Couldn't create job>,jswarn
adjsp p,-1 ; fix stack from ercal
call savmod ; read and save terminal mode word
txz b,tt%eco ; echoing off
STPAR% ; set it
call getpas ; read in a password
hrroi b,pwdbuf ; get pointer to password
movem b,crjblk+.cjpsw ; set it in pw block
jrst mak1 ; go try again
; Read a password
getpas: call termio ; set terminal input
hrroi b,[asciz/Password: /]
call setcmd ; set up for password command parse
movei b,[flddb. .cmfld,cm%sdh,,<password>]
call .comnd ; parse the password
ERRMSG <Invalid password>,jswarn ; don't type it out on error
move a,[atmbuf,,pwdbuf] ; source,,dest
blt a,pwdbuf+atmsiz-1 ; copy password into password buffer
movei a,.priin ; on terminal again
move b,modsav ; with saved terminal mode word
STPAR% ; turn echoing back on
setzm modsav ; clear so mode won't need to be set again
txo f,f%nsin ; don't save it in input file
call conf ; confirm it
ret
termio: call skptak ; in take file?
ret ; no, just return
pop p,a ; get return address
push p,cmdblk+.cmioj ; save old input pointers
move b,[.priin,,.priou] ; get terminal designators
movem b,cmdblk+.cmioj ; set them in command block
call (a) ; call our caller
aos -1(p) ; skip return propagates (over saved ioj)
pop p,cmdblk+.cmioj ; restore old i/o jfns
ret ; and return to caller's caller
;******************** The NAME (or DEFINE) command ****************************
.name: NOISE2 <subjob number>,<subjob #>
call jpsubd ; parse a subjob
CMDERR <Invalid subjob name or number> ; no, complain
NOISE <as> ; another guide word
movei b,[flddb. .cmnum,cm%sdh,^d10,,,<[
fldbk. .cmfld,cm%sdh,,<new subjob name>,,minmsk,<[
fldbk. .cmfld,cm%sdh,,<return to delete name>,,minmsk]>]>]
call .comnd ; parse subjob name
CMDERR <Invalid subjob name>
cain d,.cmnum ; was a number parsed?
ERRMSG <Subjob name must not be a number>,ptatm2
movei a,sjntab ; get table of subjob names
hrroi b,atmbuf ; and the just-parsed name
TBLUK% ; look it up
txne b,tl%exm ; was it an exact match?
ERRMSG <Subjob name already in use>,ptatm2
call addnam ; add the name to the list
jrst defun ; +1 means null name - undef
call conf ; confirm it (does the actual name addition)
jrst toplvl ; return to top level
defun: call conf ; confirm command
call undef ; undefine the name
jrst toplvl ; return to top level
;******************** The NO command ******************************************
.no: movei b,[flddb. .cmkey,,notab,<PTYCOM command,>]
call .comnd ; parse no keyword
CMDERR <Invalid PTYCOM command>
txo f,f%no ; say NO was typed
hrrz b,(b) ; get address of command server
jrst (b) ; and go do the command
;******************** The PRINT command ***************************************
.print: NOISE <debugging messages> ; guide words
call conf ; finish command parsing
txo f,f%dbug ; turn debugging on
txze f,f%no ; was NO typed?
txz f,f%dbug ; yes, turn debugging off
jrst toplvl ; return to top level
;******************** The PUSH command ****************************************
.push: NOISE2 <to EXEC>,<EXEC level>
call conf ; finish parsing command
skiple a,execfk ; is there already an EXEC subfork?
jrst exec0 ; yes, just run it
exec1: call gtexec ; no, get a fork
movem a,execfk ; and save it for later use
exec0: txo f,f%conn ; say we're pushed
setz b, ; using first entry vector (start)
SFRKV% ; start the fork
erjmp [ setzm execfk ; error means fork got reset
jrst exec1 ] ; go back and get a new one
WFORK% ; wait for it to stop
jrst toplvl ; and return to top level
;******************** The REFUSE command **************************************
.refus: txze f,f%no ; was NO typed?
jrst .accep ; yes, turn into ACCEPT command
call sjpars ; parse "ALL" or subjob name
FORMRK <move a,sjflgs(i) ; get status word
txz a,s%disc ; clear discard flag
txo a,s%refo ; and set refuse flag
movem a,sjflgs(i) ; replace status word
>
jrst toplvl ; return to top level
;******************** The RESET command ***************************************
.reset: NOISE <PTYCOM> ; noise word
call conf ; confirm with carriage return
call skpact ; any active jobs?
jrst res0 ; no, go do reset
TMSG <
Warning: Resetting now may log out your active subjobs.
>
hrroi b,[asciz/Type RETURN to continue, or any other character to abort: /]
call chconf ; confirm
jrst [ call terpri ; get a new line
TMSG <[RESET aborted]
> ; not confirmed, give abort message
jrst toplvl ] ; and return to top level
res0: call log ; make sure the log file is up to date
jrst start ; start again
;******************** The SAVE command ****************************************
.save: NOISE2 <input in file>,<input to file>
txne f,f%no ; was NO typed?
jrst nosave ; yes, stop saving input
hrroi b,[asciz/ATO/]
movem b,gtjblk+.gjext ; set default file extension to ATO
movx b,gj%fou!gj%msg!gj%xtn
movem b,gtjblk+.gjgen ; set flags for output file
movei b,[flddb. .cmfil,cm%sdh,,<file to save terminal input into>]
call .comnd ; parse save file
CMDERR <Invalid file name or no such file>
movem b,tmpjfn ; save the JFN
call conf ; finish command parsing
skipe savjfn ; was there already a save file
call clssav ; yes, close it
move a,tmpjfn ; get new JFN
move b,[7b5!of%wr!of%app] ; open it, write (append) mode
OPENF%
ERROR <Couldn't open save file>
movem a,savjfn ; save it
setzm tmpjfn ; don't flush it on return to command level
hrroi b,[asciz/;PTYCOM saved input file, started /]
setz c,
SOUT% ; make a header for the file (as a comment)
seto b, ; in the standard format
ODTIM% ; add the time
hrroi b,crlf
SOUT% ; finish with a CRLF
move a,[ABBREV S,savno] ; get abbrev for SAVE command
txne f,f%siln ; is silencing on?
move a,[KEY S,0,cm%nor] ; yes, get no-recognition key instead
movem a,sno ; save it in NO command table
jrst toplvl ; return to top level
nosave: skipn savjfn ; is there a save file?
ERROR <No save file to close> ; no
txo f,f%nsin ; don't save on saved input file
call conf ; confirm with carriage return
call clssav ; close the file
move a,[ABBREV S,silno] ; get abbrev for SILENCE command
txnn f,f%siln ; is silencing on?
move a,[KEY S,0,cm%nor] ; no, get no-recognition key instead
movem a,sno ; save it in NO command table
jrst toplvl ; return to top level
clssav: move a,savjfn ; get save file jfn
CLOSF% ; close the file
ERROR <Couldn't close save file>
setzm savjfn ; clear the JFN
ret
;******************** The SEND command ****************************************
.send: NOISE <subjob> ; guide word
call jparse ; parse new or old subjob name or number
NOISE <message> ; guide word
sndnj: move b,cmdblk+.cmptr ; get pointer to next input in command line
movem b,sndptr ; save it for later (can't use atom buffer)
movei b,[flddb. .cmuqs,cm%sdh,escbrk,<text line to send to subjob>]
call .comnd ; parse text line
CMDERR <Unexpected error parsing text line>
move b,cmdblk+.cmptr ; get pointer again
movem b,sndend ; save it for comparison
call conf ; finish command parsing
skipn sjpty(i) ; does this subjob have a PTY?
call getpty ; no, make one
skipn sjexec(i) ; is this a subfork?
jrst sndtj ; no, test for job
movem i,lstfrk ; save this as last connected fork
call fkstat ; yes, make sure fork is still there
jrst [ movem i,locsj ; lock subjob for output synchronization
call getfrk ; get a new fork
setom locsj ; unlock output
jrst snd2 ] ; go on
cain b,.rfhlt ; is it stopped?
call wakeup ; yes, wake it up
jrst snd2 ; don't check for regular job
sndtj: movem i,lstcon ; save this as last connected subjob
call getjob ; get job number or -1 in A
jrst snd2 ; got a job, go on
DBMSG <SNDTJ -- Making new job for PTY>
move a,sjpty(i)
movei b,ctrl <C>
BOUT% ; send a control-C to the PTY to wake it up
erjmp .+1
movem i,locsj ; lock subjob for output synchronization
movei a,^D500
DISMS% ; wait half a second
setom locsj ; unlock subjob output
call chkpty ; clear output buffer if any
call getjob ; is there a job now?
jrst snd2 ; yes, go on
call relpty ; no, release the PTY
ERROR <Couldn't create job on PTY> ; and complain
; Loop, sending the chars to the PTY
snd2: move c,sndptr ; get pointer to string
move a,sjpty(i) ; get JFN of PTY
snd0: ildb b,c ; get next char of string
jumpe b,snd1 ; terminate on a null byte
BOUT% ; try to send the char
erjmp snderr
came c,sndend ; are we there yet?
jrst snd0 ; no, go back for the next char
snd1: movei b,ctrl <M>
BOUT% ; add a carriage return
erjmp sndcer ; couldn't do it
movei a,500
DISMS% ; wait a half of a second
jrst toplvl ; return to top level
; Break the bad news when the send failed
snderr: setz b,
dpb b,c ; terminate string so far with a null byte
ERRMSG <The line in its entirety could not be sent.
Sent was: > ; start error message
hrroi b,atmbuf
call strout ; show what was sent so far
jrst enderr ; flush take file, return to top level
sndcer: ERROR <The line as given was sent, but a completing carriage return could not be.>
; couldn't send it, say what happened
; then return to top level
;******************** The SILENCE command *************************************
.silen: NOISE <all output to terminal> ; guide words
call conf ; finish command parsing
txze f,f%no ; was NO typed?
jrst nosil ; yes
txo f,f%siln ; turn silencing on
move a,[ABBREV S,silno] ; get abbrev for SILENCE command
skipe savjfn ; is saving turned on?
move a,[KEY S,0,cm%nor] ; yes, get no-recognition key
movem a,sno ; save it in NO command table
jrst toplvl ; return to top level
nosil: txz f,f%siln ; turn silencing off
move a,[ABBREV S,savno] ; get abbrev for SAVE command
skipn savjfn ; is saving turned on?
move a,[KEY S,0,cm%nor] ; no, get no-recognition key
movem a,sno ; save it in NO command table
jrst toplvl ; return to top level
;******************** The STATUS Command **************************************
.statu: NOISE <of PTYCOM> ; guide words
call conf ; finish command parsing
skipge lstcon ; was there a last connected subjob?
jrst [ TMSG <No connection has been made with a subjob>
jrst nosj ] ; no, just say so
TMSG <The last connected subjob was >
move i,lstcon
call prtjob ; show what last connected subjob is
nosj: skipge lstfrk ; was there a last connected subfork?
jrst [ TMSG <.
No connection has been made with an inferior subfork>
jrst nofrk ] ; no, just say so
TMSG <.
The last connected inferior subfork was >
move i,lstfrk
call prtjob ; show what last connected subfork is
nofrk: TMSG <.
The character to break connections with subjobs is >
call prtesc ; tell user what the escape char is
txne f,f%bell ; is BELL (WHEN OUTPUT WAITING) set?
TMSG <.
The terminal will beep when output is waiting from a subjob> ; yes
txne f,f%dvtr ; is DVORAK (SIMULATION) set?
TMSG <.
Dvorak keyboard simulation is enabled> ; yes
txne f,f%siln ; is terminal output silenced?
TMSG <.
Terminal output is silenced> ; yes
call skptak ; is there a take file? (jfn in a)
jrst snotak ; no, go on to next
push p,a ; save jfn on the stack
TMSG <.
Input is being read from file >
pop p,b ; restore it from the stack
call filnam ; print file name
snotak: skipn savjfn ; is there a save file?
jrst snosav ; no, go on to next
TMSG <.
Terminal input is being saved in file >
move b,savjfn ; get JFN
call filnam ; print file name
snosav: skipn logjfn ; are commands being logged?
jrst snolog ; no, go on to next
TMSG <.
Output is being logged to file >
move b,logjfn ; get JFN
call filnam ; print file name
snolog: TMSG <.
> ; finish message
jrst toplvl ; return to top level
;******************** The TAKE (or GET) command *******************************
.take: hrloi b,2-ipdl-ipdlen(iop)
jumpge b,[ERROR <TAKE files nested too deeply>]
NOISE <commands from file>
hrroi b,[asciz/ATO/]
movem b,gtjblk+.gjext ; set default file extension to ATO
movx b,gj%old!gj%xtn
movem b,gtjblk+.gjgen ; set flags for input file
movei b,[flddb. .cmfil,cm%sdh,,<file to take PTYCOM commands from>]
call .comnd ; parse the file
CMDERR <Invalid TAKE file>
movem b,tmpjfn ; save jfn (released if not reparsed)
call conf ; finish command parsing
move a,tmpjfn ; restore jfn
move b,[7b5!of%rd] ; open it, read mode
OPENF% ; try to open file
ERROR <Couldn't open file> ; couldn't open it, complain
setzm tmpjfn ; don't let it get released
hrl a,a ; move JFN to left half of A
hrri a,.nulio ; form JFN,,.NULIO
push iop,cmdblk+.cmioj ; save old i/o pointers
movem a,cmdblk+.cmioj ; put it in command block
jrst toplvl ; return to top level
;******************** The WHAT Command ****************************************
.what: NOISE <is state of subjob> ; guide words
call sjpnn ; parse ALL or subjob names
FORMRK <call fkstat ; flush any reset EXECs, skip if active
skipe sjpty(I) ; does the subjob have a PTY?
LPEXIT what0 ; yes, we have something to display
>
ERROR <No active subjobs> ; else tell user nothing to display
what0: TMSG <
Num Name TTY Output Status Job Subsys User
--- ---- --- ------ ------ --- ------ ----
> ; display header lines
FORMRK <call maksur ; does this one have a PTY?
lpnext ; no, don't show it
call w.sj ; print subjob number
TMSG < > ; blank space
call w.name ; print name (includes blank space)
call w.tty ; print terminal number
TMSG < > ; blank space
call w.out ; say what's done with output
skipe sjexec(i) ; is this an inferior subfork?
jrst w.exec ; yes, do special processing
call getjob ; get job number for this one
skipa
jrst [ TMSG <Inactive
> ; no job, say so
lpnext ] ; and go on to the next
camn a,[-2] ; is it just logging in?
jrst [ TMSG <Just logging in
> ; say so
lpnext ] ; and go on to the next
call w.sts ; print job status (includes blank space)
call w.job ; print job number
TMSG < > ; blank space
call w.subs ; print job name
TMSG < > ; blank space
call w.user ; print user name
hrroi b,crlf
call strout ; add a crlf
> ; end of massive for loop
hrroi b,crlf
call strout ; another crlf
jrst toplvl ; return to top level
; Information about both subjobs and subforks
; print subjob number
w.sj: move b,i ; get number in B
move c,[no%lfl!3b17!^D10] ; three columns, decimal
jrst numout ; print number
; print subjob name
w.name: hrro b,sjnams(I) ; get name for this subjob
call strout ; print it
hlrz b,sjnams(I) ; get number of chars
movni c,^D11
addi c,(b) ; get (num-11) in C
hrroi b,[repeat 3,<byte (7) 40,40,40,40,40>] ; fifteen spaces
jrst strou2 ; print without zeroing C
; Print terminal number
w.tty: move b,sjnpty(I) ; get terminal number
subi b,.ttdes ; make it a normal number
move c,[no%lfl!3b17!8] ; three columns, octal
jrst numout ; print number
; Print output status
w.out: move a,sjflgs(i)
txne a,s%disc ; is output discarded?
jrst [ TMSG <Discard > ; yes, say so
ret ] ; and return
txne a,s%refo ; is output refused?
jrst [ TMSG <Refuse > ; yes, say so
ret ] ; and return
TMSG <Accept > ; else output is accepted
ret ; return to caller
; Information about subjobs only
; Print job status
w.sts: move a,sjpty(i) ; get JFN of PTY
movei b,.mopih ; test if PTY is hungry
MTOPR% ; do the test
jumpe b,[ TMSG <Running > ; not hungry, so probably running
ret ] ; return to caller
TMSG <IO Wait > ; else say it's waiting for input
ret ; and return
; Print job number
w.job: move b,jinfo+.jijno ; get job number
move c,[no%lfl!3b17!^D10] ; three columns, decimal
jrst numout ; print number
; Print subsys name
w.subs: move a,jinfo+.jipnm ; get subsys name
jrst sixout ; print as sixbit
; Print user name
w.user: skipn b,jinfo+.jiuno ; get user number
jrst [ TMSG <Not logged in> ; user 0 is not logged in
ret ] ; return to caller
txne f,f%siln ; is terminal output silenced?
jrst w.unot ; yes, go on
movei a,.priou
DIRST% ; print to terminal
ERRMSG <Couldn't translate user number>,jswarn
w.unot: skipn a,logjfn ; is there a log file?
ret ; no, just return
DIRST% ; yes, print it there too
ERRMSG <Couldn't translate user number>,jswarn
ret ; return to caller
; Information about subforks only
w.exec: call fkstat ; get fork status
ERROR <Process disappeared> ; someone killed it
hrro b,fstab(b) ; get string for status
call strout
TMSG < > ; blank space for job number
move a,sjfnam(i) ; get subfork program name
call sixout ; print it
TMSG < Subfork
> ; finish row - "Subfork" instead of username
lpnext ; continue in loop
;******************** Interrupt routines **************************************
; Handler for control C
ctrlc: call savint ; save registers
txne f,f%nint ; are we NOINT? (^C still gets through)
jrst [ txo f,f%ctlc ; yes, say ^C happened
ret ] ; and return from interrupt
txz f,f%ctlc ; else say pending ^C has been processed
; (avoid doubling race)
call skptak ; are we in a take file?
jrst ctcnt ; no, just process normally
call endtak ; else abort take file
movei a,.priin
CFIBF% ; clear input buffer
ret
ctcnt: movei a,.priou
CFOBF% ; clear output buffer
movei a,.priin
CFIBF% ; clear input buffer
hrroi a,[asciz/^C
/]
PSOUT% ; show user what he just did (not on log file)
txo f,f%int ; say we're in an interrupt
call quit ; stop the fork
txz f,f%int ; no longer in an interrupt
push p,logjfn ; save log file
call noint ; no interrupts
setzm logjfn ; no logging
call refrsh ; refresh command line
pop p,logjfn ; restore log file
call okint ; allow interrupts again
ret
; Handler for inferior fork termination
;
; fkterm (interrupt)
; called whenever an inferior fork terminates
;
; call fktst
; see if any forks have terminated lately
; (in case we were in connection when they went)
fkterm: call savint ; save registers
skipl consj ; are we in a connection?
jrst fktcon ; yes, go do special handling
push p,i ; else save subjob
call fktst ; loop through, checking subjobs
pop p,i ; restore subjob
ret ; and return from interrupt
fktcon: skipn sjexec(i) ; are we connected to a subfork?
ret ; no, someone else must have stopped
call fkstat ; get fork status word in B, handle in A
jrst fktdun ; no fork, go end connection
caie b,.rfhlt ; is the fork halted?
ret ; no, return from interrupt
fktdun: move a,sjflgs(i) ; get subjob flags
txo a,s%halt ; say this one is halted
movem a,sjflgs(i) ; save it back
txo f,f%pop ; also set global flag
call skptak ; was it from a take file?
skipa ; no, go on
ret ; yes, let loop there do the work
call clrbuf ; finish any incomplete subjob output
call getbuf ; get output from subjob
skipa ; nothing there, go on
call strout ; else print output
jrst ctlx2 ; jump to interrupt-level exiter
fktst: txz f,f%pop ; nothing has popped yet
FORALL <came i,dedjob ; if still being built, ignore
call fkstat ; get fork status word in B, handle in A
lpnext ; no such fork handle, go on to next
caie b,.rfhlt ; did it halt itself?
lpnext ; no, go on to next
move a,sjflgs(i) ; get flag mode word
txoe a,s%halt ; was it already set as halted?
lpnext ; yes, go on to next
movem a,sjflgs(i) ; else replace in flag word
call terpri ; else get on a new line
TMSG <[Subfork > ; start message
call prtjob ; tell user what happened
TMSG < halted]> ; finish message
txo f,f%pop ; say something stopped
>
txze f,f%pop ; did any forks stop?
call refrsh ; yes, refresh command line if any
ret ; return from interrupt
; Handler for PTY output-ready interrupt
ptyint: call savint ; save ACs
skipl consj ; is there a connected subjob?
jrst picon ; yes, do special interrupt for it
txz f,f%iout ; no output done yet
push p,i ; save another register
move i,pi ; get first subjob in i
piloop: came i,lock ; is this the locked subjob?
call dopi ; no, try for output from it
addi i,numpi ; go on to next of this series
caige i,sjmax ; is it past the max?
jrst piloop ; no, go back again
pop p,i ; restore saved register
txnn f,f%iout ; was output actually typed?
ret ; no, return from interrupt
jrst refrsh ; else refresh the command line
picon: call getbuf ; get a buffer of chars
ret ; nothing left, just return
call strout ; print it
jrst picon ; go back for more
; Simulate a ^R to the command line
refrsh: txnn f,f%pars ; are we in a command?
ret ; no, don't do anything
call terpri ; make sure we are on a new line
move b,cmdblk+.cmrty ; get pointer to prompt
call strout ; print it
move b,cmdblk+.cmbfp ; get pointer to input buffer
jrst strout ; print that too, and return
;******************** Parsing routines ****************************************
; COMND% jacket routine
;
; call .comnd
; b/fdb
; returns +1/bad parse
; +2/succesful
; with registers as set up by COMND,
; d/type of fdb used
; if NCHRS is non-zero and .cmcfm parsed, defines name in NEWNAM for subjob
.comnd: movei a,cmdblk ; get CSB
COMND% ; do the parse
ercal cmnder ; if err, check for eof in take file
txne a,cm%nop ; was it parsed?
ret ; no, single return
skpret ; else skip return
load d,cm%fnc,(c) ; get parsed FDB
caie d,.cmcfm ; was it a carriage return?
ret ; no, return now
txz f,f%pars ; no longer parsing a command
call logcmd ; log command
jumpe nchrs,r ; if no new name, return now
call savacs ; don't smash already-set registers
DBMSG <PUTNAM -- Defining name >,<[
hrroi b,newnam
call strout ; print new job name
TMSG < for >
jrst prtsjb ]> ; print subjob number or old name
call kilnam ; flush old name
hrli a,newnam ; get new name
hrr a,sjnams(i) ; get address of name
movei b,namsiz-1(a) ; get ending address
blt a,@b ; do the blt
hrlm nchrs,sjnams(i) ; update count in new word
movei a,sjntab ; get subjob name table
hrl b,sjnams(i) ; and new address of name
hrr b,i ; make table entry by adding subjob
TBADD% ; add new word to table
ret ; return to caller
; What to do on a jsys error in the command parse
cmnder: call cmder2 ; look at error
jrst jsyser ; bad, make it a fatal jsys error
jrst top1 ; else go back to top level parse
cmder2: call savacs ; save registers from munging
move d,cmdblk+.cmioj ; get i/o designators
call clstak ; maybe close TAKE file
came d,cmdblk+.cmioj ; are i/o designators different?
skpret ; yes, give skip return
ret
; Set up for command parsing
; b/pointer to prompt
; does .cmini, sets reparse address, saves stack, etc.
setcmd: movem b,cmdblk+.cmrty ; set prompt pointer
pop p,rpret ; save return address for later
movem p,stksav ; and save it too
movei b,[flddb. .cmini]
call .comnd ; parse initialization
FATAL <Command initialization failed>
repars: txo f,f%pars ; say we're parsing now
txz f,f%nsin ; default to saving input
move p,stksav ; restore old stack pointer
jrst @rpret ; now go to return address
; Parse carriage return
conf: movei b,[flddb. .cmcfm]
call .comnd ; parse carriage return
ERRMSG <Not confirmed>,prtlin
ret ; return to caller
; Save an in-progress parse
; not re-entrant so use carefully and sparingly
; mungs register C
savprs: pop p,c ; get return address before stack is munged
push p,cmdblk+.cmioj ; save i/o pointers
push p,cmdblk+.cminc ; save chars left in main buffer
push p,cmdblk+.cmabp ; save atom buffer pointer
push p,cmdblk+.cmbfp ; save main buffer pointer
push p,cmdblk+.cmrty ; save prompt
push p,rpret ; save return address for reparse
push p,stksav ; save saved stack address
push p,[rstprs] ; restore all these on return
push p,a ; save temporary register
move a,[.priin,,.priou] ; get terminal i/o pointers
movem a,cmdblk+.cmioj ; save them
hrroi a,cmdalt ; get alternate command buffer
movem a,cmdblk+.cmbfp ; save it
hrroi a,atmalt ; get alternate atom buffer
movem a,cmdblk+.cmabp ; save it
pop p,a ; restore temp register
jrst (c) ; return to caller
rstprs: skipa ; did caller give skip return?
skpret ; yes, propagate it
pop p,stksav ; restore saved stack
pop p,rpret ; restore return address
pop p,cmdblk+.cmrty ; restore prompt
pop p,cmdblk+.cmbfp ; restore main buffer pointer
pop p,cmdblk+.cmabp ; restore atom buffer pointer
pop p,cmdblk+.cminc ; restore chars left in bug buffer
pop p,cmdblk+.cmioj ; restore i/o designators
ret ; return to SAVPRS caller's caller
; Parse a set of subjobs
;
; call sjpars
; call sjpnn
; parses a set of subjobs - use FORMRK to loop over set
; sjpars gives noise words "OUTPUT FROM SUBJOB"
sjpars: NOISE2 <output from subjob>,<output from subjobs>
sjpnn: txz f,f%all ; say ALL wasn't typed
movei b,[flddb. .cmkey,cm%sdh,alltab,<ALL or list of subjobs>,ALL]
call .comnd ; parse keyword ALL
jrst sjpar0 ; not parsed, try list of subjobs
call conf ; finish command parsing
FORALL <call marksj> ; mark all subjobs
txo f,f%all ; say ALL was typed
ret ; return to caller
sjpar0: FORALL <move c,sjflgs(I) ; get subjob status
txz c,s%mark ; clear mark
movem c,sjflgs(I) ; replace status word
>
sjpar1: call jpsubr ; parse a subjob
CMDERR <Invalid subjob name or number>
movei b,[flddb. .cmcma,cm%sdh,,<"," and another subjob>,,<[
flddb. .cmtok,cm%sdh,<
-1,,[asciz/:/]>,<":" to specify a range of subjobs>,,<[
flddb. .cmcfm]>]>]
call .comnd ; parse comma, colon, or return
ERRMSG <Not confirmed>,prtlin
cain d,.cmtok ; was colon parsed?
jrst sjpar2 ; yes, go do it
call marksj ; else mark subjob
cain d,.cmcfm ; was carriage return parsed?
ret ; yes, return
jrst sjpar1 ; else comma, loop back for more
sjpar2: push p,i ; save starting subjob
call jpsubr ; parse another one
CMDERR <Invalid subjob name or number>
pop p,a ; restore starting subjob
caml a,i ; is it lower than the ending one?
ERROR <Start of range must be before end of range>
sjpar3: call marksj ; mark the subjob
sos i ; go to previous
camg a,i ; is it still in range?
jrst sjpar3 ; yes, loop back for more
movei b,[flddb. .cmcma,cm%sdh,,<"," and another subjob>,,<[
flddb. .cmcfm]>]
call .comnd ; parse comma or carriage return
ERRMSG <Not confirmed>,prtlin
cain d,.cmcfm ; was carriage return parsed?
ret ; yes, return
jrst sjpar1 ; else comma, loop back for more
marksj: move c,sjflgs(i) ; get subjob status
txo c,s%mark ; turn on mark bit
movem c,sjflgs(i) ; put status word back in table
ret
; Routines to parse single subjobs
;
; call jpsubr
; a/csb
; parse existing subjob name or number, returning in I
; returns +1: not parsed
; +2: parsed
;
; call jpsubd
; same, but sets a default first
;
; call jparse
; call fparse
; parse existing or new subjob name.
; fparse is for subforks, jparse is for subjobs
;
; call jpc1
; i/default
; parse existing or new subjob name.
jpsubd: skipge i,lstcon ; get last connected subjob
skipl i,lstfrk ; none, get last fork instead
caia
setz i, ; none of that either, default to 0
call fldflt ; default subjob
caia ; skip over...
jpsubr: setzm sjdflt ; clear default
movei b,[<.cmnum*1b8>!cm%sdh!cm%dpp!cm%hpp![
fldbk. .cmkey,,sjntab,<subjob name,>,,minmsk]
; .cmfnp - func, flags, next fdb
^d10 ; .cmdat - func-specific data (input radix)
point 7,[asciz/subjob number (decimal)/] ; .cmhlp - help
point 7,sjdflt] ; .cmdef - byte pointer to default text
call .comnd ; parse subjob name or number
ret ; return +1 if not parsed
cain d,.cmkey ; was it a subjob name?
hrrz b,(b) ; yes, get associated number
skipl i,b ; move it to I. Is it less than zero,
cail i,sjmax ; or greater than or equal to the upper bound?
ERROR <Subjob number out of range> ; yes, complain
retskp ; return to caller
fparse: skipge i,lstfrk ; get last connected subfork
call fndfrk ; none, try to find one
jrst jpc1 ; go on to parse it
jparse: skipge i,lstcon ; get last connected subjob
call fndjob ; none, try to find one
; fall through to...
jpc1: call fldflt ; fill out subjob default
movei b,[<.cmnum*1b8>!cm%sdh!cm%dpp!cm%hpp![
fldbk. .cmkey,,sjntab,<subjob name,>,,minmsk,<[
fldbk. .cmfld,cm%sdh,,<new subjob name>,,minmsk]>]
; .cmfnp - func, flags, next fdb
^d10 ; .cmdat - func-specific data (input radix)
point 7,[asciz/subjob number (decimal)/] ; .cmhlp - help
point 7,sjdflt] ; .cmdef - byte pointer to default text
call .comnd ; try to parse it
CMDERR <Invalid subjob name or number>
cain d,.cmkey ; was it an old name?
hrrz b,(b) ; yes, get associated number
cain d,.cmfld ; was it a new name or blank?
jrst [ call addnam ; yes, save it for later
ret ; +1 means blank, use what was in i
jrst fndfre ] ; else find new subjob and return
skipl i,b ; move it to i. is it less than zero,
cail i,sjmax ; or greater than or equal to the upper bound?
ERROR <Subjob number out of range> ; yes, complain
ret
fldflt: hlrz b,sjnams(i) ; does this subjob have a name?
jumpg b,[ hrl b,sjnams(i) ; yes, get its address
hrri b,sjdflt ; and place to put it
blt b,sjdflt+namsiz-1 ; copy the string
ret ]
move a,[point 7,sjdflt] ; else get pointer to default string
move b,i ; and default subjob number
movei c,^d10 ; decimal radix
call strnum ; add number to string
setz b, ; get a null
idpb b,a ; drop it in to complete string
ret
;******************** Output routines *****************************************
; call strout
; b/string pointer
; call chrout
; b/character
; call numout
; b/number
; c/argument to NOUT jsys
; call sixout
; a/sixbit word
strout: setz c,
strou2: movei a,.priou
push p,b ; save pointer
txnn f,f%siln ; if terminal output is not silenced...
SOUT% ; print message to terminal
pop p,b ; restore pointer
skipe a,logjfn ; is there a log file?
SOUT% ; yes, print it to that, too
ret ; return to caller
chrout: movei a,.priou
txnn f,f%siln ; if terminal output is not silenced...
BOUT% ; send char to terminal
skipe a,logjfn ; is there a log file?
BOUT% ; yes, send it to that too
ret ; return to caller
numout: txne f,f%siln ; is terminal output silenced?
jrst nonot ; yes, go on
movei a,.priou ; send to primary output
NOUT%
ercal nouter ; bad, do something about it
nonot: skipn a,logjfn ; is there a log file?
ret ; no, just return
NOUT% ; yes, send it there too
ercal nouter ; bad, do something about it
ret ; return to main routine
nouter: txne f,f%err ; if within error handler, give simple msg
FATAL <Error within an error - bad call to NOUT>
jrst jsyser ; else give complicated error
sixout: movei c,6 ; sixbit routine stolen from FINGER
six0: setz b, ; clear scratch AC
rotc a,6 ; shift a sixbit letter into B
addi b,40 ; make it ASCII
push p,a ; save rest of word in PDL
call chrout ; print character
pop p,a ; restore word
sojg c,six0 ; loop through six times
ret ; return to caller
; Add a number to a string pointer
;
; call strnum
; registers as for NOUT%
; returns updated string pointer in a, garbage in b
strnum: jumpge b,strnm0 ; non-negative? go on
push p,b ; else save number
movei b,"-" ; get minus
idpb b,a ; drop it in
pop p,b ; restore number
movn b,b ; negate it
strnm0: push p,c ; save radix
idivi b,(c) ; divide and conquer
addi c,"0" ; turn remainder into a digit
exch c,(p) ; switch digit for radix
skipe b ; if quotient was zero, don't recurse
call strnm0 ; else call self
pop p,b ; restore digit
idpb b,a ; drop it in
ret ; return
; Show job name or number
;
; call prtsjb
; i/subjob number
; prints "subfork" or "subjob" then name of subjob
;
; call prtjob
; i/subjob number
; prints on terminal name for subjob if it exists, otherwise number
prtsjb: hrroi b,[asciz/subjob /] ; get string for subjob
skipe sjexec(i) ; is it a fork instead of a job?
hrroi b,[asciz/subfork /] ; yes, get string for that instead
call strout ; print it
; fall through to...
prtjob: hlrz a,sjnams(I) ; does this subjob have a name?
jumpg a,pjnam ; yes
move b,i ; else get subjob number
movei c,^D10 ; in decimal
call numout ; print it
ret ; return to caller
pjnam: hrro b,sjnams(I) ; get pointer to subjob name
call strout ; print it
ret ; return to caller
; Say what the escape character is
;
; call prtesc
; prints on the terminal the name for the escape character
; controls are represented Ctrl-X
;
; call pntchr
; b/character to print
; pretty-prints the name for the given character
prtesc: call savacs ; don't mung anything
move b,escchr ; get escape character
call pntchr ; print it
txne f,f%dvtr ; is Dvorak simulation disabled?
camn escchr,dvtab(escchr) ; or is it same as Dvorak equiv?
ret ; yes, return now
TMSG < (Dvorak > ; else start Dvorak msg
move b,dvtab(escchr) ; get Dvorak equivalent
call pntchr ; print it
CMSG <)> ; close Dvorak msg
ret
pntchr: cain b,177 ; is it delete?
jrst [ hrroi b,[asciz/Delete/]
jrst strout ] ; yes, show it as such
cail b," " ; is it a control character?
jrst chrout ; no, print the char and go on
jrst @ctltab(b) ; else jump to appropriate place
define PNTSTR (msg) <
[ hrroi b,[asciz/msg/] ; get pointer to the string
jrst strout ] ; print it and return
>
ctltab: repeat 10,<pntctl> ; ^@ - ^G
PNTSTR <Backspace> ; ^H
PNTSTR <Tab> ; ^I
PNTSTR <Linefeed> ; ^J
repeat 2,<pntctl> ; ^K - ^L
PNTSTR <Return> ; ^M
repeat 15,<pntctl> ; ^N - ^Z
PNTSTR <Escape> ; ^[
repeat 4,<pntctl> ; ^\ - ^_
pntctl: movei d,100(b) ; uncontrolify it
TMSG <Ctrl-> ; show control prefix
move b,d ; get uncontrolified char back into B
jrst chrout ; print the character and return
; Print the name for a JFN
;
; call filnam
; b/jfn
; prints on the terminal the associated filename
filnam: movei a,.priou ; first to primary output
setz c,
txnn f,f%siln ; if output is not silenced...
JFNS% ; type string for JFN
skipe a,logjfn ; is there a log file?
JFNS% ; yes, send it there too
ret ; return to caller
; Make sure cursor is on a new line
terpri: call savacs ; save caller's registers
txnn f,f%conn ; is it from a connection?
txne f,f%siln ; or is terminal output silenced?
jrst tpout ; yes, just print the crlf
movei a,.priou ; on primary output
RFPOS% ; read cursor position
trnn b,-1 ; is there a nonzero column?
ret ; no, just return
tpout: hrroi b,crlf ; get a newline
jrst strout ; print it
;******************** Miscellaneous utility routines **************************
; Save acs A, B, C, D
;
; call savacs
; on return, acs will be restored
; tries to be smart if caller RETSKPs
;
; call savint
; like savacs but on return does DEBRK
savacs: exch a,(p) ; trade first spot in pdl with a (return loc)
push p,b ; push the rest
push p,c
push p,d
push p,[rstacs] ; when return, call ac restorer
push p,a ; save place to return to
move a,-5(p) ; restore register A to original state
ret
rstacs: skipa ; caller to savacs returned +1
aos -4(p) ; increment return address
pop p,d ; pop pdl back onto acs
pop p,c
pop p,b
pop p,a
ret ; return to savacs' caller's caller
savint: exch a,(p) ; save registers like savacs
push p,b
push p,c
push p,d
push p,[rstint] ; interrupt restore on return
jrst (a) ; jump to return address
rstint: pop p,d ; restore ACs
pop p,c
pop p,b
pop p,a
DEBRK% ; exit interrupt
; Check if there's output from a subjob
;
; call chkpty
; check for output from a subjob at non-interrupt level
; i/subjob number
;
; call dopi
; called by chkpty and by ptyint
chkpty: movem i,lock ; lock subjob
call dopi ; check for subjob output
setom lock ; clear lock
ret ; return to caller
dopi: call maksur ; does this subjob have a PTY?
ret ; no, just return
camn i,locsj ; or is this subjob locked?
ret ; yes, just return
move a,sjnpty(i) ; get PTY designator
SOBE% ; is there output from this job?
skipa ; yes, go on
ret ; no, just return
move a,sjflgs(i) ; get subjob flags
txnn a,s%refo ; are we refusing from this one?
txne f,f%conn ; are we in a connection?
jrst pibeep ; just beep
txne a,s%disc ; are we discarding output from this one?
jrst [ move a,sjnpty(i) ; yes, get designator for terminal
CFOBF% ; clear buffer
ret ] ; and return from interrupt
call getbuf ; get buffer for sj in B, skip if nonempty
ret ; return
push p,b ; save pointer on PDL
call terpri ; on a new line
txo f,f%iout ; tell interrupt there was output
TMSG <[Output from > ; print header to output
call prtsjb
TMSG <]
> ; finish header
pop p,b ; restore pointer
dopi1: call strout ; print the buffer
call getbuf ; see if there's more
skipa
jrst dopi1 ; there is - go print it
movei a,250
DISMS% ; else wait a quarter second
call getbuf ; try again
jrst terpri ; no more, get a new line and return
jrst dopi1 ; else go back and print more
pibeep: movei a,ctrl <G> ; get a control G
txne f,f%bell ; are bells turned on?
PBOUT% ; yes, print it
ret ; return
; Routines to get output from a subjob
;
; call getbuf
; i/subjob number
; returns +1: there was no output
; +2: pointer to output buffer in B, suitable to call STROUT
;
; call clrbuf
; call from interrupt level when getbuf might have been in progress
; outputs partial subjob output if any
getbuf: skipn a,sjnpty(i) ; get device designator for pty
ret ; no PTY, return +1
SOBE% ; is there input from this one?
skipa ; yes, go do complicated stuff
ret ; no, just return
move a,[point 7,buffer] ; get byte pointer to buffer
skipn gtbptr ; if there is already some buffer continue
movem a,gtbptr ; else save it
gtblup: move b,[point 7,buffer+bufsiz]
camn b,gtbptr ; is there room for another char?
jrst gtbdun ; no, go on
move a,sjpty(i) ; get JFN for the pty
BIN% ; read a character
idpb b,gtbptr ; put it in the buffer
sojle c,gtbdun ; make sure there's room for more
move a,sjnpty(i) ; get terminal designator
SOBE% ; is there more output?
jrst gtblup ; yes, go back for it
gtbdun: setz b, ; get a null
idpb b,gtbptr ; terminate the buffer with it
setzm gtbptr ; zero the pointer
move b,[point 7,buffer] ; get pointer to buffer again
retskp ; return +2
clrbuf: skipn gtbptr ; is there incomplete subjob output?
ret ; no, return
setz b, ; yes, get a null byte
idpb b,gtbptr ; deposit it
setzm gtbptr ; clear pointer
hrroi b,buffer ; get pointer to buffer
jrst strout ; print it and return
; Routines to define a subjob name
;
; call addnam
; atmbuf/new name
; returns +1/name was null, +2/there was a real name
; sets newnam, nchrs for when .comnd parses .cmcfm
addnam: call savacs ; don't lose any acs
move c,[point 7,atmbuf] ; pointer to input string
movei b,newnam
hll b,c ; and pointer to new name space
movei nchrs,nammax ; get max word length
defcnt: ildb d,c ; find out what's in word
cail d,"a"
caile d,"z" ; is it lower case?
skipa ; no, just add the char
subi d,40 ; uppercasify
idpb d,b ; put it in new word space
jumpe d,def0 ; if done go do move
sojge nchrs,defcnt ; if not too many chars, loop back
ERROR <Too many characters in subjob name> ; yes, complain
def0: movni nchrs,-nammax(nchrs) ; get num of chars read
tlz nchrs,-1 ; clear out left half
jumpe nchrs,r ; if zero, just return +1
movei a,sjntab ; get subjob name table
hrro b,newnam ; get new subjob name
TBLUK% ; look it up in name table
txne b,tl%exm ; was it found?
ERROR <Subjob name is already defined> ; yes, complain
retskp
; Routines to undefine subjob names
;
; call kilnam
; i/subjob number
; removes the name, if any, for the subjob
;
; call undef
; same as kilnam, but complains if there is no name to kill
kilnam: hlrz a,sjnams(i) ; kill jobname if any of job
jumpg a,ud1 ; has a name, go kill it
ret ; else just return
undef: hlrz a,sjnams(i) ; get length of name
skipg a ; is it greater than zero?
ERROR <No existing name to delete> ; no, complain
ud1: call udsub ; call subroutine to undefine name
hrrz c,sjnams(I) ; get name pointer with length zeroed
movem c,sjnams(I) ; replace name pointer
setzm (c) ; zero name word for WHAT command
ret ; return to caller
udsub: DBMSG <UDSUB -- Undefining name for >,prtsjb
movei a,sjntab ; get table
hrro b,sjnams(I) ; get the name
TBLUK% ; look it up
txnn b,tl%exm ; was it found?
FATAL <Inconsistent subjob name data> ; no, something's very wrong
move b,a ; move matched pointer into B
movei a,sjntab ; get table once more
TBDEL% ; remove old word from table
ret ; return to caller
; Read and save the terminal mode words
; returns a/.priin
; b/terminal mode word (also in modsav)
savmod: movei a,.priin ; on primary terminal
RFMOD% ; get terminal mode word
movem b,modsav ; and save it for later
ret
; Snarf a PTY from the system
;
; call getpty
; i/subjob number
; sets sjpty(i), sjnpty(i)
getpty: DBMSG <GETPTY -- Snarfing PTY for >,prtsjb
movn d,numpty ; form AOBJN word
hrlzs d ; for use in the following loop
push p,i ; save subjob number
getp0: movei a,.ttdes(d) ; make a terminal designator
add a,firpty ; with a real terminal number
FORALL <camn a,sjnpty(i) ; does it already have this PTY?
LPEXIT getp1 ; yes, go on to the next
>
movsi a,.dvdes+.dvpty ; PTY designator
hrr a,d ; unit number
DVCHR% ; get its characteristics
txnn b,dv%av ; is it available?
jrst getp1 ; no, we can't use it
move b,a ; get device designator in b
hrroi a,devnam ; place to stash the mogrified string
DEVST% ; that we turn it into
erjmp getp1 ; bad
movei b,":" ; put a colon
idpb b,a ; on the end
movei b,.chnul ; and a null
idpb b,a ; to make it asciz
movx a,gj%sht ; short form of the jsys
hrroi b,devnam ; and the magic
GTJFN% ; jsys
erjmp getp1 ; not available
pop p,i ; restore subjob num from stack
push p,a ; save JFN
move b,[7b5!of%rd!of%wr!of%rtd]
OPENF% ; open the file
erjmp [ pop p,a ; get the JFN back off the stack
RLJFN% ; and release it since we can't have it
nop ; ignore an error
push p,i ; put subjob num back on stack
jrst getp1 ] ; try the next PTY
movei d,.ttdes(d) ; make pty number into a terminal designator
add d,firpty ; make it into a real tty number
movem d,sjnpty(i) ; store this away
pop p,sjpty(i) ; store JFN
call setpmd ; set terminal mode
move a,sjpty(i) ; get JFN of PTY
hrrz b,i ; get subjob number
txz b,777770 ; flush all but the last 3 bits
move b,pitab(b) ; get appropriate entry in PTY channel table
MTOPR% ; to set interrupt on output-ready condition
ret ; return to caller
getp1: aobjn d,getp0 ; try for another pty and return
ERROR <No free PTYS - try again later> ; couldn't get one
; Set the terminal mode of a new PTY
setpmd: movei a,.priin ; refer to the terminal we're on.
GTTYP% ; ask the system what type we are.
move a,sjnpty(i) ; reference the pty.
STTYP% ; set the pty type to the same as ourself.
skipn b,modsav ; get saved mode word if any
call [ call savmod ; none, get it
setzm modsav ; don't need to reset tty mode word later
move a,sjnpty(i) ; get pty designator again
ret ]
SFMOD%
STPAR% ; set same device parameters as controlling tty
ret
; Get an exec in a subfork
;
; call gtexec
; returns fork handle in A
;
; call getfrk
; i/subfork number
; calls gtexec and saves all the relevant information
gtexec: DBMSG <GTEXEC -- Getting an EXEC fork>
setz a, ; default run disabled
CFORK% ; try to get an inferior subfork
ERROR <Can't get a subfork>
move d,a ; move handle to safe place
seto b, ; default give process all capabilities
setz c, ; but enable none of them
EPCAP%
hrroi b,[asciz/SYSTEM:EXEC.EXE/]
movsi a,(gj%old!gj%sht) ; short form GTJFN
GTJFN% ; get a JFN on the EXEC
ERROR <Can't find SYSTEM:EXEC.EXE>
hrl a,d ; get handle in left half
GET% ; fill fork with the EXEC
hlrz a,a ; get just bare fork handle
ret ; return to caller
getfrk: movem i,dedjob ; if err in here, fix world
move a,sjnpty(i) ; get terminal designator
ASND% ; assign device
ERRMSG <Couldn't assign PTY>,jswarn
call gtexec ; get a new subfork
push p,a ; save it but don't put it in fork storage yet
hrli a,.scset ; put function code in other half of A
move b,sjnpty(i) ; terminal designator of PTY in B
SCTTY% ; set controlling terminal of subfork
erjmp [ERROR <Couldn't set controlling terminal of subfork>]
move a,(p) ; get handle again
seto b, ; set both halves of B to minus one
SPJFN% ; set primary input for subfork
setz b, ; at the first entry vector
SFRKV% ; start the fork
move a,sjflgs(i) ; get subjob flags for it
txz a,s%halt ; fork is no longer halted
movem a,sjflgs(i) ; replace flag word
pop p,sjexec(i) ; now it is started, save it in fork storage
move a,[sixbit/EXEC/]
movem a,sjfnam(i) ; set fork's jobname to EXEC
setom dedjob ; fork is now safe to keep
ret ; return to caller
; Get rid of a PTY
;
; call relpty
; i/subjob number
; flushes the PTY associated with that subjob
;
; call maksur
; i/subjob number
; makes sure that the JFN for the subjob is still associated with a PTY.
; if not, calls relpty and returns +1, otherwise returns +2.
maksur: skipn a,sjpty(i) ; get PTY for the job
ret ; none, return +1
DVCHR% ; get device characteristics
erjmp relpty ; failed, assume not a PTY
load a,dv%typ,b ; get device type
cain a,.dvpty ; is it a PTY?
retskp ; yes, return +2
DBMSG <MAKSUR - JFN is not a PTY - >,prtsjb
; else fall through to...
relpty: skipn a,sjpty(i) ; get PTY for the job
ret ; none, return
CLOSF% ; close it
nop ; don't worry if it won't close
move a,sjnpty(i) ; get device designator
RELD% ; release it
nop ; don't worry if it won't release
setzm sjpty(i) ; forget that there was a PTY
setzm sjnpty(i) ; forget it again
DBMSG <RELPTY -- Released PTY for >,prtsjb
ret
; Get status of inferior subfork, wake it up ...
;
; call fkstat
; i/subjob number
; returns +2 if there is an OK fork for that subjob, +1 otherwise
; if there was a fork but is no longer, cleans things up
;
; call wakeup
; i/subjob number
; makes sure the associated fork is started
fkstat: call maksur ; make sure there's a PTY for the job
ret ; no, return +1
skipn a,sjexec(i) ; does the job have an EXEC?
ret ; no, return +1
DBMSG <FKSTAT -- Checking subfork >,prtjob
RFSTS% ; read status
camn a,[-1] ; is it a real fork?
jrst fskill ; no, go kill it
hlrz b,a ; get it in right half, zero left
txz b,(rf%frz) ; clear freeze bit
retskp ; return +2
fskill: setzm sjexec(i) ; don't keep the fork (keep sj name though)
camn i,lstfrk ; was this last connected subfork?
setom lstfrk ; yes, forget it (will get set if in FORK)
call relpty ; release the PTY
ret ; return +1
wakeup: move a,sjexec(i) ; get fork handle
setz b, ; using first entry vector
SFRKV% ; restart it
move a,sjflgs(i) ; get subjob flags
txz a,s%halt ; say fork is not halted
movem a,sjflgs(i) ; replace flag word
DBMSG <WAKEUP -- Started fork >,prtjob
ret ; return to caller
; Protect critical code
;
; call noint
; turns off interrupts
;
; call okint
; turns interrupts back on, runs any waiting ones
noint: call savacs ; don't mung any registers
movei a,.fhslf ; on ourself
DIR% ; disable interrupt system
txo f,f%nint ; say noint is set
ret
okint: call savacs ; don't mung any registers
movei a,.fhslf ; on ourself
EIR% ; enable interrupt system
txz f,f%nint ; say okint is set
movei a,.fhslf ; get pointer to self
hrli b,(1b<chn.cc>) ; and ^C channel
txze f,f%ctlc ; was ^C pending?
IIC% ; yes, do it now
ret
; Close and reopen the log file
;
; call log
; closes and re-opens log file, so it will be up-to-date
; does the same to the save file
log: skipn a,logjfn ; is there a log file?
jrst logsav ; no, go on
hrli a,(co%nrj) ; don't release JFN
call noint ; no interrupts
CLOSF% ; close the log file
ERROR <Couldn't close log file>
move a,logjfn ; get JFN into A again
move b,[7b5!of%wr!of%app]
OPENF% ; re-open in append mode
ERROR <Couldn't re-open log file>
call okint ; allow interrupts again
DBMSG <LOG -- Log file updated>
logsav: skipn a,savjfn ; is there a save file?
ret ; no, go on
hrli a,(co%nrj) ; don't release JFN
; (don't need to go noint)
CLOSF% ; close the log file
ERROR <Couldn't close log file>
move a,savjfn ; get JFN into A again
move b,[7b5!of%wr!of%app]
OPENF% ; re-open in append mode
ERROR <Couldn't re-open log file>
DBMSG <LOG -- Save file updated>
ret ; return to caller
; Get the job number of a subjob
;
; call getjob
; i/subjob number
; returns +2 if no job, +1 if there is one (job number in A)
getjob: skipn sjpty(i) ; does this job have a PTY?
jrst gjbad ; no
move a,sjnpty(i) ; entry for subjob's PTY
move b,[-.jimax,,jinfo] ; place to put all the garbage
setz c, ; no offset in table
GETJI% ; get more info
jrst gjbad ; error means no such subjob
skipl a,jinfo+.jijno ; get job number
ret ; good, return +1
camn a,[-2] ; is it logging in?
ret ; yes, return +1
gjbad: seto a, ; bad, set A to -1
retskp ; and return +2
; Stuff to STIW interrupts on and off
;
; call intoff
; turn off all terminal interrupts
;
; call inton
; turn terminal interrupts back on
intoff: txoe f,f%tint ; set flag. if it was on before
ret ; then just return
call savacs ; don't smash anything
call rdtint ; read and save terminal interrupt word
setz c, ; no deferred interrupts
movei b,1b31 ; .TITCI -- only terminal input interrupt
STIW% ; set interrupt words
movei a,.priin ; on primary input
movei b,.morbm
movei c,sbkmsk
MTOPR% ; read break mask
movei b,.mosbm
movei c,wbkmsk
MTOPR% ; set break mask to wake up on all chars
ret ; return to caller
inton: txz f,f%tint ; clear, don't check flag (ok to run again)
call savacs ; don't smash anything
movni a,5 ; on our own job
move b,tiword ; get int word
move c,dtiwrd ; and deferred int word
STIW% ; yes, set interrupt words
movei a,.priin ; on primary input
movei b,.mosbm
movei c,sbkmsk
MTOPR% ; restore original break mask
ret ; return to caller
rdtint: movni a,5 ; on our own job
RTIW% ; get terminal interrupt words
movem b,tiword ; save int word
movem c,dtiwrd ; and deferred int word
ret
; Exit to the EXEC
;
; call quit
; does a HALTF
; will make sure it's ok if there are active subjobs
quit: call skpact ; any active jobs?
jrst quit0 ; no, go do easy stop
TMSG <
Warning: Exiting now may log out your active subjobs.
Perhaps you should use the PUSH command.
>
txne f,f%int ; at interrupt level (^C)?
call intoff ; don't let stray ^C cause another interrupt
hrroi b,[asciz/Type RETURN to exit, or any other character to return to PTYCOM: /]
call chconf ; confirm
jrst [ txne f,f%int ; at interrupt level (^C)?
call inton ; not confirmed, turn interrupts back on
call terpri ; get fresh line for abort message
TMSG <[EXIT aborted]>
ret ] ; and return without halting
txne f,f%int ; at interrupt level?
call inton ; yes, turn terminal interrupts back on
quit0: call log ; close log file
HALTF% ; stop the fork
call rdtint ; read changed terminal interrupt word
ret ; return to caller on continue
; Check if there are any active jobs
;
; call skpact
; returns +1/no active subjobs
; +2/otherwise
skpact: call savacs ; don't mung anything
setz c, ; set up for GETJI
FORALL <call getjob ; get the job number -- is there none?
camn a,[-2] ; or just logging in?
lpnext ; go on to next
skipe jinfo+.jiuno ; is it logged in?
LPEXIT [retskp] ; yes, give skip return
>
ret
; Confirm some drastic action with a carriage return
;
; call chconf
; b/prompt
; parses .cmcfm, returns +2 if successful, +1 otherwise
; doesn't save input in save file
; if TAKE is in progress, returns +2 (unless called from interrupt)
chconf: txne f,f%int ; called from interrupt level?
call savprs ; save old parse from destruction
call skptak ; take file?
skipa ; no, go on
retskp ; yes, return +2 without asking
call setcmd ; set up for parse
txo f,f%nsin ; don't save on saved-input file
movei b,[flddb. .cmcfm,cm%sdh,,,,<[flddb. .cmuqs,cm%sdh,escbrk,<
Confirm with carriage return (anything else aborts)>]>]
call .comnd ; parse it
ret ; something strange happened
cain d,.cmcfm ; was it a bare carriage return?
retskp ; yes, give skip return
jrst conf ; else parse return for logging
; Close the TAKE file, test if take file exists...
;
; call skptak
; returns +1 if no TAKE file exists, +2 otherwise
;
; call endtak
; aborts all TAKE files
;
; call clstak
; checks if the current TAKE file is finished and if so stops
; taking commands from it, cleans up etc.
skptak: hlrz a,cmdblk+.cmioj ; get TAKE file JFN
caie a,.priin ; is it the terminal?
skpret ; no, set up to return +2
ret ; else return +1
endtak: call skptak ; is there a take file?
ret ; no, just return
push p,a ; save JFN on stack for closit
call terpri ; make sure we have a new line
TMSG <[TAKE file input aborted]
> ; say what just happened
pop p,a ; restore JFN
etak2: call closit ; and go close file
call skptak ; any more?
ret ; no, finished
jrst etak2 ; else go back for more
clstak: call skptak ; is there a take file?
ret ; no, just return
GTSTS% ; get file status
txnn b,gs%eof ; has it reached end-of-file?
ret ; no, return
push p,a ; save JFN on the stack
call terpri ; make sure we have a new line
TMSG <[End of > ; start message
move b,(p) ; get JFN but leave it on the stack
call filnam ; print file name
TMSG <]
> ; close message
pop p,a ; restore JFN and fall through to...
closit: CLOSF% ; close the file
nop ; but don't care if the close fails
pop iop,cmdblk+.cmioj ; pop TAKE file level
ret ; return to caller
; Save input buffer, prompt in the log file
; Must not call ERROR or FATAL!!
;
; call logcmd
; make sure a PTYCOM command gets sent to the log file
; if a TAKE file exists, also prints it in the terminal
; if a SAVE file exists, sends the input buffer to it
logcmd: call savacs ; leave callers ACs unchanged
setz c,
hrrz a,a ; clear left half of CSB
push p,a ; save it for later
move b,cmdblk+.cmrty ; get pointer to prompt
call skptak ; is input redirected?
jrst ntlprm ; no, just print prompt in log file
movei a,.priou
txnn f,f%siln ; if terminal output is not silenced...
SOUT% ; print prompt on the terminal too
move b,cmdblk+.cmrty ; get pointer to prompt again
ntlprm: skipe a,logjfn ; is there a log file?
SOUT% ; yes, print prompt
pop p,a
hrroi b,cmdbuf ; get pointer to command buffer
call skptak ; is input redirected?
jrst ntlbuf ; no, just print buffer on log file
movei a,.priou
txnn f,f%siln ; is output silenced?
SOUT% ; no, print it on the terminal too
hrroi b,cmdbuf ; get pointer again
ntlbuf: skipe a,logjfn ; is there a log file?
SOUT% ; yes, print buffer
call skptak ; are we reading from a TAKE file?
txze f,f%nsin ; or is save file output disabled?
ret ; yes, just return
hrroi b,cmdbuf ; get command buffer once more
skipe a,savjfn ; is there a save file?
SOUT% ; yes, print buffer there too
ret ; return to caller
; Routines to find old jobs or find new free ones
;
; call fndjob
; returns first subjob that isn't a subfork, or first free subjob
; if there are none already. returns number in I
; call fndfrk
; similar, but looks for subforks
; call fndfre
; returns the first frdee subjob always.
fndfrk: FORALL <skipe sjexec(i) ; is there an associated fork?
LPEXIT r ; yes, exit with it
> ; else try next, fall through to FNDFRE
jrst fndfre ; couldn't find any, try for a free one
fndjob: FORALL <skipn sjpty(i) ; is there a PTY for it?
lpnext ; no
skipn sjexec(i) ; is it a fork?
LPEXIT r ; no, found one
> ; fall through to ...
fndfre: FORALL <hlrz c,sjnams(I) ; get length of name
jumpg c,[lpnext] ; has a name - go on to next
skipn sjpty(i) ; does this subjob have a PTY?
LPEXIT r ; found one - return
> ; else go on to next
ERROR <No free subjobs> ; got here means couldn't find a subjob
; Reading of characters from terminal or log file
;
; call getchr
; reads a character from the current input stream.
; returns it in B
; call gtchni
; reads a character after turning off all interrupts.
getchr: hlrz a,cmdblk+.cmioj ; get input JFN
BIN% ; get a char from it
ercal gtcher ; error, look into it
txz b,200 ; strip parity
call skptak ; is there a take file?
skipn a,savjfn ; or is there no save file?
ret ; return with the char
BOUT% ; else send the char there
ret ; and then return
gtchni: call intoff ; turn off interrupts
call getchr ; get a character
push p,b ; save the character
cain b,ctrl <M> ; was it a CR?
jrst [ BIN% ; yes, read the corresponding linefeed
skipe a,savjfn ; is there a save file?
BOUT% ; yes, send it there
jrst .+1 ] ; return to in-line code
call inton ; turn interrupts back on
pop p,b
ret ; return to caller
gtcher: call skptak ; is there a take file?
jrst jsyser ; no, complain now
move d,cmdblk+.cmioj ; save old i/o designator
call clstak ; maybe take file is bad
camn d,cmdblk+.cmioj ; is i/o desig changed?
jrst jsyser ; no, go report error
hlrz a,cmdblk+.cmioj ; get input designator again
sos (p) ; return -1 to try again
ret
;******************** Error handling routines *********************************
; call doerr
; don't call this -- use the ERRMSG macro instead
;
; jrst prtlin
; prints the remainder of the command line and returns to top level
;
; jrst prtatm, jrst ptatm2 (ptatm2 doesn't print jsys error)
; prints the atom buffer after a command-parsing error.
;
; jrst jswarn
; prints what the last jsys error was
;
; jrst enderr
; flushes take files, returns to top level (common to most err handlers)
doerr: call savacs ; keep info for further error handler
txz f,f%siln!f%frst ; output to tty again, no longer first time
movei a,.priou ; get normal output pointer
txze f,f%rscn ; was RSCAN input in progress?
hrrm a,cmdblk+.cmioj ; yes, reset command block
txze f,f%pars ; are we in the middle of a command?
call logcmd ; yes, send it to the log file
movei a,.priin
CFIBF% ; flush any typeahead
call terpri ; make sure we are on a new line
call strout ; print string left in B for us (still there)
ret ; return (probably to ERRMSG macro)
prtlin: TMSG < - "> ; start section of error message
move c,cmdblk+.cmptr ; get line pointer
ptlin0: ildb b,c ; and a character from it (assume non-null)
cain b," " ; is it a space?
jrst ptlin0 ; yes, go back for another
ptlin1: caie b,ctrl <[> ; if it's not an escape
call chrout ; print the character
ildb b,c ; get the next character
caie b,ctrl <J> ; is it a linefeed?
cain b,ctrl <M> ; or a carriage return?
skipa ; yes, go on
jumpn b, ptlin1 ; no, go back for more if non-null
movei b,42 ; doublequote
call chrout ; hand-expand losing CMSG <">
jrst enderr ; and finish handling error
jswarn: call prterr ; print what the problem was
jrst enderr
prtatm: call prterr ; print the specific error
ptatm2: move b,[point 7,atmbuf] ; get pointer to atom buffer
ildb b,b ; get first character
jumpe b,enderr ; if null, end now
TMSG < - "> ; ready for atom buffer
hrroi b,atmbuf ; get pointer to it
call strout ; print it
movei b,42 ; doublequote
call chrout ; hand-expand losing CMSG <">
; fall through to...
enderr: call endtak ; close take file if any
jrst toplvl ; return to top level
; Obtain a symbol
;
; call symout
; location in a
; returns +1/no symbol
; +2/symbol found and printed
symout: call savacs ; don't mung registers
movem a,xval ; save away ac location
setzm baddr ; no best symbol
move d,.jbsym ; get location and length of symbol table
hlro a,d
sub d,a ; -count,,last address + 1
symlk1: ldb a,[point 4,-2(d),3] ; get type of symbol (left 4 bits)
caile a,2 ; 0 = prog name, 1 = global, 2 = local
jrst symlk2 ; don't want suppressed labels
jumpe a,symlk2 ; don't want program names, either
move a,-1(d) ; get value of the symbol
camn a,xval ; exact match?
jrst syml2a ; yes, select it
caml a,xval ; smaller than value sought?
jrst symlk2 ; no, too big
skipe b,baddr ; get best one so far
camle a,-1(b) ; compare to previous best
movem d,baddr ; current is best so far
symlk2: add d,[2000000-2] ; add 2 in left, sub 2 in right
jumpl d,symlk1 ; loop unless at top of table
skipa
syml2a: movem d,baddr ; here for exact match
skipn d,baddr ; find anything helpful?
ret ; no, return +1
move a,xval ; get the desired value
sub a,-1(d) ; less symbol's value = offset
cail a,100 ; small enough offset?
ret ; no, not good enough match
move d,baddr ; get symbol's address
move a,-2(d) ; get the name of the symbol
call r50dop ; print the name
move b,xval ; get desired value
sub b,-1(d) ; less the symbol's value
jumpe b,[retskp] ; if exact, go back +2
push p,b ; save it from cmsg
CMSG <+> ; say it's plus something
pop p,b ; restore offset
movei c,^d8 ; radix octal
call numout ; send it to terminal etc.
retskp ; give "found it" return
; Output radix50 value (for symout)
;
; call r50dop
; radix50 value in a
r50dop: call savacs ; don't mung registers
tlz a,740000 ; clear any symbol flags
r50dp1: idivi a,50 ; divide by 50
push p,b ; save remainder, a char
skipe a ; if a zero, unwind stack
call r50dp1 ; call self recursively
pop p,b ; pop radix50 char
adjbp b,[point 7,[ascii\ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%\],6]
ldb b,b ; get the character
jrst chrout ; print it and return
; Jsys error handler
;
; ercal jsyser
; print info about jsys error and die
;
; jrst die
; the program is too far gone to stay alive. uncontinuable death.
jsyser: txo f,f%err ; say we're in error handler for numout
exch a,(p) ; save a register, put pushed loc in a
push p,b ; save another register
push p,c ; and another
ERRMSG <Error at > ; start error message
and a,[37,,777777] ; so we can get sections
subi a,2 ; subtract two from this to point to jsys
call symout ; output the symbol for this
skipa ; no symbol if here
jrst jser0 ; here if have symbol, don't do number
push p,a ; save pc again
hlrzm a,b ; get left half to b
movei c,^d8 ; radix octal
jumpe b,jser1 ; if section 0, don't worry
call numout ; else print the number
TMSG <,,> ; divide left and right half
jser1: pop p,b ; get location again
hrrzs b ; zero left half
movei c,^d8 ; radix octal
call numout ; print it
jser0: call prterr
jser2: pop p,c
pop p,b
pop p,a ; save the registers
txz f,f%err ; clear flag in case started randomly
; fall through to...
die: call endtak ; close the take file, if any
HALTF% ; stop the program
FATAL <Can't continue> ; don't go on (FATAL jumps back to DIE)
; Print the last error
prterr: TMSG < - > ; separator of address from error msg
movei a,.priou ; to tty, again
hrloi b,.fhslf ; with last error on our own fork
setz c, ; with no limit
ERSTR% ; print error string
jrst prter1
jrst prter2
skipn a,logjfn ; are we logging?
ret ; no, go on
ERSTR% ; print error string (again)
jrst prter1
jrst prter2
ret
prter1: txne f,f%err ; if within error handler, give simple msg
FATAL <Error within an error - undefined error number>
jrst jsyser ; else give complicated error
prter2: txne f,f%err ; if within error handler, give simple msg
FATAL <Error within an error - bad call to ERSTR>
jrst jsyser ; else give complicated error
;******************** Pure data ***********************************************
crlf: asciz/
/ ; carriage return and line feed
eoktab: 732152,,006360 ; bits for which chars are ok as escape
176320,,000100
000000,,000760
400000,,000740
wbkmsk: 4 ; break mask to wake up on all chars
repeat 4,<777777,,777760>
escbrk: 001220,,470000 ; break mask for parsing text strings
000000,,000020
400000,,000000
000000,,000000
minmsk: 777777,,777760 ; break mask with no minus sign
777774,,001760
400000,,000760
400000,,000760
fstab: [asciz/Running /] ; table of fork status strings
[asciz/IO Wait /]
[asciz/Halted /]
[asciz/Err halt /]
[asciz/Frk Wait /]
[asciz/Sleep /]
[asciz/JSYS trap /]
[asciz/Addr brk /]
; The main command table
cmdtab: TABTOP
cmd ACCEPT,.accep,hlpacc
cmd BELL,.bell,hlpbel
abbrev C,conkey
cmd CHANGE,.chang,hlpchg
conkey: cmd CONNECT,.conne,hlpcon
abbrev D,diskey
invcmd DDT,.ddt,hlpddt
syn DEFINE,NAME,.name
diskey: cmd DISCARD,.disca,hlpdsc
invcmd DVORAK,.dvora,hlpdvo
cmd EXIT,.exit,hlpext
cmd FORK,.fork,hlpfrk
syn GET,TAKE,.take
cmd HELP,.help,hlphlp
cmd KILL,.kill,hlpkil
cmd LOG,.log,hlplog
invcmd MAKE,.make,hlpmak
abbrev N,nokey
cmd NAME,.name,hlpnam
nokey: cmd NO,.no,hlpno
abbrev P,pshkey
invcmd PRINT,.print,hlpprt
pshkey: cmd PUSH,.push,hlppsh
syn QUIT,EXIT,.exit
abbrev R,refkey
abbrev RE,refkey
syn REDEFINE,CHANGE,.chang
refkey: cmd REFUSE,.refus,hlpref
cmd RESET,.reset,hlpres
abbrev S,sndkey
cmd SAVE,.save,hlpsav
sndkey: cmd SEND,.send,hlpsnd
cmd SILENCE,.silen,hlpsil
cmd STATUS,.statu,hlpsts
cmd TAKE,.take,hlptak
cmd WHAT,.what,hlpwht
TABBOT
; Other pure keyword tables
jcltab: TABTOP ; commands allowable on JCL input
key CONNECT,.conne
key FORK,.fork
key HELP,.help
key MAKE,.make
TABBOT
maktab: TABTOP ; subcommands for MAKE command
key CONNECT,0 ; all code checks for is non-zero data
key STAY,1
TABBOT
alltab: TABTOP
key ALL, ; parse ALL as a keyword (tokens lose badly)
TABBOT
; Help strings for the various commands
hlpacc: asciz/The ACCEPT command tells PTYCOM to accept output from all subjobs
or from a specified subjob. PTYCOM starts out accepting output from
all jobs. NO ACCEPT is the same as REFUSE.
/
hlpbel: asciz/The BELL command tells PTYCOM to ring the terminal's bell when
output from a subjob is waiting.
/
hlpchg: asciz/The CHANGE command redefines the escape character (initially
Ctrl-X) used to return to PTYCOM's top level.
Illegal escape characters are: ^C, ^O, ^Q, ^S, backspace, linefeed,
return, escape, delete, 0-9, A-Z, and a-z.
/
hlpcon: asciz/The CONNECT command connects your terminal with a subjob.
While you are connected to a subjob anything you type will be sent
to it and all output from that job will go to your terminal.
If not given a subjob name or number the CONNECT command
will connect to the subjob or subfork to which you had last connected.
If there is no such subjob it will create a new one.
One returns from a connection by typing the "escape character". When
you type this character PTYCOM will return to its top level
command-reading loop. The escape character is initially Ctrl-X.
/
hlpddt: asciz/The DDT command enters DDT on PTYCOM's core image. Return with R$G.
/
hlpdsc: asciz/The DISCARD command tells PTYCOM to discard output from all subjobs or
from a specified subjob. The output will be thrown away and can not
be recovered. NO DISCARD is the same as ACCEPT, but NO ACCEPT is not
the same as DISCARD.
/
hlpdvo: asciz\The DVORAK command tells PTYCOM to simulate a Dvorak keyboard on a normal
QWERTY keyboard. This simulation applies only during connections;
PTYCOM commands will be read normally and the escape character will not
be changed. The translation is complete, except for the following control
characters: assuming keytops changed, type ^? to get ^Z, ^, for ^V,
^. for ^W and ^; for ^S.
A Dvorak keyboard looks like this:
/ , . P Y F G C R L
A O E U I D H T N S
; Q J K X B M W V Z
\
hlpext: asciz/The EXIT command returns to PTYCOM's caller, usually the EXEC. If
there are any active subjobs PTYCOM asks for special confirmation,
because the jobs may be logged out by leaving PTYCOM.
/
hlpfrk: asciz/The FORK command creates an inferior subfork with an EXEC
running in it, and attaches that subfork to a subjob on a PTY.
The FORK command is very much like CONNECT except that no new job will
be created; instead, FORK creates an inferior EXEC and attaches that
fork to a PTY. Return to PTYCOM either by giving the POP command to
the inferior EXEC or by typing the escape character.
/
hlphlp: asciz/The HELP command describes PTYCOM. If given a subtopic name it will
give information about that subtopic; if given the name of a command
it will describe that command. If given neither of the above it will
give a general description and overview of PTYCOM.
/
hlpkil: asciz/The KILL command logs out the specified subjobs and frees their PTYs.
KILL ALL (the default) asks for confirmation: type a carriage return
to the prompt to tell PTYCOM that you really want to kill all subjobs.
/
hlplog: asciz/The LOG command tells PTYCOM to send almost everything it types
on the terminal to a log file. The file name PTYCOM.LOG will be used
if none is specified. This can be used to keep a permanent record of
a terminal session.
/
hlpmak: asciz /The MAKE command makes a job for a given username on a new subjob.
If a password is needed it will be asked for. The user has the option
either to form a connection with the newly-created subjob or to remain
in PTYCOM.
/
hlpnam: asciz/The NAME command associates a name with a subjob number. From that
point on the name can be used wherever the number can. It is also
possible to create a subjob name by giving a new name to the CONNECT
and FORK commands; in that case a new subjob will be created with that
name. Subjob names can be deleted by giving the NAME command with no name.
/
hlpno: asciz/The NO command inverts the meaning of the next command.
Commands which can be prefixed by NO are:
ACCEPT (OUTPUT FROM SUBJOB)
BELL (WHEN OUTPUT WAITING)
DISCARD (OUTPUT FROM SUBJOB)
LOG (OUTPUT TO FILE)
REFUSE (OUTPUT FROM SUBJOB)
SAVE (INPUT IN FILE)
SILENCE (ALL OUTPUT TO TERMINAL)
/
hlpprt: asciz/The PRINT command makes various routines print messages of the form
FOO -- Doing bar to subjob BAZ
when they are called.
/
hlppsh: asciz/The PUSH command creates an EXEC inferior to PTYCOM.
This is useful if you want to leave PTYCOM without logging
out any active subjobs. To return to PTYCOM use the EXEC's
POP command.
/
hlpref: asciz/The REFUSE command tells PTYCOM not to accept any output from all
subjobs or from a specified subjob. The output may be read by
connecting to the subjob or by accepting output from it. NO REFUSE is
the same as ACCEPT.
If output is refused for a subjob, PTYCOM will not read the output from
that subjob and the subjob will hang until output is accepted from it again.
/
hlpres: asciz/The RESET command re-initializes PTYCOM to its start-up state.
Any subjobs will probably be detached and may log out.
/
hlpsav: asciz/The SAVE command saves all terminal input to a given file. The input
saved in this file can then be used later with the TAKE command.
/
hlpsnd: asciz/The SEND command sends a one-line message to a subjob.
If there is no job associated with the given subjob, a new one
is created.
/
hlpsil: asciz/The SILENCE command tells PTYCOM not to send any output to the terminal.
Output will still be logged if there is a log file, and commands read
from the terminal will be echoed. Silencing is turned off if an error
occurs.
/
hlpsts: asciz/The STATUS command displays a list of information about the current
state of PTYCOM, including what the escape character is set to, to
which job and fork you last connected, and whether TAKE and LOG files
are being used.
/
hlptak: asciz/The TAKE command tells PTYCOM to read commands from a disk file.
PTYCOM will use this file as its primary input instead of the terminal
until the end of the file is reached or an error occurs.
The file name PTYCOM.ATO will be used if none is specified.
Ctrl-C typed at any time during input from a TAKE file will abort the file.
/
hlpwht: asciz/The WHAT command prints a table of all subjobs by number and name,
showing various data about the state of the job and the PTY to which
it is attached.
/
; Help table
hlptab: TABTOP
KEY <BASIC-COMMANDS>,hlpbas
KEY <DEBUGGING>,hlpdeb
KEY <FILE-MANIPULATION>,hlpfil
KEY <INFO-COMMANDS>,hlpinf
KEY <LEAVING-PTYCOM>,hlpqit
KEY <OTHER-COMMANDS>,hlpoth
KEY <SUBJOB-OUTPUT>,hlpsjo
TABBOT
hlpovw: asciz/
PTYCOM lets the user manipulate other jobs on pseudo-terminals.
A pseudo-terminal (abbreviated "PTY") is treated by the system as a
normal terminal in most respects, but it can only be used from
programs. The purpose of PTYCOM is to make connections between
regular terminals and PTYs: to send all of what you type to a job
logged in on a PTY and to display on your screen the system's
responses.
PTYCOM deals with subjobs; that is, with PTYs and the jobs or forks
associated with them. Subjobs can be referenced either by name or by
number. They are created using the CONNECT command, and destroyed
using the KILL command. The STATUS and WHAT commands give information
about the state of PTYCOM and its subjobs.
For more information about PTYCOM follow the HELP command with the
name of a subtopic or PTYCOM command. For a list of subtopics type
"HELP ?" to the PTYCOM> prompt.
/
hlpbas: asciz/
To create a connection with a subjob use either the CONNECT or the
FORK command. The CONNECT command will connect your terminal to a
different job on a PTY. It is possible to log in again on this job as
yourself or as another user. The FORK command attaches a subfork of
your own job to a PTY and connects your terminal to that PTY.
One returns from a connection by typing the "escape character". When
you type this character PTYCOM will return to its top level command
reading loop. The escape character is initially Ctrl-X, but it may be
changed by using the CHANGE command. It is also possible to return
from FORK connections by giving the EXEC command POP to the subfork.
To log out your subjobs and free their PTYs use the KILL command.
If you exit PTYCOM your jobs may be detached and log out.
/
hlpdeb: asciz/
The DDT command enters DDT on PTYCOM's core image. Return with RET$X.
TOPLVL$G will also work. $G will re-start the fork, clearing most
parameters and closing all subjobs (equivalent to a RESET command).
The PRINT command makes various routines print messages of the form
FOO -- Doing bar to subjob BAZ
when they are called.
The RESET command re-initializes PTYCOM to its start-up state.
Any subjobs will probably be detached and may log out; because of
this it asks for confirmation analogously to the EXIT command.
/
hlpfil: asciz/
The LOG command tells PTYCOM to send almost everything it types on the
terminal to a log file. This command can be used to keep a permanent
record of a terminal session.
The TAKE command tells PTYCOM to read commands from a disk file.
PTYCOM will use this file instead of the terminal as its primary input
until the end of the file is reached or an error occurs. It is
possible for this file to create connections with subjobs; input for
these connections will also be read from the TAKE file. Ctrl-C typed
at any time during input from a TAKE file will abort the file.
The SAVE command saves all terminal input to a given file. The input
saved in this file can then be used later with the TAKE command.
/
hlpinf: asciz/
The HELP command describes PTYCOM. If given a subtopic name it will
give information about that subtopic; if given the name of a command
it will describe that command. If given neither of the above it will
give a general description and overview of PTYCOM.
The STATUS command displays a list of information about the current
state of PTYCOM, including what the escape character is set to, to which
job you last connected, and whether TAKE and LOG files are being used.
The WHAT command prints a table of all subjobs by number and name,
showing various data about the state of the job and the PTY to which
it is attached.
/
hlpqit: asciz/
The EXIT command returns to PTYCOM's caller, usually the EXEC. If
there are any active subjobs PTYCOM asks for special confirmation,
because the jobs may be logged out by leaving PTYCOM.
The PUSH command creates an EXEC inferior to PTYCOM, and runs it.
This is useful if you want to leave PTYCOM without logging out any
active subjobs. To return to PTYCOM use the EXEC's POP command.
/
hlpsjo: asciz/
Normally whenever a subjob has output waiting and you are at the top
level command-reading loop PTYCOM will interrupt your commands with
the output. This can be changed so that the output will wait until
you accept it again, or so that the output will be discarded and
unavailable. If output is refused the BELL command tells PTYCOM
to ring the terminal's bell when subjobs have output.
The ACCEPT command tells PTYCOM to accept output from all subjobs or
from a specified subjob. PTYCOM starts out accepting output from all
jobs.
The DISCARD command tells PTYCOM to discard output from all
subjobs or from a specified subjob. The output will be thrown away
and can not be recovered.
The REFUSE command tells PTYCOM not to accept any output from all
subjobs or from a specified subjob. The output may be read by
connecting to the subjob or by accepting output from it. Messages are
automatically refused in the PUSH command and in connections with subjobs.
/
hlpoth: asciz/
The NAME command associates a name with a subjob number. From that point
on the name can be used wherever the number can. It is also possible to
create a subjob name by giving a new name to the CONNECT and FORK commands.
Subjob names can be deleted by giving the NAME command with no name.
The NO command inverts the meaning of the next command.
Commands which can be prefixed by NO are:
ACCEPT (OUTPUT FROM SUBJOB)
BELL (WHEN OUTPUT WAITING)
DISCARD (OUTPUT FROM SUBJOB)
LOG (OUTPUT TO FILE)
REFUSE (OUTPUT FROM SUBJOB)
SAVE (INPUT IN FILE)
SILENCE (ALL OUTPUT TO TERMINAL)
The SEND command sends a one-line command to a subjob. It is also possible
to send messages to subjobs by typing the subjob, a "-", and the command line.
The SILENCE command turns off all output to the terminal except for
command prompting. Output is still sent to the log file.
/
; Function descriptor blocks
;
; the preferable thing to do is use literals for FDBs. however,
; sometimes it's convenient to have a label, so...
hlpfdb: flddb. .cmcfm,cm%sdh,,<carriage return for an overview of PTYCOM>,,hstfdb
hstfdb: flddb. .cmkey,,hlptab,<HELP subtopic,>,,cmdfdb
cmdfdb: flddb. .cmkey,,cmdtab,<PTYCOM command,>,,<[flddb. .cmcfm,cm%sdh]>
; Dvorak translation table
Comment |
A Dvorak keyboard looks like this:
/ . , P Y F G C R L
A O E U I D H T N S
; Q J K X B M W V Z
This table simulates a dvorak keyboard on a normal keyboard. Presumably the
keytops have been exchanged, so the keyboard looks like the above, but the
keys still generate the same codes that they used to.
Lower and upper case letters will be translated to match this layout, and
the punctuation characters involved will also be translated. Unfortunately
control-punctuation codes do not exist, thus ^W, ^V, ^S, ^Z cannot be generated
Therefore, ^/ will give ^Z, ^. will give ^V, ^, will give ^W and ^; will give
^S [i.e. the real thing is close to a mirror image of the way it should be
with respect to these 4 characters]
|
dvtab: ctrl <@> ; control characters
ctrl <A>
ctrl <X>
ctrl <J>
ctrl <E>
ctrl <W>
ctrl <U>
ctrl <I>
ctrl <D>
ctrl <C>
ctrl <H>
ctrl <T>
ctrl <N>
ctrl <M>
ctrl <B>
ctrl <R>
ctrl <L>
ctrl <Z>
ctrl <P>
ctrl <O>
ctrl <Y>
ctrl <G>
ctrl <K>
ctrl <V>
ctrl <Q>
ctrl <F>
ctrl <S>
ctrl <[>
ctrl <\>
ctrl <]>
ctrl <^>
ctrl <_>
" " ; symbols
"!"
42 ; doublequote
"#"
"$"
"%"
"&"
"'"
"("
")"
"*"
"+"
"w" ; , is small w
"-" ; - is untranslated
"v" ; . is small v
"z" ; / is small z
"0"
"1"
"2"
"3"
"4"
"5"
"6"
"7"
"8"
"9"
"S" ; : is capital S
"s" ; ; is small S
"W" ; less-than is captial W
"=" ; = is untranslated
"V" ; greater-than is capital V
"Z" ; ? is capital Z
"@" ; start of letters
"A"
"X"
"J"
"E" ; < to appease FAIL
">"
"U"
"I"
"D"
"C"
"H"
"T"
"N"
"M"
"B"
"R"
"L"
"?"
"P"
"O"
"Y"
"G"
"K"
"<" ; > appease FAIL
"Q"
"F"
":"
"["
"\"
"]"
"^"
"_"
"`" ; start of lower case
"a"
"x"
"j"
"e"
"."
"u"
"i"
"d"
"c"
"h"
"t"
"n"
"m"
"b"
"r"
"l"
"/"
"p"
"o"
"y"
"g"
"k"
","
"q"
"f"
";"
"["+40 ; small-letter punctuation
"\"+40
"]"+40
"^"+40
"_"+40
; Interrupt stuff
chnmsk: 770000,,217000 ; mask of interrupts to activate
define pient (num) <
3,,[movei pi,num ; get number of this interrupt in PI reg
jrst ptyint] ; and go to main pty int handler
>
chntab: 2,,ctrlc ; 0: control-C (level 1)
2,,cti ; 1: input from terminal
pient<0> ; 2-5: PTY interrupts
pient<1>
pient<2>
pient<3>
repeat 15,<0> ; 6-18: reserved
1,,fkterm ; 19: inferior fork termination
repeat 3,<0> ; 20-22: reserved
pient<4> ; 23-26: more PTY interrupts
pient<5>
pient<6>
pient<7>
repeat 9,<0> ; 27-35: unused
pitab: mo%oir!1b17!.moapi ; table of interrupt words for MTOPR
mo%oir!2b17!.moapi
mo%oir!3b17!.moapi
mo%oir!4b17!.moapi
mo%oir!26b17!.moapi
mo%oir!27b17!.moapi
mo%oir!30b17!.moapi
mo%oir!31b17!.moapi
levtab: pc1 ; place to save pc on interrupt
pc2
pc3
lit: LIT ; expand literals here
;******************** Preloaded impure data ***********************************
; Initialized subjob tables
define sjtab (code) <
index==0
repeat sjmax,<
code
index==index+1
>
>
sjntab: 0,,sjmax ; number of names,,max number of names
repeat sjmax,<0> ; space to put the names
sjnams: sjtab <sjnamt+(namsiz*index)>
; adresses of names
; COMND jsys data
cmdblk: repars ; .cmflg: flags,,reparse address
.priin,,.priou ; .cmioj: input, output JFNs
0 ; .cmrty: prompt
-1,,cmdbuf ; .cmbfp: start of command buffer
-1,,cmdbuf ; .cmptr: start of next input
cmdsiz*5-1 ; .cmcnt: size in bytes of command buffer
0 ; .cminc: number of unparsed characters
-1,,atmbuf ; .cmabp: atom buffer pointer
atmsiz*5-1 ; .cmabc: size of atom buffer
gtjblk ; .cmgjb: GTJFN block pointer (for file parses)
notab: TABTOP
KEY ACCEPT,.accep ; refuse subjob output
KEY BELL,.bell ; don't ring bell when output waiting
KEY DISCARD,.disca ; don't discard subjob output
KEY DVORAK,.dvora,cm%inv
KEY LOG,.log ; don't log output
KEY PRINT,.print,cm%inv
KEY REFUSE,.refus ; don't refuse subjob output (same as ACCEPT)
sno: KEY S,0,cm%nor ; hack for S escape recognition
savno: KEY SAVE,.save ; don't save terminal input
silno: KEY SILENCE,.silen ; type subjob output
TABBOT
; GTJFN block (for parsing file names)
gtjblk: 0 ; .gjgen: flags, generation
.priin,,.priou ; .gjsrc: i/o designators
0 ; .gjdev: default device
0 ; .gjdir: default directory
-1,,[asciz/PTYCOM/] ; .gjnam: default filename
0 ; .gjext: default extension
0 ; .gjpro: default protection
0 ; .gjact: default account
0 ; .gjjfn: jfn to set
0 ; .gjf2: flags, num extra words
0 ; .gjcpp: byte pointer to store user input
0 ; .gjcpc: bytes in previous pointer
0 ; .gjrty: pointer to ^R buffer
0 ; .gjbfp: obsolete
0 ; .gjatr: file spec attribute block
;******************** Impure uninitialized data *******************************
sndptr: block 1 ; pointer to buffer for send
sndend: block 1 ; end of line to send
rpret: block 1 ; return address for SETCMD
stksav: block 1 ; saved stack pointer for SETCMD
sjdflt: block namsiz ; subjob number or name default text
pdl: block pdlen ; the stack
ipdl: block ipdlen ; the TAKE file stack
jinfo: block .jimax ; job info block
pc1: block 1 ; place to save PC on interrupt
pc2: block 1
pc3: block 1
lock: block 1 ; place to save locked subjob
; so interrupt doesn't steal output
xval: block 1 ; stuff for symout
baddr: block 1
consj: block 1 ; place to save number of connected subjob
locsj: block 1 ; place for subjob before connection is made
; so output isn't mistimed
cmdbuf: block cmdsiz ; command buffer
atmbuf: block atmsiz ; atom buffer
cmdalt: block cmdsiz ; alternate command buffer
atmalt: block atmsiz ; alternate atom buffer
sbkmsk: block 5 ; saved terminal break mask
tiword: block 1 ; place to save terminal interrupt word
dtiwrd: block 1 ; place to save deferred term int word
modsav: block 1 ; place to save terminal mode words
firpty: block 1 ; first PTY number
numpty: block 1 ; number of PTYs
gtbptr: block 1 ; byte pointer for GETBUF
devnam: block 2 ; place to store string for PTY name
execfk: block 1 ; saved fork handle for EXEC
logjfn: block 1 ; JFN for log file
savjfn: block 1 ; JFN for save file
tmpjfn: block 1 ; place to save JFN (flushed on reparse)
lstcon: block 1 ; last connected subjob
lstfrk: block 1 ; last connected fork
dedjob: block 1 ; make sure incomplete subfork gets flushed
buffer: block bufsiz ; buffer for PTY output
newnam: block namsiz ; extra name for new definitions
; Data for the CRJOB jsys
actbuf: block atmsiz ; account string buffer
pwdbuf: block atmsiz ; password buffer
unmbuf: block atmsiz ; user name of user to CRJOB
crjblk: block .cjslo+1 ; CRJOB command block
; Uninitialized subjob tables
sjflgs: block sjmax ; subjob flags
sjexec: block sjmax ; exec fork for subjob
sjfnam: block sjmax ; program name for the subfork
sjpty: block sjmax ; PTY for each subjob (0 if none)
sjnpty: block sjmax ; number of the PTY
sjnamt: block sjmax*namsiz ; space for names
end <3,,evec>
; Local Modes:
; Mode: FAIL
; Comment Begin: "; "
; Comment Column: 32
; End: