.MCall .Module .Module KEDIO1 RELEASE=V02 VERSION=58 COMMENT=,IDENT=NO,AUDIT=NO ;>>>cleanup/sob/flag scan not done ; 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. ; ; 058 22-Feb-1997 ARB Globalization of RSTS labels ; ;MODULE: KedIO1 (formerly KEDIO) ; ;ABSTRACT: ; ; This is the root module of the system dependent ; package to support I/O ; .SbTtl KedIO1 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 VT10$0 .SbTtl for VT100 terminal .IIf EQ VT10$0 .SbTtl for VT52 terminal .IIf NE MIN$C .SbTtl MINC owner checking enabled .IIf NE Virt$ .SbTtl Virtual Ked .IIf EQ Virt$ .SbTtl Normal Ked .SbTtl .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 JUSR =: 46 ;USR load address JErB =: 52 ;SYS error byte E.FetE =: -4 ;.Fetch failed (I/O or load over USR/RMON) E.DirE =: -3 ;Directory I/O Error E.EOF =: 0 ;End of File E.IOEr =: 1 ;Read/Write IO error E.Siz =: 1 ;Enter -- space not available E.FNF =: 1 ;File Not Found E.Prot =: 3 ;Protected file JRMON =: 54 ;RMON base ; ; 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 Versi$ =: 276 ;offset in RMON to monitor version MinVer =: 5 ;minimum version supported is V5 Confg$ =: 300 ;offset in RMON to config word FB$ =: 000001 ;FB bit in above word Sysgn$ =: 372 ;offset in RMON to sysgen word MTTY$ =: 020000 ;multi-terminal bit in above word $TCfig =: 424 ;address of TTCNFG word CRLF$ =: 000002 ;issue at right margin XON$ =: 000200 ;use XON/XOFF LC$ =: 040000 ;allow lowercase Scope$ =: 100000 ;use for ; ; EMT CODES ; .CDfn =: 15 ;code for .CDfn request .CMkT =: 23 ;code for .CMkT request .Enter =: 2 ;code for .Enter request .GVal =: 34 ;code for .GVal request ..GVal =: 0 ;subcode (Chan) for .GVal request .GtJb =: 20 ;code for .GtJb request .LookUp =: 1 ;code for .LookUp request .MrkT =: 22 ;code for .MrkT request .SCCA =: 35 ;code for .SCCA request .SpFun =: 32 ;code for .SpFun request SP$Siz =: 373 ;.SPFUN code for size request ; ; Area for programmed requests is in the scrollers impure area. ; The label 'Area' contains the address of the 20 word area. ; .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 .Savest .MCall .TtInR .TtyIn .TtyOut .MCall .WritW .MCall ...CMY ...CMZ ;From KEDMAC.MLB .MCall ...... Bon Boff DfnChn .MCall Pop $Print PSect Push SavReg .If EQ Virt$ .MCall Sob .EndC; EQ Virt$ .MCall AbtOn AbtOff IsAbt .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 NE Rsts$ ; ; RSTS RT-11 SetSQB EMT ; .Macro .SetFQB Emt 360 .EndM .SetFQB ; ; RSTS RT-11 emulator trap Ctrl/C ; ;input: ; R0 = AST address ; .Macro .CtrlC EMT 362 .EndM .CtrlC ; ; RSTS RT-11 emt PREFIX ; .Macro .Prefix EMT 377 .EndM .Prefix ; ; RSTS RT-11 Clear FQB emt ; .Macro .ClrFQB EMT 370 .EndM .ClrFQB ; ; RSTS UUO request ; .Macro .UUO EMT 66 .EndM .UUO .EndC; NE Rsts$ .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 KedIO1 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 I1,Err ;Invoke macro to define error macro ;- ;+ ;HELPER ; .MCall HlpDef HlpDef I1 ;Invoke macro to define help macro ;- .SbTtl .SbTtl Psect Definitions ; ; Psect Definitions ; ; ; This module orders the psects for the link ; .SbTtl Patch Area PSect $PATCH ;Patch space Pat$:: ;Beginning of patch space ;;; .BlkW 100. ;~d~Should be plenty Pat$Zz:: ;end of patch space .=Pat$ ;back to the beginning of patch area ; >>>>>insert patches here<<<<< .IIf GT .-Pat$Zz .Error .-Pat$Zz ;patch area overflow ; .=:Pat$Zz ;back to end of patch area ;+ .If NE 0 ;+ ;ERROR Unable::.Ascii "W-Unable to set terminal characteristics - Continue (Y,N)? " ;~d~ .Byte ;~d~ ;can't modify terminal characteristics which may be wrong ;- .EndC; NE 0 PSect ASTSCT ;for completion routines ;(out of usr's way) PSect KEDCMD ;command module PSect IMPURE ;impure data PSect KEDIO ;for most of the code PSect .TXT. ;text PSect IODATA ;data for i/o use PSect VWTDAT ;vwatch data for root PSect KEDIO ;back for the code PSect KEDIO .SbTtl KEDSTR - Start address for Ked ; ; Start address for Ked ; ; The transfer address is not in the command module so other ; operating systems can initialize data areas before starting ; the editor. ; .Enabl LSB .Assume . EQ KedStr-2 Br 10$ ;~x~restart .............. KedStr:: ;~x~Start address for KED/K52, ;overlay start address for KEX/K5X Add #2,JLmt ;bump job limit for new LINK DfnChn ;~x~Start by defining channels 10$: Jmp RStart ;~x~Go for it .............. .Dsabl LSB .SbTtl SAVREG - Save Registers Coroutine ;++ ;SAVREG ; ;functional description: ; ; save registers coroutine ; ;input: none ; ;output: ; registers restored ; carry preserved ;-- .Enable LSB SavReg:: ;~x~ Push Push 12.(SP) ;return location Call @(SP)+ ;~x~exchange him for us Pop ,SAVE=*C* ;*c* restore the registers Pop <>,SAVE=*C* ;*C* dump the return Return ;~x~ ...... Old.R0 ==: 2 Old.R1 ==: 4 Old.R2 ==: 6 Old.R3 ==: 10 Old.R4 ==: 12 Old.R5 ==: 14 .SbTtl DECASC - Decimal to ascii unsigned ;++ ;DecAsc ; ;functional description: ; ; decimal to ascii- unsigned ;input: ; R0 = num ; R1 = byte pointer ; ;output: ; 5 bytes produced ;-- .Enable LSB DecAsc:: ;~x~ SavReg ;~x~clobber no regs Clr R4 ;leading zero suppress Mov #60$,R2 ;table address 10$: ;~x~ Clr R3 ;digit value 20$: ;~x~ Sub @R2,R0 ;divide by subtract Blo 30$ ;~x~underflow Inc R3 ;count it up Br 20$ ;~x~ ........... 30$: ;~x~ Add (R2)+,R0 ;correct- advance pointer Bis R3,R4 ;Set leading non-zero flag Bne 40$ ;~x~nope Tst @R2 ;last digit Beq 40$ ;~x~yes- always store MovB #,(R1)+ ;store a space Br 50$ ;~x~and continue ........... 40$: ;~x~ Add #,R3 ;make ascii digit MovB R3,(R1)+ ;store it away 50$: ;~x~ Tst @R2 ;end of table?? Bne 10$ ;~x~nope- next divisor Return ;~x~ ...... 60$: .Word 10000.,1000.,100.,10.,1,0 ;~d~divisors for decimal PSECT KEDIO .SbTtl $FETCH - Fetch handler ;++ ; $FETCH ; ;functional description: ; ; Fetch handler for device name pointed to by R0 ; ;Input: ; R0 contains address of handler name ; ;Output: ; Carry clear -- ok ; Carry set -- error ; ;R0 destroyed ;-- .Enable LSB $Fetch:: ;~x~ Push ;save pointer to handler name .Fetch HdlSpc,R0 ;~x~Fetch input handler .If EQ Virt$ Bcc 10$ ;~x~got it CmpB @#JErB,#E.FetE ;did the fetch fail on memory/IO? Bne 20$ ;~x~no, other problem, return Carry Set Mov #USRSwp,@#JUSR ;swap usr over base of program .SetTop ..MaxM ;~x~try for all memory Mov @SP,R0 ;point to name again .Fetch HdlSpc,R0 ;~x~Fetch input handler .IfTF; EQ Virt$ Bcs 20$ ;~x~no can do 10$: Mov R0,HdlSpc ;~x~save top of handler .IfT; EQ Virt$ Tst (PC)+ ;normal return .IfTF; EQ Virt$ 20$: ;~x~ .IfT; EQ Virt$ Sec ;~x~error .EndC; EQ Virt$ Pop ;*C* restore R0 and stack Return ;~x~ ...... .Dsabl LSB .SbTtl $READW - Read from main file .Enable LSB $READW:: ;~x~ .Br $WritW .SbTtl $WRITW - Write to main file $WRITW:: ;~x~ Mov R0,EMTBlk ;save R0 contents in case error EMT 375 ;~x~just issue a read request Bcc 30$ ;~x~no error CmpB @#JErB,#E.IOEr ;I/O error? Bne 30$ ;~x~no, pass it thru Push ;save work registers Mov EMTBlk,R2 ;point to emt block Mov MXIBlk,R1 ;assume input file .Assume RW.Chn EQ 0 CmpB @R2,#Ou$Chn ;output file? Bne 10$ ;~x~no Mov MXOBlk,R1 ;use output file size 10$: ;~x~ Inc R1 ;Fudge Sub RW.Blk(R2),R1 ;number of blocks from beginning of ;the request to the end of the file Cmp #377,R1 ;too far for a "truncation"? Blo 20$ ;~x~yes, so a real I/O error SwaB R1 ;number of word to end of file Cmp R1,RW.WCn(R2) ;did we "truncate"? Bhi 20$ ;~x~no, wouldn't have reached End Of Disk Mov R1,R0 ;yes, return truncated count Tst (PC)+ ;Clear CARRY 20$: Sec ;~x~Set CARRY Pop ;restore work registers 30$: ;~x~ Return ;~x~and return ...... PSECT IMPURE EMTBlk: .BlkW 1 ;~d~R0 contents before prev EMT issued RW.Chn =: 0 ;~d~.READx/.WRITx EMT area layout RW.Blk =: 2 ;~d~ RW.Buf =: 4 ;~d~ RW.WCn =: 6 ;~d~ RW.Cmp =: 8. ;~d~ PSECT KEDIO .SbTtl $TTYIN - Read one character ;++ ;$TtyIn ; ;functional description: ; ; read one character from the terminal ; ;input: none ; ;output: ; R0 = character ;-- .Enable LSB $TtyIn:: ;~x~ .TtyIn ;~x~use rt-11 call Br CrLfCk ;~x~check for CR LF pair .............. .SbTtl $TNOWT - Read character without waiting ;++ ;$TNoWt ; ;functional description: ; ; read one character without waiting. if no character ; is available in buffer then return error condition ; ;input: none ; ;output: ; c clr and ; R0 = character ;or ; c set and ; R0 undetermined ;-- .Enable LSB $TNoWt:: ;~x~ ; ; under RSTS and RT-11 FB we must set the no wait ; bit of the JSW or we will stall anyway without returning ; the no character available condition. ; Bis #J$NoWt,@#JSW ;don't wait on chars .TtInR ;~x~command waiting?? Bic #J$NoWt,@#JSW ;dump the don't wait bit Bcs 20$ ;~x~no character, return carry set CrLfCk: ;~x~ ;>>> change for 8bit support Bic #^c177,R0 ;clear high bit CmpB #,R0 ;is it a CR? Bne 10$ ;~x~No, just return it .TtyIn ;~x~Yes, eat the LF MovB #,R0 ;and return a CR 10$: ;~x~ Clc ;indicate a char is coming back 20$: ;~x~ Return ;~x~ ...... .SbTtl $TYOUT - Output a single char ;++ ;$TyOut ; ;functional description: ; ; Print a single char from R0. ; ; Output is disabled when executing a macro so that when ; a macro is repeated things like 'Model:' don't keep flashing ; on the screen. ; ;input: ; R0 = Character to print ;-- .Enable LSB $TyOut:: ;~x~ ;>>>> NEW JMP VWATCH IsSer ;Doing a /RECOVER? Bne 10$ ;~x~Yup ; IsExe ;executing a macro? Bne 30$ ;~x~if so don't print 10$: ;~x~ .If EQ Rsts$ ;>>> Change for 8bit support Bic #^c177,R0 ;clear high bit .IfF; EQ Rsts$ Tst Rt$Rts ;native RT? Beq 20$ ;~x~no ;>>> Change for 8bit support Bic #^c177,R0 ;clear high bit 20$: ;~x~ .EndC; EQ Rsts$ .TtyOut ;~x~with RT-11 it is simple 30$: ;~x~ Return ;~x~ ...... .SbTtl $Print - Print a string ;++ ;$Print ; ;functional description: ; ; This routine prints the specified data at the terminal. It ; is assumed that the data is terminated with a null or octal ; nOcRlF byte. If the terminator is a null, a cr/lf pair is printed ; following the data. ; ; Output is disabled when a macro is being executed so that when ; a macro is repeated, things like 'Model:' don't keep flashing ; on the screen. ; ;input: ; R0 -> String ;-- .Enable LSB $PrinC:: ;~x~ Mov R0,@SP ;copy parm address to top of stack Mov @R0,R0 ;load parm Add #2,@SP ;skip parm word, point to real return $Print:: ;~x~ ;>>>>NEW JMP VWATCH IsSer ;Doing a /RECOVER? Bne 10$ ;~x~Yup IsExe ;executing a macro? Bne 50$ ;~x~if so don't print 10$: ;~x~ ; ; editor cannot be busy when the output occurs since ; if the working message occurs working may do output ; which would corrupt the output going on here. ; to wit, we save and restore the busy flag and make ; the flag not busy while we print. ; Push BusyF ;save busy flag Clr BusyF ;and clear so no working message now .If NE Rsts$ Tst Rt$Rts ;native RT? Beq 40$ ;~x~no Push R0 ;save pointer 20$: ;~x~ CmpB @R0,# ;end of string? Beq 30$ ;~x~yes ;>>> Change for 8bit support BicB #^c177,(R0)+ ;clear high bit Bne 20$ ;~x~if not a null, keep fixing 30$: ;~x~ Pop R0 ;restore R0 40$: ;~x~ .EndC; NE Rsts$ .Print ;~x~rt-11 call is just perfect Pop BusyF ;restore busy flag 50$: ;~x~ Return ;~x~ ...... .SbTtl $SPON - Set terminal special mode .SbTtl $SPOFF - Clear terminal special mode ;++ ;$SpOn $SpOff ; ;functional description: ; ; set and clear terminal special mode and lower case input ; ; terminal special mode reads one character at a time without ; echo and without editing. ; ;input: none ; ;output: none ;-- .Enable LSB $SpOn:: ;~x~ Bis #J$SpMod,@#JSW ;lc,special Return ;~x~ ...... $SpOff:: ;~x~ Bic #J$SpMod,@#JSW ;lc,special Return ;~x~ ...... .SbTtl $TFLSH - Flush input buffer ;++ ;$TFlsh ; ;functional description: ; ; flush input ring buffer ; ;input: none ; ;output: ; R0 wrecked ; input ring flushed ; c set unless script file active ;-- .Enable LSB $TFlsh:: ;~x~flush tty input waiting 10$: ;~x~ Call $TNoWt ;~x~with out waiting Bcc 10$ ;~x~til gone ;note c set for normal return Return ;~x~ ...... .SbTtl $RCTLO - Reset ctrl/o ;++ ;$RCtlO ; ;functional description: ; ; reset control o, restart output ; ;input: none ; ;output: ; R0 destroyed ;-- $RCtlO:: ;~x~ .RCtrlO ;~x~use rt-11 call Return ;~x~ ...... .SbTtl ERR - Error routine for startup and shutdown routines ;+ ;Err ; ;functional description: ; ; error routine for this module ; We want a routine which returns to its caller's caller ; ;input: ; Jsr R4,Err ; .Word Msg ; ;output: ; Error message printed via routine 'error' and ; return made to caller's caller ;- .Enable LSB Err:: ;~x~ Push ;save flag settings Bic #T.SEr!T.Exe,TtInp ;allow printing always Mov (R4)+,ErrorX ;get address of message Jsr R4,ErrorV ;~x~call command routine Pop ;restore flag settings Pop R4 ;fix to go to caller's caller Return ;~x~to caller's caller ...... .SbTtl $PURGE - Purge files ;+ ;$Purge ; ;functional description: ; ; purge output and input files ; ;input: none ; ;output: ; R0 destroyed ;- ;+ ;purgo ; ;functional description: ; ; purge the output file only ; ;input: none ; ;output: ; R0 destroyed ;- .Enable LSB $Purge:: ;~x~ .Purge #In$Chn ;~x~input file PurgO:: ;~x~ .Purge #Ou$Chn ;~x~output file Return ;~x~ ...... .Dsabl LSB .SbTtl CLSOUT - Close output file .SbTtl CLSINP - Close input file ;++ ;ClsOut ; ;functional description: ; ; close output file ; ;input: none ; ;output: ; output file closed ;-- .Enabl LSB ClsOut:: ;~x~ .Close #Ou$Chn ;~x~output channel Return ;~x~return c to caller ...... ;++ ;ClsIn ; ;functional description: ; ; close input file ; ;input: none ; ;output: ; input channel closed ;-- ClsIn:: .Close #In$Chn ;~x~input channel Return ;~x~return c to caller ...... .DsAbl LSB .SbTtl FLSAME - Compare filespecs for identical ;++ ;FlSame ; ;functional description: ; ; compare file specs and the ppn's if its rsts ; ;input: ; files at InFil and OutFil ; ;output: ; z set if equal ; z clr if not ; ;register usage: ; R2, R3 used and not restored ; ;-- .Enable LSB FlSame:: ;~x~ Mov #InFil,R2 ;check two names Mov #OutFil,R3 ;if they are the same ok FlSam1:: ;~x~ .If NE Rsts$ .Rept 4 ;check the device, filname and type Cmp (R2)+,(R3)+ ;a word at a time Bne 20$ ;~x~different- so check .EndR Tst RT$RTS ;under rsts? Bon 10$ ;~x~no -same so a backup- enter file Cmp OutPPN,InPPN ;check ppn's under rsts Bne 20$ ;~x~ 10$: Sez ;~x~equal .IfF; NE Rsts$ .Rept 3 ;check the device, filname and type Cmp (R2)+,(R3)+ ;a word at a time Bne 20$ ;~x~different- so check .EndR Cmp @R2,@R3 ;and the last word .EndC; NE Rsts$ 20$: Return ;~x~return not equal ...... .Dsabl LSB .If NE Rsts$ .SbTtl RSTS Save and Restore PPN routines ;++ ;Save and Restore RSTS project programmer information ; ;functional description: ; ;there are four words which are normally hidden from an rt program when ;running on rsts. ppn, prot, mode, cluster ;these words are saved by the rt emulator for the files and this works ;fine except when you do fancy things with the filespecs. the editor ;does such incredible things (you wouldn't believe) with the filespecs ;that some special magic is required to keep the filespecs and ppn ;straight. this magic is not used on standard rt (heaven forbid) ;since the routines check to see if rsts is the current system. ; ;-- ; ; equated symbols ; ; ; firqb offsets to save ; FQB == 402 ;FIRQB communications area ;058 FQFun == FQB+3 ;function byte ;058 UU.TRm == 16. ;Set terminal characteristics ;058 FQPPN == FQB+6 ;PPN word ;058 FQProt == FQB+27-1 ;protection code ;058 FQMode == FQB+22 ;mode of open (/mode:N) ;058 FQClus == FQB+34 ;cluster size ;058 .EndC .SbTtl .SbTtl Data for overlay modules ; ; terminal output data ; PSect IODATA ToPtr: .BlkW 1 ;~d~pointer to buffer ToBuf: .BlkB 80. ;~d~buffer for chars ToBEnd: .BlkW 1 ;~d~end of buffer ;*ORDER* TtyRSt::.Word TtyNop+<.-.> ;~d~address of routine to restore .If NE Rsts$ TtySav::.BlkW 11. ;~d~save area ; ;for RSTS contains 11 words .IfF; NE Rsts$ TtySav::.BlkW 5. ;~d~ .IfTF; NE Rsts$ ; ;for MTTY contains LUN in word 1 ; ; then 4 words of status ; ;for Single terminal contains 2 words .EndC; NE Rsts$ ;*END ORDER* ; ; data for startup routines ; .If NE Rsts$ Chain:: .BlkW 5. ;~d~area for chain-to PPN and DBLK Rt$Rts::.BlkW 1 ;~d~RT RTS under RSTS flag ;058 ; ;= 0 -> RT RTS under RSTS ; ;<> 0 -> RT11 itself .IfF; NE Rsts$ Chain:: .BlkW 4. ;~d~Area for chain-to DBLK .EndC; NE Rsts$ GetJob::.BlkW 12. ;~d~Get Job data area ; ; data areas for $csi - ORDER dependent! ; ChnArg:: ;this area overlays next 82. bytes ;insure they are not needed before ;CSI is done. ; Output file specs OutFil:: .BlkW 5. ;~d~output file JouFil:: .BlkW 5. ;~d~journal file Ou3Fil:: .BlkW 5. ;~d~unused output file ; Input file specs InFil:: .BlkW 4. ;~d~input file RecFil:: .BlkW 4. ;~d~recover file IniFil:: .BlkW 4. ;~d~initialization file In4Fil:: .BlkW 4. ;~d~unused input file In5Fil:: .BlkW 4. ;~d~unused input file In6Fil:: .BlkW 4. ;~d~unused input file D.Dev ==: 0 ;~d~offset to device name D.Name ==: 2 ;~d~offset to file name D.Type ==: 6 ;~d~offset to file type D.Size ==: 10 ;~d~offset to size (output files) CSwt:: .BlkW 1. ;~d~nonzero for /C (create file) NSwt:: .BlkW 1. ;~d~nonzero for /N (suppress init file) YSwt:: .BlkW 1. ;~d~nonzero for /Y (suppress query) IllR50 ==: -1 ;~d~illegal RAD50 value DfTyps:: .Word IllR50,IllR50 ;~d~default extensions .Rad50 /JOU/ ;~d~journal output file .Word IllR50 ;~d~ .If NE Rsts$ OutPPN::.BlkW 4 ;~d~save area for output ppn InPPN:: .BlkW 4 ;~d~save area for input ppn TstFil::.Rad50 "DDDKEDXXXTMP" ;~d~test file for probing accts ;058 .EndC; NE Rsts$ ; ; data for $Alloc ; JLmt==:.+2 LBfTab==JLmt ;-> macro entry directory .Limit ;limits of job HdlBas::.BlkW 1 ;~d~base of handler area HdlSpc::.BlkW 1 ;~d~handler space base DStatus:: .BlkW 4. ;~d~DStatus return block VarSz$ ==: 000400 ;~d~variable sized device FilSt$ ==: 100000 ;~d~random access device ; ; data for $PRMPT responses ; PmtDef::.BlkB 1 ;~d~Response to most recent $prmpt .Even ; if any PSect KEDIO .SbTtl .SbTtl High speed tty output management .SbTtl ; ; The idea here is that less overhead is incurred by terminal output ; if it is done in blocks of characters instead of character ; by character. the screen manager uses these routines to output ; text to the screen to save the cost of many directive service calls ; .SbTtl $TOSTR - Setup the terminal output buffering .SbTtl $TOBUF - Buffer one character .SbTtl $TOEND - Flush the output buffer ;++ ;$ToStr,$ToBuf,$ToEnd ; ;functional description: ; ; tty output management ; ; these routines are used by the screen management ; routines of the editor to output characters to the ; terminal. they collect a buffer of characters ; to output via a line request to the exec to save ; large amounts of emt decode overhead. ; ; $tostr initilize buffer ; $tobuf output char in r0 ; $toend flush last buffer ; ;input: ; $tobuf r0 = character to output ; ;output: ;-- .Enable LSB $ToBuf:: ;~x~ MovB R0,@ToPtr ;output the char Beq 10$ ;~x~zero bytes are not output Inc ToPtr ;advance pointer Cmp ToPtr,#ToBEnd ;end of buffer Blo 10$ ;~x~nope $ToEnd:: ;~x~ Push R0 ;save char reg MovB #,@ToPtr ;end line $Print #ToBuf ;~x~print line Pop R0 ;restore reg $ToStr:: ;~x~ Mov #ToBuf,ToPtr ;reset pointer 10$: ;~x~ Return ;~x~ ...... .Dsabl LSB .SbTtl .SbTtl Prompt and Error Display Routines .SbTtl .SbTtl $PRTHL - Print a help message ;++ ;$PrtHl ; ;functional description: ; ; This routine is called to print a help message. The message ; is centered and displayed on the bottom line of the screen. ; If the terminal is a VT100, the message is reverse video. ; ;input: ; ; HLPTXT -> Message to display ; ;output: ; ; R0,R1,R2 modified ;-- .Enable LSB $PrtHl:: ;~x~ Call ClrBot ;~x~Clear bottom of screen Call $GtHlp ;~x~Get help message text overlay Br 10$ ;~x~ .......... $PrtPr:: ;~x~ Call ClrBot ;~x~Clear bottom of screen Call $GtMsg ;~x~Get error message text overlay 10$: Mov H.Size,R2 ;~x~center on screen width Mov HlpTxt,R1 ;Look at message 20$: ;~x~ ;>>> change for 8Bit BitB #177,(R1)+ ; Bon 20$ ;~x~Look for end Sub HlpTxt,R1 ;Make length Sub R1,R2 ;Make centering factor Asr R2 ;Divide by 2 Bmi 50$ ;~x~All done (BLE will not work) Beq 50$ ;~x~ .If NE VT10$0 $Print #EscCsi ;~x~Write control sequence intro Clr R0 ;Make factor 30$: ;~x~ Inc R0 ;Make size Sub #10.,R2 ; Bge 30$ ;~x~ Add #10.,R2 ;Make first digit Dec R0 ; Ble 40$ ;~x~Br if none to write Add #,R0 ;Else make ASCII Call $TyOut ;~x~Write it 40$: ;~x~ Mov R2,R0 ; Add #,R0 ;Make second digit Call $TyOut ;~x~Write it Mov #,R0 ;Write final character Call $TyOut ;~x~ .IfF; NE VT10$0 Add #40,R2 ;Add 1 for column to start and ; add 37 to get parameter MovB R2,Col52 ;Move to escape sequence $Print #Cent52 ;~x~Center the message .IfTF; NE VT10$0 50$: ;~x~ .EndC; NE VT10$0 .If NE VT10$0!VT62$ $Print #HlpOpn ;~x~Start help message .IfTF; NE VT10$0!VT62$ $Print HlpTxt ;~x~Print the help .IfT; NE VT10$0!VT62$ $Print #HlpCls ;~x~End the help message .EndC; NE VT10$0!VT62$ CallR $GtCod ;~x~Get code back .............. .Dsabl LSB .If EQ VT10$0 Cent52: .Byte ,,<37+23.> ;~d~Next to last line Col52: .BlkB 1 ;~d~Insert column number here .Byte ;~d~ .Even .EndC; EQ VT10$0 .SbTtl Data for Displaying Help Messages PSect .TXT. .NList BEX .If NE VT62$ ;;;HlpOpn: .Byte ,'<,,,,,,,,,, :d~ HlpOpn: .Byte ,, ;~d~ HlpCls: ;~d~ NrmVid: .Byte ,, ;~d~ .EndC; NE VT62$ .If NE VT10$0 HlpOpn: .Byte ,,,, ;~d~Set reverse video HlpCls: ;~d~ NrmVid::.Byte ,,, ;~d~Clear video attributes .EndC; NE VT10$0 PSect IMPURE .List BEX PSect KEDIO .SbTtl $DSPRM - Display prompt ;++ ;$DsprM ; ;functional description: ; ; This routine is called to display a prompt such as 'Command:' or ; 'Model:'. The prompt is displayed on the top line of the screen ; and, if the terminal is a VT100, the 60 byte response area is ; painted in reverse video. On return from this routine, the video ; attribute is still set for reverse video so that all input will ; display that way. The routines $RSTVA,$SETVA, and $TRMPR are ; used in conjunction with this routine. ; ;INPUT: ; ; R4 -> Prompt message to output ; ;OUTPUT: ; ; R0 modified ;-- $DsPrm:: ;~x~ Call ClrTop ;~x~Clear top two lines $Print @R4 ;Print prompt .If NE VT10$0!VT62$ $Print #RevRsp ;~x~Response area reverse video .EndC; NE VT10$0 Return ;~x~ ...... .If NE VT62$ PSect .TXT. .NList BEX ;;;RevRsp: .Byte ,'<,,,,,,,,,,, ;~d~ RevRsp: .Byte ,,, ;~d~ PSect KEDIO .EndC; NE VT62$ .If NE VT10$0 PSect .TXT. .NList BEX RevRsp: .Byte ,,,,, ;~d~Use reverse video & leading space .List BEX PSect KEDIO .EndC; NE VT10$0 .SbTtl $PRMPT - Get prompt response ;++ ;$Prmpt ; ;functional description: ; ; This routine gets the user's response to a previously displayed ; prompt message. Used by: ERRPMT (CM1). If the $Prmpt is being ; issued during a RECOVER operation, the default prompt from the ; journal is used, or else a default of N is used. ; ;OUTPUT: ; ; R0 modified ; ; Z SET if user response affirmative (Y or y) ; Z CLR otherwise ;-- .Enable LSB $Prmpt:: ;~x~ Tst RecSsn ;Are we doing a /RECOVER? Boff 10$ ;~x~Nope, carry on MovB PmtDef,R0 ;Use whatever we used in the original ; session (if we have it) Bne 40$ ;~x~We have the response, go use it MovB ..YES,R0 ;Other default to Y for opening aux Br 40$ ;~x~ files .......... 10$: ;~x~ .If NE VT10$0!VT62$ $Print #RevVid ;~x~Reverse video .IfTF; NE VT10$0!VT62$ Call $TFlsh ;~x~Flush the ring buffer Push @#JSW ;Save the JSW to preserve ;Special mode Call $SpOff ;~x~Turn special mode off Bis #J$NoSL,@#JSW ;Disable SL for now Call $TtyIn ;~x~Response char (y,n or bad) MovB R0,PmtDef ;Put response where $wrpmt can get it Push R0 ;Save response a sec IsCmd ;Are we in command mode? Beq 20$ ;~x~No Call PmtCmd ;~x~Yes, record response in journal Br 30$ ;~x~And continue ............ 20$: Call $WrPmt ;~x~Record response in journal (if any) 30$: Call $TFlsh ;~x~flush rest of line .IfT; NE VT10$0!VT62$ $Print #NrmVid ;~x~clear video attributes .EndC; NE VT10$0!VT62$ Pop R0 ;restore response Pop @#JSW ;restore tt mode as before 40$: Bic #UCase,R0 ;~x~force to uppercase CmpB R0,..YES ;is it "YES" 50$: Return ;~x~return with z ...... .If NE VT62$ PSect .TXT. ;;;RevVid: .Byte ,'<,,,,,,,,,, ;~d~ RevVid: .Byte ,, ;~d~ PSect KEDIO .EndC; NE VT62$ .If NE VT10$0 PSect .TXT. .NList BEX RevVid: .Byte ,,,, ;~d~set reverse video .List BEX PSect KEDIO .EndC; ne VT10$0 .SbTtl $RSTVA - Restore video attributes to normal ;++ ;$RstVA ; ;functional description: ; ; This routine is called by the routine that prompts for input ; after the 'Command:', 'Model:', and 'Repeat:' prompts to ; clear the video attributes before deleting a character. ; ;OUTPUT: ; ; R0 modified ;-- .If NE VT10$0!VT62$ $RstVA:: ;~x~ $Print #NrmVid ;~x~Clear video attributes Return ;~x~ ...... .EndC; NE VT10$0!VT62$ .SbTtl $SETVA - Set video attributes ;++ ;$SetVA ; ;functional description: ; ; This routine sets the video attribute for the terminal. It is ; called by the routine that prompts for input after the 'Command:', ; 'Model:' and 'Repeat:' prompts to reset the video attributes ; after they've been cleared to delete a character. ; ;OUTPUT: ; ; R0 modified ;-- .If NE VT10$0!VT62$ $SetVA:: ;~x~ $Print #RevVid ;~x~Set reverse video Return ;~x~ ...... .EndC; NE VT10$0!VT62$ .SbTtl TTY??? - Console restore routines ;++ ;TtyMTt, TtyNop, TtySTt, TtyRTS ; ;functional description: ; ; These routines use status information stored in TTYSAV ; to restore the terminal status. ; ;-- TtyMTt:: ;~x~restore the MTTY flavour .MTSet Area,#TtySav+2,TtySav ;~x~put saved options back Bcs TtyErr ;~x~failed TtyNop:: ;~x~nothing to do entry Return ;~x~done ...... TtySTt:: ;~x~restore the single term flavour .Poke Area,TtySav,TtySav+2 ;~x~restore old value 60$: ;~x~ Return ;~x~done ...... .If NE Rsts$ TtyRTS: ;~x~restore the RSTS flavour .ClrFQB ;~x~clear the FQB Mov #TtySav,R1 ;point to source pat$g3:: ;~x~ Call RstMov ;~x~set up FQB Call TtyTRm ;~x~issue RSTS terminal status request Bne TtyErr ;~x~failed Mov #TtyRTS,ttyRST ;use RSTS restore routine Return ;~x~done ...... .EndC; NE Rsts$ TtyErr:: ;~x~ pat$g4: ;~x~ Call TtyAsk ;~x~ask to continue Beq 60$ ;~x~yes, continue Jmp $Exit ;~x~fatal (very) ............. .If NE RSTS$ PAT$G6:: ;~d~ KEDTrm:: ;~d~ ;058 .Byte 254.+1 ;+6 ;~d~ .Byte 0 ;+7 ;~d~ .Byte 0,0 ;+10,11 ;~d~ .Byte 377 ;+12 ;~d~ .Byte 200 ;+13 ;~d~ .Byte 377 ;+14 ;~d~ .Byte 377 ;+15 ;~d~ .Byte 0,0,0,0 ;+16,17,20,21 ;~d~ .Byte 377 ;+22 ;~d~ .Byte 377 ;+23 ;~d~ .Byte 0,0,0 ;+24,25,26 ;~d~ .Byte 200 ;+27 ;~d~ .Byte 200 ;+30 ;~d~ .Byte 377 ;+31 ;~d~ .EndC; NE Rsts$ .Enable LSB TtyMov:: ;~x~move a block of words ;R0 = number of words to move ;R1 -> destination area ;R2 -> source area ;R0, R1, R2 destroyed 10$: ;~x~ Mov (R2)+,(R1)+ ;save it Sob R0,10$ ;~x~continue as required Return ;~x~ ...... .Dsabl LSB .If NE Rsts$ .SbTtl TTYTRM - Issue RSTS terminal status request ;++ ; TTYTRM ; assume area setup except for terminal number and request code ; set those up, issue request and check for error. ;-- TtyTRm:: ;~x~ ;058 MovB #UU.TRm,FQFun ;set the function to terminal status MovB #-1,FQB+5 ;indicate current terminal .PreFix ;~x~tell RT11 to pass next EMT thru .UUO ;~x~get terminal statistics TstB FQB ;any error? Return ;~x~ ...... .EndC; NE Rsts$ TtyAsk:: ;~x~error prompt for TtyFix Jsr R4,ErrPmt ;~x~print the question .Word Unable ;ask for permission to continue Bne TtyXit ;~x~No, so quit Sec ;set carry Return ;~x~return, BCC means continue SET ...... TtyXit: Jmp $Exit ;~x~ .............. .SbTtl $PRTER - Print ked error message ;++ ;$PrtEr ; ;functional description: ; ; This routine prints the KED error environment and the indicated ; error message on the bottom line of the screen. ; ;INPUT: ; ; (R4) -> Error message text ; ;OUTPUT: ; ; R0 modified ;-- $PrtEr:: ;~x~ $Print #ErrEnv ;~x~Print environment prefix Mov @R4,R0 ;Save text pointer Call $GtMsg ;~x~Get message text in memory $Print ;~x~Print the message .If NE VT10$0!VT62$ Call $GtCod ;~x~Get code back .Br $TrmPr ;~x~Close message and clear video attr ; if environment changed anything .Iff; NE VT10$0!VT62$ ; CallR $GtCod ;~x~Get code back .............. .EndC; NE VT10$0!VT62$ .SbTtl $TRMPR - Terminate prompt input ;++ ;$TrmPr ; ;functional description: ; ; This routine is called when the response to a prompt is ; terminated to clear the terminal's video attributes. ; ;OUTPUT: ; ; All registers preserved ;-- .If NE VT10$0!VT62$ $TrmPr:: ;~x~ Push R0 ;Save R0 $Print #HlpCls ;~x~Print trailing reverse video space ; and clear video attributes Pop R0 ;Restore R0 Return ;~x~ ...... .EndC; NE VT10$0!VT62$ .SbTtl Error Environment Prefix ; ;Environment for error messages from CSI level ; PSect .TXT. ErrEnv: ;~d~ .If NE VT10$0 .Byte ,,,'2,'4, ;~d~Move to bottom left of screen .Byte ,,,, ;~d~Print message in reverse video ; with leading space .IfF; NE VT10$0 .Byte ,,<37+24.>,<37+1> ;~d~Move to bottom of screen .If NE VT62$ ;;; .Byte ,'<,,,,,,,,, ;~d~ .Byte , ;~d~ .EndC; NE VT62$ .EndC; NE VT10$0 .Ascii "?" ;~d~ .Byte ,, ;~d~ .Ascii "-" ;~d~ .Byte ;~d~ PSect KEDIO .SbTtl .SbTtl $MRKS - Start marktime for working message ;++ ;$Mrks ; ;functional description: ; ; Add queue element and initialize for not busy ; (i.e. 'working...' message off) ; ;input: none ; ;output: ; data set for working message ;-- .Enable LSB $Mrks:: ;~x~ .QSet #MTQue,#NQueEl ;~x~add elements for marktime Clr FBusy ;editor not busy to start Return ;~x~ ...... ;;; .MrkT #MkA,#BsyTic,#BusyR,#1 ;start the timing MarkTm:: ;~d~ .Byte 0,.MrkT ;~d~ .Word BsyTic ;~d~ .Word BusyR ;~d~ .Word 1 ;~d~ .Dsabl LSB .SbTtl BSYON - Turn on "working..." message .SbTtl BSYOFF - Turn off "working..." message ;++ ; ; Start 'WORKING...' message by issuing a marktime request. ; ; Input: FBusy = 1 if 'working...' is already active ; = 0 if not 'working...' yet ; ; Output: FBusy = 1 ; BusyF = 1 ; Marktime set for 'working...' message ;-- .Enabl LSB BsyOn:: ;~x~ Push R0 ; Tst FBusy ; Bne 10$ ;~x~ .MrkT #MarkTm,Code=NoSet ;~x~start the 'working...' msg Mov SP,FBusy ; 10$: Mov SP,BusyF ;~x~ Pop R0 ; Return ;~x~ .DsAbl LSB ;++ ; ; Cancel 'WORKING...' message by cancelling a marktime request. ; ; Input: FBusy = 1 if 'working...' is active ; = 0 if not 'working...' ; ; Output: FBusy = 0 ; BusyF = 0 ; Marktime cancelled for 'working...' message ;-- .Enabl LSB BsyOff:: ;~x~ IsExe ;Are we executing now? Bne 20$ ;~x~Yes, then don't cancel 'working...' Push R0 ; Tst FBusy ; Beq 10$ ;~x~ .Cmkt #CanMkt,,,Code=NoSet ;~x~stop the 'working...' msg Clr FBusy ; 10$: Clr BusyF ;~x~ Pop R0 ; 20$: Return ;~x~ .DsAbl LSB PSECT IODATA FBusy:: .Word .-. ;~d~=1 if 'working...' marktime is active ;;; .CMkT Area,#0 ;cancel marktime outstanding CanMkt:: ;~d~ .Byte 0,.CMkT ;~d~ .Word 0 ;~d~ .Word 1 ;~d~ PSECT KEDIO .SbTtl BUSYR - mark time routine for 'working...' ;++ ;BusyR ; ;functional description: ; ; This is a marktime completion routine which is started ; before the editor begins and keeps itself going every one ; second. ; ; ***CAUTION*** It is absolutely essential that this routine ; never be entered with BUSYF><0 if the program is in VWATCH. ; VWATCH is not reentrant and this routine may call VWATCH ; which will blow away. Note that the least that will happen ; is that the screen will be corrupted. ; ; If a macro is being executed, the output routines are disabled. ; However, the working message should still display;this routine ; saves the macro execution indicator, sets it to <= 0 so that the ; working message will display, and restores it before returning. ; ;INPUT: ; ; BUSYF Non-zero if editor is busy ; Bit 0 = 0 first time thru (before CLRTOP called) ; Bits 1-15 = 0 if CLRTOP has been called ; BSYFF Flipflops for display message or clear top 2 lines ; MTQUE Extra queue elements for MRKT ; MKA Special area for MRKT requests ;-- .Enable LSB PSect ASTSCT ;section for ast code BusyR:: ;~x~ Push TtInp ExeOff ;Make sure we print Tst BusyF ;Editor busy? Boff 50$ ;~x~If not, exit quickly Bit #1,BusyF ;Else check for first time thru Bon 10$ ;~x~Ok if not Inc BusyF ;Else indicate been thru once Br 50$ ;~x~And exit ........... 10$: ;~x~ Bit #-2,BusyF ;Has top been cleared? Boff 20$ ;~x~Continue if so ; Call ClrTop ;~x~Else clear top two lines ; ;The CLRTOP code is duplicated here because if the USR is active ;CLRTOP is under the USR and we cannot call it from here. ; $Print #Ers2Ln ;~x~Erase top 2 lines Bic #InsBit,CurCmd ;Disable optimizations Bic #InsBit,LstCmd ; so screen will be updated Call $RCtlO ;~x~Reenable output Clr BusyF ;Clear busy Mov #V.2Top,R0 ;Clear top 2 lines Call VWatch ;~x~Call VWATCH to forget top 2 lines ;End of CLRTOP code Inc BusyF ;Make busy flag 1 (cleared by CLRTOP) Clr BsyFF ;Indicate display message next ; and do it 20$: ;~x~ Com BsyFF ;Display message? Beq 40$ ;~x~Br if not .If NE VT10$0 Mov #Bsy80,R0 ;Assume narrow screen Cmp H.Size,#80. ;Check screen size Blos 30$ ;~x~bR IF NARROW Mov #Bsy132,R0 ;Else wide screen 30$: ;~x~ $Print ;~x~Center message .EndC; NE VT10$0 $Print #BsyMs ;~x~Print working message Br 50$ ;~x~ and exit ........... 40$: ;~x~ $Print #Ers2Ln ;~x~Else erase the message 50$: ;~x~ ;;; .MrkT #MkA,#BsyTic,#BusyR,#1 ;Restart marktime .MrkT #MarkTm,Code=NoSet ;~x~Restart marktime Pop TtInp ;Restore macro exec state Return ;~x~ ...... .SbTtl Data for Working Message and Channel Definition ; ; this data must be here since usr may swap over the other ; data psects ; ; data for working message ; BsyTic::.Word 0,60. ;~d~tics til next call here Busyf:: .BlkW 1 ;~d~busy flag for editor BsyFF: .BlkW 1 ;~d~flopflip for message type .If NE VT10$0 Bsy80: .Byte ,,,,'3,'4,, ;~d~for narrow screen Bsy132: .Byte ,,,,'6,'0,, ;~d~for wide screen .Even .EndC; NE VT10$0 .If EQ Virt$ NQueEl =: 2 MTQue:: .BlkW NQueEl*10. ;~d~que space for mk time requests ;xm que elements are longer by some ; ; channel block area ; Channl:: ;~d~ .BlkW 22.*5. ;~d~Use our own channels so we don't ;destroy the chaining programs ;channels (BASIC-Plus) CDfnBk::.Byte 0,.CDfn ;~d~ .Word Channl ;~d~ .Word 22. ;~d~ .IfF; EQ Virt$ ;KEX definition of this data is in ; the KEDLOW module .EndC; EQ Virt$ .NList BEX BsyMs: ;~d~ .If NE VT10$0 .Byte ,,,, ;~d~display message in reverse video .IfF; NE VT10$0 .If NE VT62$ ;;; .Byte ,'<,,,,,,,,, ;~d~ .Byte , ;~d~ .EndC; NE VT62$ .Byte ,,<37+1>,<37+27.> ;~d~center message .IfTF; NE VT10$0 .Ascii " WORKING... " ;~d~ .If NE VT62$ ;;; .Byte ,'<,,,,,,,, ;~d~ .Byte , ;~d~ .EndC; NE VT62$ .IfT; NE VT10$0 .Byte , ;~d~restore cursor and video attributes .EndC; NE VT10$0 .Byte ;~d~ .Even .List BEX ;this symbol must be the last ;contribution to the astsct USRSwp:: ;swap the usr here to avoid problems PSect KEDIO ;back to .SbTtl .If NE Rsts$ .SbTtl CTRL$C - control c ast for rsts ;++ ;Ctrl$C ; ;functional description: ; ; control c ast for rsts ; ;input: ; we run as if interrupted in the task context ; ctrl/o has been effected ; the ast has been cleared ; ;output: ; ctrl/o is cleared ; the ast is reset ; ctrlc is set minus ;-- .Enable LSB Ctrl$C:: ;~x~ ;058 .IrpC x,<543210> Push .EndR Bis #100000,CtrlC ;set bit in ast word .RCtrlO ;~x~reset ctrl/o flag Mov #Ctrl$C,R0 ;reset ast .CtrlC ;~x~with rsts emt .IrpC x,<012345> Pop .EndR RTI ;~x~return to our task ...... .EndC; NE Rsts$ .SbTtl .SbTtl Auxiliary File Management .SbTtl .SbTtl Auxiliary File Descriptors ; ; file data structures ; ;Each auxiliary file has a control block associated with it and when ;the command routines call the file routines the address of the proper ;control block is in R4. ; ;The control block looks as follows: ; .Macro FilSet Nam,Chn,IO,Buff,?FNam,?PPN Nam:: .Byte Chn ;~d~channel .Byte IO ;~d~status and direction FNam: .BlkW 4 ;~d~filename .BlkW ;~d~block number .BlkW ;~d~buff pointer .BlkW ;~d~buff counter .Word FNam ;~d~file name address Buff:: .BlkW 1 ;~d~buffer address .If NE RSTS$ .Word PPN ;~d~address of ppn PPN: .BlkW 4 ;~d~rsts ppn info .EndC; NE RSTS$ .endm ; ; definitions of offsets and sizes ; fb$bks == 1 ;blocks in buffer fb$siz == fb$bks*512. ;one block buffer fb$wds == fb$siz/2 ;in words f$chn == 0 ;channel f$sts == 1 ;status byte fst$ac == 200 ;active bit fst$io == 1 ;nonzero for output f$fnam ==2 ;file name f$blkn ==12 ;block number f$bptr ==14 ;pointer f$bctr ==16 ;counter f$nama ==20 ;addr of name f$bufa ==22 ;addr of buffer f$ppna = 24 ;rsts ppn info address ; ; list of all files ; PSect IODATA FilLst::.Word Ax$Out ;~d~ .Word Ax$Inp ;~d~ .Word Ln$Out ;~d~ .Word Ln$Inp ;~d~ .Word Jo$Out ;~d~ .Word Jo$Inp ;~d~ .Word 000000 ;~d~ ; file blocks ; ; Note: The channel numbers were changed in RT-11 V5.4D for BASIC-Plus ; interface. (formerly 6 & 7) ; FilSet Ax$Out,16.,FSt$IO,AInBuf ;output file FilSet Ax$Inp,17.,0,AOuBuf ;input file FilSet Ln$Out,18.,FSt$IO,LOuBuf ;output learn macro file (SAVE) FilSet Ln$Inp,18.,0,LInBuf ;input learn macro file (LOAD) FilSet Jo$Out,19.,FSt$IO,JOuBuf ;output journal file FilSet Jo$Inp,18.,0,JInBuf ;input recover journal file and @file .MDelete FilSet ;define it out of existance .SbTtl Data for journal and executable auxiliary file processing ; ;Data for executable and text auxiliary file processing ; OSpace:: .BlkW 15. ;~d~file space for .csispc in $OpFil OFNam:: .BlkW 24. ;~d~ input spec to use AuxDef:: ;~d~ NoDeft:: .Word 0,0,0,0 ;~d~no default extensions InitDK:: .Rad50 /DK / ;~d~Default to DK:KEDINI.KED first .Rad50 /KEDINIKED/ ;~d~ InitFl:: .BlkW 4 ;~d~Actual initialization file FStart:: .BlkW 1. ;~d~0 = first call, <> = subsequent call ; ;Data for journal file processing ; JoSave:: .Word 0 ;~d~0 = delete journal on exit/quit ;1 = save journal on exit/quit JoFreq:: .Word 0 ;~d~<>0 Number of modifications to allow Deffrq == 10. ; between writes to the journal JoFCnt:: .Word 0 ;~d~Number of modifications since last ;write to the journal RecSsn:: .Word 0 ;~d~This session has a recover file ComSsn:: .Word 0 ;~d~This session has an init file JouSsn:: .Word 0 ;~d~This session has a journal file JoWFlg:: .Word 0 ;~d~Write to journal was done w/o request LstMod:: .Word 0 ;~d~Pointer to the end of the last ; modification in the journal buffer JouMin:: .Word 10. ;~d~Minimum amount to allow journaling ;without message JouOp:: .Word 0 ;~d~ =0 -> $OpFil is for auxiliary files ;<>0 -> $OpFil is for journal files ..JSiz:: .Word 50. ;~d~Journal file size in blocks ; *ORDER DEPENDENT* JTmpBf:: .BlkW 80. ;~d~Temporary Storage for commands until ; they graduate to the journal buffer JTPtr:: .BlkW 1 ;~d~Pointer into temporary storage buffer ; *END ORDER DEPENDENT* JouTyp:: .RAD50 /JOU/ ;~d~.Jou file type KedTyp:: .RAD50 /KED/ ;~d~.Ked file type .SbTtl Input Mode Nesting Data Area ; ; Learn or Execute macro entry: ; M.Name == 0 ;Macro buffer name M.Offs == 2 ;Offset into buffer M.Mode == 4 ;Current operating mode: from TtInp M.Size == 6 ;Size of macro nesting entry ; ; Recover file entry: ; ;Savestatus info R.CSW == 0 ;Channel status word R.SBlk == 2 ;Starting block of file or ; 0 if non-file structured R.Leng == 4 ;Length of file R.Used == 6 ;Highest block written R.DevQ == 10 ;Number of Pending requests R.Unit == 11 ;Device unit number ;FilSet descriptor info R.BPtr == 12 ;Offset into buffer R.BCtr == 14 ;Counter R.Blk == 16 ;Current block number ;State info R.Mode == 20 ;Current operating mode: from TtInp R.Size == 22 ;Size of Recover entry ; ;Nesting Stack ; MaxNst == 4 ;Allowed level of nesting. NstStk::.BlkW ;~d~ EndStk == . N.Cur:: .BlkW 1 ;~d~Pointer to current nesting entry PSect KEDIO .SbTtl MOV401 - Move a DBLK from R0 to R1 Mov401:: ;~x~ .Rept 4. Mov (R0)+,(R1)+ ;move a word .EndR Return ;~x~ ...... .SbTtl $NEST - Nest input mode information ;+ ;$Nest ; ;Record current input information on nesting stack. Important: Check ;recover mode first, then execute, then learn. ;If we are journaling, make sure there is room to nest a recover operation ;in addition to the current nesting level, otherwise we may end up with ;a journaled session that is unrecoverable. ;- .Enabl LSB $Nest:: SavReg ;~x~ Mov N.Cur,R1 ;R1 => current nesting entry IsRec ;Are we recovering a file? Beq 20$ ;~x~No, skip saving file info Tst JouSsn ;Are we journaling? Beq 10$ ;~x~Nope, don't need extra room Cmp N.Cur,#> ;Is there enough room for ;this entry plus a recovery? Bgt 70$ ;~x~Nope 10$: Cmp N.Cur,# ;~x~Is there room for this entry? Bgt 70$ ;~x~Nope Mov #Jo$Inp,R4 ;Point to file descriptor Mov f$blkn(R4),R.Blk(R1) ;Save the current block # Mov f$bptr(R4),R.BPtr(R1) ;Save the buffer pointer Mov f$bctr(R4),R.BCtr(R1) ;Save the buffer counter Mov TtInp,R.Mode(R1) ;Save the current input mode SErOff ;don't propogate error suppression Call Savest ;~x~Savestatus in entry Bcs Flub ;~x~savestatus error Add #R.Size,N.Cur ;Point to the next place for an RecOff ;Turn recovery mode off ExeOff ;Turn execute mode off Br 60$ ;~x~ entry ....... 20$: IsJou ;~x~Are we journaling? Beq 30$ ;~x~Nope, don't need extra room Cmp N.Cur,# ;Is there enough room for ;this entry plus a recovery? Bgt 70$ ;~x~Nope 30$: Cmp N.Cur,# ;~x~Is there room for this entry? Bgt 70$ ;~x~Nope IsExe ;Is this an execute entry? Beq 40$ ;~x~Nope Mov Ttptr,M.Offs(R1) ;Calculate offset into buffer Mov E.Cur,R2 ;R2 => current executing macro buffer Mov TtInp,M.Mode(R1) ;Save the current mode ExeOff ;Turn execute mode off Br 50$ ;~x~ ....... 40$: ;~x~If we get here we have a learn ; mode entry Mov Lnptr,M.Offs(R1) ;Calculate offset into buffer Mov L.Cur,R2 ;R2 => current learn macro buffer Mov TtInp,M.Mode(R1) ;Save the current mode LrnOff ;Turn learn mode off 50$: Sub L.Buf(R2),M.Offs(R1) ;~x~ Mov L.Id(R2),M.Name(R1) ;Save the macro identifier Add #M.Size,N.Cur ;Point to the next place for an entry 60$: Clc ;~x~ Return ;~x~ 70$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;There is not enough room allocated to record this level of macro/journal ;nesting. A customization patch may be applied to adjust the allowable ;level of nesting. ;- Flub: ;~x~ ;+ ;HELPER HELPER ;~x~ ;Logic or savestatus error ;- .DsAbl LSB .SbTtl $UNNST - Unnest input modes ;+ ;$Unnst ; ;Unnest previous input mode and restore the previous input context ;- .Enabl LSB $Unnst:: ;~x~ SavReg Mov N.Cur,R3 ;Point to bottom of nesting entry Mov -(R3),TtInp ;Restore input mode (whatever it is) IsRec ;Is it recover? Beq 10$ ;~x~Nope Sub #R.Size,N.Cur ;Point the beginning of the entry Cmp N.Cur,#NstStk ;Is there an entry to unnest? Blt Flub ;~x~No, logic error Mov N.Cur,R3 ;R3=> nesting entry Mov #Jo$Inp,R4 ;Point to input file descriptor Call Reopen ;~x~Reopen the file Mov R.BPtr(R3),f$bptr(R4) ;Get the buffer pointer Mov R.BCtr(R3),f$bctr(R4) ;Get the buffer counter Mov R.Blk(R3),f$blkn(R4) ;Get the next block number Sub #fb$Bks,f$blkn(R4) ;Read in that block again .ReadW Area,@R4,f$bufa(R4),#fb$wds,f$blkn(R4) ;~x~ Mov R.Blk(R3),f$blkn(R4) ;*C* Get the next block number again Br 30$ ;~x~*C* Done ...... 10$: Sub #M.Size,N.Cur ;~x~Point to the beginning of the entry Cmp N.Cur,#NstStk ;Is there an entry to unnest? Blt Flub ;~x~No, logic error Mov N.Cur,R3 ;R3=> nesting entry Mov M.Name(R3),R0 ;Get the macro name Call FndLBf ;~x~And look up it's descriptor Mov L.Buf(R2),R1 ;Calculate the position in the Add M.Offs(R3),R1 ; learn buffer IsExe ;Is it execute? Beq 20$ ;~x~Nope Mov R2,E.Cur ;Yup Mov R1,TtPtr Br 30$ ;~x~Done ....... 20$: ;~x~If we get here we have a learn ; mode entry Mov R2,L.Cur ;Yup Mov R1,LnPtr 30$: Return ;~x~ ...... .Dsabl LSB .SbTtl Savest - Savestatus call for nesting input modes .SbTtl Reopen - Reopen call for unnesting input modes ;+ ;Savest,Reopen ; ;System calls for [un]nesting RECOVER mode input info ; ;- .Enabl LSB Savest: Call 10$ ;~x~Set up EMT block MovB #5,1(R0) ;Subcode .Savestatus Area,,,Code=NoSet ;~x~ Return ;~x~ ...... Reopen: Call $PrgFl ;~x~Purge channel before reopening Call 10$ ;~x~Set up EMT block MovB #6,1(R0) ;Subcode .Reopen Area,,,Code=NoSet ;~x~ BisB #fst$ac,f$sts(r4) ;mark active Return ;~x~ ...... 10$: Mov Area,R0 ;~x~EMT data block MovB f$chn(R4),@R0 ;Channel Mov N.Cur,2(R0) ;Take status info directly from entry Return ;~x~ ...... .DsAbl LSB .SbTtl $OPFIL - Open file from asciz name .SbTtl $OPF50 - Open file from RAD50 name ;++ ;$OpFil, $OpF50 ; ;FUNCTIONAL DESCRIPTION: ; ; open file for auxiliary i/o ; ;INPUT: ; At entry point $OpFil : ; R1 -> filespec as asciz string ; R4 -> file data structure ; JouOp = 0 if normal aux file open ; <>0 if should use opening a journal ; for the first time ; or ; At entry point $OpF50 : ; R2 -> decoded filespec ; =0 if file data structure (@R4) already contains it ; R4 -> file data structure ; JouOp as described above ;OUTPUT: ; c set if error ; file all set for i or o ; JouOp = size of journal file opened if JouOp on ; entry was non-zero ;-- .Enable LSB ; Asciz entry point $OpFil:: ;~x~ SavReg Call $ClsFl ;~x~close file Mov SP,R3 ;save stack pointer ; Check for end of line on for commands: LOAD, SAVE, OPEN ... Push R1 ;save R1 10$: TstB @R1 ;~x~is this the end of the line? Beq 30$ ;~x~yup, go use it CmpB (R1)+,#'! ;is this a comment indicator? Beq 20$ ;~x~yup CmpB -1(R1),# ;is it a tab? Beq 20$ ;~x~yup CmpB -1(R1),# ;is it a space? Bne 10$ ;~x~nope 20$: ClrB -(R1) ;~x~call it the end of the ; line for CSI's sake 30$: Pop R1 ;~x~restore R1 ; ; Get file spec from command line ; .Assume OFNam EQ OSpace+<15.*2.> .CsiSpc #OSpace,#NoDeft,R1 ;~x~file spec Bcs 60$ ;~x~no good Pop <> ;dump switches Bne 50$ ;~x~if non-zero, error 40$: Mov #OFNam,R2 ;~x~R2 => file name Br 70$ ;~x~Go do open ....... 50$: Mov R3,SP ;~x~restore stack pointer 60$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;file spec passed to $opfil was erroneous ;- ; ; RAD50 entry point ; ; R2 -> RAD50 file spec ; $OpF50:: ;~x~ SavReg ;save registers Call $ClsFl ;~x~close file ; ; Common code for open ; 70$: ;~x~ .If NE Rsts$ Mov R2,R0 ;prepare to save ppn info Mov F$PPNA(R4),R1 ;address to save it Jsr R4,SvPPN ;~x~save it .EndC; Ne Rsts$ Mov F$NamA(R4),R3 ;address in block Mov R3,R0 ;save pointer for fetch Tst R2 ;Should we move the file dblk Beq 80$ ;~x~No, no need to .Rept 4 Mov (R2)+,(R3)+ .EndR ; ; Fetch and DSTAT the device ; ; ; Fetch and DSTAT the device ; 80$: Tst JouOp ;~x~opening the output journal file? Beq 90$ ;~x~nop Mov ..JDev,R2 ;get possible forced journal device Beq 90$ ;~x~no force device name Mov R2,F$FNam(R4) ;force device name 90$: Call $Fetch ;~x~fetch handler Bcs 100$ ;~x~nogood .If NE Rsts$ Mov F$PPNA(R4),R0 ;prepare to use a ppn Jsr R4,UsPPN ;~x~get the ppn back .EndC; NE Rsts$ .DStatus Area,F$NamA(R4) ;~x~look at device 100$: Bcs 230$ ;~x~no such device?? BitB #FSt$IO,F$Sts(R4) ;check in or out Boff 210$ ;~x~input Tst @Area ;file structured?? Bpl 170$ ;~x~nope, skip clash check ; ; Check for an existing file ; Tst F$FNam+D.Name(R4) ;look for file name Boff 260$ ;~x~no filename, bad request Call 270$ ;~x~look for a clash Bcc 110$ ;~x~yes- figure out why CmpB @#JErB,#E.FNF ;file not found?? Beq 160$ ;~x~ok to enter Br 250$ ;~x~signal error if else why ............ ; ; Auxiliary output file exists... ; 110$: Call ClsChn ;~x~close clash channel Bcs 260$ ;~x~something is in our way Tst JouOp ;Should we prompt? Bne 150$ ;~x~Yes, but use journal prompt IsExe ;Are we executing? Beq 120$ ;~x~No IsSer ;Is it the /RECOVER file? Beq 130$ ;~x~No, it's a macro or @, assume yes 120$: Jsr R4,ErrPmt ;~x~find out if clash is ok .Word ErIAOE ; "auxiliary file exists - replace?" Bne 260$ ;~x~and go home with sorrow ; ; Enter the auxiliary output file ; 130$: ;~x~ .If NE Rsts$ Mov F$PPNA(R4),R0 ;Now set to use the ppn again Jsr R4,UsPPN ;~x~Use the output ppn .EndC; NE Rsts$ .Enter Area,@R4,F$NamA(R4),#0 ;~x~1/2 enter Bcs 250$ ;~x~No good 140$: Mov F$BufA(R4),F$BPtr(R4) ;~x~Setup addresses Mov #FB$Siz,F$BCtr(R4) ;Counter 145$: Clr F$BlkN(R4) ;~x~Zero block number BisB #FSt$Ac,F$Sts(R4) ;*C* Set active Return ;~x~ ...... ; ; Journal file exists ... ; 150$: ;~x~ Push ;Save current recovery session state Clr RecSsn ;Force off why asking question Jsr R4,ErrPmt ;~x~Find out if user wants to continue .Word EriJFE ;"Journal file exists - Replace?" Bne 155$ ;~x~User said no, quit now Tst (PC)+ ;Clear carry, skip SEC - said yes 155$: Sec ;~x~Said no Pop ;Restore recovery session state Bcs 260$ ;Away if no ; ; Enter the journal file ; 160$: Tst JouOp ;~x~Auxiliary or journal file? Beq 130$ ;~x~ Auxiliary ; Journal 170$: Mov JouFil+D.Size,R2 ;~x~Get journal size Bne 180$ ;~x~If specified Mov ..JSiz,R2 ;Else use ..JSiz 180$: .Enter Area,@R4,F$NamA(R4),R2 ;~x~Open file of ..JSiz size Bcs 200$ ;~x~no good 190$: ;~x~ Mov R0,JouOp ;Return size of file entered Br 140$ ;~x~Successful enter ........... 200$: ;~x~Space problem? CmpB #E.Siz,@#JErB ;Is it? Bne 250$ ;~x~No, then no hope .Enter Area,,,#0,Code=NOSET ;~x~try for 1/2 of largest Bcc 190$ ;~x~got some space Br 250$ ;~x~give up ............ ; ; lookup input file ; 210$: Call 270$ ;~x~ look for file Bcs 240$ ;~x~nogood Clr F$BCtr(R4) ;no chars in buffer now Call 145$ ;~x~clear block number and set active Call RdFil ;~x~read the first block Bcs 240$ ;~x~error 220$: Clc ;~x~ Return ;~x~ ...... 230$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;FETCH failed for device passed to $OPFIL ;- 240$: ;~x~ Call ClsChn ;~x~close the channel ;+ ;HELPER HELPER ;~x~ ;.LOOKUP failed for auxiliary input file ;- 250$: ;~x~ Call ClsChn ;~x~close the channel 260$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;.ENTER failed for auxiliary output file ;or CLOSE failed during clash check ;- 270$: .Lookup Area,@R4,F$NamA(R4) ;~x~ Return ;~x~ ...... .If NE 0 ;never assemble here ;+ ;ERROR ErIAOE:: ;~d~ .Ascii /Auxiliary output file exists - Replace (Y,N) ? / ;~d~ .Byte ;~d~ ;Attempt to open an auxiliary output file which exists. YES will replace ;existing file with new one. NO will abort the command. ;- ;+ ;ERROR EriJFE:: ;~d~ .Ascii /W-Journal file exists - Replace (Y,N) ? / ;~d~ .Byte ;~d~ ;Attempt to open a journal file which already exists. YES will replace ;existing file with new one. NO will abort the command. ;- .EndC; NE 0 ;never assemble here .Dsabl LSB .SbTtl $OPINI - Open initialization file ;++ ;$OpIni ; ;functional description: ; ;Open the initialization file using the RT defaults: DK:KEDINI.KED and ;SY:KEDINI.KED ; ;output: ; C = 1 if command file is not open ; Z = 1 if user did specify a command file ;-- .Enabl LSB $OpIni:: ;~x~ Mov #InitDK,R0 ;Use the DK:KEDINI.KED as the default Mov #,R1 ;Point to the init file descriptor Call Mov401 ;~x~And move the default name in Mov #,R1 ;Point to the init file descriptor Clr R3 ;Assume the user didn't specify Mov #InitFl,R2 ;Now replace default with user-spec'd Tst @R2 ; if there was any Beq 20$ ;~x~There wasn't any Mov #2,R3 ;Indicate user did specify the file Mov @R2,@R1 ;Substitute the device name Tst 2(R2) ;Did the user specify a file name? Beq 10$ ;~x~Nope Mov 2(R2),2(R1) ;Substitute the file name Mov 4(R2),4(R1) ; 10$: Tst 6(R2) ;~x~Did the user specify a file type? Beq 20$ ;~x~Nope Mov 6(R2),6(R1) ;Substitute the file type 20$: Clr R2 ;~x~Indicate Jo$Inp file descriptor is Mov #Jo$Inp,R4 ; ready for opening Call $OpF50 ;~x~Open it Bcc 40$ ;~x~Good Tst R3 ;Did we use DK:KEDINI.KED default? Bne 30$ ;~x~No, error Inc R3 ;Only go around once Mov #<^RSY >,f$fnam(R4) ;Try SY! Br 20$ ;~x~ ........... 30$: Cmp R3,#2 ;~x~Did the user specify a file? ; Z=1 if user specified ; Z=0 if default Sec ;*C*,*Z* Return ;~x~*C*,*Z* Return C=1, Z=1 ...... 40$: Clc ;~x~No error Return ;~x~ ...... .DsAbl LSB .SbTtl $CLSFL - Close an auxiliary file ;++ ;$clsfl ; ;functional description: ; ; close an auxiliary file ; ;input: ; r4 -> file block ; ;output: ; file closed, last buffer written if needed ;-- .Enable LSB $clsfl:: ;~x~ Clc ;No error BitB #FSt$Ac,F$Sts(R4) ;*C* active?? Boff 20$ ;~x~Nope BitB #fst$io,f$sts(r4) ;Output? Boff 10$ ;~x~Nope input Call wrtxfl ;~x~Write last buffer Bcc 10$ ;~x~Ok Call 30$ ;~x~Error closing file 10$: BicB #fst$ac,f$sts(r4) ;~x~Not active Call clschn ;~x~Close the file Bcs 40$ ;~x~Error closing file 20$: Return ;~x~ ...... 30$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;write to output failed during close ;- 40$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;Probably attempt to violate protection under RSTS by writing into another ;acct. ;- .SbTtl CLSCHN - Close an auxiliary channel ;++ ;clschn ; ;functional description: ; ; close an auxiliary channel ; ;input: ; r4 -> file block ; ;output: ; c set if error occured ;-- .Enable LSB ClsChn: .Close @r4 ;~x~the proper channel Return ;~x~return c to caller ...... .SbTtl $PRGFL - Purge an auxiliary file ;++ ;$prgfl ; ;functional description: ; ; purge an auxiliary file ; ;input: ; r4 -> file block ; ;output: ; file purged ;-- .Enable LSB $PrgFl:: ;~x~ .Purge @r4 ;~x~purge the file BicB #fst$ac,f$sts(r4) ;mark inactive Return ;~x~ ...... .SbTtl PUGALL - Mark all files inactive ;++ ;prgall ; ;functional description: ; ; purge all files (mark inactive) ; ;input: none ; ;output: ; all files marked inactive ; ;register usage: ; r1, r2 used without restoration ;-- .Enable LSB prgall:: ;~x~ Mov #fillst,r1 ;list of files 10$: ;~x~ Mov (r1)+,r2 ;first file Beq 20$ ;~x~end of list BicB #fst$ac,f$sts(r2) ;mark not active Br 10$ ;~x~ ........... 20$: return ;~x~ ...... .SbTtl $PUTCH - Write a char to auxiliary file ;++ ;$putch ; ;functional description: ; ; write a character to an auxiliary file ; ;input: ; r4 -> file block ; r0 = char ; ;output: ; c set if error ;-- .Enable LSB $putch:: ;~x~ CmpB #fst$ac!fst$io,f$sts(r4) ;good output file? Bne 40$ ;~x~nope Tst f$bctr(r4) ;enough chars Bgt 20$ ;~x~plenty Cmp R4,#Jo$Out ;Is this the journal we're writing? Bne 10$ ;~x~Nope Clr JoFCnt ;Yup, zero the modification counter Mov Sp,JoWFlg ;Flag we wrote over block boundry 10$: Call wrtxfl ;~x~write the block Bcs 40$ ;~x~error 20$: MovB r0,@f$bptr(r4) ;~x~put a char Beq 30$ ;~x~do not store nulls Inc f$bptr(r4) ;next address Dec f$bctr(r4) ;one less 30$: Tst (pc)+ ;~x~-) 40$: Sec ;~x~-( Return ;~x~ ...... .Dsabl LSB .SbTtl WRTXFL - Write a buffer to an auxiliary file ;++ ;wrtxfl ; ;functional description: ; ; write a buffer to output file ; ;input: ; r4 -> file block ; ;output: ; buffer written, setup for next time ;-- .Enable LSB WrtXFl:: ;~x~ SavReg ;save all the registers Sub #fb$siz,f$bctr(r4) ;bytes to write Beq 30$ ;~x~none Neg f$bctr(r4) ;make a proper count Inc f$bctr(r4) ;round up to words Bit #1,f$bctr(r4) ;fill last word? Bon 10$ ;~x~nope Clrb @f$bptr(r4) ;yes- zap top of last word 10$: Asr f$bctr(r4) ;~x~make words .writw area,@r4,f$bufa(r4),f$bctr(r4),f$blkn(r4) ;~x~ bcs 40$ ;~x~error Add #fb$bks,f$blkn(r4) ;next block 20$: ;~x~ Mov f$bufa(r4),f$bptr(r4) ;setup pointer Mov #fb$siz,f$bctr(r4) ;counter 30$: clc ;~x~no error return ;~x~ ...... 40$: Call 20$ ;~x~adjust pointers and counters .Assume E.EOF EQ 0 TstB @#JErB ;error type Beq 50$ ;~x~end of file ;+ ;HELPER HELPER ;~x~ ;.WRITE failed for auxiliary output file. File is not closed or purged ;The user may do either of these things depending on the type of error ;he suspects. Garbage may be in the file at the point of error. ;- 50$: Cmp R4,#Jo$Out ;~x~Is this the journal we're writing? Bne 70$ ;~x~No JouOff ;Terminate journaling BicB #FSt$Ac,F$Sts(R4) ;and deactivate file Push TtInp ;Save input mode Clr TTInp ;Make query at the terminal Jsr R4,ErrPmt ;~x~Find out if user wants to exit .Word EriJFF ;"Journal output file full - ; Exit (Y,N)?" Beq 60$ ;~x~Go Exit Pop TtInp ;Restore input mode Br 30$ ;~x~Don't exit ........... 60$: Pop TtInp ;~x~Restore input mode CallR SpcExt ;~x~Say Goodnight Gracie .............. 70$: ;~x~ ;+ ;HELPER HELPER ;~x~ ;end of space reached in output file. The file is not closed or purged. ;The user may do either of these things at this point. ;- .If NE 0 ;never assemble here ;+ ;ERROR ErIJFF:: ;~d~ .Ascii /Journal output file full - Exit session (Y,N)? / ;~d~ .Byte ;~d~ ;there is no more room to write the journal file. The user ;may want to end the session at this point because further editing ;in this session will not be journaled. If the user replies "Y", an ;EXIT is performed (the text file is saved). ;- .EndC; NE 0 ;never assemble here .Dsabl LSB .SbTtl $GETCH - Read character from auxiliary file ;++ ;$getch ; ;functional description: ; ; read character from auxiliary input file ; ;input: ; r4 -> fileblock ; ;output: ; r0 = next char from file ;-- .Enable LSB $getch:: ;~x~ CmpB #fst$ac,f$sts(r4) ;valid file?? ;this assumes FSt$IO=0 for input files Bne 30$ ;~x~nope 10$: ;~x~ Tst f$bctr(r4) ;buffer empty? bgt 20$ ;~x~nope Call rdfil ;~x~read next buffer bcs 30$ ;~x~error 20$: ;~x~ MovB @f$bptr(r4),r0 ;get char inc f$bptr(r4) ;next address dec f$bctr(r4) ;one less char ;>>> change for8Bit bic #^c177,r0 ;clear parity and char null? beq 10$ ;~x~yes- ignore Tst (pc)+ 30$: sec ;~x~return error return ;~x~ ...... .Dsabl LSB .SbTtl RDFIL - Read buffer from auxiliary file ;++ ;rdfil ; ;functional description: ; ; read buffer from auxiliary input file ; ;input: ; r4 -> fileblock ; ;output: ; next buffer in place ;-- .Enable LSB rdfil:: .readw AREA,@r4,f$bufa(r4),#fb$wds,f$blkn(r4) ;~x~ bcs 10$ ;~x~ Add #fb$bks,f$blkn(r4) ;next block number Mov f$bufa(r4),f$bptr(r4) ;setup pointer Mov #fb$siz,f$bctr(r4) ;char counter clc return ;~x~ ...... 10$: ;~x~ .Assume E.EOF EQ 0 TstB @#JErB ;error?? type?? beq 20$ ;~x~end of file ;+ ;HELPER HELPER ;~x~ ;.READW failed for reasons other than end of file ;- 20$: ;~x~ Call $clsfl ;~x~close the input file ;help message is set by caller sec ;signal end of file return ;~x~ ...... .Dsabl LSB .SbTtl .SbTtl Journal File Routines .SbTtl .SbTtl $JOINCL - Include in journal file ;+ ;$JOINCL - Include recent input in journal file ; ;FUNCTIONAL DESCRIPTION: ; ;If journaling is on, the last modification marker is moved up to ;include the most recent changes to the journal output buffer ; ;MUST PRESERVE R3 FOR CHDSP ROUTINE IN KEDCM1 ; ;OUTPUT: ; ;R4 destroyed ;- .Enabl LSB $JoIncl:: ;~x~ IsJou ;Are we journaling? Beq 50$ ;~x~Nope IsAbt ;Are we processing an abort record? Bne 10$ ;~x~Yup, skip initializing counter Clr StpCtr ;Yup, clear out the step counter for Clr StpCtr+2 ; the next command 10$: SavReg ;~x~ Clr JoWFlg ;Clear journal-just-written flag Mov #Jo$Out,R4 ;Point to journal output descriptor Mov #JTmpBF,R1 ;R1-> Beginning of journal temp buffer 20$: Cmp R1,JTPtr ;~x~Are we done cleaning the buffer? Beq 30$ ;~x~Yup MovB (R1)+,R0 ;Move another char to the permanent Call $PutCh ;~x~ journal buffer Tst JoWFlg ;Did we just do a write? Beq 20$ ;~x~Nope Call $WrtJo ;~x~Yup, put ^Z in file next to mark EOF Br 20$ ;~x~Next character ............ 30$: Mov #JTmpBF,JTPtr ;~x~Reinitialize temp buffer pointer Inc JoFCnt ;Increment count of modifications ; not yet written to journal Tst JoFreq ;Any specified frequency limit? Beq 50$ ;~x~Nope, carry on Cmp JoFCnt,JoFreq ;Are we within the frequency limit? Blt 50$ ;~x~Yup, okay CallR $WrtJo ;~x~Nope, write what we've got .............. .SbTtl $JOEXCL - Exclude from journal file ;+ ;$JOEXCL - Exclude recent input from journal file ; ;FUNCTIONAL DESCRIPTION: ; End of journal input marker is moved back where the last modification was ;recorded in the journal output buffer. Used following cursor movement ;commands are entered so the the journal file is not littered with cursor ;movement input. A single cursor position record is put in the journal file. ;If several cursor movement commands are entered in a row, the position record ;will be overwritten several times and the final record will contain the ;cumulative cursor position change. If a block boundary has been hit and the ;journal file has been written between now and the last modification, go ;do $JoIncl to eliminate the possibility of a partial movement command being ;entered in the journal. ; ;MUST PRESERVE R3 FOR CHDSP ROUTINE IN KEDCM1 ;- $JoExcl:: ;~x~ IsJou ;Are we journaling? Beq 50$ ;~x~Nope Bit #,TtInp ;Are we doing /REC,/COM or learning? Bne $JoIncl ;~x~Yup, journal everything ; IsJRe ; IsLrn Clr StpCtr ;Reset step counter Clr StpCtr+2 ; (double precision) 40$: Mov #JTmpBf,JTPtr ;~x~Initialize the temp buffer again Call $WrPos ;~x~Write a position record in journal 50$: Return ;~x~Return for $JoIncl and $JoExcl ...... .Dsabl LSB .SbTtl $WRTJO - Write to journal file without updating counters ;+ ;$WrtJo ; ;FUNCTIONAL DESCRIPTION: ; ;Write buffer to the journal file even if it is not full: ; ; If it isn't full, do not update FILSET information so that the block can ;be filled and written out again when it is full. ; ; If it is full, write out the full block first, then put ^Z in the buffer ;and write it out as described above for a buffer that isn't full. ;- .Enabl LSB $WrtJo:: ;~x~ IsJou ;Are we journaling? Beq 30$ ;~x~No SavReg ;~x~Yes, save some registers Mov #Jo$Out,R4 ;Look at the journal file Tst f$bctr(r4) ;Is the buffer full bgt 10$ ;~x~No Call WrtXFl ;~x~Yes, write out the full buffer first ; then write the partial with ^Z Bcs 40$ ;~x~Error 10$: Push ;~x~Remember the block number Push ; and buffer pointer Push ; and buffer counter MovB #,R0 ;Put an end of file marker Call $PutCh ;~x~ in the buffer Bcs 20$ ;~x~Error, skip write routine Call WrtXFl ;~x~Write out the buffer 20$: Mov #0,JoFCnt ;~x~*C* Zero the modification count Pop ;*C* Pop ;*C* Pop ;*C* Bcs 40$ ;~x~Error 30$: Return ;~x~ ...... 40$: JouOff ;~x~Terminate journaling Push TtInp ;Save input mode Clr TTInp ;Make query at the terminal Jsr R4,ErrPmt ;~x~Find out if user wants to exit .Word EriJOE ;"Journal file I/O error- Exit (Y,N)?" Beq 50$ ;~x~Go exit Pop TtInp ;Restore input mode Return ;~x~ ...... 50$: Pop TtInp ;~x~Restore input mode CallR SpcExt ;~x~Exit .............. .If NE 0 ;never assemble here ;+ ;ERROR ErIJOE:: ;~d~ .Ascii /Journal file output error - Exit session (Y,N)? / ;~d~ .Byte ;~d~ ;there was an error (not file full) on a write to the journal. The user ;may want to end the session at this point because further editing ;in this session will not be journaled. If the user replies "Y", an ;EXIT is performed (the text file is saved). ;- .EndC; NE 0 ;never assemble here .Dsabl LSB .SbTtl $RDREC - Common routine for $RDPOS and $RDABT and $RDPMT .SbTtl $RDPOS - Read position record from journal .SbTtl $RDABT - Read abort record from journal .SbTtl $RDPMT - Read prompt record from journal ; ;$RdPos ; ;Functional Description: ; ;Read a position record from the journal input file, and reposition ;the cursor as specified in the record. ;;Note that a position record may fall between an abort record and the command ;to be aborted. Abort records will never apply to position processing because ;/RECOVER files cannot be aborted. Thus, abort info will always be preserved ;during the processing of a position record. ; ; ;$RdAbt ; ;Functional Description: ; ;Read an abort record from the journal input file, and put the information ;in the abort step counter so that the next command will be aborted at ;the appropriate spot, and turn the abort flag on. ; ; ;$RdPmt ; ;Functional Description: ; ;While processing a /RECOVER, read a prompt response record from the journal ;input file, and set the prompt default. ; .Enabl LSB $RdRec:: ;~x~ SavReg ;Save registers Clr R1 ;Clear the R1,R2 to hold Clr R2 ; recorded position Mov #11.,R3 ;Count 11. digits 10$: Call TtyIn ;~x~Try to read record identifier... CmpB #,R0 ;Was this a duplicate ^C? Beq 10$ ;~x~Yup, get the next letter CmpB #<'P>,R0 ;Is it a prompt record? Beq $RdPmt ;~x~Yes Mov #<$RdPos>,R4 ;Assume we have a position record CmpB #<'A>,R0 ;Is it an abort record? Bne 30$ ;~x~No Mov #<$RdAbt>,R4 ;Move abort routine address to R4 20$: Call TtyIn ;~x~Read octal digit 30$: Sub #'0,R0 ;~x~Subtract ascii bias .Rept 3 Asl R1 ;Make room for octal digit Rol R2 ; in double precision number .EndR Add R0,R1 ;Add in digit Sob R3,20$ ;~x~Do next digit ;>>>callr? Call @R4 ;~x~Call processing routine Return ;~x~ ...... $RdPos: Push TtInp ;~x~Save input mode AbtOff ;Turn abort mode off incase this ; position record falls between an ; abort record and the aborted command Call RgnPos ;~x~Regain that position Pop TtInp ;Restore input mode Clr RepCtr ;Clear repeat counter Return ;~x~ ...... $RdAbt: Mov R1,AbtAt ;~x~Put the total number of steps to Mov R2,AbtAt+2 ; take in the d.p. counter Clr StpCtr ;Start counting the next command from Clr StpCtr+2 ; zero (d.p) AbtOn ;Flag that next command is to be ; aborted after AbtAt(+2) steps Return ;~x~ ...... $RdPmt: Call TtyIn ;~x~Get the response character MovB R0,PmtDef ;And put it in the default response Return ;~x~ ...... .Dsabl LSB .SbTtl $WRREC - Common routine for $WRPOS and $WRABT .SbTtl $WRPOS - Write position records in journal .SbTtl $WRABT - Write abort records in journal ; ;$WrPos ; ;Functional Description: ; ;Write a position record to the journal file based on the current ;value of PosCtr and PosCtr+2. The record has the form: ; ; nnnnnnnnnnn ; ;where nnnnnnnnnnn is the ascii octal representation of the signed double ;precision position counter. The position counter is relative to the position ;the cursor was left at after the last modification was made. ; ;$WrAbt ; ;Functional Description: ; ;Write an abort record directly to the journal file so that it preceeds the ;command that was aborted. The abort record has the current value of ;StpCtr and StpCtr+2 which is the number of basic steps made by the command ;before it was aborted. The record has the form: ; ; nnnnnnnnnnn ; ;where nnnnnnnnnnn is the ascii octal representation of an unsigned double ;precision step counter. The step counter is initialized to zero before each ;command is processed. ; .Enabl LSB $WrPos:: ;~x~ IsJou ;Do we have a journal? Beq 50$ ;~x~No SavReg Mov PosCtr,R3 ;Make copy of the position Mov PosCtr+2,R5 ; counter MovB #,R0 ;Put "^C" in journal for special Call Journl ;~x~ record. ; MovB #,@JTPtr ; Inc JTPtr Mov #2,R1 ;Start with 2 bits for high digit Mov #11.,R2 ;There'll be 11. digits all together Br 20$ ;~x~ ........... 10$: Mov #3,R1 ;~x~Next three bits make an octal digit 20$: Call $WrRec ;~x~R0 = digit character Call Journl ;~x~Put character in temp journal buffer ; MovB R0,@JTPtr ;Put character in the journal buffer ; Inc JTPtr ; and increment pointer Sob R2,10$ ;~x~Until all 11. are done Return ;~x~ command in journal ...... $WrAbt:: ;~x~ IsJou ;Do we have a journal? Beq 50$ ;~x~No SavReg ;Save those registers Mov StpCtr,R3 ;Make copy of the step counter Mov StpCtr+2,R5 ; Mov #Jo$Out,R4 ;R4-> journal output file descriptor MovB #,R0 ;"^C" marks special record Call $PutCh ;~x~ MovB #<'A>,R0 ;Put in an "A" to mark it as an Call $PutCh ;~x~ abort record Mov #2,R1 ;Start with 2 bits for high digit Mov #11.,R2 ;There'll be 11. digits all together Br 40$ ;~x~ ........... 30$: Mov #3,R1 ;~x~Next three bits make an octal digit 40$: Call $WrRec ;~x~R0 = digit character Call $PutCh ;~x~Put abort info in file before command Sob R2,30$ ;~x~Until all 11. are done 50$: Return ;~x~ $WrRec: Clr R0 ;~x~Build ASCII digit in R0 60$: Asl R5 ;~x~Slide bits out the right Rol R0 ;Roll them into R0 Asl R3 ;Double precision Adc R5 ; Sob R1,60$ ;~x~Loop until have whole digit Add #'0,R0 ;And add ASCII bias Return ;~x~ .Dsabl LSB .SbTtl $WRPMT - Write prompt records in journal ; ;$WrPmt ; ;Functional Description: ; ;After the user has responded to an ERRPMT query, write a prompt ;response record to the journal file using the response character in R0. ; ;The record has the form: ; ; Px ; ;where x is the ascii representation of the response given by the user. ; .Enabl LSB $WrPmt:: ;~x~ IsJou ;Do we have a journal? Beq 10$ ;~x~No SavReg ;Save those registers Mov #Jo$Out,R4 ;R4-> journal output file descriptor MovB #,R0 ;"^C" marks special record Call $PutCh ;~x~ MovB #<'P>,R0 ;Put in an "P" to mark it as an Call $PutCh ;~x~ prompt response record MovB PmtDef,R0 ;Put in the response character Call $PutCh ;~x~Put abort info in file before command 10$: Return ;~x~ .DsAbl LSB .End KedStr ;~x~Transfer address for Ked