.MCall .Module .Module KEDIO2 RELEASE=V02 VERSION=18 COMMENT=,IDENT=NO,AUDIT=NO,GLOBAL=.KEDI2 ; 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. ; ; 018 21-Feb-1997 ARB ; Fixed PAT$G3 and TtyErr references to KEDIO1 ; and globalized UsePPn, UsPPn, SvPPn, RSTmov ;+ ;COND ; ; Rsts$ ; Virt$ ; Min$c ; $KED$ ;- ;MODULE: KedIO2 ; ;ABSTRACT: ; ; This is the second part of the system dependent package ; to support the keypad editor under RT-11. It contains ; most of the editor's startup routines. ; .SbTtl KedIOO RT-11 system dependent routines .Enable LC .Enable GBL .SbTtl Assembly parameters: .SbTtl .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 ; .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 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.FNF =: 1 ;File Not Found E.Prot =: 3 ;Protected file JRMON =: 54 ;RMON base ; ; RT11 chain area ; JChain =: 500 ;DBLK for program to chain to JChnArg =: 510 ;beginning of arguments for chain ; ; 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 ; .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 ; ; I/O channels used by scroller ; ; Note: Input channel changed for RT-11 V5.5 to interface ; with BASIC-Plus. JMP Ou$Chn ==: 13. ;output channel In$Chn ==: 14. ;input channel .If NE Rsts$ Cp$Chn ==: 24. ;channel for RSTS shutdn copy ; same as jo$inp .EndC; Ne Rsts$ ; ; 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 setout routine ; OuInc =: 50. ;Increment to derive output ;file size OuMin =: 10. ;Minimum amount to allow to insert ;without message MaxSiz =: 077777 ;Maximum output file size .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 .MCall .SCCA .SErr .SetTop .SpFun .SReset .MCall .TtInR .TtyIn .TtyOut .MCall .WritW ;From KEDMAC.MLB .MCall ...... Bon Boff DfnChn .MCall Pop $Print PSect Push SavReg .If EQ Virt$ .MCall Sob .EndC; EQ Virt$ .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 KedIO2 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 I2,Err ;Invoke macro to define error macro ;- ;+ ;HELPER ; .MCall HlpDef HlpDef I2 ;Invoke macro to define help macro ;- .SbTtl .SbTtl Pure Data PSect .TXT. ;text data ; ; our calling card ; HloTxt: ;~d~ .Byte ,, ;~d~ .Ascii " " ;~d~ .Byte ,, ;~d~ .Ascii "." ;~d~ .Byte , ;~d~ ; ; Byte to contain patch level character ; PatLvl:: ;~d~ .Byte Pat ;~d~second patch .Asciz "" ;~d~end the string PSect KEDIO .SbTtl PSect KEDIO .SbTtl TTYFIX - setup the console ;++ ;TtyFix ; ;functional description: ; ; Determine which operating system we are under (RSTS, ; RT w/MTTY, RT FB!XM w/o MTTY, or RT SJ w/o MTTY). ; Save the current terminal status and reset the status ; to what KED wants. ; ;input: ; ; Rt$Rts should be set (for Rsts$ version) ; ;output: ; ; TTYRST is set to address of proper restore routine ; old status is saved in TTYSAV ;-- .Enable LSB TtyFix:: ;~x~ SavReg ;save registers Mov #TtyRst,R1 ;point to save area Mov Area,R2 ;point to data area Mov R2,R3 ;point to EMT parm block Add #6.,R2 ;skip EMT block area Mov #TtyNop,@R1 ;assume SJ, restore is nop .If NE Rsts$ Tst Rt$Rts ;are we running under RSTS? Boff 60$ ;~x~yes ; ;else must be RT itself .EndC; NE Rsts$ ;;; .GVal R3,#Sysgn$ ;test for single or multi-terminal .GVal #GSysgn,Code=NoSet ;~x~test for single or multi-terminal Bcs TtyEr1 ;~x~failed Bit #MTty$,R0 ;is it Multi? Boff 30$ ;~x~no ; ;else MTTY Mov #TtyMTt,(R1)+ ;restore is Multi-terminal type MovB GetJob+<5*2>,R4 ;R4 now contains console number Mov R4,(R1)+ ;save unit number .MTAtch R3,#0,R4 ;~x~attach the terminal Bcc 10$ ;~x~attach was ok, just return Call TtyAsk ;~x~warn and ask for permission Mov #TtyNop,-4(R1) ;give up, don't try to restore Br 20$ ;~x~just return ........... 10$: ;~x~ .MTGet R3,R2 ;~x~get its current characteristics Bcs TtyEr1 ;~x~failed Push R2 ;save status block address Mov #4,R0 ;four words to move Call TTyMov ;~x~call the move routine Pop R2 ;get the address back Bis #XOn$!LC$!Scope$,@R2 ;enable XON/XOFF, lowercase, scope Bic #CrLf$,@R2 ;disable at margin .MTSet R3 ;~x~and set them Bcc 20$ ;~x~succeeded Jmp 40$ ;~x~failed ........... 20$: Br 70$ ;~x~done ........... 30$: ;~x~SINGLE TERMINAL ;;; .GVal R3,#Confg$ ;test to see if SJ/FB/XM .GVal #GConfg,Code=NoSet ;~x~test to see if SJ/FB/XM TtyEr1: ;~x~make prev BCS reach Bcc 50$ ;~x~suceeded 40$: Jmp TtyErr ;~x~failed .............. 50$: Bit #FB$,R0 ;~x~is it SJ? Boff 70$ ;~x~can't set it if SJ Mov #TtySTT,(R1)+ ;restore is Single-terminal type ;;; .GVal R3,#$TCfig ;get address of TTCNFG word .GVal #GTCfig,Code=NoSet ;~x~get address of TTCNFG word Mov R0,R2 ;save it in R2 .Peek R3,R2 ;~x~get the value Mov R2,TtySav ;save address Mov R0,TtySav+2 ;save current status Bis #XOn$!LC$!Scope$,R0 ;enable XON/XOFF, lowercase, scope Bic #CrLf$,R0 ;disable at margin Push R0 ;save it for a sec(ond) .Poke R3,,(SP)+ ;~x~put it back Br 70$ ;~x~done ........... .If NE Rsts$ 60$: ;~x~RSTS type pat$g8:: ;~x~ Mov #TtyNop,(R1)+ ;restore is ????? type .ClrFQB ;~x~clear the FQB Call TtyTrm ;~x~issue RSTS terminal status request Beq 65$ ; ;018 Jmp TtyErr ;~x~failed ;018 65$: Mov #FQB+6,R2 ;point to data to save ;018 Mov #11.,R0 ;11 words to move Call TTyMov ;~x~save it pat$g2:: ;~x~ .ClrFQB ;~x~clear out the FQB again Mov #KedTrm,R1 ;point to characteristics to set Jmp PAT$G3 ;~x~go setup FQB and set terminal ;018 .............. RSTMov:: ; ;018 Mov #FQB+6,R2 ;~x~point to FQB area MovB (R1)+,(R2)+ ;copy a byte to +6 CmpB (R1)+,(R2)+ ;skip +7 Cmp (R1)+,(R2)+ ;skip +10(&11) Mov (R1)+,(R2)+ ;copy +12(&13) Mov (R1)+,(R2)+ ;copy +14(&15) Cmp (R1)+,(R2)+ ;skip +16(&17) Cmp (R1)+,(R2)+ ;skip +20(&21) Mov (R1)+,(R2)+ ;copy +22(&23) Cmp (R1)+,(R2)+ ;skip +24(&25) CmpB (R1)+,(R2)+ ;Skip +26 MovB (R1)+,(R2)+ ;Move a byte to +27 Mov (R1)+,(R2)+ ;copy +30(&31) .EndC; NE Rsts$ 70$: ;~x~ Return ;~x~done or gave up ...... ;;; .GVal R3,#Sysgn$,Code=List ;test for single or multi-terminal GSysGn: ;~d~ .Byte ..GVal,.GVal ;~d~ .Word Sysgn$ ;~d~ ;;; .GVal R3,#Confg$ ;test to see if SJ/FB/XM GConfg: ;~d~ .Byte ..GVal,.GVal ;~d~ .Word Confg$ ;~d~ ;;; .GVal R3,#$TCfig ;get address of TTCNFG word GTCfig: ;~d~ .Byte ..GVal,.GVal ;~d~ .Word $TCFig ;~d~ .Dsabl LSB .SbTtl $CSI - Command String Interpreter ;+ ;$CSI ; ;functional description: ; ; command string interpreter ; ;output: ; C-SET on error ; R0=Max block of input file, -1 for no file ; R1=Max block of output file, -1 for no file ; ; INSPCT = 1 if inspect mode ;- .Enable LSB $CSI:: SavReg ;~x~ 10$: ;~x~ ;;; .SCCA Area,#0 ;reset ctrl/C trapping .SCCA #NoSCCA,Code=NoSet ;~x~reset ctrl/C trapping .If NE Rsts$ Tst Rt$RTS ;RSTS? Bon 20$ ;~x~no Clr R0 ;no more trapping ctrl/c .CtrlC 20$: ;~x~ .EndC; NE Rsts$ $Print #AltOff ;~x~keypad back to numeric mode Call $SpOff ;~x~turn special mode off ;Note: preserve channels for chaining programs (BASIC-Plus) .RCtrlO ;~x~reset ctrl/O Mov HdlBas,HdlSpc ;reset base of handlers for us Mov PlyGnd,R4 ;address for command string Call @TtyRst ;~x~restore terminal characteristics Clr R1 ;assume not chained to Tst Chain+2 ;were we? Boff 30$ ;~x~no Mov #ChnArg,R1 ;point to command line Br 40$ ;~x~and go get it ........... ;~x~if we weren't chained to 30$: .SReset ;~x~ reset all files and handlers DfnChn ;~x~Redefine channels 40$: .CSISpc #OutFil,#DfTyps,R1,R4 ;~x~get command line Bcs 50$ ;~x~illegal command string Call TtyFix ;~x~set new terminal characteristics Call $SpOn ;~x~turn special mode on $Print #AltOn ;~x~and set keypad to applicaton mode ;Check for illegal command line Call DmpSwt ;~x~dump switches 50$: Bcs 150$ ;~x~br if illegal command string TstB @R4 ;command line entered? Bon 60$ ;~x~br if so $Print #HloTxt ;~x~else print Ked id Br 170$ ;~x~check for chaining ............ 60$: Tst Ou3Fil ;~x~check for extra output file spec Bon 150$ ;~x~error if not empty Mov #In4Fil,R1 ;check for extra input file specs Mov #12.,R2 ;3 at 4 words each 70$: Tst (R1)+ ;~x~should be all nulls Bon 150$ ;~x~error if not Sob R2,70$ ;~x~check next byte ;Process command line .If NE Rsts$ Jsr R4,SavPPN ;~x~save ppn info if rsts .Word InFil,inPPN ;src and dst Jsr R4,SavPPN ;~x~save for output too .Word OutFil,OutPPN ;src and dst .EndC; NE Rsts$ Force: ;~x~entry for forced /I Mov #OutFil,R1 ;pointer to output file block Mov #InFil,R2 ;pointer to input file block Tst @R2 ;any input file specified? Boff 80$ ;~x~nope Cmp D.Type(R2),#IllR50 ;was an extension specified? Bne 80$ ;~x~yes, leave it Mov ..IExt,D.Type(R2) ;assume Inspect mode Tst Inspct ;Inspect mode? Bon 80$ ;~x~yes Mov ..EExt,D.Type(R2) ;no, use other default 80$: Cmp D.Type(R1),#IllR50 ;~x~was an output extension specified? Bne 90$ ;~x~yes Mov InFil+D.Type,D.Type(R1) ;use input file's extension, if any Tst InFil+D.Name ;is there an input file? Bon 90$ ;~x~yes Mov ..EExt,D.Type(R1) ;no, use editting default extension 90$: ;~x~ Tst Inspct ;inspect mode specified? Boff 100$ ;~x~br if not Tst @R1 ;else check for output file Bon 150$ ;~x~error if one specified Br 140$ ;~x~else continue ........... 100$: ;~x~ Tst CSwt ;create a file? Bon 110$ ;~x~br if so Tst @R2 ;input file specified? Boff 140$ ;~x~br if not Tst @R1 ;else check for back-up case Boff 110$ ;~x~yes, back-up file ;not back-up if output file Tst D.Name(R1) ;is there an output dev w/o file name? ; (TSX+) Bon 140$ ;~x~no, got a name Cmp (R1)+,(R2)+ ;skip device names Br 120$ ;~x~copy in name to out ............ 110$: ;~x~else set up for back-up Mov (R2)+,(R1)+ ;copy input file to output Mov (R2)+,(R1)+ ;copy input file to output 120$: ;~x~ Mov (R2)+,(R1)+ ;copy input file to output Mov (R2)+,(R1)+ ;copy input file to output Tst CSwt ;creating a file? Boff 130$ ;~x~br if not .Rept 4 Clr -(R2) ;else clear input file spec .EndR 130$: ;~x~ .If NE Rsts$ Tst Rt$RTS ;RSTS? Bon 140$ ;~x~br if not Mov #InPPN,R1 ;else copy the ppn across Mov #OutPPN,R2 .Rept 4 Mov (R1)+,(R2)+ .EndR .EndC; NE Rsts$ 140$: ;~x~ Call SetInp ;~x~setup input file Bcs 170$ ;~x~ Mov R0,MxIBlk ;return input file size Call SetOut ;~x~setup output file Bcs 170$ ;~x~ Mov R0,MxOBlk ;output file size Bpl 160$ ;~x~ok- not both missing Tst InFil ;was there an input file? Bon 160$ ;~x~no 150$: Br 180$ ;~x~display error, check for chaining 160$: Tst (PC)+ ;~x~Clear carry 170$: Sec ;~x~Set carry Return ;~x~- .......... 180$: ;~x~ ;+ ;ERROR Error ,F ;~x~ ; ;The format of the command line was illegal. The prompt is redisplayed ;and the user can enter another command. ;- ;;; .SCCA Area,#0 ;reset ctrl/C trapping NoSCCA: ;~d~ .Byte 0,.SCCA ;~d~ .Word 0 ;~d~ ;;; .SCCA Area,#CtrlC SCCA: ;~d~ .Byte 0,.SCCA ;~d~ .Word CtrlC ;~d~ .DsAbl LSB .SbTtl ACTIVE - Set editor to active mode ;+ ;ACTIVE ; ;functional description: ; ;Set flag to let error routines know that the edit session is active. ;Begin to trap control-C's. ;- .Enabl LSB Active:: ;~x~ Mov #CtrlC,R1 ;make abs adr of status word Clr @R1 ;clear the ast word for ;no outstanding ctrl/C ;;; .SCCA Area,R1 ;trap ctrl/C's .SCCA #SCCA,Code=NoSet ;~x~trap ctrl/C's .If NE Rsts$ Tst Rt$RTS ;RSTS Bon 10$ ;~x~nope Mov #Ctrl$C,R0 ;set ctrl/C ast .CtrlC ;~x~ 10$: ;~x~ .EndC; NE Rsts$ Clr YSwt ;/NOQUERY no longer applies Inc EdActv ;mark editor as active for errors Return ;~x~ ...... .Dsabl LSB .SbTtl SETINP - Setup input file ;++ ;SETINP ; ;functional description: ; ; setup input file ; ;input: ; HdlSpc -> area for handlers ; InFil = input file spec ; ;output: ; input file open ; R0 = max block number ; c set on error ;-- .Enable LSB SetInp: ;~x~ Clr R0 ;no blocks yet Mov #InFil,R1 ;point to file spec Tst @R1 ;any input file? Boff 30$ ;~x~no, done .DStatus #DStatus,R1 ;~x~find out about the device Bcs 40$ ;~x~unable to access device ; .Assume FilSt$ EQ 100000 Tst DStatus ;random access Bpl InvDev ;~x~no, can't edit sequential Mov R1,R0 ;point to device name Call $Fetch ;~x~fetch handler Bcs 40$ ;~x~failed .If NE Rsts$ Jsr R4,UsePPN ;~x~get the ppn to use on rsts .Word InPPN ;input file ppn .EndC; NE Rsts$ ;;; .Lookup Area,#In$Chn,R1 ;open file for input .Lookup #LookIn,Code=NoSet ;~x~open file for input Bcs 50$ ;~x~error Tst D.Name(R1) ;does the file have a name? Bon 20$ ;~x~yes Bit #VarSz$,DStatus ;variable sized? Boff 10$ ;~x~no ;;; .SpFun Area,#In$Chn,#SP$Siz,#DStatus+6 ;get size .SpFun #SpSize,Code=NoSet ;~x~get size Bcs 40$ ;~x~unable to size device 10$: ;~x~ Mov DStatus+6,R0 ;assume fixed size 20$: ;~x~ .Assume MaxSiz EQ 077777 ;;; Cmp R0,#MaxSiz ;maximum size file? ;;; Bhi TooBig ;~x~too large a file to edit Tst R0 ;test the size Bmi TooBig ;~x~too large to edit .If NE Rsts$ Tst Rt$RTS ;RSTS? Bon 30$ ;~x~nope TstB OutPPN+2 ;protection specified? Bon 30$ ;~x~yes, use it MovB @#FQProt+1,OutPPN+2+1 ;propogate rsts file protection MovB #377,OutPPN+2 ;set flag for use it .EndC; NE Rsts$ 30$: ;~x~ Dec R0 ;max block Clc ;return no error Return ;~x~return ...... 40$: ;~x~ ;+ ;ERROR Error ,F ;~x~ ;fetch failed on input device. ;device name illegal, not installed or something else caused failure ;- TooBig: ;~x~ ;+ ;ERROR Error ,F ;~x~ ;File or device is too big to edit (block number -) ;- 50$: ;~x~ CmpB @#JErB,#E.FNF ;Was it a File not found? Bne 70$ ;~x~Yes Tst OutFil+D.Dev ;any output file? Boff 60$ ;~x~no Call FlSame ;~x~is it "backup"? Bne 70$ ;~x~no, quit 60$: ;~x~ Tst Inspct ;Inspecting? Bon 70$ ;~x~give up Jsr R4,ErrPmt ;~x~ask if creation is to occur .Word EriFNF ;since we can't find it Bne 80$ ;~x~no Call $Purge ;~x~clear the channels Mov SP,CSwt ;and fake /C Pop <> ;align stack Jmp Force ;~x~force reprocessing ............. 70$: ;~x~ Call ClsIn ;~x~close input file ;+ ;ERROR Error ,F ;~x~ ;Lookup failed for input file. ;- 80$: ;~x~ Sec ;return error Return ;~x~ ...... .If NE 0 ;+ ;ERROR EriFNF:: ;~d~ .Ascii "W-File not found - Create it (Y,N)? " ;~d~ .Byte ;~d~ ;- .EndC; NE 0 InvDev: ;~x~ ;+ ;ERROR ERROR ,F ; ;The device to be used as the edit input/out device must be ;random access. This device isn't. ;- ;;; .SpFun Area,#In$Chn,#SP$Siz,#DStatus+6 ;get size SPSize: ;~d~ .Byte In$Chn,.SpFun ;~d~ .Word 0 ;~d~ .Word DStatus+6 ;~d~ .Word 0 ;~d~ .Byte -1,SP$Siz ;~d~ .Word 0 ;~d~ ;;; .Lookup Area,#In$Chn,R1 ;open file for input LookIn: ;~d~ .Byte In$Chn,.LookUp ;~d~ .Word InFil ;~d~ .Word 0 ;~d~ .Dsabl LSB ;>>>to here on cleanup .SbTtl SETOUT - Setup output file ;++ ;SetOut ; ;functional description: ; ; setup output file ; ;input: ; R0 = maxblock in input file ; OutFil = output file spec ; HdlSpc -> place to load handler ; ;output: ; R0 = max block in output file ; c set on error ;-- .Enable LSB SetOut: ;~x~ Clr R1 ;output max block Tst OutFil ;output file?? (or device) Boff 70$ ;~x~nope Mov R0,R4 ;save for later Mov OutFil+D.Size,R1 ;get size specified .If NE Rsts$ Bon 20$ ;~x~he said, so use it Tst Rt$RTS ;RSTS? Bon 20$ ;~x~for rt-11 try what he gave us ;or zero first Mov #OuInc,R1 ;get inc for output file Tst R0 ;is there an input file? Blt 10$ ;~x~br if not Add R0,R1 ;else add input size to inc 10$: ;~x~ Cmp R1,#MaxSiz ;is it too large?? Blos 20$ ;~x~no its ok Mov R0,R1 ;make its size as the input Add #OuMin,R1 ;plus the minimum length Cmp R1,#MaxSiz ;is this too large too Blos 20$ ;~x~no, continue Jmp 210$ ;~x~too big ............ .EndC; NE Rsts$ 20$: ;~x~ .DStatus #DStatus,#OutFil ;~x~find out about the device Bcs 30$ ;~x~unable to access device ; .Assume FilSt$ EQ 100000 Tst DStatus ;random access Bpl InvDev ;~x~no, can't edit sequential Mov #OutFil,R0 ;point to device name Call $Fetch ;~x~fetch handler .If EQ Rsts$ 30$: Bcs 170$ ;~x~no handler can fetch .IfF; EQ Rsts$ Bcc 40$ ;~x~fetched 30$: Jmp 170$ ;~x~failed ............ 40$: ;~x~ .EndC; EQ Rsts$ .If NE MIN$C Mov #OutFil,R0 ;point to output file Call OwnChk ;~x~check the volume owner for output Bcs 160$ ;~x~error .EndC; NE MIN$C Call FlSame ;~x~are the two files the same? Beq 100$ ;~x~yes identical .If NE Rsts$ Jsr R4,UsePPN ;~x~get ppn to use for output file .Word OutPPN .EndC; NE Rsts$ ;;; .Lookup Area,#0,#OutFil ;look for a clash .Lookup #LookOu,Code=NoSet ;~x~look for a clash Bcc 50$ ;~x~ok CmpB @#JErB,#E.FNF ;check error code for file not found Beq 100$ ;~x~no clash .If EQ Rsts$ Br 200$ ;~x~signal error ........... .IfF; EQ Rsts$ Jmp 200$ ;~x~signal error .............. .EndC; EQ Rsts$ ............ 50$: ;~x~ Call ClsOut ;~x~close channel .If NE Rsts$ Bcs 110$ ;~x~something is wrong .IfF; NE Rsts$ Bcs 210$ ;~x~something is wrong .EndC; NE Rsts$ ;;; .Enter Area ;see if it is protected .Enter #EntrOu,Code=NoSet ;~x~see if it is protected Push @#JErB&177776 ;save error code Call PurgO ;~x~purge output file CmpB (SP)+,#E.Prot ;is it? Bne 80$ ;~x~no 60$: ;~x~ Jsr R4,ErrPmt ;~x~print message with error .Word EriOFP ;the message (output file protected...) Bne 90$ ;~x~ Call $Purge ;~x~close any open channels Mov SP,Inspct ;force inspect mode Clr CSwt ;no creation Mov #OutFil,R0 Mov #InFil,R1 Call Mov401 ;~x~copy output file to input file DBLK Clr OutFil+D.Dev ;kill output DBLK Clr OutFil+D.Name Pop <> ;dump return address Jmp Force ;~x~do a forced inspection .............. 70$: ;~x~ Dec R1 ;max block Mov R1,R0 ;return in R0 Return ;~x~ ...... 80$: ;~x~ Jsr R4,ErrPmt ;~x~print message with error .Word EriOFE ;the message (output file exists...) 90$: Bne 160$ ;~x~bad return ; ; we are going to probe the target acct to see if we can ; enter, close and delete a file in the acct. ; if so its ok to edit in that acct, if not fail now not later ; 100$: ;~x~ .If NE Rsts$ Tst Rt$RTS ;only probe acct on RSTS Bon 120$ ;~x~under rt its ok Mov OutFil,TstFil ;copy device name across Jsr R4,UsePPN ;~x~get ppn to use .Word OutPPN Mov @#JRMon,R0 ;point to 'scratchpad' **POKE** Mov #000377,2(R0) ;force protection code to 'none' **POKE** ; .Assume Ou$Chn EQ 0 .Enter Area,#Ou$Chn,#TstFil,#0 ;~x~quick enter Bcs 200$ ;~x~no go Call ClsOut ;~x~try a close 110$: Bcs 210$ ;~x~use same error if failed Jsr R4,UsePPN ;~x~setup ppn again .Word OutPPN ; .Assume Ou$Chn EQ 0 .Delete Area,#Ou$Chn ;~x~delete probe file Bcs 200$ ;~x~also an error .IfTF; NE Rsts$ 120$: ;~x~ .IfT; NE Rsts$ Jsr R4,UsePPN ;~x~setup ppn again .Word OutPPN .IfTF; NE Rsts$ ; .Assume Ou$Chn EQ 0 .Enter Area,#Ou$Chn,#OutFil,R1 ;~x~ Bcs 180$ ;~x~error .IfT; NE Rsts$ Cmp R0,#MaxSiz ;is the size too large?? Blos 130$ ;~x~no its ok Mov #MaxSiz,R0 ;use max number- its big enough 130$: ;~x~ .EndC; NE Rsts$ Mov R0,R3 ;save blocks in output Mov R4,R2 ;input max block Inc R2 ;make into blocks in file Sub R2,R0 ;make residual Bge 140$ ;~x~ok enough space Call PurgO ;~x~else purge output channel Tst R1 ;already use our trump card or ; specified size Bon 220$ ;~x~yes - too few blocks Mov #177777,R1 ;no - bid trump Br 120$ ;~x~and try enter again ........... ; ; see if there is enough extra space in the file ; and if not, obtain the user's opinion. ; 140$: ;~x~ Cmp R0,#OuMin ;enough more? Bgt 150$ ;~x~ok Mov #EriAvl,R1 ;no, ask user if should continue with Mov #EriBks-EriAvl,R2 ; what we have Call ArgPmt ;~x~ Bne 160$ ;~x~user said to bag it 150$: Mov R3,R1 ;~x~use blocks in output .Assume MaxSiz EQ 077777 Bpl 70$ ;~x~ok Jmp TooBig ;~x~too big to edit .............. 160$: ;~x~ Sec ;return error Return ;~x~ ...... 170$: ;~x~ ;+ ;ERROR Error ,F ;~x~ ;fetch failed for output device. device name illegal or ;not installed. ;- 180$: ;~x~ CmpB @#JErB,#E.Prot ;protected file clash? Beq 190$ ;~x~yes, ask to inspect CmpB @#JErB,#E.DirE ;write protected device? .If NE Rsts$ Bne 200$ ;~x~no 190$: Jmp 60$ ;~x~yes, ask to inspect ........... .IfF; NE Rsts$ 190$: Beq 60$ ;~x~yes, ask to inspect .EndC; NE Rsts$ 200$: ;~x~ Call ClsOut ;~x~close output channel 210$: ;~x~ ;+ ;ERROR Error ,F ;~x~ ;fetch or enter failed for output file. ;- 220$: ;~x~ ;+ ;ERROR Error ,F ;~x~ ;space for output file is shorter than input file ;- .Dsabl LSB .List CND .If NE 0 ;never assemble here ;+ ;ERROR EriOFE:: ;~d~ .Ascii /W-Output file exists - Continue (Y,N) ? / ;~d~ .Byte ;~d~ ;a file exists with the same name as the output file. the file is not ;automatically superceded unless the output and input filenames and types ;and devices are the same. this message does not occur in that case ;since the intention is to edit a file with backup. ;- ;+ ;ERROR EriOFP:: ;~d~ .Ascii /W-Output file or device protected - Inspect (Y,N) ? / ;~d~ .Byte ;~d~ ;a file exists with the same name as the output file. ;This file is protected. The user is asked if he wants to inspect it. ;- ;+ ;ERROR EriAvl:: ;~d~ .Ascii "W-Only " ;~d~ EriBks:: ;~d~ .Ascii "nnnnn blocks available for insertions" ;~d~ .Ascii / - Continue (Y,N) ? / ;~d~ .Byte ;~d~ ;less than 10 blocks are available or inputs to file. number of ;blocks are printed in decimal (nnnnn). and the user is asked ;if he would like to proceed. ;- .EndC; NE 0 .NList CND ;;; .Lookup Area,#0,#OutFil ;look for a clash LookOu: ;~d~ .Byte Ou$Chn,.LookUp ;~d~ .Word OutFil ;~d~ .Word 0 ;~d~ ;;; .Enter Area ;see if it is protected EntrOu: ;~d~ .Byte Ou$Chn,.Enter ;~d~ .Word OutFil ;~d~ .Word 1 ;~d~ .Word 0 ;~d~ .SbTtl DMPSWT - Dump switches from the stack ;++ ;DmpSwt ; ;functional description: ; ; Dump switches from stack. The valid switches are: ; ; /A => allocation (not valid with /I) ; /C => create (not valid with /I) ; /I => inspect mode (not valid with /C) ; /N => no initialization file ; /Y => no query ; ;input: ; (SP) = count of switches on the stack ; n(SP) = switches and values ; ;output: ; No more switches on stack ; R0-R3 destroyed ; Inspct = 1 if /I specified ; CSwt = 1 if /C specified ; NSwt = 1 if /N specified ; YSwt = 1 if /Y specified ;-- .Enable LSB DmpSwt: Pop R0 ;~x~Return address Clr CSwt ;Assume no /C Clr NSwt ;Assume no /N Clr YSwt ;Assume no /Y Clr Inspct ;Assume not inspect mode Pop R1 ;*C* Get switch count Beq 100$ ;~x~If no switches ok (C-CLR) ;>>>Change for 8 bit support 10$: Bic #UCase,@SP ;~x~force char on stack to be uppercase Mov #SwtLst,R3 ;Point to the switches 20$: Tst (R3)+ ;~x~Are we done with the switch list? Beq 70$ ;~x~Yup, go dump switches CmpB -2(R3),@SP ;Is this the switch? Bne 60$ ;~x~Nope Pop <> ;Does it have a value? Bpl 50$ ;~x~Nope Bit #1,@R3 ;Is it supposed to? Beq 90$ ;~x~Nope - error Bic #1,@R3 ;Get the address for the value Pop @(R3) ;And put it in there Bis #1,@R3 ;Get the address for the value 30$: Tst (R3)+ ;~x~Point to the illegal combo list Tst @R3 ;Is there an illegal combo? Beq 40$ ;~x~No, done with this switch Tst @(R3) ;Is this flag non-zero? Bne 90$ ;~x~Yup - error 40$: Sob R1,10$ ;~x~Are there more switches Br 100$ ;~x~done ........... 50$: Bit #1,@R3 ;~x~Is it supposed to have a value? Bne 90$ ;~x~Yes - error Inc @(R3) ;Mark the flag to say we got this Br 30$ ;~x~ switch .......... 60$: Tst (R3)+ ;~x~Skip to end of option info Bne 60$ ;~x~ Br 20$ ;~x~ .......... ;Dump invalid switches 70$: Pop <> ;~x~Dump switch Bpl 90$ ;~x~Br if no value 80$: Pop <> ;~x~Else dump value too 90$: Sob R1,70$ ;~x~Keep dumping til done Sec ;Error Jmp @R0 ;~x~Return ........... 100$: Clc ;~x~No error Jmp @R0 ;~x~Return ........... .Dsabl LSB PSECT IODATA ; ;Switch, Value, Illegal combos ; ; odd value means accept a switch value, otherwise make location non-zero ; SwtLst: .Word 'A, OutFil+D.Size+1, Inspct, 0 ;~d~ .Word 'C, CSwt, Inspct, 0 ;~d~ .Word 'I, Inspct, CSwt, 0 ;~d~ .Word 'N, NSwt, 0 ;~d~ .Word 'Y, YSwt, 0 ;~d~ .Word 0 ;~d~ PSECT KEDIO ; ;ARGPMT ; ;FUNCTIONAL DESCRIPTION: ; ; Issue error prompt with decimal argument ; ;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 ArgPmt:: ;~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 .If NE MIN$C .SbTtl .SbTtl MINC specific routines .SbTtl .SbTtl Data for Ownchk ; ; data for owner check routine ; ; ; equated symbols ; VIdBlk = 1 ;volume id block OwnOfs = 362*2 ;offset to owner OwnL = 12 ;length of 'digital' PSect IODATA NonFil: .Word 0,0,0,0 ;~d~non file device for lookup OwnDec: .Ascii "DIGITAL" ;~d~ .Byte 0,0,0,0,0 ;~d~trailing nulls to treat spaces and ;nulls as legal pads .Even PSect KEDIO .SbTtl OWNCHK - Volume owner check ;++ ;OwnChk ; ;functional description: ; ; volume owner check for digital ; ; this routine checks for volume owner of 'digital' ; 'digital' implies distribution media. ; ;input: ; R0 -> dblk ; Ou$Chn is valid channel to use ; PlyGnd -> area to read vid block ; Area -> area for prgreq ; ;output: ; c set if owner is digital ; channel closed and message ; printed ;-- .Enable LSB OwnChk: ;~x~ SavReg Mov R0,R2 ;copy DBLK pointer .DStatus Area,R2 ;~x~check device type Bcs 30$ ;~x~impossible error since fetch worked Tst @Area ;check for device type Bpl 40$ ;~x~non file structured- illegal Mov @R2,NonFil ;get the device name ; .Assume Ou$Chn EQ 0 .Lookup Area,#Ou$Chn,#NonFil ;~x~non filestructured lookup Bcs 50$ ;~x~unable to check volume owner Mov PlyGnd,R2 ;space to read block ; .Assume Ou$Chn EQ 0 .ReadW Area,#Ou$Chn,R2,#256.,#VidBlk ;~x~ Bcs 50$ ;~x~unable to check volume owner ; .Assume Ou$Chn EQ 0 .Close #Ou$Chn ;~x~close channel Mov #OwnL,r4 ;compare owner name Mov #OwnDEC,r3 ;prototype Add #OwnOfs,r2 ;offset to owner name 10$: ;~x~ MovB (R2)+,R0 ;get owner char Bic #<040>,R0 ;force upper case CmpB R0,(R3)+ ;check with proto Bne 20$ ;~x~ok - not digital Sob R4,10$ ;~x~keep looking ;+ ;ERROR .If NE MIN$C Error ,F ;~x~ .EndC; NE MIN$C ;editor found volume owner of output device was 'digital' ;- 20$: ;~x~ Clc ;no error Return ;~x~ ...... 30$: ;~x~ ;+ ;ERROR .If NE MIN$C Error ,F ;~x~ .EndC; NE MIN$C ;logic error, or system failure in owner check ;fetch of handler succeeded but dstatus failed here ;- 40$: ;~x~ ;+ ;ERROR .If NE MIN$C Error ,F ;~x~ .EndC; NE MIN$C ;non directory device was specified for output to editor ;and editor cannot use it for output. volume owner check ;caught this error. ;- 50$: ;~x~ ;+ ;ERROR .If NE MIN$C Error ,F ;~x~ .EndC; NE MIN$C ;non filestructured lookup or readw failed during owner check ;logic error or device error. ;- .EndC; NE MIN$C .IF NE Rsts$ .SbTtl SAVPPN - Save RSTS PPN for later use ;++ ;SavPPN SvPPN ; ;functional description: ; ; save a ppn for use later ; ;input: ; Jsr R4,SavPPN ; .Word DBLK,SavArea ; or ; Mov #DBLK,R0 ; Mov #SavArea,R1 ; Jsr R4,SvPPN ; ; DBLK -> device-filename block ; SavArea -> 4 word save area for ppn stuff ; ;output: ; 4 words of file data in save area if rsts is os ;-- .Enable LSB SavPPN:: ;~x~ ;018 Mov (R4)+,R0 ;get dblk Mov (R4)+,R1 ;get save area SvPPN:: ;~x~ ;018 Tst Rt$RTS ;RSTS? Bon 10$ ;~x~nope .SetFQB ;~x~RSTS magic Mov FQPPN,(R1)+ ;save FIRQB data til later Mov FQProt,(R1)+ Mov FQMode,(R1)+ Mov FQClus,(R1)+ 10$: ;~x~ Rts R4 ;~x~ .......... ;++ ;UsePPN UsPPN ; ;functional description: ; ; prepare to do a file operation with a ppn ; ;input: ; Jsr R4,UsePPN ; .Word SavArea ; or ; Mov #SavArea,R0 ; Jsr R4,UsPPN ; ;output: ; filestuf placed for use by next file request ;-- .Enable LSB UsePPN:: ; ;018 Mov (R4)+,R0 ;~x~get save area UsPPN:: ; ;018 Tst Rt$RTS ;~x~RSTS? Bon 10$ ;~x~nope Push R1 ;save R1 from destruction Mov @#JRMON,R1 ;get addr .Rept 4 Mov (R0)+,(R1)+ ; **poke** .EndM Pop R1 ;restore R1 10$: Rts R4 ;~x~ .......... .EndC; NE Rsts$ .End