.MCall .Module .Module KEDIO3 RELEASE=V02 VERSION=16 COMMENT=,IDENT=NO,AUDIT=NO,GLOBAL=.KEDI3 ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. ; ; 016 22-Feb-1997 ARB Missing JRMon Definition ; ;+ ;COND ; VIRT$C ; RSTS$ ;- ;MODULE: KedIO3 ; ;ABSTRACT: ; ; This is the third part of the system dependent package ; to support the keypad editor under RT-11. It contains ; routines for nesting input modes and allocation of ; memory. ; .SbTtl KedIO3 RT-11 system dependent routines .Enable LC .Enable GBL .SbTtl Assembly parameters .IIf NDF VT10$0 VT10$0 = 1 ;assume VT100 version .IIf NDF VT62$ VT62$ = 0 ;Assume no VT62 support .IIf NDF Virt$ Virt$ = 0 ;assume normal, not Virtual job .IIf NDF Rsts$ Rsts$ = 0 ;assume NO RSTS support ; ;MIN$C NE To enable owner checking of output volume for ; digital and to disallow output to a 'DIGITAL' ; owned volume. ; .IIf NDF MIN$C MIN$C = 0 ;Assume not MINC version ; ; display subtitles for the flavor we are assembling ; .SbTtl .IIf NE Virt$ .SbTtl Virtual Ked .IIf EQ Virt$ .SbTtl Normal Ked .IIf NE VT10$0 .SbTtl for VT100 terminal .IIf EQ VT10$0 .SbTtl for VT52 terminal .IIf NE MIN$C .SbTtl with MINC owner checking enabled .SbTtl .SbTtl Macro Definitions ; ; RT-11 Macro Definitions ; ; From SYSMAC.SML .MCall .Assume .MCall .Br .MCall .Chain .Close .CMkT .CSISpc .MCall .Delete .DStatus .MCall .Enter .Exit .MCall .Fetch .MCall .GTim .GtJb .GVal .MCall .HReset .MCall .Lookup .MCall .MrkT .MTAtch .MTDtch .MTGet .MTSet .MCall .Peek .Poke .Print .Purge .PVal .MCall .QSet .MCall .RCtrlO .ReadW .Renam .ReOpen .MCall .SCCA .SErr .SetTop .SpFun .SReset .MCall .Savestatus .MCall .TtInR .TtyIn .TtyOut .MCall .WritW .MCall ...CMY ...CMZ ; From KEDMAC.MLB .MCall ...... Bon Boff DfnChn .MCall Pop $Print PSect Push SavReg .MCall CmdOn CmdOff IsCmd .MCall CROn CROff IsCR .MCall ExeOn ExeOff IsExe .MCall ExIOn ExIOff IsExI .MCall JouOn JouOff IsJou .MCall JReOn JReOff IsJRe .MCall LrnOn LrnOff IsLrn .MCall RecOn RecOff IsRec .MCall SerOn SerOff IsSer .MCall SLFOn SLFOff IsSLF .If EQ Virt$ .MCall Sob .EndC; EQ Virt$ .SbTtl Equated symbols .SbTtl Equated symbols ; ; RT11 SYSCOM locations ; JStk =: 42 ;stack address JSW =: 44 ;status word J$NoSL =: 000020 ;disable single line editor J$NoWt =: 000100 ;don't wait for I/O on terminal J$Chain =: 000400 ;chain bit J$Rntr =: 020000 ;reenter bit of JSW J$Char =: 010000 ;character (not line) mode J$LC =: 040000 ;LC J$SpMod =: J$Char!J$LC ;LC and character mode ; ; RT11 chain area ; JChain =: 500 ;DBLK for program to chain to JChnArg =: 510 ;beginning of arguments for chain ; ; RMON offsets ; JRMon =: 54 ;RMON Base ;016 Versi$ =: 276 ;offset in RMON to monitor version MinVer =: 5 ;minimum version supported is V5 ; ; EMT CODES ; .GtJb =: 20 ;code for .GtJb request ; ; RT11 SYSCOM locations ; JUSR =: 46 ;USR load address ; ; RMON offsets ; CCLRTS =: 242 ;BYTE 0 = not CCL, 0 <> CCL with args ;The above for RSTS RT11 RTS V3C USRLod =: 266 ;offset to USR load address ; ; EMT CODES ; .GVal =: 34 ;code for .GVal request ..GVal =: 0 ;subcode (Chan) for .GVal request ; ; Area for programmed requests is in the scrollers impure area. ; The label 'Area' contains the address of the 20 word area. ; ; ; CtrlC ; Scroller flag for Ctrl/C trapping, status word for .SCCA ; ; ; Symbols for allocation routine ; KLmt =: 3000 ;Largest handler space allocated KSmall =: 400. ;Smallest handler space allocated .SbTtl Define error macros $Ked$ = 1 ;Defined here but not in error module .If NE 0 ;This code is assembled in the error module ;+ ;ERROR ; .Page .SbTtl Errors from KedIO3 module .IIf NDF MIN$C MIN$C = 0 ;Assume not MINC version ;- .EndC; NE 0 ; ;The following code is included as an error section so that it will be ;pulled out and assembled in the error module also. In this module, the ;error macro is defined to print an error message and the help macro ;defined to set up a help message. In the error module, the macros are ;defined to assemble the message text. ; ;+ ;ERROR ; .MCall ErrDef ErrDef I3,Err ;Invoke macro to define error macro ;- ;+ ;HELPER ; .MCall HlpDef HlpDef I3 ;Invoke macro to define help macro ;- .SbTtl PSECT KEDIO .SbTtl $START - Setup to restart editor ;++ ;$Start ; ;functional description: ; ; setup stack and reenter bit to restart ; ;This routine does anything necessary before each command line ;to the editor. ; ;input: ; JStk = stack base ; ;output: ; tt input in normal mode ; stack reset ; mark time for 'working...' canceled ; reenter bit set, editor marked non active ; soft reset done ; aux files purged ; R0-R4 destroyed ;-- .Enable LSB $Start:: ;~x~ Pop R0 ;save return Clr TtInp ;normal mode input Mov JStk,SP ;reset stack Bis #J$Rntr,@#JSW ;set reenter bit Clr EdActv ;editor not active yet Push R0 ;return back to stack ;;; .CMkT Area,#0 ;cancel marktime outstanding .CMkT #CanMkt,,,Code=NoSet ;~x~cancel marktime outstanding .SErr ;~x~handle all errors ourselves Tst FStart ;first time thru? Bon ChainCk ;~x~No, check for chaining Mov SP,FStart ;indicate not first time thru 10$: ;~x~ Return ;~x~return ...... .SbTtl CHAINCK - Check for chained to ChainCk:: ;~x~check for chained to, if so, EXIT .If NE Rsts$ Tst Chain+2 ;chained to? .IfF; NE Rsts$ Tst Chain ;chained to? .EndC; NE Rsts$ Boff 10$ ;~x~no .Br $Exit ;drop thru .SbTtl $EXIT - return to monitor ;++ ;$Exit ; ;functional description: ; ; exit to rt11 monitor ; ;input: none ; ;output: none ;-- $Exit:: ;~x~ Mov #Chain,R0 ;point to DBLK, also set R0 <> 0 .If NE Rsts$ Tst 2(R0) ;were we chained to? .IfF; NE Rsts$ Tst @R0 ;were we chained to? .IfTF; NE Rsts$ Boff 30$ ;~x~no Mov #JChain,R1 ;point to system DBLK area .IfT; NE Rsts$ Tst Rt$Rts ;under RSTS? Bon 20$ ;~x~no Mov (R0),@JRMon ;Set PPN for chain (NOTE: PPN$ is 0) **PVAL** ;Note;this must NOT, repeat NOT, be done under real RT-11! 20$: ;~x~ Tst (R0)+ ;skip PPN word .EndC; NE Rsts$ Call Mov401 ;~x~move dblock .Chain ;~x~chain back ...... 30$: ;~x~ .Exit ;~x~do an exit ...... PSect KEDIO .SbTtl RSTART - Begin address for Ked ;+ ;RSTART ; ;- .Enable LSB RStart:: ;~x~ ...CMZ ; ExeOff ;Not executing a macro Clr FStart ;Set first time thru flag Mov #Chain,R1 ;Point to place for return DBLK Clr Chain+2 ;Assume not chained to Bit #J$Chain,@#JSW ;Were we chained to? Boff 20$ ;~x~No .If NE Rsts$ Mov #JChnArg,R0 ;Point to chain arguments Mov (R0)+,(R1)+ ;Save possible PPN .IfF; NE Rsts$ Mov #JChnArg+2,R0 ;Point to chain arguments (skip PPN) .EndC; NE Rsts$ Call Mov401 ;~x~Save DBLK Mov #ChnArg,R1 ;Now point to area for command line 10$: ;~x~ MovB (R0)+,(R1)+ ;Move a char Bne 10$ ;~x~Until a NULL is moved 20$: ;~x~ Mov #Area+2,Area ;Set area pointer .GTim Area,Area ;~x~Ask for time to cause date rollover ;;; .GVal Area,#0 ;Check the first word of the monitor .GVal #GZero,Code=NoSet ;~x~Check the first word of the monitor .If NE Rsts$ Mov R0,Rt$Rts ;= 0 -> RT RTS under RSTS ;<> 0 -> RT11 itself .IfF; NE Rsts$ Tst R0 ;Is this RSTS? Bon 40$ ;~x~No, all is well Call 30$ ;~x~ Br Fatal ;~x~ ............. 30$: ;~x~ ;+ ;ERROR .If EQ Rsts$ ERROR ,F ;~x~ .EndC; EQ Rsts$ ; ;This version does not support RSTS ;- .IfTf; NE Rsts$ .IfF; NE Rsts$ 40$: ;~x~ .IfT; NE Rsts$ Boff 60$ ;~x~version not important under RSTS? .IfTF; NE Rsts$ ;;; .GtJb Area,#GetJob,#-1 ;get data about this job .GtJb #GtJob,Code=NoSet ;~x~get data about this job ;;; Bcs ??? ;~x~ ;;; .GVal Area,#Versi$ ;get RT version number .GVal #GVersi,Code=NoSet ;~x~get RT version number ;;; Bcs ??? ;~x~failed SwaB R0 ;fix to make binary order proper Cmp R0,#MinVer*400 ;is this at least version 5? Bhis 60$ ;~x~yes, continue Call 50$ ;~x~ Fatal: ;~x~ Jmp $Fatal ;~x~ .............. 50$: ;~x~ ;+ ;ERROR ERROR ,F ;~x~ ; ;This version does not support old RT versions ;- .EndC; NE Rsts$ 60$: ;~x~ Jmp Ked ;~x~command module entry point ........... ;;; .GVal Area,#0,Code=List ;check the first word of the monitor GZero: ;~d~ .Byte ..GVal,.GVal ;~d~ .Word 0 ;~d~ ;;; .GVal Area,#Versi$,Code=List ;get RT version number GVersi: ;~d~ .Byte ..GVal,.GVal ;~d~ .Word Versi$ ;~d~ ;;; .GtJb Area,#GetJob,#-1,Code=List GtJob: ;~d~ .Byte 0,.GtJb ;~d~ .Word GetJob ;~d~ .Word -1 ;~d~ .SbTtl $ALLOC - Allocate memory area and playground ;++ ;$Alloc ; ;functional description: ; ; Allocate memory space for r/w area and ; playground ; ;input: none ; ;output: ; R0 -> start of playground ; R1 -> past end of playground ; R2 = blocking factor, scbmin*n ; HdlBas -> base of handler area ; PasBuf,PasSiz set to paste buffer area ; MapSt set to start of screen map ; R3,R4 destroyed ; ; KED prints an error message and exits if there is not enough ; space to run. ;-- .Enable LSB $Alloc:: ;~x~ ...CMY DfnChn ;~x~reset channels Mov #H.Max*V.Max+<4*FB$Siz>,R1 ;screen map is allocated here ;and buffers for Aux files Mov ..MacN,-(SP) ;get number of macro definitions Mov @SP,-(SP) ; and mult by 6 Asl @SP ; *2 Add (SP)+,@SP ; *3 Mov @SP,LrnLim ;save *3 value Asl @SP ; *6 Add @SP,R1 ;add into space requirement Add ..MacS,R1 ;add buffer into space requirement ;NOTE: the buffer must immediately follow the directory area ; the buffer address is used as a stopper for the search! .If EQ Virt$ ;;; .GVal Area,#USRLod ;USR load address .GVal #GUSRLd,Code=NoSet ;~x~USR load address Sub #2,R0 ;adjust for last true loc Cmp R0,JLmt ;try to keep USR in core Blos 20$ ;~x~ask for all- won't help Cmp R0,..MaxM ;check the limit Blo 10$ ;~x~not above it Mov ..MaxM,R0 ;use MIN(USRLod,..MaxM) 10$: ;~x~ .SetTop ;~x~ask for it Call Aloc ;~x~figure spaces Bcs 20$ ;~x~not enough space- try again Cmp R2,#2*SCbMin ;USR swap limit blocking factor Bhis 30$ ;~x~ok- no USR swap 20$: ;~x~ Mov #USRSwp,@#JUSR ;swap usr over base of program .IfTF; EQ Virt$ .SetTop ..MaxM ;~x~try for all memory Call Aloc ;~x~fix spaces Bcs 40$ ;~x~fatal - no memory 30$: ;~x~ Mov JLmt,R0 ;start of r/w area Add @SP,R0 ;-> end of macro directory area Sub (SP)+,R1 ;reduce fixed part Mov R0,TtBfr ;-> macro area Add ..MacS,R0 ;-> end of macro area Sub ..MacS,R1 ;reduce fixed part Push #FB$Siz ;push common constant Mov R0,LInBuf ;point to buffer Mov R0,LOuBuf ; load, save, & recover (@) share Mov R0,JInBuf ; a buffer Add @SP,R0 ;next free address Sub @SP,R1 ;reduce fixed part Mov R0,JOuBuf ;point to journal output buffer Add @SP,R0 ;next free address Sub @SP,R1 ;reduce fixed part Mov R0,AInBuf ;point to aux input buffer Add @SP,R0 ;next free address Sub @SP,R1 ;reduce fixed part Mov R0,AOuBuf ;and to aux output buffer Add @SP,R0 ;next free address Sub (SP)+,R1 ;reduce fixed part Mov R0,MapSt ;save start of map Add R1,R0 ;start of playground Mov R0,R1 ; Sub R2,R4 ;get playground size Add R4,R1 ;end of playground = Mov R1,PasBuf ; start of paste buffer Sub R4,R3 ;use rest of space for paste buffer Mov R3,PasSiz ;size of paste buffer Add R3,R1 ;end of paste buffer = .IfT; EQ Virt$ Mov R1,HdlBas ; start of handler space .IfF; EQ Virt$ Mov #LowSpc,HdlBas ;use low memory area for handlers .IfTF; EQ Virt$ Mov PasBuf,R1 ;return pointer to end of playground .EndC; EQ Virt$ Return ;~x~ ...... 40$: ;~x~ Pop <> ;adjust stack Call 50$ ;~x~ Jmp $Fatal ;~x~ .............. 50$: ;~x~ ;+ ;ERROR ; ERROR ,F ;~x~ ; ;The memory available is less than the minimum required by KED in ;order to run. ;- .If EQ Virt$ ;;; .GVal Area,#USRLod,Code=List ;USR load address GUSRLd: ;~d~ .Byte ..GVal,.GVal ;~d~ .Word USRLod ;~d~ .EndC; EQ Virt$ .SbTtl Dynamically acquired memory layout .Rem % JLmt -> +-------+------------------------ LBfTab=JLmt | | ^ ^ ^ | | ..MacN*6. | | | | v (8.*6) | | TtBfr -> +-------+-- | | | | ^ | | | | ..MacS | | | | v (512.) | | LInBuf -> +-------+-- | | LOuBuf=LInBuf | | ^ | | JInBuf=LInBuf | | 512. | | | | v | | JOuBuf -> +-------+-- | | | | ^ | | | | 512. | | | v | | AInBuf -> +-------+-- | | | | ^ | | | | 512. | | | | v | | AOuBuf -> +-------+-- | | | ^ | | | | 512. | | | | v | | MapSt -> +-------+-- | | | | ^ | | | | H.Max*V.Max | | | | v v | R0 -> +-------+---------------- | | | ^ | | | ? | | | v | PasBuf -> +-------+-- | R1=PasBuf | | ^ | | | ? | | | v | HdlBas -> +-------+-- (if not KEX) | | | ^ | | | | | | v v top of job mem +-------+------------------------ = 0 if KEX = /4 if KLmt < /4 then = KLmt if KSmall > /4 then = 0 % .SbTtl ALOC - Allocation helper ;++ ;Aloc ; ;functional description: ; ; allocation helper routine ; ;input: ; R0 = top address allowed ; R1 = fixed r/w requirements ; ;output ; R1 = fixed r/w requirements ; R2 = blocking factor ; R3 = total r/w space available ; R4 = space required for playground + paste buffer ;-- .Enable LSB Aloc: ;~x~ .If NE Rsts$ Tst Rt$Rts ;running on RSTS? Boff 20$ ;~x~yes .EndC; NE Rsts$ .If EQ Virt$ Mov R0,R3 ;make guess Sub JLmt,R3 ;total space Asr R3 ;/2 Asr R3 ;/4 Tst GetJob ;which job are we? Bon 20$ ;~x~not the background, so never fetch Cmp R3,#KLmt ;largest handler space allowed Blos 10$ ;~x~less- ok Mov #KLmt,R3 ;use max 10$: ;~x~ Cmp R3,#KSmall ;too small?? Bhi 30$ ;~x~no- ok 20$: ;~x~ Clr R3 ;use nothing for handler space 30$: ;~x~ Neg R3 ; Add R0,R3 ;make new top address .IfF; EQ Virt$ Mov R0,R3 ;copy top address .EndC; EQ Virt$ Sub R1,R3 ;- fixed requirements Blos 50$ ;~x~not enough memory Sub JLmt,R3 ;- bottom Blos 50$ ;~x~not enough memory ;RWTop-FixRW-JLmt->PlyGnd space Mov #*2+Hystrs,R4 ;minimum playground size ;SpcMin = minimum screen space ;ScBMin = minimum blocking size ;Hystrs = hysterisis for mov Clr R2 ;blocking factor guess Cmp R4,R3 ;enough memory for min?? Bhi 50$ ;~x~no- fail 40$: ;~x~ Add #ScBMin,R2 ;adjust blocking factor Add #ScBMin*3,R4 ;guess next size and allow ;for paste buffer Cmp R4,R3 ;ok?? Blos 40$ ;~x~yes- keep trying Sub #ScBMin*3,R4 ;total size back Tst (PC)+ ;clear carry, skip SEC ; ; return error from aloc routine if not enough memory available ; 50$: ;~x~ Sec ;return error- no memory Return ;~x~ ...... .SbTtl SETCOM - Set up the initialization command file ;+ ;SETCOM - Set Up the Initialization Command File ; ;FUNCTIONAL DESCRIPTION: ; ; Use $OpIni to see if there is an initialization file and open it. ; We do this here so that we can query the user if necessary before ; we do the recovery process (if any). The init file (if any) ; will be reopened and executed later by the COMMND routine. ;- .Enable LSB SetCom:: ;~x~ Clr ComSsn ;Assume no initialization file Tst NSwt ;Did the user specify /NOCOMMAND (/N?) Bne 20$ ;~x~Yes, skip initialization file Mov #IniFil,R0 ;Save initialization file spec Mov #InitFl,R1 ; in command file definition Call Mov401 ;~x~ Cmp -(R1),#IllR50 ;Was an extension specified? Bne 10$ ;~x~Yup, okay Mov KedTyp,@R1 ;Nope, use .KED file type 10$: Call $OpIni ;~x~Find and open an initializatn file Bcc 30$ ;~x~Got it! Bne 20$ ;~x~Didn't get it but it was the default ; so no error Jsr R4,ErrPmt ;~x~Ask if user wants to continue .Word EriNIF ; without her init file Bne Sortie ;~x~No, user wants out 20$: Clr HlpTxt ;~x~No help messages to give Mov SP,NSwt ;Remember we don't have an init file Return ;~x~No errors return from here ...... 30$: Mov SP,ComSsn ;~x~This session has a command file Return ;~x~No errors return from here ...... .If NE 0 ;+ ;ERROR EriNIF::.Ascii "W-Command file not found - Continue (Y,N)? " ;~d~ .Byte ;~d~ ;User specified command file isn't found. User should respond Y to continue ;and enter the work session or N to stop now. ;- .EndC; NE 0 .Dsabl LSB .SbTtl SETREC - Recover File Processing ;+ ;SETREC ; ;FUNCTIONAL DESCRIPTION: ; ;Set up the Jo$Inp auxiliary file descriptor with the /RECOVER file ;information. ;- .ENABL LSB SetRec:: ;~x~ Clr RecSsn ;Assume no recover file Mov #RecFil,R0 ;Save recover file spec Mov #,R1 ; in input journal file definition Call Mov401 ;~x~ Mov #,R1 ;Point to the recover file spec Tst @R1 ;Was a recover file specified at all? Beq 40$ ;~x~Nope Tst 2(R1) ;Was a file name specified? Bne 10$ ;~x~Yup Mov #OutFil,R3 ;Nope, copy the output file name Mov 2(R3),2(R1) ; to the journal file spec Mov 4(R3),4(R1) ; 10$: Cmp 6(R1),#IllR50 ;~x~Was an extension specified? Bne 20$ ;~x~Yup, okay Mov JouTyp,6(R1) ;Nope, use .JOU file type 20$: Mov #Jo$Inp,R4 ;~x~Point to the journal input file Clr R2 ;Say the recover file is already there Call $OpF50 ;~x~Open recover file Bcc 30$ ;~x~All set, go process Jsr R4,ErrPmt ;~x~Ask if user wants to continue .Word EriNRF ; without recovery Beq 40$ ;~x~Yes Sortie: Mov SP,Inspct ;~x~No, set inspect and purge files ; to suppress the "Output files Call PrgAll ;~x~ purged" message from SpcQut CallR SpcQut ;~x~ and jump to the quit routine .............. 30$: Mov SP,RecSsn ;~x~This session has a recover file 40$: Return ;~x~No errors are returned from this ...... ; routine .If NE 0 ;+ ;ERROR EriNRF::.Ascii "W-Recover file not found - Continue (Y,N)? " ;~d~ .Byte ;~d~ ;- .EndC; NE 0 .Dsabl LSB .SbTtl SETJOU - Setup journal file ;+ ;SetJou ; ;functional description: ; ; If there's a journal file spec: ; o Set up journal file (directory entry made permanent) ; o Turn on flag to indicate this session is being journaled ; o Turn on journaling ; If not: ; o Indicate there's no journaling this session ; o Turn off journalling ; ;input: ; JouFil contains journal file spec ; ;output: ; JouFil is open on file descriptor Jo$Out ; journaling is on ; ;registers used: R2-R4 ; ;-- .Enable LSB SetJou:: ;~x~ Tst (PC)+ ;Do we want to always journal? ..Jou:: .Word 0 ;SIPP to non-zero if yes Beq 10$ ;~x~No Tst Inspct ;Inspect overrides journal if user ; patched for automatic journaling Bon 80$ ;~x~Inspect mode, so don't journal Br 20$ ;~x~Go startup the journal ........... 10$: Tst JouFil ;~x~Did the user ask for a journal file? Boff 80$ ;~x~No, remember no journaling Tst Inspct ;Are we trying to journal and inspect? Bon 100$ ;~x~Yup, no modifications to journal 20$: Mov #Jo$Out,R4 ;~x~Yes, open journal file spec Mov #JouFil,R2 ;Point to jou DBlk Mov #OutFil,R3 ;Copy the output file name Tst @R2 ;Was a device specified? (in case the ; user sipped ..JOU above) Bne 30$ ;~x~Yup Mov InitDk,@R2 ;No, default to DK 30$: Tst 6(R2) ;~x~Was a device specified? (in case the ; user sipped in a NOP above) Bne 40$ ;~x~Yup Mov JouTyp,6(R2) ;No, default to .JOU 40$: Tst 2(R2) ;~x~Was a file name specified? Bne 50$ ;~x~Yup Mov 2(R3),2(R2) ; to the journal file spec Mov 4(R3),4(R2) ; 50$: Call FlSam1 ;~x~Compare output file name to journal Beq 120$ ;~x~Error, they can't be the same Mov SP,JouSsn ;This session has a journal file Tst Jo$Inp+f$fnam ;Is there a recover file also? Beq 60$ ;~x~Nope Mov #JouFil,R2 ;Compare journal file name to Mov #,R3 ; recover file name Call FlSam1 ;~x~Are they identical? Bne 60$ ;~x~No Call $RnRec ;~x~Go rename the recover file 60$: Mov #Jo$Out,R4 ;~x~Point to journal file descriptor Mov #JouFil,R2 ;Point to journal DBlk again Mov SP,JouOp ;Tell $OpFil to use "journal" messages Call $OpF50 ;~x~Open the journal as temporary Bcs 70$ ;~x~Error occured Cmp JouMin,JouOp ;Is there > minimum room for the .jou? Blt 110$ ;~x~Yup Mov JouOp,R0 ;Nope Mov #EriJAv,R1 Mov #EriJBk-EriJAv,R2 ;Does user want to continue without ; a journal? .IF NE VIRT$ Call ArgPmt ;~x~ KEX prompts with routine in KEDIO2 .IFF Call ArgPm1 ;~x~ KED has it's own routine in this .ENDC ;NE VIRT$ ; overlay Beq 110$ ;~x~User said yes, continue Call $Prgfl ;~x~User said to bag journaling ;If we get here if either we can't open the journal file, or the user opts not ; to journal. We prompt to see if user wants to continue with the session. 70$: Jsr R4,ErrPmt ;~x~Can't journal, still wanna edit? .Word EriJUO ; Bne 90$ ;~x~User has no confidence in her system 80$: Clr JouSsn ;~x~Continue without journal JouOff ; Tst (PC)+ ;No error 90$: Sec ;~x~Error, end session on return Mov #0,JouOp ;*C* Tell $OpFil to use "aux file" Return ;~x~ messages ...... 100$: ;~x~ ;+ ;ERROR ERROR ,F ;~x~ ;Attempt to journal an "inspect mode" session. In inspect mode there are ;no modifications made, so there is nothing to journal. The user must ;decide to continue and inspect the file without journaling, or start over ;with a new command line. ;- ; If we get here, the user has a journal file to use. The number of ; available blocks is still in JouOp. First we want to see if the ; recover file has the same name as the journal file. ; If they have the same name, we rename the recover file. ; Then we write to the last block so we can reserve that space. Close ; and reopen with .LOOKUP 110$: Dec f$bctr(r4) ;~x~Force write Dec JouOp ; to last block Mov JouOp,f$blkn(R4) ; Mov #JouFil,R2 ;Reset R2 => journal DBlk Mov SP,JouOp ;Tell $OpFil that this is the journal ; file and not to use prompts ; (file exists) Call $ClsFl ;~x~Write last block and close BicB #fst$io,f$sts(R4) ;Fake that this is an input file ; so that a lookup is done when ; we reopen instead of an ENTER Call $OpF50 ;~x~Reopen the file Bcs 70$ ;~x~Error occured BisB #fst$io,f$sts(R4) ;Mark it correctly as an output file Mov #FB$Siz,F$BCtr(R4) ;Empty buffer Clr f$BlkN(R4) ;First block Clr JouOp ;Tell $OpF50 to use "aux file" mesages Clr JoFCnt ;No modifications since last write Clr JoSave ;Delete the journal on exit/quit Mov #JTmpBf,JTPtr ;Temp journal buffer empty JouOn ;Begin with journaling on Return ;~x~ ....... 120$: ;~x~ ;+ ;ERROR ERROR ,F ;~x~ ;Journal and output file have same filespec. ;- .List CND .If NE 0 ;never assemble here ;+ ;ERROR EriJAv:: ;~d~ .Ascii "W-Only " ;~d~ EriJBk:: ;~d~ .Ascii "nnnnn blocks available for journal file" ;~d~ .Ascii / - Continue (Y,N) ? / ;~d~ .Byte ;~d~ ;less than 10 blocks are available for the journal file. number of ;blocks are printed in decimal (nnnnn). and the user is asked ;if she would like to proceed with journaling. If she says no, she will ;be prompted to see if she would like to continue with the editing session at ;all. ;- ;+ ;ERROR EriJFS:: ;~d~ .Ascii /W-Journal file size below minimum - Continue (Y,N) ? / ;~d~ .Byte ;~d~ ;Journal file is below set minimum. If user opts to continue, journaling ;will be turned on, but the journal file may become full quickly. ;- ;+ ;ERROR EriJUO:: ;~d~ .Ascii /W-Unable to open journal file - Continue (Y,N) ? / ;~d~ .Byte ;~d~ ;Fetch or enter failed on the journal file ;- .EndC .NList CND .DsAbl LSB .SbTtl $RNREC - Rename the recover file to .JBK type ; ;$RnRec ; ;functional description: ; ;The recover file is ; ;Output: ; ; R0,R1,R2,R4 destroyed ; .Enabl LSB $RnRec: Mov #Jo$Inp,R4 ;~x~Point to the recover file descriptor Call $ClsFl ;~x~Close the file so we can rename it Mov JInBuf,R1 ;Use recover buffer for rename data Mov #,R0 ;Point to recover file name Call Mov401 ;~x~Copy the original name Mov #,R0 ;Point to recover file name Call Mov401 ;~x~Copy it again Mov #^rJBK,-(R1) ;Change the extension to .JBK ..JBAK ==: .-2 ;Extension for journal backup file .Rename Area,Jo$Inp,JInBuf ;~x~Rename recover file Bcs 10$ ;~x~Error Mov #^rJBK, ;Fix file descriptor to have .JBK Clr R2 ;Say everything's setup, just open it CallR $OpF50 ;~x~Open and return from there .............. 10$: ;~x~ ;+ ;ERROR ERROR ,F ;~x~ ;Recover and journal files have same name so we tried to rename ;the recover file to .JBK, but failed. Probably because a protected ;file by that name already exists. ;- .Dsabl LSB .IF EQ VIRT$ ; ;ARGPM1 ; ;FUNCTIONAL DESCRIPTION: ; ; Issue error prompt with decimal argument ; Same as ARGPMT in KEDIO2. Duplicated in this overlay for KED. ; ;INPUT: ; R0 = value of argument ; R1 => error prompt message ; R2 = offset to argument place within message ; ;OUTPUT: ; z =0 if reply was yes ; z<>0 if reply was no ; R0,R1,R2 modified ; .Enable LSB ArgPm1: ;~x~ Push ;save registers (can't use savreg,will ; destroy return condition codes) Call $GtMsg ;~x~get message text into memory Mov PlyGnd,R5 ; Mov #30$,R3 ;point to code Mov #40$-30$/2,R4 ;words of code to move 10$: ;~x~ Mov (R3)+,(R5)+ ; Sob R4,10$ ;~x~ Mov R5,-4(R5) ;point word to message Push R5 ;and save destination address 20$: ;~x~ MovB (R1)+,@R5 ;move a byte CmpB (R5)+,# ;done? Bne 20$ ;~x~no Pop R1 ;pop message address into R1 Pop ;pop saved registers Add R2,R1 ;address in message of numeric part Call DecAsc ;~x~make into ascii CallR @PlyGnd ;~x~call the impure routine ............... ;This code moved to playground to keep KEDIO and message pure 30$: Jsr R4,@#ErrPmt ;~x~use error routine to .Word .-. ;print message Return ;~x~and return ...... 40$: ;~x~ .DsAbl LSB .ENDC ;EQ VIRT$ .End