Trailing-Edge
-
PDP-10 Archives
-
decuslib20-10
-
decus/20-184/photo.mac
There are no other files named photo.mac in the archive.
TITLE PHOTO - Photograph a terminal session
SUBTTL EDIT HISTORY
SEARCH MONSYM,MACSYM,MLIB
INTERN DIE,SETTAB
.REQUES LIB:MLIB
.DIRECT FLBLST ;only list first line of multiline text
.DIREC SFCOND ;suppress failing conditional assembly
SALL ;make neat listings
VWHO==^o2 ;2 indicates an edit at customer site
VMAJOR==^o1 ;MAJOR version number
VMINOR==^o0 ;MINOR ver.- reset to zero when major changes
VEDIT==^o5 ;EDIT number - never reset to zero
VERSION==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
;WHO DATE Edit MODIFICATIONS
;=== ========= ==== ================================================
;DLW 15-Dec-83 -genesis
;DLW 12-Mar-83 01 -have XSRCH always make the PMP routine map in an
; extra page incase the backward search for <lf> crosses
; the page boundary
;DLW 13-Mar-83 02 -sometimes when "[Recording.... to PHOTO.PIC.1]" is
; displayed the last part of the message gets clipped. I
; will try adding TL%ERO when doing TLINK% to solve it.
;DLW 2-Aug-84 03 -fix bug in CKDSKF so when there is an error the program
; will return to another command instead of continuing.
;DLW 17-Aug-84 04 -clean up handling of RSCAN buffer when TAKE command
; is a command in the buffer
;DLW 20-Jun-85 05 -^A ^Z message for replay was comming out in the wrong
; place
SUBTTL CONDITIONAL ASSEMBLY SWITCHES
KEEPNL==1 ;when 1 program will keep the nulls at the beginning of the
; file which holds FIXMSG. This is so that if the file is appened to then
; the entire file does not need to be move up to make room for this
; message. If this switch is 0 then these nulls are remove after every
; photo session.
SUBTTL DEFINITIONS
;Alternate register assignments
BPTR=13 ;holds byte pointer
BCNT=14 ;holds byte count
;flags used in register "F"
; Bits "1B30 to 1B35" are reserved for flags used in MLIB
F%APND==1B29 ;1=append photo session to photo log file
F%HOLE==1B28 ;1=file has holes (see CKFPGS)
F%LMAP==1B27 ;1=log file (default PHOTO.PIC) is mapped into memory
F%LOGD==1B26 ;1=logging to LOG file is disabled
F%LOGO==1B25 ;1=inferior EXEC can't logout
F%STRT==1B24 ;1=pty created and recording started (see .START)
F%FIX==1B23 ;1=file was "fixed" in some way (see .FIX)
F%VT==1B22 ;1=controlling terminal type is a VT100
F%IDLE==1B21 ;1=this fork is doing nothing except recording terminal
; session of the inferior EXEC (see PTYOUT)
F%CCOW==1B20 ;1=CCOC words + terminal width altered (see REPSCW)
F%REPL==1B19 ;1=a photo log file is being replayed (see .REPLA)
DEFINE RECMSG (MSG) <
HRROI T1,[ASCIZ /MSG on /]
CALL [ PSOUTL
MOVEI T1,.PRIOU
SETO T2,
SETZ T3,
ODTIM%
TMSG < to >
FILSTR (LOGJFN) ;;output name of file
TMSG <]
>
RET]
>
DEFINE BRKJSY ($JSYS) <
;; macro to set up break table for which jsys calls to intercept
DEFINE AWRD (ARG1) < W'ARG1'.==0
$WRD==$WRD+1 >
$WRD==0
REPEAT ^D14,<AWRD \"<$WRD+"A">> ;;define symbols + init. jsys table
DEFINE AWRD (ARG1) < W'ARG1'.==<W'ARG1'.!1B<$BIT>> >
IRP $JSYS,<
$JSYS==<<$JSYS_^D18>_^D<-18>> ;;clear right half of jsys
$WRD==$JSYS/^D36 ;;calc. word jsys goes into
$BIT==$JSYS-<$WRD*^D36> ;;bit positon of jsys in word
AWRD \"<$WRD+"A"> ;;set bit in appropiate word
>
DEFINE AWRD (ARG1) < W'ARG1'.
PURGE W'ARG1'.
$WRD==$WRD+1 >
$WRD==0
REPEAT ^D14,<AWRD \"<$WRD+"A">> ;;assemble jsys table
PURGE $JSYS,$BIT,$WRD,AWRD ;;remove from symbol table
>
SUBTTL CORRUPTIBLE DATA AREA
CMD.DA (<PHOTO>,<PHOTO>>) ;set up command data area
ENDCMD==:GETCMD## ;no special exit routine after each command
RCNHLN==CMDBLN
RCNHBF: BLOCK RCNHLN ;area to hold RESCAN buffer for a while
VARBEG==. ;start of variable area zeroed for warm restart
CMD.ZV ;assemble COMND variables to be zeroed
WAITIM: 0 ;wait time in milliseconds between displaying bytes (see .REPLA)
WAITMN: 0 ;minimum wait time (bigger for terminals with slower baud rates)
LOGJFN: 0 ;JFN of where photo output will go (default PHOTO.PIC)
REPJFN: 0 ;JFN of file used for replay
PTYJFN: 0 ;JFN of PTY I am using
TTYPDE: 0 ;TTY designator of the PTY I am using
FKHAN: 0 ;fork handle of inferior process (EXEC is run in it)
TERWID: 0 ;terminal width
LOGPCT: 0 ;count of number of pages written to log file
VAREND==.-1 ;end of variable area zeroed for warm restart
TMPPTR: 0 ;temporary storage for byte pointer
SAC: BLOCK P+1 ;storage area for saved accumulators F to P
VTCLR: ASCIZ /[H[2J/ ;cursor home, erase to end of screen
CCOC: BLOCK 2 ;saves original CCOC words for terminal
CCOCR: 125252,,525252 ;CCOC words for replay mode - tells monitor to send
525252,,525252 ; actual character for all control characters
; but send nothing for nulls (^@)
ITRCHR: .TICCX,,.ITRCH ;interrupt char. (default ^X) ,, interrupt-channel
LGTCHR: .TICCY,,.LGTCH ;log-toggle char. (default ^Y) ,, interrupt-channel
JSBITS==1000 ;length of bit table (in bits)
JSBITT: BRKJSY (<LGOUT%,TLINK%>) ;break on these jsys calls
SUBTTL NON-CORRUPTIBLE DATA AREA
;=============================================================================
;These tables lists all the commands this program can process. When adding
;new entries make sure they are added in alphabetical order
CMDTAB: CMDTLN,,CMDTLN ;actual,,maximum number of entries
TBL (CONTINUE)
TBL (EXIT)
TBL (FIX)
TBL (HELP)
TBL (INFORMATION)
TBL (KILL)
TBL (QUIT,CM%INV,.QUIT##) ;same as EXIT at the top command level
TBL (R,CM%INV!CM%ABR,$REPLA) ;"R" is and acceptable abrev for REPLAY
$REPLA: TBL (REPLAY)
TBL (RESET)
TBL (S,CM%INV!CM%ABR,$START) ;"S" is and acceptable abrev for START
TBL (SET,,.SET##)
$START: TBL (START)
TBL (TAKE,,.TAKE##)
CMDTLN==<.-CMDTAB>-1
SETTAB: SETTLN,,SETTLN ;actual,,max length of table
TBL (ECHO,,.SECHO##)
; TBL (ESC-SEQ-SIMULATION,,SETESS)
TBL (INTERRUPT-CHARACTER,,SETIC)
TBL (LOG-TOGGLE-CHARACTER,,SETLTC)
TBL (LOGOUT-CAPABILITY,,SETLGA)
TBL (NO,,.SNO##)
TBL (REPLAY-SPEED,,SETSRP)
SETTLN==<.-SETTAB>-1
STSWI: FLDBK. .CMSWI,,SWITAB,,,,CONFRM## ;FDB for the start comamnd
.APPEN==1 ;code for append switch
SWITAB: SWITLN,,SWITLN ;actual,,maximum number of entries
TBL (APPEND)
SWITLN==<.-SWITAB>-1 ;get length of SWITAB
; replay speed table
.SLOW==1 ;code for slow
.FAST==2 ;code for fast
RPSTAB: RPSTLN,,RPSTLN ;actual,,maximum number of entries
TBL (FAST)
TBL (SLOW)
RPSTLN==<.-RPSTAB>-1 ;get length of RPSTAB
; table used by the CONTINUE and KILL commands
KILTAB: KILTLN,,KILTLN ;actual,,maximum number of entries
TBL (PHOTO-SESSION,,.START)
TBL (REPLAY)
KILTLN==<.-KILTAB>-1 ;get length of KILTAB
; make a modified break mask for .CMFLD function of COMND% to allow reading
; of control characters
BRINI. (FLDB0.,FLDB1.,FLDB2.,FLDB3.) ;init. 4 word .CMFLD break mask
UNBRK. (1,11) ;don't break on ^A to ^I
UNBRK. (13,14) ;don't break on ^K to ^L
UNBRK. (16,32) ;don't break on ^N to ^Z
UNBRK. (34,37) ;don't break on ^\ to ^_
UNBRK. "^"
CCBMSK: EXP W0.,W1.,W2.,W3. ;assemble break mask here
;=============================================================================
; SOFTWARE INTERRUPT TABLES AND VARIABLES
LALL
P.LVT ;assemble LEVTAB data for software interrupt processing
SALL
; NOTE: the priority level of PTYOUT must be higher than any other interrupt
; routine that may display information during a photo session (eg LOGTOG,
; CTRLC, etc) to insure that information gets recorded.
; Also, LOGTOG must be higher than INTRUP to allow toggling of logging while
; INTRUP is in progress.
CHNTAB::DCW (2,CTRLC,.CCCH) ;0 control-C interrupt
DCW (1,PTYOUT,.PTYCH) ;1 output-is-ready from PTY
DCW (3,INTRUP,.ITRCH,.ITRLV) ;2 interrupt char (default ^X)
DCW (2,LOGTOG,.LGTCH) ;3 toggle picture logging (default ^Y)
DCW (3,CTRLA,.CACH,.CALV) ;4 intercepts ^A
DCW (3,CTRLZ,.CZCH,.CZLV) ;5 intercepts ^Z
0 ;6 arithmetic overflow
0 ;7 arithmetic floating pt overflow
0 ;8 reserved for DEC
0 ;9 PANIC - pushdown list overflow
0 ;10 end of file condition
0 ;11 PANIC - data error file condition
0 ;12 PANIC - disk full or quota exceeded
0 ;13 reserved for DEC
0 ;14 reserved for DEC
0 ;15 PANIC - illegal instruction
0 ;16 PANIC - illegal memory read
0 ;17 PANIC - illegal memory write
0 ;18 reserved for DEC
0 ;19 inferior process termination
0 ;20 PANIC - system resources exhausted
0 ;21 reserved for DEC
0 ;22 nonexistent page reference
DCW (2,JSTRAP,.JSTCH) ;23 intercepts jsys calls (LGOUT%)
REPEAT ^D12,<0> ;24-35 free
ONCHNL:: $ONCHN
PURGE $ONCHN
FIXMSG: ASCIZ /File problem. Run PHOTO and use "FIX"/
FIXMLN==<.-FIXMSG> ;length of FIXMSG in words
SUBTTL MAIN PROGRAM
;start of entry vector
ENTVEC: JRST START ;"@START" address
JRST START ;"@REENTER" address
VERSION ;version number (must be 3rd word)
EVLEN==.-ENTVEC ;get length of entry vector
START: RESET% ;initialize the world
SETZ F, ;initialize flag register
MOVE P,[IOWD PDLEN,PDL] ;initialize stack register
SETNAM (PHOTO,PHOTO) ;set private & system names of program
SKIPN STWARM ;is this a warm start?
IFSKP. ;no, go to ENDIF.
;this code is only executed for warm restarts
ZERO (VARBEG,VAREND) ;reinitialize memory
CMD.WM ;assemble warm restart code for COMND
ENDIF.
CALL INIT ;intialize everything
CALL ENAPSI## ;enable the interrupt system
CALL RCNINP## ;set up to read commands from RESCAN
SKIPN STWARM ;is this a warm start
CALL TAKINI## ;no, setup to get commands from INI file
SETOM STWARM ;next time though its a warm start
MOVEI T1,DIE ;exit routine for this command level
HRROI T2,TOPCLP ;prompt string for this command level
CALL BEGCML## ;set up this command level
PARSE (,<.CMKEY,,CMDTAB,<A command,>>)
HRRZ T2,(T2) ;get address of command server
JRST (T2) ;dispatch to it
SUBTTL Server for START command
;=============================================================================
.START: NOISE (photo session)
HRLZI T4,(GJ%FOU) ;set up GTJBLK for COMND%
MOVEM T4,GTJBLK+.GJGEN
HRROI T4,[ASCIZ/PHOTO/]
MOVEM T4,GTJBLK+.GJNAM ;default file name
HRROI T4,[ASCIZ/PIC/]
MOVEM T4,GTJBLK+.GJEXT ;default file extension
TXZ F,F%APND ;assume no append
PARSE (,<.CMFIL,,,,,,STSWI>)
TLZ T3,-1 ;get function discriptor block parsed
CAIN T3,STSWI ;did I parse /APPEND ?
SKIPA ;yes
JRST .STAR3 ;no, user must have entered a file name
;user must have entered /APPEND so...
TXO F,F%APND ;set append switch
SETZM GTJBLK+.GJGEN ;parse an existing file if one exists
PARSE (,<.CMFIL,,,,,,CONFRM##>)
; note: I don't need to check for "CONFRM##" here since CONFRM## can never be
; parsed by COMND% (if user just hits <crlf> then default file name will
; be used) the only reason why CONFRM## is used is to let the user know he
; can just hit <crlf> to complete the command
.STAR3: MOVEM T2,TMPJFN ;save JFN
CONFIRM
TXNE F,F%REPL ;is replay in progress?
CALL REPLCX ;yes, kill it
TXNE F,F%STRT ;is recording in progress?
JRST [TMSG <? There is a photo session in progress - can't start another one
>
JRST ENDCMD] ;done - go get another command
CALL CKDSKF ;make sure were dealing with a disk file
TXNE F,F%APND ;append to file?
JRST [MOVE T1,TMPJFN ;yes, get JFN of file
SIZEF% ;get number of pages in file
JERR (?,,PC,DIE)
SKIPN T3 ;is file empty (0 pages)?
TXZ F,F%APND ;yes - nothing to append to !!
JRST .+1]
MOVE T1,TMPJFN ;get the file jfn COMND% parsed
MOVEM T1,LOGJFN ;save it and zero it to prevent it from
SETZM TMPJFN ;being released when next command parsed
MOVE T2,[^D7B5+OF%WR+OF%RTD] ;Open for write, restricted access
TXNE F,F%APND ;append to the file?
TXO T2,OF%RD ;yes - must set read bit
OPENF%
ERCAL [CAIE T1,OPNX9 ;"Invalid simultaneous access"?
ERRMSG (JRST,ERMSGH,?,,PC,DIE) ;no
ERRMSG (JRST,CMDERH,?,<File probably in use by another photo>,PC,ENDCMD)]
CALL GETPTY ;get a free PTY
; map the log file (default PHOTO.PIC) into memory
HRLZ T1,LOGJFN ;JFN,,page number
MOVE T2,[.FHSLF,,LOGFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!PM%RD!LOGPLN] ;map this many pages
TXNE F,F%APND ;append to the file?
HRRI T3,1 ;yes - only map first page in
PMAP%
JERR (?,,PC,DIE)
TXO F,F%LMAP ;indicates LOG file is mapped
TXNE F,F%APND ;append to the file?
CALL APND10 ;yes, do some unique things for /APPEND
MOVE T1,LOGJFN
HRLI T1,.FBBYV(CF%NUD) ;change this word (no wait)
MOVX T2,FB%BSZ ;change these bits
MOVX T3,FLD (^d7,FB%BSZ) ;this byte size
CHFDB% ;do it
JERR (?,,PC)
; set byte count to that of FIXMLN incase user logs out instead of using "@POP"
; to end photo session. If this happens then when the log file (PHOTO.PIC) is
; typed only the FIX message (FIXMSG) will be displayed.
HRLI T1,.FBSIZ(CF%NUD) ;change this word (no wait)
SETO T2, ;change whole word
MOVEI T3,FIXMLN*5 ;say this many bytes in file
CHFDB% ;change file discriptor block
JERR (?,,PC)
BLTMOV (FIXMSG,FIXMSG+FIXMLN-1,LOGFPG*1K) ;put "FIX" message...
; ... in file (just in case)
SETZM LOGPCT ;initialize page count
HRROI BPTR,LOGFPG*1K+FIXMLN ;initialize byte pointer for pmap area
TXNE F,F%APND ;append to the file?
CALL APND20 ;yes, do some unique things for /APPEND
MOVE T1,BPTR ;get pointer to pmap area
CALL PUTNAM ;put user name + conn. dir. in file
MOVEM T1,BPTR ;save new byte pointer
HRROI T2,LOGFPG*1K ;make byte pointer to start of pmap area
CALL CNTBYT## ;count number of bytes between pointers
SUBI T3,1 ;don't include null at end in byte count
MOVEI BCNT,LOGPLN*1K*5 ;total # bytes in pmap area
SUB BCNT,T3 ;calculate # bytes left in pmap area
; one page of the file will be written to disk now. This is done in case the
; user LOGOUT's instead of using @POP to end the photo session. If the user
; does a logout in the middle of a photo session then any pages of the file
; still in memory will be written to disk by the monitor - therefore no (or
; very little) of the photo session will be lost. However, since the byte
; count is not updated when this happens the user will not beable to see this
; information unless he uses the "FIX" command to update the byte count.
MOVE T1,LOGPCT ;get # pages prev. written to LOG file
HRL T1,LOGJFN ;use this file
MOVE T2,[UF%NOW!1] ;don't wait,, update first page
UFPGS%
JERR (?,,PC)
; create an inferior fork - start the EXEC in it
SKIPE FKHAN ;do I have a fork already?
JRST [ SETO T1, ;yes - must clean it up
HRLZ T2,FKHAN
MOVE T3,[PM%CNT+777]
PMAP% ;unmap everything from non virgin fork
JERR (?,,PC,DIE)
JRST .STAR7]
MOVSI T1,(CR%CAP) ;create a fork and give
CFORK% ;it my capabilities
JERR (?,,PC,DIE)
MOVEM T1,FKHAN ;save fork handle
CALL SELOGO ;set logout ability of process
CALL JSTON ;turn on jsys traping
.STAR7: MOVSI T1,(GJ%SHT!GJ%OLD) ;must get JFN of .EXE again since
HRROI T2,[ASCIZ/SYSTEM:EXEC.EXE/] ;GET% may have released it
GTJFN%
JERR (?,,PC,DIE)
HRL T1,FKHAN ;fork handle,,JFN
GET% ;map EXEC into fork
JERR (?,,PC,DIE)
; Assign the interrrupt characters/conditions channels I will need
TXO F,F%STRT ;say photo session is started
MOVE T1,PTYJFN ;Get PTY jfn
MOVE T2,[MO%OIR!<<.PTYCH-1>B17>!.MOAPI] ;Enable PTY psi, on ch .PTYCH
MTOPR% ;Assign output-ready interrupt for PTY
JERR (?,,PC,DIE)
HRR T1,TTYPDE ;get the terminal designator of our PTY
HRLI T1,(TL%SAB!TL%ABS) ;and make it accept links
TLINK%
JERR (?,,PC,DIE)
MOVEI T1,.CTTRM ;get jfn mode word for controlling TTY
RFMOD%
MOVEM T2,T3 ;save JFN mode word
TXZ T2,TT%DAM ;make VTCLR esc.seq. work
SFMOD%
HRROI T1,VTCLR
TXNE F,F%VT ;is it a VT100
PSOUT% ;yes, clear screen
MOVEI T1,.CTTRM
MOVE T2,T3 ;restore jfn mode word
SFMOD%
TMSG < Enter "@POP">
HRROI T1,[ASCIZ/ or "@LOGOUT"/]
TXNN F,F%LOGO ;can user log out inferior exec?
PSOUT% ;yes
TMSG < to terminate the photo session. Use ^>
HLRZ T1,ITRCHR ;get interrupt character
ADDI T1,"@" ;convert to a printable character
PBOUT%
TMSG < to temporarly
return to the photo command level - ^>
HLRZ T1,LGTCHR ;get log-toggle character
ADDI T1,"@" ;convert to a printable character
PBOUT%
HRROI T1,[ASCIZ ? to enable/disable the recording process.
?]
PSOUT%
CALL ETLINK ;establish a link to PTY
RECMSG (< [Recording initiated>)
; If I'm still reading from the RSCAN buffer then I must empty it before
; starting the inferior EXEC otherwise it will read anything that's left
SETZM RCNHBF ;initialize RSCAN hold buffer
TXNN F,F%RSCN ;am I processing the RSCAN buffer?
IFSKP. ;no
MOVEI T1,<RCNHLN*5-1> ;size of RSCAN hold buffer in bytes
HRROI T2,RCNHBF ;put data from RSCAN here
CALL RCNRD## ;read all data left in RSCAN buffer
ENDIF.
HRRZ T1,FKHAN ;0,,fork handle
SETZ T2, ;start it at this offset in entry vector
SFRKV%
JERR (?,,PC,DIE)
MOVE T1,LGTCHR ;assign log-toggle character
ATI%
JERR (?,,PC)
;NOTE: must wait until last moment to assign interruput character (^X) so
; I'm not interrupted until WFORK%. When I am interrupted (^X) the
; CONTINUE command will return program execution back here (SWFORK)
SWFORK: MOVE T1,ITRCHR ;assign interrupt character
ATI%
JERR (?,,PC)
TXO F,F%IDLE ;say this fork is idle
SKIPE T1,FKHAN ;get handle of inferior EXEC
WFORK% ;wait for fork to finish
JERR (?,,PC,DIE)
TXZ F,F%IDLE ;say this fork is busy
; NOTE: Don't trust AC's when program returns from WFORK% - some may be trashed
; due to interrupt processing
HRROI T1,RCNHBF ;were rscan data was held
SKIPE RCNHBF ;if I was reading from the rscan...
CALL RCNINS## ; ...before START then continue it
CALL STARTX ;do stuff to end recording session...
JRST ENDCMD ;go get another command
;=============================================================================
; This routine will cleanup and end the photo session.
; CALL STARTX
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 - always
STARTX: MOVE T1,TTYPDE ;get the TTY designator of our PTY
DOBE% ;wait until all output to PTY completed
JERR (?,,PC)
TXZN F,F%LOGD ;is logging disabled?
JRST RECEN2 ;no - so don't need to enable it
RFMOD% ;get jfn mode word for PTY
JERR (?,,PC)
TXZ T2,TT%OSP ;turn "^O..." off
SFMOD% ;set it
JERR (?,,PC)
RECEN2: RECMSG (< [Recording terminated>)
MOVE T1,TTYPDE ;get the TTY designator of our PTY
DOBE% ;wait until all output to PTY completed
JERR (?,,PC)
HRRZ T1,PTYJFN ;get JFN of PTY
CLOSF% ;this should clear the link as well
JERR (?,,PC)
SETZM PTYJFN
TXO F,F%IDLE ;say this fork is idle
HLRZ T1,ITRCHR ;deassign interrupt character
DTI%
JERR (?,,PC)
HLRZ T1,LGTCHR ;deassign log-toggle character
DTI%
JERR (?,,PC)
CALL UMPLOG ;unmap LOG file from memory
IFN KEEPNL <
; remove FIXMSG by overwritting it will nulls
HRLZ T1,LOGJFN ;JFN,,page number
MOVE T2,[.FHSLF,,LOGFPG] ;map first page of file here
MOVE T3,[PM%CNT!PM%RD!PM%WR!1] ;map this many pages
PMAP%
JERR (?,,PC,DIE)
TXO F,F%LMAP ;indicates LOG file is mapped
ZERO (LOGFPG*1K,<<LOGFPG*1K>+FIXMLN-1>) ;overwrite FIXMSG will nulls
CALL UMPLOG ;unmap LOG file from memory
>
IFE KEEPNL <
; remove FIXMSG by moving entire file down FIXMLN
MOVE T2,BCNT ;get # free bytes in pmap area
IDIVI T2,^D512*5 ;calc. # free pages
MOVE T3,LOGPCT ;get # pages prev. written to log file
ADDI T3,LOGPLN ;add length of pmap area
SUB T3,T2 ;calc. size of file in pages
HRRZ T1,LOGJFN
MOVEI T2,FIXMLN
CALL MVFDN ;wipe out FIXMSG at beginning of file
ADDI BCNT,FIXMLN*5 ;correct byte count since FIXMSG is gone
>
CALL UPBYTE ;update byte count for file
HRRZ T1,LOGJFN
CLOSF% ;close the file
JERR (?,,PC)
SETZM LOGJFN
TXZ F,F%STRT ;say photo session done
RET ;done
;=============================================================================
; This routine will write the user name and connect directory to a
;destination in memory.
; CALL PUTNAM
;ACCEPTS:
; T1 - destination byte pointer
;RETURNS:
; +1 - always with updated byte pointer in T1
PUTNAM: HRROI T2,[ASCIZ/ [Recorded by /]
CALL MOVSTR##
MOVEM T1,T4 ;save byte pointer
SETO T1, ;get information for this job
MOVE T2,[-2,,Q1] ;put info here
MOVEI T3,.JIUNO ;start at this offset
GETJI%
JERR (?,,PC,DIE)
MOVE T1,T4 ;get saved byte pointer
MOVE T2,Q1 ;get user number
DIRST%
JERR (?,,PC)
HRROI T2,[ASCIZ/ from /]
CALL MOVSTR##
MOVE T2,Q2 ;get user's connected directory number
DIRST%
JERR (?,,PC)
HRROI T2,[ASCIZ/]
/]
CALLRET MOVSTR## ;write string and return to caller
;=============================================================================
; This routine will perform specialized functions required by /APPEND
;for the .START routine. It will insure there is enough space at the beginning
;of the file to hold FIXMSG. If there isn't then space will be allocated by
;moving the entire file up a number of words.
; CALL APND10
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 - always
APND10: HRROI T1,LOGFPG*1K ;byte pointer to start of pmap area
HRROI T2,FIXMSG ;string to search for
MOVEI T3,FIXMLN*5 ;don't search more than this
SETZ T4,
CALL SRCH
SKIPA ;string not found
RET ;there's enough room to hold FIXMSG
MOVSI T4,-777 ;yes, set up for AOBJN
SKIPN LOGFPG*1K(T4) ;search first page of file
AOBJN T4,.-1 ;loop until non-null word is found...
; ...or I've searched entire page
JUMPGE T4,[TMSG <? Holes in PHOTO log file !! Can't /APPEND
>
JRST DIE]
TLZ T4,-1 ;get # nulls at beginning of file
SUBI T4,FIXMLN ;sub length of FIXMSG
SKIPL T4 ;enoungh room to hold FIXMSG ?
RET ;yes, there's enough room to hold FIXMSG
; Not enough room at beginning of file to hold FIXMSG so I must move entire
; file up a number of words
MOVMM T4,T4 ;calc. # words I need to move file up
CALL UMPLOG ;unmap log file from memory
MOVE T1,LOGJFN
MOVE T2,T4 ;get # words I need to move file up
CALL MVFUP ;move file up this many words
HRLZ T1,T1 ;JFN,,page number
MOVE T2,[.FHSLF,,LOGFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!PM%RD!LOGPLN] ;map this many pages
TXNE F,F%APND ;append to the file?
HRRI T3,1 ;yes - only map first page in
PMAP%
JERR (?,,PC,DIE)
TXO F,F%LMAP ;indicates LOG file is mapped
RET ;done - return to caller
;=============================================================================
; This routine will perform specialized functions required by /APPEND
;for the .START routine. It will map in the last page of the file and
;initialize BPTR and LOGPCT.
; CALL APND20
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 - always
APND20: CALL UMPLOG ;unmap log file
HRLZ T1,LOGJFN ;JFN,,0
CALL CKFHOL ;check file for holes
JRST [TMSG <? Holes in PHOTO log file !! Can't /APPEND
>
JRST DIE]
SUBI T1,1 ;calc JFN,,number-of-last-page-in-file
MOVE T2,[.FHSLF,,LOGFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!PM%RD!LOGPLN] ;map this many pages
PMAP%
JERR (?,,PC,DIE)
TXO F,F%LMAP ;indicates LOG file is mapped
HRRZM T1,LOGPCT ;initialize page count
; find last non-null word on the last page of file
MOVEI T4,777 ;initialize for loop
SKIPN LOGFPG*1K(T4)
SOJG T4,.-1 ;loop until non-null word is found...
; ...or I've searched entire page
ADD T4,[POINT 7,LOGFPG*1K] ;build pointer to last non-null word
ILDB T1,T4 ;get first byte of non-null word
JUMPN T1,.-1 ;find first null byte
MOVNI T3,1 ;backup one byte
ADJBP T3,T4 ;new byte pointer is in T3
LDB T1,T3 ;get last non-null byte
CAIE T1,.CTRLJ ;is it a ^J <lf>
JRST [ MOVEI T2,.CTRLM ;no - deposit ^M
IDPB T2,T3
MOVEI T2,.CTRLJ ;no - deposit ^J
IDPB T2,T3
JRST .+1]
MOVEI T2,.CTRLL ;deposit ^L (form feed)
IDPB T2,T3
MOVEM T3,BPTR ;save current byte pointer
RET ;done - return to caller
;=============================================================================
; This routine will establish a link between our terminal and the PTY to
;begin recording.
; CALL ETLINK
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 - always
ETLINK: MOVEI T1,.CTTRM ;get jfn mode word for controlling TTY
RFMOD%
MOVEM T2,T3 ;save JFN mode word
TXO T2,TT%OSP ;throw away "LINK FROM <_____> TTY__"
SFMOD%
MOVE T1,TTYPDE ;get the terminal designator of our PTY
SFMOD% ;throw away output here too
HRLOI T1,(TL%EOR!TL%ERO) ;[02] establish a two way link
MOVE T2,TTYPDE ;get the terminal designator of our PTY
TXZ F,F%IDLE ;say this fork is busy
TLINK% ;Do the link and start recording
ERCAL [CALL ETLINK9 ;turn off ^O... so error message...
ERRMSG (JRST,ERMSGH,?,,PC,DIE)] ; ...will be displayed
ETLIN9: MOVEI T1,.CTTRM ;get jfn mode word for controlling TTY
MOVE T2,T3 ;get JFN mode word - restore TTY ouput
SFMOD% ;restore output to terminal
MOVE T1,TTYPDE ;get the terminal designator of our PTY
SFMOD% ;restore ouput here too
RET ;return to caller
SUBTTL Server for REPLAY command
;=============================================================================
.REPLA: NOISE (photo session from)
HRLZI T4,(GJ%OLD)
MOVEM T4,GTJBLK+.GJGEN ;parse existing file
HRROI T4,[ASCIZ/PHOTO/]
MOVEM T4,GTJBLK+.GJNAM ;default file name
HRROI T4,[ASCIZ/PIC/]
MOVEM T4,GTJBLK+.GJEXT ;default file extension
PARSE (,<.CMFIL,CM%SDH,,<file name or confirm with a carrage return>,<PHOTO.PIC>>)
MOVEM T2,TMPJFN ;save JFN
NOISE (starting at)
SETZM ATMBUF ;say no search string
PARSE (,<.CMQST,CM%SDH,,<"search-string">,,,[FLDBK. .CMTXT,CM%SDH,,<search-string (NO "quotes")>,,,CONFRM##]>)
; TLZ T3,-1 ;get function discriptor block parsed
; CAIN T3,CONFRM## ;did user confirm command?
; JRST REPLA1 ;yes
CONFIRM
REPLA1: TXNE F,F%REPL ;is replay in progress?
CALL REPLCX ;yes, kill it
CALL CKDSKF ;make sure were dealing with a disk file
SKIPN WAITMN ;have I calcuated minimum wait time?
CALL SETMWT ;no, do it
MOVE T1,TMPJFN ;get the file jfn COMND% parsed
MOVEM T1,REPJFN ;save it and zero it to prevent it from
SETZM TMPJFN ;being released when next command parsed
CALL FILPB ;get number of pages & bytes in file
DMOVEM T2,Q1 ;save it here
MOVE T2,[^D7B5+OF%RD] ;Open the file, ascii read
OPENF%
ERCAL [CAIE T1,OPNX9 ;"Invalid simultaneous access"?
ERRMSG (JRST,ERMSGH,?,,PC,DIE) ;no
ERRMSG (JRST,CMDERH,?,<File probably in use by another photo>,PC,ENDCMD)]
CALL REPATI ;assign interrupt characters for replay
CALL REPSCW ;set CCOC + terminal width for replay
SETZM TMPPTR ;initialize for search
SETZ P1, ;initialize page of file to start with
SKIPE ATMBUF ;search for a string?
IFSKP. ;yes, clear screen later
HRROI T1,VTCLR
TXNE F,F%VT ;is it a VT100
PSOUT% ;yes, clear screen
ENDIF.
TMSGL < = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
= Use ^A to increase replay speed, ^Z to decrease it, ^>
HLRZ T1,ITRCHR ;get interrupt character
ADDI T1,"@" ;convert to a printable character
PBOUT%
TMSG < to abort =
= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
>
REPLA3: CALL REPPMP ;map in some pages of file
SKIPN ATMBUF ;search for a string?
JRST REPLA4 ;no
CALL XSRCH ;search for search-string in pmap area
JRST REPLA7 ;string not found, keep on looking
HRROI T1,VTCLR
TXNE F,F%VT ;is it a VT100
PSOUT% ;yes, clear screen
; loop to display all the bytes in the pmap area
REPLA4: MOVN T3,T3 ;calc. -( # bytes in pmap area )
REPLA5: ILDB T1,T2 ;get a byte
JUMPE T1,REPLA6 ;skip over nulls in file
PBOUT%
SKIPLE T1,WAITIM ;does user want a slow replay?
JRST REDISM ;yes, go sleep for a while
MOVEI T1,.PRIOU
ADDI T3,1 ;adjust for byte written above
RESOUT: SOUT% ;no, replay at full speed
JERR (?,,PC,DIE)
MOVNI T1,1 ;adjust byte pointer + byte count...
ADJBP T1,T2 ; ...incase SOUT% was...
MOVEM T1,T2 ; ...aborted by CTRLZ routine
SUBI T3,1
SKIPA
REDISM: DISMS% ;sleep for a while
REPLA6: AOJL T3,REPLA5 ;loop back if any more bytes left
REPLA7: JUMPG Q2,REPLA3 ;loop back if still bytes in file
JUMPG Q1,[TMSGL <% Byte and page count do NOT agree - Use the "FIX" command to correct
>
JRST .+1]
SKIPN ATMBUF ;was search string found?
JRST REPLA9 ;yes, quit
TMSG <% String not found ">
HRROI T1,ATMBUF
PSOUT%
TMSG <"
>
REPLA9: CALL REPLAX ;do stuff to end replay
JRST ENDCMD ;go get another command
;=============================================================================
; This routine will cleanup and end the replay session.
; CALL REPLAX
; CALL REPLCX - to clear PSI system first
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 - always
REPLCX: CIS% ;clear interruption of replay
REPLAX: CALL REPRCW ;reset CCOC + terminal width for replay
CALL REPDTI ;deassign interupt characters for replay
CALL UMPGEN ;unmap file from memory
HRRZ T1,REPJFN
CLOSF% ;close the file
JERR (?,,PC)
SETZM REPJFN
TXZ F,F%REPL ;say replay is finished
RET ;return to caller
;-----------------------------------------------------------------------------
; Routine to set the CCOC words and terminal width so replay of a
;terminal session comes out right.
REPSCW: MOVEI T1,.CTTRM
MOVEI T2,.MORLW ;get terminal's page width
MTOPR%
JERR (?,,PC)
MOVEM T3,TERWID ;save it
MOVEI T2,.MOSLW ;set terminal's page width to zero so
SETZ T3, ;so recording comes out right
MTOPR%
JERR (?,,PC)
MOVEI T1,.CTTRM
RFCOC% ;get the CCOC words for the terminal
JERR (?,,PC)
DMOVEM T2,CCOC ;save the original CCOC words
DMOVE T2,CCOCR ;get CCOC word for replay
SFCOC%
JERR (?,,PC)
TXO F,F%CCOW
RET ;return to caller
;-----------------------------------------------------------------------------
; Routine to restore the CCOC words and terminal width to their original
;values.
REPRCW: MOVEI T1,.CTTRM ;restore original CCOC words
DMOVE T2,CCOC
SFCOC%
JERR (?,,PC)
MOVEI T2,.MOSLW ;reset terminal's page width back to
MOVE T3,TERWID ;previous value
MTOPR%
JERR (?,,PC)
TXZ F,F%CCOW
RET ;return to caller
;-----------------------------------------------------------------------------
; Routine to assign the interrupt characters used by REPLAY.
REPATI: TXO F,F%REPL ;say replay is started
MOVE T1,[.TICCC,,.CCCH] ;activate to intercept ^C
ATI%
JERR (?,,PC)
MOVE T1,ITRCHR ;assign interrupt character
ATI%
JERR (?,,PC)
MOVE T1,[.TICCA,,.CACH] ;activate to intercept ^A
ATI%
JERR (?,,PC)
MOVE T1,[.TICCZ,,.CZCH] ;activate to intercept ^Z
ATI%
JERR (?,,PC)
RET ;return to caller
;-----------------------------------------------------------------------------
; Routine to deassign the interrupt characters used by REPLAY.
REPDTI: MOVEI T1,.TICCA ;deassign ^A
DTI%
JERR (?,,PC)
MOVEI T1,.TICCZ ;deassign ^Z
DTI%
JERR (?,,PC)
HLRZ T1,ITRCHR ;deassign interrupt character
DTI%
JERR (?,,PC)
MOVEI T1,.TICCC ;deassign ^C
TXNN F,F%STRT ;don't deactivate ^C if recording...
DTI% ; ...is in progress
JERR (?,,PC)
RET ;return to caller
SUBTTL Server for FIX command
;=============================================================================
.FIX: NOISE (file)
HRLZI T4,(GJ%OLD)
MOVEM T4,GTJBLK+.GJGEN ;parse existing file
PARSE (,<.CMFIL,CM%SDH,,<name of file you want fixed>>)
MOVEM T2,TMPJFN ;save JFN
CONFIRM
TXNE F,F%REPL ;is replay in progress?
CALL REPLCX ;yes, kill it
CALL CKDSKF ;make sure were dealing with a disk file
MOVE T1,TMPJFN ;get the file jfn COMND% parsed
MOVE T2,[^D7B5+OF%RD+OF%WR] ;Open the file, ascii read write
OPENF%
ERCAL [CAIE T1,OPNX9 ;"Invalid simultaneous access"?
ERRMSG (JRST,ERMSGH,?,,PC,DIE) ;no
ERRMSG (JRST,CMDERH,?,<File probably in use by another photo>,PC,ENDCMD)]
;T1 = JFN
CALL CKFSIZ ;check the file size
TXZ F,F%FIX ;say nothing fixed
CAMN T1,T3 ;are page counts ok?
JRST FIX1 ;yes,
; warn user about page counts being wrong - need wheel to fix
PUSH P,T2 ;save some registers
PUSH P,T4
MOVEM T1,Q1
MOVEM T3,Q2
TMSGL <%WARNING: Page count from file's FDB is ">
MOVEI T1,.PRIOU
HRRZ T2,Q1 ;get old page count
MOVEI T3,^D10
NOUT%
JERR (?,,PC,DIE)
TMSG <" but I think it should be ">
MOVEI T1,.PRIOU
HRRZ T2,Q2 ;get new page count
MOVEI T3,^D10
NOUT%
JERR (?,,PC,DIE)
TMSG <"
Have a user with wheel privileges check this out and change it if necessary !!
>
POP P,T4 ;restore saved registers
POP P,T2
FIX1: CAMN T2,T4 ;are byte counts ok?
JRST FIX3 ;yes
; correct byte counts in FDB
MOVEM T2,Q1 ;save the information
MOVEM T4,Q2
TMSG <% Changing byte count from >
MOVEI T1,.PRIOU
MOVE T2,Q1 ;get old byte count
MOVEI T3,^D10
NOUT%
JERR (?,,PC,DIE)
TMSG < to >
MOVEI T1,.PRIOU
MOVE T2,Q2 ;get new byte count
MOVEI T3,^D10
NOUT%
JERR (?,,PC,DIE)
TMSG <
>
MOVE T1,TMPJFN
HRLI T1,.FBSIZ(CF%NUD) ;change this word (no wait)
SETO T2, ;change whole word
MOVE T3,Q2
CHFDB% ;do it
JERR (?,,PC)
TXO F,F%FIX ;say something fixed
FIX3: TXZE F,F%FIX
JRST FIX5 ;yes remove fix message from file
TMSGL <% No problems - both PAGE and BYTE count appear to be correct
>
JRST FIX9 ;done
; Since something was fixed in file let's look for FIXMSG and remove it if
; it's there
TXNE F,F%HOLE ;does file contain holes?
JRST [ TMSGL <% File contains holes - photo log files shouldn't contain holes!!??
>
JRST FIX9]
FIX5: HRLZ T1,TMPJFN ;JFN,,page number
MOVE T2,[.FHSLF,,GENFPG] ;map it here
MOVE T3,[PM%CNT!PM%RD!PM%WR!1] ;map this many pages
PMAP%
JERR (?,,PC,DIE)
HRROI T1,GENFPG*1K ;byte pointer to start of pmap area
HRROI T2,FIXMSG ;string to search for
MOVEI T3,FIXMLN*5 ;don't search more than this
SETZ T4,
CALL SRCH
JRST FIX7 ;string not found so quit
IFN KEEPNL <
ZERO (GENFPG*1K,<<GENFPG*1K>+FIXMLN-1>) ;overwrite FIXMSG will nulls
>
IFE KEEPNL <
CALL UMPGEN ;unmap file from memory
HRRZ T1,TMPJFN
MOVEI T2,FIXMLN
CALL MVFDN ;wipe out FIXMSG at beginning of file
HRLI T1,.FBSIZ(CF%NUD) ;change this word (no wait)
SETO T2, ;change whole word
MOVNI T3,FISMLN*5 ;get -( # bytes in FIXMSG )
ADD T3,Q2 ;calc. new byte count
CHFDB% ;do it
JERR (?,,PC)
JRST FIX9 ;done
>
FIX7: CALL UMPGEN ;unmap file from memory
FIX9: HRRZ T1,TMPJFN
CLOSF% ;close the file
JERR (?,,PC)
SETZM TMPJFN ;say JFN is released
JRST ENDCMD ;go get another command
SUBTTL Server for HELP (for)
;=============================================================================
; For HELP to give help on a given photo command requires a special
;PHOTO.HLP file. Each keyword must start with the <del> (177 octal) character.
;Photo will then display text starting from the beginning of the line with
;the keyword and ending with <del><cr>
.HELP: NOISE (for)
PARSE (,<.CMKEY,,CMDTAB,,,,CONFRM##>)
TLZ T3,-1 ;get function discriptor block parsed
SETZ Q3, ;assume give help on everything
CAIN T3,CONFRM## ;did user confirm command?
JRST HELP4 ;yes, give help on everything
MOVEM T2,Q3 ;save info about keyword parsed
HRRZ T2,(T2) ;get code of keyword parsed
CAIE T2,.SET ;help for the set command?
JRST HELP1 ;no, go confirm command
PARSE (,<.CMKEY,,SETTAB,,,,CONFRM##>)
TLZ T3,-1 ;get function discriptor block parsed
CAIN T3,CONFRM## ;did user confirm command?
JRST HELP3 ;yes, give help on everything
MOVEM T2,Q3 ;save it
HELP1: CONFIRM
HELP3: MOVE T1,[POINT 7,ATMBUF] ;put search string here
MOVEI T2,.CHDEL ;string starts with this
IDPB T2,T1
HLRO T2,(Q3) ;get string for keyword parsed
CALL MOVSTR##
TMSG <
>
TRNA
HELP4: CALL DOECHO## ;echo the command if necessary
MOVSI T1,(GJ%SHT!GJ%OLD)
HRROI T2,[ASCIZ/HLP:PHOTO.HLP/]
GTJFN%
ERJMP [TMSG <? Can't find HLP:PHOTO.HLP Sorry.....
>
JRST ENDCMD]
MOVEM T1,TMPJFN ;save JFN
MOVE T2,[^D7B5+OF%RD] ;Open the HLP file, ascii read
OPENF%
JERR (?,,PC,DIE)
;initilaize for HLPPMP routine
CALL FILPB ;get number of pages & bytes in file
DMOVEM T2,Q1 ;save it here
SETZM TMPPTR ;initialize for search
SETZ P1, ;initialize page of file to start with
SKIPE Q3 ;giving help on a particular keyword?
JRST HELP20 ;yes,
; user want general help so type out entire help file
HELP11: CALL HLPPMP ;map in some pages of help file
MOVEI T1,.PRIOU
MOVN T3,T3 ;ouput everything in pmap area
SOUT%
JERR (?,,PC,DIE)
JUMPG Q2,HELP11 ;loop back if still bytes in file
JRST HELP9 ;done
; user wants help on a particular keyword
HELP20: CALL HLPPMP ;map in some pages of help file
SKIPN ATMBUF ;have I already found the keyord?
JRST HELP22 ;yes
CALL XSRCH ;search for search-string in pmap area
JRST HELP27 ;keyword not found, keep on looking
SETZ Q3, ;init. counter to determine end of...
; help text. It's decremented each time <del>not<cr>
; is found and incremented for <del><cr>
SETZ T4, ;initialize to enter loop
; rejoin code to display help message
HELP22: CAIN T4,.CHDEL ;was last byte written a <del>
JRST HELP25 ;yes,
HELP23: MOVEI T1,.PRIOU
MOVEI T4,.CHDEL ;make SOUT% terminate on this byte
SOUT%
JERR (?,,PC,DIE)
LDB T4,T2 ;save last byte written
; CAIE T4,.CHDEL ;was it a <del>
SKIPG T3 ;any more bytes left in pmap area
JRST HELP27 ;no, must be at end of pmap area (T3=0)
HELP25: MOVE T1,T2 ;get byte pointer
ILDB T4,T1 ;get next byte to be written
ADDI Q3,1 ;assume next byte is a <cr>
CAIE T4,.CTRLM ;is it a <cr>
SUBI Q3,2 ;no, decrement counter
JUMPGE Q3,HELP9 ;quit if end of help for keyword
JRST HELP23 ;output some more help text
HELP27: JUMPG Q2,HELP20 ;loop back if still bytes in file
SKIPE ATMBUF ;was search string found?
JRST [ TMSG <% No help found for ">
HRROI T1,ATMBUF
PSOUT%
TMSG <"
>
JRST .+1]
HELP9: SETO T1, ;unmap the file from memory
MOVE T2,[.FHSLF,,HLPFPG] ;start unmapping here
MOVE T3,[PM%CNT!HLPPLN] ;unmap this many pages
PMAP%
JERR (?,,PC,DIE)
TMSGL < [End of >
FILSTR (TMPJFN)
TMSG <]
>
MOVE T1,TMPJFN
CLOSF% ;close the file
JERR (?,,PC)
SETZM TMPJFN
JRST ENDCMD ;go get another command
;=============================================================================
; Routine to pmap a file into memory. It will update and return a number
;of pieces of information.
; CALL PMP
;ACCEPTS:
; T1 - JFN,,?
; T2 - ?,,process-page-to-start-pmaping-at
; T3 - 0,,length-of-pmap-area
; Q1 - # pages left in file
; Q2 - # bytes left in file
; P1 - file page # to start pamping at
;RETURNS:
; +1 always with:
; T1 - trashed
; T2 - byte pointer to start of pmap area
; T3 - # of ascii bytes in pmap area
; Q1 - updated (zero when no more pages left in file)
; Q2 - updated (zero when no more bytes left in file)
; P1 - updated
;-----------------------------------------------------------------------------
; Routine to set up pmap for HELP file.
; CALL HLPPMP
HLPPMP: HRL T1,TMPJFN
MOVEI T2,HLPFPG ;map it here
MOVEI T3,HLPPLN ;plan to map in this many pages
CALLRET PMP ;go do pmap
;-----------------------------------------------------------------------------
; Routine to set up pmap for REPLAY file.
; CALL REPPMP
REPPMP: HRL T1,REPJFN
MOVEI T2,GENFPG ;map it here
MOVEI T3,GENPLN ;plan to map in this many pages
CALLRET PMP ;go do pmap
;-----------------------------------------------------------------------------
PMP: HRR T1,P1 ;get current page count
HRLI T2,.FHSLF
CAMLE T3,Q1 ;are there this many pages left in file?
MOVE T3,Q1 ;no - just map in as many as we need
HRLI T3,(PM%CNT!PM%RD!PM%PLD)
PMAP%
JERR (?,,PC,DIE)
TLZ T3,-1 ;get # pages I mapped in
SUB Q1,T3 ;update count of pages left
ADD T1,T3
HRRZM T1,P1 ;update current page count
IMULI T3,1K*5 ;calc. # of bytes in pmap area
SUB Q2,T3 ;recalulate bytes left in file
SKIPGE Q2 ;were enough bytes left?
ADD T3,Q2 ;no - adjust bytes to be written
LSH T2,9 ;convert page number to address
HRLI T2,(POINT 7) ;pointer to start of pmap area
RET ;return to caller
;=============================================================================
; eXtended SeaRCH routine to search for a search-string in memory. It is
;eXtended because it allows the search to be carried on where it left off in
;case the string being searched for extends over end of search area.
;This routine was designed to be used with the PMP routine.
; CALL XSRCH
;ACCEPTS:
; T2 - byte pointer to start of pmap area to search
; T3 - # bytes in pmap area
; Q1,Q2,P1 - as left by last call to PMP
; TMPPTR - byte pointer to where in search-string to start searching
; (will be used to initialize T4 for SRCH - should be zero first
; time this routine is called)
; ATMBUF - string to search for
;RETURNS:
; +1 - search-string not found with:
; T1,T2,T3,T4 - as left by SRCH
; Q1,Q2,P1 - updated if necessary so next call to PMP will map in the last
; page again
; TMPPTR - initialized to where in search-string SRCH left off
; (0 if search-string does not extend over end of search area)
; +2 - search-string found with:
; T2 - updated byte pointer to start of line search string begins on
; T3 - # bytes left in pmap area
; ATMBUF - first word set to zero
XSRCH: MOVEM T3,Q3 ;save # of bytes in pmap area
MOVE T1,T2 ;start seaching at start of pmap area
SKIPN T4,TMPPTR ;get where I left off in search
JRST XSRCH3
ADDI T1,1K ;don't search first page again
SUBI T3,1K*5 ;adjust # bytes to search
XSRCH3: MOVEM T2,TMPPTR ;save pointer to start of pmap area
HRROI T2,ATMBUF ;search for this string
CALL SRCH
JRST XSRCH7 ;search-string not found
; search string found, start searching backward for <lf>
SETZM ATMBUF ;say search-string found
SUB Q3,T3 ;calc. # bytes searched
ADD T3,Q3 ;save # bytes in pmap area in T3
MOVE T1,TMPPTR ;get pointer to start of pmap area
XSRCH5: MOVE T2,Q3 ;set up for ADJBP to gets last byte
ADJBP T2,T1 ;back pointer up another byte
LDB T4,T2 ;get byte
CAIE T4,.CTRLJ ;is it a <lf>
SOJG Q3,XSRCH5 ;no, back up one more byte and try again
SUB T3,Q3 ;calc. # of bytes left in pmap area
RET.2 ;search string found, return +2
; since search failed to find search-string I must check to see if part of
; the search-string was found when the byte count ran out. If is was then
; search-string could be on next page we map in.
XSRCH7:
;[01] always map an extra page in incase I must search backwards over the
;[01] page boundary for the <lf> search string begins on
;[01] SETZM TMPPTR ;assume no overlap of search-string
;[01] CAMN T2,T4 ;was part of search-string found?
;[01] RET ;no, return +1
MOVEM T4,TMPPTR ;yes, save where I left off
; adjust Q1,Q2, and P1 so that the last page currently mapped in will be the
; first page mapped in when PMP is next called
SKIPG Q2 ;any bytes left in file?
RET ;no, don't backup any pages
SUBI P1,1 ;decrement file page # to map in next
ADDI Q1,1 ;increase # pages in file
ADDI Q2,1K*5 ;increase # bytes in file
RET ;return +1 - search string not found
SUBTTL Server for the SET command
;;-----------------------------------------------------------------------------
;;Server for SET ESC-SEQ-SIMULATION
;
;SETESS: CONFIRM
; TMSG < ......Not implimented yet >
; JRST ENDCMD ;go get another command
;-----------------------------------------------------------------------------
;Server for SET INTERRUPT-CHARACTER
SETIC: NOISE (to)
PARSE (,<.CMFLD,CM%SDH,,<a control character>,<>,CCBMSK>)
CALL GETCC ;get the control character
JRST ENDCMD ;error - go get another command
CALL SETIC9 ;go set it
JRST ENDCMD ;go get another command
SETIC9: HRLM T1,ITRCHR ;save new interrupt character
RET ;return to caller
;-----------------------------------------------------------------------------
;Server for SET LOG-TOGGLE-CHARACTER
SETLTC: NOISE (to)
PARSE (,<.CMFLD,CM%SDH,,<a control character>,<>,CCBMSK>)
CALL GETCC ;get the control character
JRST ENDCMD ;error - go get another command
CALL SETLT9 ;go set it
JRST ENDCMD ;go get another command
SETLT9: HLRZ T2,LGTCHR ;get old log-toggle character
CAMN T2,T1 ;are they the same?
RET ;yes, return to caller
HRLM T1,LGTCHR ;no, save new log-toggle character
TXNN F,F%STRT ;is recording in progress?
RET ;no, return to caller
DTI% ;yes, deassign log-toggle character
JERR (?,,PC)
MOVE T1,LGTCHR ;assign new log-toggle character
ATI%
JERR (?,,PC)
RET ;return to caller
;=============================================================================
; Routine to examine ATMBUF for a control character from ^@ to ^Z.
;A two character representation of the control character will be accepted
;but it will be converted to the code of the actual control character.
; CALL GETCC
;ACCEPTS:
; - ATMBUF must contian text user typed in
;RETURNS:
; +1 - with control character in T1
; +2 - error, no control character found in ATMBUF
GETCC: MOVE T4,ATMBUF ;save first word of atom buffer
CONFIRM
MOVE T2,[POINT 7,T4]
ILDB T1,T2 ;get first character user typed in
CAIG T1,.TICCZ ;is it a control character?
RET.2 ;yes, success - return +2
CAIE T1,"^" ;is this the character?
JRST GETCC9 ;no
ILDB T1,T2 ;get next character user typed in
CAIL T1,"a" ;is it a lowercase letter?
CAIL T1,"z"
SKIPA ;not a lowercase letter
SUBI T1,"a"-"A" ;convert lowercase to uppercase
CAIG T1,"Z" ;skip if bigger than this
CAIGE T1,"@" ;skip if bigger than this
JRST GETCC9 ;error
;charcter is between "@" and a "Z"
SUBI T1,"@" ;convert to a control character
RET.2 ;success - return +2
GETCC9: ERR (?,<not a control character>)
RET
;-----------------------------------------------------------------------------
;Server for SET SPEED-OF-REPLAY
SETSRP: NOISE (to)
PARSE (,<.CMKEY,,RPSTAB,,<FAST>>)
HRRZ T2,(T2) ;get code of keyword parsed
MOVEM T2,Q1 ;save it
CONFIRM
SKIPN T1,WAITMN ;have I calcuated minimum wait time?
CALL SETMWT ;no, do it
CAIG T1,^D32 ;is minimum wait time at least this?
MOVEI T1,^D32 ;no, use this wait time for slow replay
MOVEM T1,WAITIM ;assume start replay slowly
CAIE Q1,.SLOW ;user want to start replay slowly?
SETZM WAITIM ;no, replay quickly
JRST ENDCMD ;go get another command
;-----------------------------------------------------------------------------
; Routine to calculate the minimum wait time for replay. Terminals with
;slower baud rates have a larger minimum wait time between displaying characters
;so that ^A and ^Z look good when fine adjusting the speed of replay.
; CALL SETMWT
;ACCEPTS:
; no registers need to be initialized
;RETURNS:
; +1 always with WAITMN initialized and WAITMN in T1
SETMWT: MOVEI T1,.CTTRM ;controlling terminal
MOVEI T2,.MORSP ;get this terminal's line speed
MTOPR%
JERR (?,,PC,DIE)
TLZ T3,-1 ;zero out lelf half (input speed)
CAIN T3,-1 ;is the output speed known?
MOVEI T3,^D4800 ;no - assume 4800
; NOTE: if changing make sure min. wait time is initialized to a power of 2
MOVEI T1,1 ;min. wait time for speeds .GT. 2400
CAIG T3,^D2400 ;is speed greater than 2400 baud?
MOVEI T1,^D2 ;no - use this min. wait time
CAIG T3,^D300 ;is speed greater than 300 baud?
MOVEI T1,^D64 ;no - use this min. wait time
CAIG T3,^D110 ;is speed greater than 110 baud?
MOVEI T1,^D128 ;no - use this min. wait time
MOVEM T1,WAITMN ;save min. wait time
RET ;return to caller
;-----------------------------------------------------------------------------
;Server for SET LOGOUT-CAPABILITY
SETLGA: NOISE (for inferior EXEC)
CONFIRM
TXZ F,F%LOGO ;assume LOGOUT capability
TXNE F,F%NO ;user want NO LOGOUT capability?
TXO F,F%LOGO ;yes
SKIPE T1,FKHAN ;do I have a fork already?
CALL SELOGO ;yes, set logout capability for process
JRST ENDCMD ;go get another command
;=============================================================================
; Routine to set logout capability of inferior process. It uses the
;setting of F%LOGO.
;ACCEPTS:
; T1 - process handle
;RETURNS:
; +1 always
SELOGO: RPCAP% ;get process capcapability word
JERR (?,,PC,DIE)
TXZ T2,SC%LOG ;assume no LOGOUT capability
TXNN F,F%LOGO ;give process LOGOUT capability?
TXO T2,SC%LOG ;yes
EPCAP% ;set process capability word
JERR (?,,PC,DIE)
RET ;return to caller
SUBTTL Server for INFORMATION command
;=============================================================================
C.INFO <
HRROI T1,[ASCIZ/ ***** A photo session is in progress *****
/]
TXNE F,F%STRT
PSOUT%
HRROI T1,[ASCIZ/ ***** A replay session is in progress *****
/]
TXNE F,F%REPL
PSOUT%
TMSG < Interrrupt character is ^>
HLRZ T1,ITRCHR ;get interrupt character
ADDI T1,"@" ;convert to a printable character
PBOUT%
TMSG <
Log-toggle character is ^>
HLRZ T1,LGTCHR ;get log-toggle character
ADDI T1,"@" ;convert to a printable character
PBOUT%
TMSG <
>
HRROI T1,[ASCIZ/ Logging/]
TXNE F,F%APND
HRROI T1,[ASCIZ/ Appending/]
PSOUT%
TMSG < of photo session to >
SKIPE LOGJFN
IFSKP.
HRROI T1,[ASCIZ/log file/]
PSOUT%
ELSE.
FILSTR (LOGJFN)
ENDIF.
TMSG < is >
HRROI T1,[ASCIZ/EN/]
TXNE F,F%LOGD
HRROI T1,[ASCIZ/DIS/]
PSOUT%
TMSG <abled
>
TMSG < Inferior EXEC >
HRROI T1,[ASCIZ/will be given/]
TXNE F,F%LOGO
HRROI T1,[ASCIZ/will NOT be given/]
PSOUT%
TMSG < the ability to use the "@LOGOUT" command
>
>;end of C.INFO
SUBTTL Server for the RESET (all settings to default values) command
;=============================================================================
.RESET: NOISE (all settings to default values)
CONFIRM
CALL INIT ;reset everything
JRST ENDCMD ;go get another command
;-----------------------------------------------------------------------------
; Routine to initalize all variables used to their default settings.
;Be careful when modifying since this routine may be called if the user
;interrupts a photo or replay session (^X) and issues the RESET command.
INIT: SETZM WAITIM ;replay quickly
TXZ F,F%ECHO!F%LOGO ;zero these flags
SKIPE T1,FKHAN ;do I have a fork already?
CALL SELOGO ;yes, set logout capability for process
MOVEI T1,.TICCX ;get default interrupt character
CALL SETIC9 ;go set it
MOVEI T1,.TICCY ;get default log toggle character
CALL SETLT9 ;go set it
MOVEI T1,.CTTRM ;controlling TTY
GTTYP% ;get terminal type
JERR (?,,PC)
;; TXO F,F%VT ;assume VT100
;; CAIE T2,.TT100 ;is it a VT100 ?
;; TXZ F,F%VT ;no
CKTTY (F%VT) ;check whether it is a VT100 type
CALL ERESET## ;say program has encountered no errors
RET
SUBTTL Server for CONTINUE command
;=============================================================================
.CONTI: PARSE (,<.CMKEY,,KILTAB,,,,CONFRM##>)
TLZ T3,-1 ;get function discriptor block parsed
CAIE T3,CONFRM## ;did user confirm command?
JRST CONTI3 ;no
CALL DOECHO## ;echo the command if necessary
MOVEM F,T1 ;get flag register
TXC T1,F%REPL!F%STRT
TXNN T1,F%REPL!F%STRT
JRST [TMSGL <% Both a REPLAY and PHOTO-SESSION are in progress - be specific
>
JRST ENDCMD] ;go get another command
TXNE F,F%REPL ;is a replay in progress?
JRST CONT.R ;yes
TXNE F,F%STRT ;is a photo session in progress?
JRST CONT.S ;yes - continue it
TMSGL <% Nothing in progress to continue
>
JRST ENDCMD ;go get another command
CONTI3: HRRZ T2,(T2) ;get code of keyword parsed
MOVEM T2,Q1 ;save it
CONFIRM
CAIN Q1,.REPLA ;continue replay?
JRST CONT.R ;yes
CAIN Q1,.START ;continue photo-session?
JRST CONT.S ;yes
TMSGL <? Problem in .CONTI - call Data Center
>
JRST ENDCMD
;-----------------------------------------------------------------------------
; Routine to continue replay session
CONT.R: TXNN F,F%REPL ;is replay in progress?
JRST [TMSGL <% No REPLAY is in progress
>
JRST ENDCMD] ;go get another command
CALL REPSCW ;set CCOC + terminal width for replay
CALL REPATI ;assign interrupt characters for replay
MOVEM F,SAC+F ;save new flag register
BLTMOV (SAC,SAC+P,F) ;restore registers F to P
DEBRK% ;dismiss interrupt
;-----------------------------------------------------------------------------
; Routine to continue inferior exec
CONT.S: TXNN F,F%STRT ;is a photo session in progress?
JRST [TMSGL <% No PHOTO SESSION is in progress
>
JRST ENDCMD] ;go get another command
MOVEI T1,.TICCC ;deactivate ^C interrupts
DTI%
JERR (?,,PC)
SKIPE T1,FKHAN ;get handle of inferior EXEC
RFORK% ;resume it and all its inferiors
JERR (?,,PC,DIE)
JRST SWFORK ;go wait for fork to finish
SUBTTL Server for KILL command
;=============================================================================
.KILL: PARSE (,<.CMKEY,,KILTAB,,,,CONFRM##>)
TLZ T3,-1 ;get function discriptor block parsed
CAIE T3,CONFRM## ;did user confirm command?
JRST KILL3 ;no
CALL DOECHO## ;yes, echo the command if necessary
;kill everything in progress
TXNN F,F%REPL!F%STRT
JRST [TMSGL <% Nothing in progress to kill
>
JRST ENDCMD] ;go get another command
SETZ Q1, ;say no keyword parsed
TXNE F,F%REPL ;is replay in progress?
CALL KILL.R ;yes
TXNE F,F%STRT ;is recording in progress?
JRST KILL.S ;yes
JRST ENDCMD ;go get another command
KILL3: HRRZ T2,(T2) ;get code of keyword parsed
MOVEM T2,Q1 ;save it
CONFIRM
CAIN Q1,.REPLA ;kill replay?
JRST KILL.R ;yes
CAIN Q1,.START ;kill photo-session?
JRST KILL.S ;yes
TMSGL <? Problem in .KILL - call Data Center
>
JRST ENDCMD
;-----------------------------------------------------------------------------
; Routine to kill a replay session in progress.
KILL.R: TXNN F,F%REPL ;is replay in progress?
JRST [TMSGL <% No REPLAY is in progress
>
JRST ENDCMD] ;go get another command
CALL REPLCX ;kill replay session
SKIPN Q1 ;more things to kill?
RET ;yes, return to caller
JRST ENDCMD ;go get another command
;-----------------------------------------------------------------------------
; Routine to kill the photo session. I have to kill the fork rather
;than simply halting it so I can get rid of any inferior forks as well (user
;may have pushed many times before using ^X to get back to photo command level.
KILL.S: TXNN F,F%STRT ;is a photo session in progress?
JRST [TMSGL <% No PHOTO SESSION is in progress
>
JRST ENDCMD] ;go get another command
MOVEI T1,.FHINF ;kill all inferiors of this fork
KFORK%
JERR (?,,PC)
SETZM FKHAN
JRST CONT.S ;rejoin code to continue fork
SUBTTL Server for EXIT command
;=============================================================================
.EXIT: NOISE (from this program)
CONFIRM
TXNE F,F%REPL ;is replay in progress?
CALL REPLCX ;yes, kill it
TXNN F,F%STRT ;is recording in progress?
JRST DIE ;no - quit
PSOUT%
HRROI T1,[ASCIZ/% A photo session is still in progress... Kill it? (Y,N) /]
MOVEM T1,T3 ;save ^R text for RDTTY%
PSOUT%
HRROI T1,Q1 ;put answer here
MOVE T2,[RD%BEL!RD%RAI!^D10]
RDTTY%
JERR (?,,PC,DIE)
LDB T4,[POINT 7,Q1,6] ;get first byte of answer
CAIE T4,"Y" ;OK to kill photo session?
JRST ENDCMD ;no - go get another command
CALL STARTX ;end recording session
JRST DIE ;die
;-----------------------------------------------------------------------------
DIE: TXNE F,F%RSCN ;am I processing the rscan buffer?
CALL RCNCLR## ;yes, clear any unread characters
TXNE F,F%CCOW ;are CCOC + term.width altered
CALL REPRCW ;yes, restore it
MOVEI T1,.FHINF ;kill all inferiors I might have
KFORK%
JERR (?,,PC)
SETZM FKHAN
TXNE F,F%LMAP ;is log file mapped into memory?
CALL UMPLOG ;unmap LOG file from memory
SETO T1, ;close and release any files and
CLOSF% ;JFN's that might be hanging around
JERR (?,,PC)
HALTF%
JRST START ;"@CONTINUE" - begin again
SUBTTL GENERAL SUBROUTINES
;=============================================================================
; Routine to get a PTY. The pty will be opened and JFN placed in PTYJFN.
;The terminal characteristics of the PTY will be set to the same as the
;controlling terminal (with execption of allowing links - TT%ALK ).
; CALL GETPTY
GETPTY: GJINF% ;get job number
MOVEM T3,Q1 ;save it
MOVE T1,['PTYPAR']
SYSGT% ;get number-of-PTY's,,first-PTY
JERR (?,,PC,DIE)
HLRZM T1,T4 ;get number of PTY's on system
HRRZM T1,TTYPDE ;save the TTY number of the first PTY
MOVN T4,T4 ;make AC for AOBJN instruction
HRLZS T4 ;so I can search through PTY's
MOVSI T1,<.DVDES+.DVPTY> ;construct device designator for PTY
GETPT1: HRR T1,T4
DVCHR%
JERR (?,,PC,DIE)
TXNE T2,DV%AV ;is device assignable by us?
CALL GETPT2 ;yes, check it out
AOBJN T4,GETPT1 ;no - loop back for rest of PTY's
;falls through when no more PTY's
ERRC <?,<There are no free PTY's - try again later.....>,,ENDCMD)
; Program gets here when a PTY has been found. I must check to make sure PTY
; is not already assigned to this job - if it is I have to look for another
GETPT2: HLRZ T3,T3 ;get job PTY is assigned to (if it is)
CAMN T3,Q1 ;is PTY assigned to this job?
RET ;yes, keep on looking for a free PTY
POP P,T3 ;remove call from stack
ADD T4,TTYPDE ;add TTY number of PTY to counter
TXO T4,.TTDES ;Make it a terminal designator
HRRZM T4,TTYPDE ;save it
MOVE T2,T1 ;Get device designator of PTY
HRROI T1,Q1 ;Store name string in Q1 and Q2
DEVST% ;Convert designator to string
JERR (?,,PC,DIE)
MOVEI T2,":"
IDPB T2,T1 ;Tack character on end string
SETZ T2,
IDPB T2,T1 ;Tack character on end string
TMSGL < [Using ">
HRROI T1,Q1
PSOUT%
TMSG <" to log terminal output on]
>
MOVSI T1,(GJ%SHT!GJ%ACC) ;Short style gtjfn
HRROI T2,Q1 ;Point to file name (PTYnn:)
GTJFN% ;Get a JFN for it
JERR (?,,PC,DIE)
HRRZM T1,PTYJFN ;Store it for later
MOVE T2,[^D7B5+OF%RD+OF%WR] ;Open the pty, ascii read write
OPENF% ;Open the file
JERR (?,,PC,DIE)
;don't need to do ^O... bit default is "off"
; MOVEI T1,.CTTRM ;get jfn mode word for controlling TTY
; RFMOD%
; MOVE T1,TTYPDE ;get TTY designator of our PTY
; TXZ T2,TT%OSP ;make sure PTY will allow output (^O...)
; SFMOD% ;give PTY the jfn mode word
MOVEI T1,.CTTRM ;Get terminal type of controlling TTY
GTTYP%
MOVE T1,TTYPDE ;get TTY designator of our PTY
STTYP% ;make PTY the same terminal type
RET ;return to caller
;=============================================================================
;Unmaps LOG file pmap area
; CALL UMPLOG
UMPLOG: SETO T1, ;unmap LOG file from memory
MOVE T2,[.FHSLF,,LOGFPG] ;start unmapping here
MOVE T3,[PM%CNT!LOGPLN] ;unmap this many pages
PMAP%
JERR (?,,PC,DIE)
TXZ F,F%LMAP ;say LOG file is unmapped
RET
;=============================================================================
;Unmaps GENeral pmap area
; CALL UMPGEN
UMPGEN: SETO T1, ;unmap the file from memory
MOVE T2,[.FHSLF,,GENFPG] ;start unmapping here
MOVE T3,[PM%CNT!GENPLN] ;unmap this many pages
PMAP%
JERR (?,,PC,DIE)
RET
;=============================================================================
;Updates the byte count in LOGJFN. before calling insure LOGJFN has been
;initialized.
; CALL UPBYTE
UPBYTE: MOVE T3,LOGPCT ;get # pages prev. written to log file
IMULI T3,1K*5 ;times number of characters/page
ADDI T3,LOGPLN*1K*5 ;add total # bytes in pmap area
SUB T3,BCNT ;sub. # of free bytes in pmap area
MOVE T1,LOGJFN
HRLI T1,.FBSIZ(CF%NUD) ;change this word (no wait)
SETO T2, ;change whole word
CHFDB% ;change file discriptor block
JERR (?,,PC)
RET ;done
;=============================================================================
; Routine to search a region of memory for an ASCIZ string (null
;terminates string and is not considered as part of the search string). This
;routine will ignore case differences (uppercase=lowercase).
; CALL SRCH
;ACCEPTS:
; T1 - byte pointer to where to begin search at
; T2 - byte pointer to search-string (to search for)
; T3 - count of max. number of characters to search before quiting
; T4 - byte pointer to place in search string to begin search at (set
; to zero to use T2 for place to start search)
;RETURNS:
; +1 if string found, +2 if string not found. In both cases:
; T1 - updated byte pointer
; T2 - unchanged
; T3 - updated byte count (# of unsearched characters)
; (T3 will be negative if string not found)
; T4 - byte pointer to byte of search-string being processed when
; byte count (T3) ran out
SRCH: PUSH P,Q1 ;save some registers
PUSH P,Q2
PUSH P,P1
PUSH P,P2
HLRZ Q1,T1
CAIN Q1,777777 ;is it a symbolic byte pointer
HRLI T1,(POINT 7) ;yes - convert to a valid pointer
HLRZ Q1,T2
CAIN Q1,777777 ;is it a symbolic byte pointer
HRLI T2,(POINT 7) ;yes - convert to a valid pointer
MOVEM T2,Q1 ;get pointer to start of search-string
ILDB Q2,Q1 ;get byte from search-string
DMOVEM Q1,P1 ;save byte pointer + 1st byte
MOVEM T2,Q1 ;get pointer to start of search-string
SKIPE T4 ;start at other place in search-string?
MOVEM T4,Q1 ;yes, get new byte pointer
SRCH3: ILDB Q2,Q1 ;get byte from search-string
JUMPE Q2,SRCH9 ;quit if end of search-string
SRCH5: SOJL T3,SRCH9 ;quit if no bytes left in search area
ILDB T2,T1 ;get byte from search area
CAMN T2,Q2 ;do bytes match?
JRST SRCH3 ;yes, try next byte of search-string
CAIL T2,"a" ;is it a lowercase letter?
CAIL T2,"z"
SKIPA ;not a lowercase letter
SUBI T2,"a"-"A" ;convert lowercase to uppercase
CAIL Q2,"a" ;is it a lowercase letter?
CAIL Q2,"z"
SKIPA ;not a lowercase letter
SUBI Q2,"a"-"A" ;convert lowercase to uppercase
CAMN T2,Q2 ;do bytes match?
JRST SRCH3 ;yes, try next byte of search-string
SRCH7: DMOVE Q1,P1 ;restore byte pointer + 1st byte
JRST SRCH5 ;keep on searching
SRCH9: MOVNI T4,1
ADJBP T4,Q1 ;restore ptr. to where search left off
MOVNI T2,1
ADJBP T2,P1 ;restore ptr. to start of search-string
POP P,P2 ;restore used registers
POP P,P1
POP P,Q2
POP P,Q1
SKIPL T3 ;was string found?
AOS 0(P) ;yes, return +2
RET ;no, return +1
;=============================================================================
; CKDSKF - check to make sure TMPJFN belongs to a file on disk
;Before calling insure TMPJFN has be initialized
CKDSKF: MOVE T1,TMPJFN ;get the file jfn COMND% parsed
DVCHR% ;get characteristics of LOG file
JERR (?,,PC,DIE)
TLZ T2,777000 ;remove unwanted info
HLRZ T2,T2 ;get device type
CAIE T2,.DVDSK ;is it a disk file (required for PMAP%)
ERR (?,<File must be on disk for PMAP%>,PC,ENDCMD)
RET ;return to caller
;=============================================================================
; Routine to get the number of pages and (7bit) bytes in a file.
; CALL FILPB
;ACCEPTS:
; T1 - file JFN
;RETURNS:
; +1 -always. T1 will remain untouched. T2 will contain the # pages in
; the file. T3 will have number of (7 bit) bytes in the file.
FILPB: PUSH P,T1 ;save needed AC's
PUSH P,Q1
PUSH P,Q2
MOVE T2,[2,,.FBBYV] ;get number of pages and bytes in file
MOVEI T3,Q1 ;start saving info here
GTFDB%
JERR (?,,PC,DIE)
LDB T1,[POINT 6,Q1,11] ;get byte size
CAIE T1,7 ;is it 7-bit bytes
JRST [ MOVEI T2,^D36 ;# bits/word
IDIV T2,T1 ;calc # bytes/word
MOVE T1,Q2 ;get # bytes in file
IDIV T1,T2 ;calc # words in file
CAIN T2,0 ;any partial words?
ADDI T1,1 ;yes, bump up # words in file
IMULI T1,5 ;calc. # ascii bytes in file
MOVEM T1,Q2 ;save it
JRST .+1]
TLZ Q1,-1 ;get number of pages in file
DMOVE T2,Q1 ;get page and byte count
POP P,Q2 ;restore AC's
POP P,Q1
POP P,T1
RET ;return to caller
;=============================================================================
; CKFSIZ - check out file size
; The byte and page count will be extracted from the file's FDB as well
;as calculated by a separate means. These counts will be returned to the user.
;Before calling insure the file is open for at least read access.
; CALL CKFSIZ
;ACCEPTS:
; T1 - JFN of file to check (file must be open)
;RETURNS:
; +1 - always with:
; T1 - byte-size,,page-count (from FDB)
; T2 - byte-count (from FDB)
; T3 - byte-size,,page-count (calculated)
; T4 - byte-count (calculated)
; (Note: the byte-size in T3 is from the FDB as well (same as in T1))
CKFSIZ: PUSH P,Q1 ;save needed registers
PUSH P,Q2
PUSH P,Q3
;T1 = JFN
MOVE T2,[2,,.FBBYV] ;get number of pages and bytes in file
MOVEI T3,Q1 ;start saving info here
GTFDB%
JERR (?,,PC,DIE)
LDB T2,[POINT 6,Q1,11] ;get byte size
SKIPN T2 ;is byte size zero?
MOVEI T2,1 ;yes - assume byte size of 1
HRLM T2,Q1 ;save byte size
HRLM T2,Q3
HRLZ T1,T1 ;JFN,,0
CALL CKFPGS ;check the pages of the file
HRRM T2,Q3 ;save # pages in file
; At this point T1 => JFN,,number-of-last-page-in-file
; It doesn't matter if files contains holes or not. I now can map last page
; of the file into memory so I can calculate byte count
;T1= JFN,,number-of-last-page-in-file
MOVE T2,[.FHSLF,,GENFPG] ;map it here
MOVE T3,[PM%CNT!PM%RD!PM%PLD!1] ;map in this many pages
PMAP%
JERR (?,,PC,DIE)
; find last non-null word of file
MOVEI T4,777 ;initialize for loop
SKIPN GENFPG*1K(T4)
SOJG T4,.-1 ;loop until non-null word is found...
; ...or I've searched entire page
HLRZ T1,Q1 ;get byte size
MOVEI T2,^D36 ;number of bits/word
IDIV T2,T1 ;calc # bytes/word
HRLM T2,T4 ;save # bytes/word
MOVN T3,T2 ;set up for AOBJN
HRLZ T3,T3
MOVE T2,[POINT ,GENFPG*1K(T4)] ;make pointer for last non-null word
DPB T1,[POINT 6,T2,11] ;put byte size in pointer
CKFSI5: ILDB T1,T2 ;get first byte of word
SKIPE T1 ;skip if it's a null byte
AOBJN T3,CKFSI5 ;loop back for next byte
TLZ T3,-1 ;get # used bytes in last used word
HRRZ T2,Q3 ;get # pages in file
SUBI T2,1 ;calc. # complete pages
LSH T2,9 ;calc. # words (multiply by 1K)
HLRZ T1,T4 ;get # bytes/word
TLZ T4,-1
ADD T2,T4 ;add number of used words on last page
IMUL T2,T1 ;calc. # bytes
ADD T2,T3 ;add # bytes in last used word of file
MOVEM T2,T4 ;save this calculated byte count
CALL UMPGEN ;unmap file from memory
MOVE T3,Q3 ;get calculated page count
DMOVE T1,Q1 ;get saved info from file's FDB
POP P,Q3 ;restore used registers
POP P,Q2
POP P,Q1
RET ;done
;=============================================================================
; Uses FFUFP to calculate number of pages in the file. Will also tell if
; file has holes. Before calling insure file is open.
; CALL CKFPGS
;ACCEPTS:
; T1 - JFN,, page-to-start-checking-at (normally use JFN,,0 )
;RETURNS:
; +1 - always with:
; T1 - JFN,,page-number-of-last-page-in-file
; T2 - total-number-pages-in-file
; F%HOLE - will be set (1=file has holes, 0=no holes in file)
; (The file has no holes if T1+1=T2)
CKFPGS: PUSH P,T3 ;save registers I will use
SETZ T2, ;accumulate total number of pages here
CKFPG1: MOVEM T1,T3 ;save info
FFUFP% ;find first used page
JRST CKFPG3 ;failed - check out reason
ADDI T2,1 ;increment total # of pages
AOJA T1,CKFPG1 ;find next used page
CKFPG3: CAIE T1,FFUFX3 ;was error "No used page found"
ERR (?,,PC,DIE) ;no - other error - report it
MOVE T1,T3 ;get contents of T1 before error
HRRM T2,T3
TXZ F,F%HOLE ;assume file doesn't have holes
CAME T1,T3 ;does file have holes?
TXO F,F%HOLE ;yes set flag
SKIPE T2 ;skip if no used pages in file
SUBI T1,1 ;calc. page number of last used page
POP P,T3 ;restore used registers
RET ;done
;=============================================================================
; Check to see if file has holes. Before calling insure file is open.
; CALL CKFHOL
;ACCEPTS:
; T1 - JFN,,0
;RETURNS:
; T1 - JFN,,page-number-of-first-free-page
; T2,T3 - trashed
; +1 - file has holes
; +2 - file has NO holes
CKFHOL: HLRZ T1,T1 ;make 0,,JFN
SIZEF% ;get number of pages in file
JERR (?,,PC,DIE)
FFFFP% ;find first free page
JERR (?,,PC,DIE)
;T1 = JFN,,page-number-first-free-page
HRRZ T2,T1 ;get page # of first free page
CAMN T2,T3 ;does file have holes?
AOS 0(P) ;no, set +2 return
RET ;done
.IF EXTEND,OPCODE < ;use this code if processor has "EXTEND"
;=============================================================================
; Routine to move information in a file up an integral number of words.
;Before calling the file must be open for write access and GENFPG pmap area
;must be free. When the file is moved up nulls will be placed at the beginning
;of the file. This routine does NOT work correctly on files with holes.
; CALL MVFUP
;ACCEPTS:
; T1 - JFN of file
; T2 - number of words to move the file up
;RETURNS:
; +1 always with T1,T2 unchanged
MVFUP: SKIPG T2 ;is # words to move file up zero?
RET ;yes quit
PUSH P,T1 ;save needed registers
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,Q1
PUSH P,Q2
PUSH P,Q3
MOVEM T2,Q3 ;save info passed to me
SIZEF% ;get number of pages in file
JERR (?,,PC,DIE)
; now get ready to map in the last few pages of the file plus one extra one
; incase when I move things up I need to go to a new page. Before entering
; the loop I need to intialize a few things
; T1-T3 = initialized for PMAP jsys
; Q3 = # words I need to move file up
HRL T1,T1 ;make JFN,,page number
HRR T1,T3
MOVE T2,[.FHSLF,,GENFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!PM%RD!PM%PLD!GENLMX] ;map this many pages
SETZ Q1, ;flag to say first time through loop
; start of loop to read in pages and move everything up
MVFUP1: HRRZM T1,T4 ;get number of pages in file to go
JUMPLE T4,MVFUP9 ;quit if no pages left in file?
SUBI T4,GENLMX-1 ;subtract room we have for pmaping
JUMPGE T4,MVFUP3 ;jump if enoungh file pages left to...
; ...fill entire pmap area
;not enough pages to fill pmap area so.....
ADD T3,T4 ;reduce # pages I need to map in
MOVM T4,T4 ;get absolute value
ADD T2,T4 ;start pmaping here instead of GENFPG
SETZ T4, ;page # of file to start pmaping at
;rejoin code...
MVFUP3: HRR T1,T4 ;get page # in file to start pmap at
PMAP%
JERR (?,,PC,DIE)
JUMPN Q1,MVFUP5 ;jump if NOT the first time thru loop
MOVEI Q1,777
SKIPN <GENFPG+GENLMX-2>*1K(Q1) ;search last page of file
SOJG Q1,.-1 ;loop until non-null word is found...
; ...or I've searched entire page
ADDI Q1,<GENFPG+GENLMX-2>*1K+1 ;calculate source for XBLT
MVFUP5: MOVEM Q1,Q2 ;get source for XBLT
ADD Q2,Q3 ;calc. destination for XBLT
HRRZM T2,T4 ;get page # where file starts
LSH T4,9 ;convert it to an address
SUB T4,Q1 ;calc. -( # words to move )
;T4 = # words to move with XBLT
;Q1 = source for XBLT instruction
;Q2 = destination for XBLT instruction
EXTEND T4,[XBLT] ;do XBLT to move words up
MOVEM T1,T4 ;save contents of T1
TLZ T1,-1 ;get current page of file
JUMPN T1,MVFUP7 ;skip if not page 0
; execution gets here when this is the last time through the loop and I'm
; processing the final page of the file. This code will zero out (make null)
; the same number of words at the beginning of the file as I have moved the
; file up.
SETZM (Q1) ;zero first word of destination
HRL Q1,Q1 ;make source for BLT
ADDI Q1,1 ;make source,,destination for BLT
HRLI Q2,(BLT Q1,) ;make BLT instruction to zero words...
SUBI Q2,1
XCT Q2 ; ...at beginning of file
MVFUP7: SETO T1, ;unmap the file pages
PMAP%
JERR (?,,PC,DIE)
MOVE T1,T4 ;restore T1
MOVEI Q1,<GENFPG+GENLMX-1>*1K ;initialize source for next XBLT
JRST MVFUP1 ;loop back for more pages
MVFUP9: POP P,Q3 ;restore used registers
POP P,Q2
POP P,Q1
POP P,T4
POP P,T3
POP P,T2
POP P,T1
RET
> ;end of conditional assembly for "EXTEND"
.IFN EXTEND,OPCODE < ;use this code if processor doesn't have "EXTEND"
;=============================================================================
; Routine to move information in a file up an integral number of words.
;Before calling the file must be open for write access and GENFPG pmap area
;must be free. When the file is moved up nulls will be placed at the beginning
;of the file. This routine does NOT work correctly on files with holes.
; CALL MVFUP
;ACCEPTS:
; T1 - JFN of file
; T2 - number of words to move the file up
;RETURNS:
; +1 always with T1,T2 unchanged
MVFUP: SKIPG T2 ;is # words to move file up zero?
RET ;yes quit
PUSH P,T1 ;save needed registers
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,Q1
PUSH P,Q2
PUSH P,Q3
MOVEM T2,Q2 ;save info passed to me
SIZEF% ;get number of pages in file
JERR (?,,PC,DIE)
; now get ready to map in the last few pages of the file plus one extra one
; incase when I move things up I need to go to a new page. Also, before entering
; the loop I need to intialize for the POP instruction I will use to move words
; in the file up.
; T1-T3 = initialized for PMAP jsys
; Q1 = "stack" for POP the first time it is executed in loop
; Q2 = contians the POP instruction to move words up
; Q3 = "stack" for POP after the first time through loop
HRL T1,T1 ;make JFN,,page number
HRR T1,T3
MOVE T2,[.FHSLF,,GENFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!PM%RD!PM%PLD!GENLMX] ;map this many pages
SETZ Q3, ;flag to say first time through loop
HRLI Q2,(POP Q1,0(Q1)) ;make POP instruction to move words up
MOVE Q1,[400000+<<GENLMX-1>*1K-1>,,<GENFPG+GENLMX-1>*1K-1]
IFL <400-GENLMX>,<PRINTX ?Too many words in pmap area for POP to handle>
; start of loop to read in pages and move everything up
MVFUP1: HRRZM T1,T4 ;get number of pages in file to go
JUMPLE T4,MVFUP9 ;quit if no pages left in file?
SUBI T4,GENLMX-1 ;subtract room we have for pmaping
JUMPGE T4,MVFUP3 ;jump if enoungh file pages left to...
; ...fill entire pmap area
;not enough pages to fill pmap area so.....
ADD T3,T4 ;reduce # pages I need to map in
MOVM T4,T4 ;get absolute value
ADD T2,T4 ;start pmaping here instead of GENFPG
LSH T4,9 ;calc. # words (*1K) in pages not mapped
HRLZ T4,T4 ; ...and...
SUB Q1,T4 ;adjust # words to move up with POP
SETZ T4, ;page # of file to start pmaping at
;rejoin code...
MVFUP3: HRR T1,T4 ;get page # in file to start pmap at
PMAP%
JERR (?,,PC,DIE)
JUMPN Q3,MVFUP5 ;jump if NOT the first time thru loop
MOVEM Q1,Q3 ;save "stack" for future POP's
MOVEI T4,777
SKIPN <GENFPG+GENLMX-2>*1K(T4) ;search last page of file
SOJG T4,.-1 ;loop until non-null word is found...
; ...or I've searched entire page
TXC T4,777 ;calc. # null words found
HRL T4,T4
SUB Q1,T4 ;adjust "stack" for POP
MVFUP5: XCT Q2 ;execute POP instruction to move a...
JUMPL Q1,.-1 ; ...word in file up - loop until done
MOVEM T1,T4 ;save contents of T1
TLZ T1,-1 ;get current page of file
JUMPN T1,MVFUP7 ;skip if not page 0
; execution gets here when this is the last time through the loop and I'm
; processing the final page of the file. This code will zero out (make null)
; the same number of words at the beginning of the file as I have moved the
; file up.
ADD Q2,Q1 ;make BLT instruction to zero words...
HRLI Q2,(BLT Q1,) ; ...at beginning of file
ADDI Q1,1 ;make destination for BLT
SETZM (Q1) ;zero first word of destination
HRL Q1,Q1 ;make source for BLT
ADDI Q1,1 ;make source,,destination for BLT
XCT Q2 ;execute BLT
MVFUP7: SETO T1, ;unmap the file pages
PMAP%
JERR (?,,PC,DIE)
MOVE T1,T4 ;restore T1
MOVE Q1,Q3 ;restore "stack" for next POP loop
JRST MVFUP1 ;loop back for more pages
MVFUP9: POP P,Q3 ;restore used registers
POP P,Q2
POP P,Q1
POP P,T4
POP P,T3
POP P,T2
POP P,T1
RET
> ;end of conditional assembly for "EXTEND"
IFE KEEPNL <
;=============================================================================
; Routine to move information in a file down an integral number of words.
;Before calling the file must be open for write access and GENFPG pmap area
;must be free. When the file is moved down nulls will be placed at the end
;of the file. This routine does NOT work correctly on files with holes.
; CALL MVFDN
;ACCEPTS:
; T1 - JFN of file
; T2 - number of words to move the file down
; T3 - number of pages in file (or zero). If zero then size of file
; will be determined by the SIZEF% jsys call
;RETURNS:
; +1 always with T1,T2 unchanged
MVFDN: SKIPG T2 ;is # words to move file down zero?
RET ;yes quit
PUSH P,T1 ;save needed registers
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,Q1
PUSH P,Q2
PUSH P,Q3
HRLZM T2,Q1 ;save info passed to me
MOVNM T2,Q2
SKIPG T3 ;skip if I was passed size of file
SIZEF% ;get number of pages in file
JERR (?,,PC,DIE)
MOVEM T3,T4 ;save it
; now get ready to map in the first few pages of the file by initializing for
; the PMAP jsys and make a BLT instruction to execute
; T1-T3 = initialized for PMAP jsys
; Q1 = source,,destination for BLT the first time it is executed in loop
; Q2 = contians the BLT instruction to move words down
; Q3 = source,,destination for BLT after the first time through loop
HRLZ T1,T1 ;make JFN,,page number
MOVE T2,[.FHSLF,,GENFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!PM%RD!PM%PLD!GENLMX] ;map this many pages
ADD Q1,[GENFPG*1K,,GENFPG*1K] ;source,,destination for 1st BLT
MOVEM Q2,Q3 ;save -( # words to move down )
ADD Q2,[BLT Q1,<<GENFPG+GENLMX>*1K-1>] ;make BLT instruction
ADD Q3,[<GENFPG+1>*1K,,<GENFPG+1>*1K] ;BLT source,,destination
SUBI T1,GENLMX-1 ;initialize to get into loop
SUBI T4,1
; start of loop to read in pages and move everything down
SKIPE T4
MVFDN1: JUMPLE T4,MVFDN9 ;quit if no pages left in file?
ADDI T1,GENLMX-1 ;increment file page to start pmaping at
SUBI T4,GENLMX-1 ;update # page left in file
JUMPGE T4,MVFDN3 ;jump if enoungh file pages left to...
; ...fill entire pmap area
;not enough pages to fill pmap area so.....
ADD T3,T4 ;reduce # pages I need to map in
LSH T4,9 ;calc. # words (multiply by 1K)
ADD Q2,T4 ;adjust last word of destination for BLT
SETZ T4, ;say no more pages in file
;rejoin code...
MVFDN3: PMAP%
JERR (?,,PC,DIE)
XCT Q2 ;execute BLT to move words down
JUMPG T4,MVFDN7 ;jump if NOT the last time thru loop
; execution gets here when this is the last time through the loop and I'm
; processing the final page of the file. This code will zero out (make null)
; the same number of words at the end of the file as I have moved the file
; down.
SETZM (Q1) ;zero first word
HLR Q2,Q1 ;get updated source form previous...
SUBI Q2,1 ; ...BLT and make it last word...
; ...of destination for the new BLT
HRL Q1,Q1 ;make new source,,destination for...
ADDI Q1,1 ; ...new BLT
XCT Q2 ;execute BLT to zero words
MVFDN7: MOVEM T1,Q1 ;save contents of T1
SETO T1, ;unmap the file pages
PMAP%
JERR (?,,PC,DIE)
MOVE T1,Q1 ;restore T1
MOVE Q1,Q3 ;restore source,,destination for...
; ...next time BLT is executed
JRST MVFDN1 ;loop back for more pages
MVFDN9: POP P,Q3 ;restore used registers
POP P,Q2
POP P,Q1
POP P,T4
POP P,T3
POP P,T2
POP P,T1
RET
> ;end of conditional assembly for KEEPNL
SUBTTL INTERRUPT HANDLING ROUTINES
;=============================================================================
; When output is ready on PTY program gets here.
PTYOUT: TXO F,F%IDLE ;is this fork idle?
JRST PTYOU1 ;yes, don't bother saving AC's
PUSH P,T1 ;save needed AC's
PUSH P,T2
PUSH P,T3
PTYOU1: MOVE T1,TTYPDE ;Get terminal designator for PTY
SOBE% ;Any output from the PTY?
JRST PTYOU5 ;Yes, read it
TXNE F,F%IDLE ;is this fork idle?
DEBRK% ;yes, don't bother restoring AC's
POP P,T3 ;restore used AC's
POP P,T2
POP P,T1
DEBRK% ;dismiss interrupt
PTYOU5: MOVN T3,T2 ;have SIN% read this many bytes
CAMLE T2,BCNT ;does byte count exceed available space?
MOVN T3,BCNT ;yes - so only read this many bytes
ADD BCNT,T3 ;decrement # of characters
MOVE T1,PTYJFN ;read info from here
MOVE T2,BPTR ;put the information here
SIN%
JERR (?,,PC,DIE)
MOVEM T2,BPTR ;save updated byte pointer
TLZ T2,-1 ;get address
SKIPLE BCNT ;is there still room in pmap area?
JRST PTYOU1 ;yes, go see if any more output from PTY
; program gets here when pmap area full. I will unmap the full pages I have
; so I can map more into memory
CALL UMPLOG ;unmap LOG file from memory
MOVE T1,LOGPCT ;get # pages prev. written to LOG file
ADDI T1,LOGPLN ;calculate # page written to log file
HRRZM T1,LOGPCT ;save total
HRL T1,LOGJFN
;T1= JFN,,file-page-number-to-start-at
MOVE T2,[.FHSLF,,LOGFPG] ;map it here
MOVE T3,[PM%CNT!PM%WR!LOGPLN] ;map this many pages
PMAP%
JERR (?,,PC,DIE)
TXO F,F%LMAP ;indicates LOG file is mapped
HRROI BPTR,LOGFPG*1K ;byte pointer to start of pmap area
MOVEI BCNT,LOGPLN*1K*5 ;this many free characters in pmap area
JRST PTYOU1 ;go see if any more PTY output to read
;=============================================================================
; Interrupt routine to toggle logging input to the LOG file (PHOTO.PIC)
LOGTOG: TXZ F,F%IDLE ;say this fork is busy
PUSH P,T1 ;save registers I will use
PUSH P,T2
PUSH P,T3
TMSG <
>
MOVE T1,TTYPDE ;get the TTY designator of our PTY
RFMOD% ;get jfn mode word for PTY
JERR (?,,PC,DIE)
TXC T2,TT%OSP ;toggle "^O..." switch
TXCN F,F%LOGD ;toggle flag bit
JRST LOGTO5 ;go disable logging
SFMOD% ;turn logging back on
JERR (?,,PC,DIE)
RECMSG (< [Logging enabled>)
; TMSG <
;>
JRST LOGTO9 ;done
LOGTO5: PUSH P,T2 ;save jfn mod word
RECMSG (< [Logging disabled>)
MOVE T1,TTYPDE ;get the TTY designator of our PTY
POP P,T2 ;restore jfn mode word
SFMOD% ;give PTY the jfn mode word
JERR (?,,PC,DIE)
LOGTO9: POP P,T3 ;restore registers
POP P,T2
POP P,T1
TXO F,F%IDLE ;say this fork is idle
DEBRK% ;dismiss interrupt
;=============================================================================
; Routine to handle JSYS trap interrupts. When an inferior fork tries to
;execute the LGOUT% jsys I will be interrupted. This allows me to clean up the
;photo session log file prior to logout. TLINK% jsys will also be traped so
;that if an inferior forks attemts to break all links (@BREAK) it can
;reestablish the PTY link to continue the photo session.
JSTRAP: TXZ F,F%IDLE ;say this fork is busy
PUSH P,T1 ;save need registers
PUSH P,T2
PUSH P,T3
PUSH P,T4
RTFRK% ;read which fork trapped
JERR (?,,PC,DIE)
HRRZM T1,T4 ;save fork handle in case of error
CAMN T2,[LGOUT%] ;is this the jsys?
JRST JSTLGO ;yes, go handle it
CAMN T2,[TLINK%] ;is this the jsys?
JRST JSTLNK ;yes, go handle it
TMSG <? PHOTO got a bad jsys - call Data Center
>
JRST JSTRA9 ;quit
;-----------------------------------------------------------------------------
; Routine to handle TLINK% done by inferior forks
JSTLNK: MOVEI T2,SAC ;put the fork's AC's here
RFACS%
JERR (?,,PC,DIE)
DMOVE T1,SAC+T1 ;get T1,T2 of fork
TXNN T1,TL%COR ;wants to clear object to remote links?
JRST JSTRA9 ;no, quit
TLZ T2,-1 ;zero left half
CAIE T2,-1 ;clear all remote links?
CAMN T2,TTYPDE ;clear remote links with my pty?
SKIPA ;yes
JRST JSTRA9 ;no, quit
DMOVE T1,SAC+T1 ;get T1,T2 from fork
MOVEI T3,1 ;assume TLINK will go ok
TLINK% ;execute jsys for this fork
CALL TLFAIL ;jsys failed...
MOVE T1,T4 ;restore fork handle
RFSTS% ;get current PC of fork
JERR (?,,PC,DIE)
MOVE T1,T4 ;restore fork handle
ADD T2,T3 ;fake +1 or +2 return from TLINK%
SFORK% ;set new PC for the fork
JERR (?,,PC,DIE)
SKIPE T3 ;did TLINK% fail?
CALL ETLINK ;no, must reestablish link to PTY
JSTRA9: MOVE T1,T4 ;restore fork handle
UTFRK% ;resume fork, allow the jsys to proceed
JERR (?,,PC,DIE)
POP P,T4 ;restore registers
POP P,T3
POP P,T2
POP P,T1
TXO F,F%IDLE ;say this fork is idle
DEBRK% ;dismiss interrupt
;-----------------------------------------------------------------------------
; Routine to handle LGOUT% done by inferior forks
JSTLGO: RPCAP% ;read process capabilities
TXNE T2,SC%LOG ;does process have LOGOUT capability?
JRST JSTLG1 ;yes
TMSG <% Use "@POP" to end photo session - then you can logout
>
JRST JSTRA9 ;done
JSTLG1: MOVEI T2,SAC ;put the fork's AC's here
RFACS%
JERR (?,,PC,DIE)
SKIPGE SAC+T1 ;fork want to log current job out?
CALL STARTX ;yes, end recording session
;no, false alarm, user must be logging someone else off
JRST JSTRA9 ;quit
;=============================================================================
; Routine to handle failure of the TLINK% jsys. If it fail I have to
;pass back the changed AC's to the inferior fork and set its "last error
;message". I must check to see what instruction follows the TLINK% call in
;the inferior fork so I can fake a return that will be handled correctly.
; CALL TLFAIL
;ACCEPTS:
; T1 - as is after TLINK% failure (will contain error code)
; T2 - as is after TLINK% failure
; T4 - fork handle
; SAC - contains AC's for the fork
;RETURNS:
; +1 - if instruction following TLINK% in inferior fork is NOT a ERJMP
; or ERCAL. T3 will contain zero (offset to add to PC to fake
; a +1 error return)
; JSTRA9 - if instruction following TLINK% was a ERJMP or ERCAL. T4 will
; have the flag UT%TRP set so that when fork is resumed with the
; UTFRK% call the ERJMP or ERCAL route will be taken.
TLFAIL: PUSH P,Q1 ;save a register
DMOVEM T1,SAC+T1 ;save AC's from TLINK% failure
MOVE T1,T4 ;get fork handle
MOVEI T2,SAC ;get AC's from here
SFACS% ;pass back AC's to process
JERR (?,,PC,DIE)
MOVE T2,SAC+T1 ;get last error code
SETER% ;set last error message for the fork
JERR (?,,PC,DIE)
RFSTS% ;get current PC of fork
JERR (?,,PC,DIE)
MOVEM T2,Q1 ;save it
; now map in the page of the process to check the instruction which follows
; the TLINK% call
HRRZ T1,T2 ;get PC
LSH T1,-^D9 ;make page number
HRL T1,T4 ;process-handle,,page-number
MOVE T2,[.FHSLF,,FRKFPG] ;map fork's page here
MOVSI T3,(PM%RD) ;get read access
PMAP%
JERR (?,,PC,DIE)
TRZ Q1,777000 ;remove page number of fork's PC
MOVE Q1,FRKFPG*1K(Q1) ;get instruction following TLINK%
SETO T1, ;umap fork page I mapped in
PMAP%
JERR (?,,PC,DIE)
HLRZ T3,Q1 ;swap halves for comparisons
TRZ T3,37 ;zero X and I fields of instruction
POP P,Q1 ;remove saved AC from stack
CAIE T3,(ERJMP) ;is it this?
CAIN T3,(ERCAL) ;is it this?
JRST TLFAI5 ;yes
SETZ T3, ;take +1 failure path when...
RET ; ...fork is resumed
TLFAI5: POP P,T1 ;remove call to this routine from stack
TXO T4,UT%TRP ;take ERJMP/ERCAL failure path when...
JRST JSTRA9 ; ...fork is resumed
;=============================================================================
; Routines to turn on and off jsys trapping.
JSTON: MOVEI T1,.FHINF ;freeze all inferior forks
FFORK%
JERR (?,,PC)
HRLI T1,.TFSPS ;set up interrupt channel for jsys
MOVE T2,[.JSTCH,,JSBITS] ;interrupt channel,,# of bits in JSBITT
MOVEI T3,JSBITT ;address of jsys bit table
TFORK%
JERR (?,,PC)
HRLI T1,.TFSET ;say which jsyses to trap
TFORK%
JERR (?,,PC)
JSTON9: TLZ T1,-1 ;get 0,,.FHINF
RFORK% ;unfreeze fork
JERR (?,,PC)
RET ;return to caller
;-----------------------------------------------------------------------------
; Routine to turn off jsys traping
JSTOFF: MOVEI T1,.FHINF ;freeze all inferior forks
FFORK%
JERR (?,,PC)
HRLI T1,.TFRES ;remove jsys traps for all inferiors
TFORK%
JERR (?,,PC)
CALLRET JSTON9 ;return to caller
;=============================================================================
; Interrupt routine for interrupting the photo session or replay.
;The CONTINUE command can then be use to continue from the interruption.
INTRUP: TXZ F,F%IDLE ;say this fork is busy
MOVEM T1,SAC+T1 ;save register just incase REPLAY
HLRZ T1,ITRCHR ;get interrupt character
DTI% ;deassign it
JERR (?,,PC)
TXNE F,F%REPL ;is replay in progress?
JRST IRREPL ;yes, handle it
TXNE F,F%STRT ;is recording in progress?
JRST IRSTRT ;yes, handle it
TMSG <? Call Data Center - internal program problem with INTRUP
>
HALTF%
JRST .-2 ;redisplay error
;-----------------------------------------------------------------------------
; Routine to handle interruption of a photo session.
IRSTRT: MOVE T1,TTYPDE ;get the TTY designator of our PTY
DOBE% ;wait until all output to PTY completed
JERR (?,,PC,DIE)
MOVE T1,[.TICCC,,.CCCH]
ATI%
JERR (?,,PC)
MOVE T1,FKHAN ;get handle of inferior EXEC
FFORK% ;freeze it (note: all its inferiors...
JERR (?,,PC) ; ...will also be frozen indirectly)
; Program must have been somewhere in the SWFORK routine when it got this
; interrupt (probably at WFORK%). The user can use the CONTINUE command to
; return to this routine later. I will DEBRK% this interrupt now so that if
; the user wants to REPLAY a photo session the ^A, ^Z, and ^X interrupts will
; work there.
DMOVE T1,@LEVTAB+.ITRLV-1 ;get PC + flags
TXO T1,PC%USR ;abort jsys (WFORK%) I interrupted
MOVEI T2,ENDCMD ;have program return here
DMOVEM T1,@LEVTAB+.ITRLV-1
DEBRK% ;dismiss interrupt (return to ENDCMD)
; Refer to the CONTINUE command to see how the inferior exec is continued
;-----------------------------------------------------------------------------
; Routine to handle interruption of a replay session.
IRREPL: MOVE T1,SAC+T1 ;restore register saved earlier
BLTMOV (F,P,SAC) ;save registers F to P in SAC
CALL REPDTI ;deassign interupt characters for replay
CALL REPRCW ;reset CCOC + terminal width for replay
JRST ENDCMD ;go get a command
; Refer to the CONTINUE command to see how the replay session is continued
;=============================================================================
; Handles ^A, ^Z interrupts to vary replay speed
; here to increase speed of replay
CTRLA: PUSH P,T1 ;save needed AC's
PUSH P,T2
SKIPG T1,WAITIM ;get present wait time
JRST CTRLA5 ;jump if wait time is already zero
IDIVI T1,2 ;half it
CAMGE T1,WAITMN ;is it less than the minumum wait time?
SETZ T1, ;yes, set wait time to zero
CAIN T1,^D16 ;don't use wait times of 4,8 or 16
MOVEI T1,^D2 ;since resolution of DISMS% = 20ms
MOVEM T1,WAITIM ;save new wait time
; must check to see if instruction I interrupted was DISMS% if it was then
; I must abort it so user does not have to wait for it to finish for this
; increase in replay speed to take effect.
PUSH P,T3 ;save needed Ac
DMOVE T1,@LEVTAB+.CALV-1 ;get PC + flags
CAIN T2,REDISM+1 ;was it executing DISMS% ?
TXON T1,PC%USR ;yes, have DEBRK return execution to...
DMOVEM T1,@LEVTAB+.CALV-1 ; ...instruction following DISMS%
POP P,T3 ;restore AC's
JRST CTRLA9 ;done
CTRLA5: TMSG <> ;let user know I can't make speed
; of replay go any faster
CTRLA9: POP P,T2 ;restore AC's
POP P,T1
DEBRK% ;dismiss interrupt
; here to decrease speed of replay
CTRLZ: PUSH P,T1 ;save needed AC's
SKIPG T1,WAITIM ;is present wait time zero
CALL CTRLZ5 ;yes, abort SOUT% if necessary
IMULI T1,2 ;double it
SKIPG T1 ;was result zero?
MOVEI T1,1 ;yes, set time to wait to 1
CAMGE T1,WAITMN ;is it less than the minumum wait time?
MOVE T1,WAITMN ;yes, use the minimum wait time
CAIN T1,^D4 ;don't use wait times of 4,8 or 16
MOVEI T1,^D32 ;since resolution of DISMS% = 20ms
MOVEM T1,WAITIM ;save new wait time
POP P,T1 ;restore AC's
DEBRK% ;dismiss interrupt
; This routine willcheck to see what instruction ^Z interrupted. If it was
; SOUT% the I must abort it to have decrease in replay speed to take effect.
CTRLZ5: PUSH P,T1 ;save a register
PUSH P,T2
PUSH P,T3
DMOVE T1,@LEVTAB+.CZLV-1 ;get PC + flags
CAIN T2,RESOUT+1 ;was it executing SOUT% ?
TXON T1,PC%USR ;yes, have DEBRK return execution to...
DMOVEM T1,@LEVTAB+.CZLV-1 ; ...instruction following SOUT%
POP P,T3 ;restore AC's
POP P,T2
POP P,T1
RET ;return to caller
;=============================================================================
; Handles ^C interrupts
;-----------------------------------------------------------------------------
; This routine will handle ^C interrupts during an active replay and/or
;photo session. If ^C during REPLAY then the terminal width and speed will
;be restored before HALTF%. They will be set again if the user decides
;to continue. If ^C during an active photo session (user must be at the "PHOTO>"
;command level - got there using ^X) then logging will be disabled and a warning
;will be given. Recording will be enabled again if the user decides to continue.
CTRLC: PUSH P,T1 ;save needed AC's
PUSH P,T2
PUSH P,T3
PUSH P,T4
TMSG <^C
>
TXNN F,F%CCOW ;are CCOC + term.width altered
JRST CTRLC3 ;no
CALL REPRCW ;yes, restore it temporarly
TXO F,F%CCOW ;insure they are set again after HALTF%
CTRLC3: TXNE F,F%STRT ;skip if no photo session in progress
TXNE F,F%LOGD ;is logging disabled?
JRST CTRLC5 ;yes - don't need to disable it
RECMSG (< [Logging disabled>)
MOVE T1,TTYPDE ;get the TTY designator of our PTY
DOBE% ;wait until all output to PTY completed
JERR (?,,PC)
RFMOD% ;get jfn mode word for PTY
JERR (?,,PC)
TXC T2,TT%OSP ;toggle "^O..." switch
SFMOD% ;set it
JERR (?,,PC)
CTRLC5: HRROI T1,[ASCIZ/%WARNING: A photo session is in progress. Don't forget to "@CONTINUE" later.
/]
TXNE F,F%STRT ;is a photo session in progress?
PSOUT% ;yes, display message
HALTF% ;stop program for a while
TXNE F,F%STRT ;skip if no photo session in progress
TXNE F,F%LOGD ;was logging previously disabled?
JRST CTRLC9 ;yes - no need to enable it again
;T2 - should still contain JFN mode word of PTY
MOVE T1,TTYPDE ;get the TTY designator of our PTY
TXC T2,TT%OSP ;toggle "^O..." switch
SFMOD% ;set it
JERR (?,,PC)
RECMSG (< [Logging enabled>)
CTRLC9: TXNE F,F%CCOW ;CCOC + term.width temporarly reset?
CALL REPSCW ;yes, restore them again
MOVEI T1,.PRIIN ;prime input with ^R to get "PHOTO>"...
MOVEI T2,"" ; ...prompt back
STI%
JERR (?,,PC)
CCEXIT: SETNAM (PHOTO,PHOTO) ;set private & system names of program
POP P,T4 ;restore AC's
POP P,T3
POP P,T2
POP P,T1
DEBRK% ;dismiss interrupt
SUBTTL PMAPing Area
;-----------------------------------------------------------------------------
.ORG 100000 ;start area for PMAPing at this address
HLPFPG==._^D-9 ;first page of pmap area for HLP
HLPPLN==5 ;length of pmap area (must be at least 2)
BLOCK <HLPPLN*1K>
HLPLPG==<._^D-9>-1 ;last page of pmap area for HLP
IFN <^D36-<^L<._^D27>>>,<PRINTX ?Data not on page boundary>
;-----
FRKFPG==._^D-9 ;first page of pmap area for FRK
FRKPLN==1 ;length of pmap area
BLOCK <FRKPLN*1K>
FRKLPG==<._^D-9>-1 ;last page of pmap area for FRK
IFN <^D36-<^L<._^D27>>>,<PRINTX ?Data not on page boundary>
;-----
LOGFPG==._^D-9 ;first page of pmap area for LOG file
LOGPLN==8 ;length of pmap area (must be at least 2)
BLOCK <LOGPLN*1K>
LOGLPG==<._^D-9>-1 ;last page of pmap area for LOG file
IFN <^D36-<^L<._^D27>>>,<PRINTX ?Data not on page boundary>
;-----
GENFPG==._^D-9 ;first page of GENeral pmap area
GENPLN==14 ;normal length of pmap area (must be at least 2)
GENLMX==700-GENFPG ;maximum length of pmap area
BLOCK <GENPLN*1K>
GENLPG==<._^D-9>-1 ;last page of GENeral pmap area
IFN <^D36-<^L<._^D27>>>,<PRINTX ?Data not on page boundary>
;NOTE: Don't place any pmap area after GEN due to value of GENLMX
.ORG ;reset relocation counter back to previous value
;-----------------------------------------------------------------------------
LITPOL: XLIST ;so user can identify literal pool when running DDT
LIT ;put literals here
LIST
END <EVLEN,,ENTVEC> ;set length and start of entry vector