UNIVERS DCN SUBTTL Macros for DECnet CUSPS SEARCH JOBDAT,UUOSYM,MACTEN,SWIL F=:0 ;Flag register T4=:1+>> ;Temporary ACs P4=:1+>>;Permanent ACs S4=:1+>>;Saved ACs E=:S4+1 ;Opcode of LUUO. Used by dispatch routine. U=:E+1 ;LUUO itself. P=:17 ;Push down list pointer C==1+ ;SCAN acs OPDEF CALL [PUSHJ P,] ;instruction used to call all routines in here OPDEF RET [POPJ P,] ;Bad return OPDEF RETSKP [JRST .POPJ1##] ;good return from most routines OPDEF SKP [TRNA] ;skip over an instruction OPDEF NOOP [TRN] ;do nothing. Ignore skip returns OPDEF XMOVEI [SETMI] ;get full 30 bit immediate address OPDEF XHLLI [HLLI] ;get section number in left half OPDEF IFIW [1B0] ;Instruction formatted indirect word DEFINE $HISEG,> DEFINE $LOSEG,> SUBTTL Storage allocation macros DEFINE $BLOCK(LABEL,SIZE),< $LOSEG LABEL: BLOCK SIZE $HISEG > DEFINE $LVAR(LABEL),< $LOSEG LABEL: BLOCK 1 $HISEG > DEFINE $GVAR(LABEL),< $LOSEG LABEL:: BLOCK 1 $HISEG > DEFINE $ABS(LOCATION,VALUE,LABEL),< $$.ABS==$$.SEG IFG $$.ABS,<$LOSEG> IFL $$.ABS,<$HISEG> LOC IFNB , VALUE IFG $$.ABS,<$HISEG> IFL $$.ABS,<$LOWSG> > DEFINE $STACK,< IFNDEF PDLSIZ, $BLOCK STACK,PDLSIZ PDL: IOWD PDLSIZ,STACK ;For move p,pdl > SUBTTL Error definition macros DEFINE $DIE(PFX,ARG),< DIE. (SIXBIT /PFX/) > DEFINE $ERROR(PFX,TXT,RTN,INSTR,DIE),< $ERRMC ERROR,PFX,,,, > ;;END $ERROR MACRO DEFINE $WARN(PFX,TXT,RTN,INSTR,DIE),< $ERRMC WARN,PFX,,,, > ;END $WARN MACRO DEFINE $INFOR(PFX,TXT,RTN,INSTR,DIE),< $ERRMC INFOR,PFX,,,, > DEFINE $ERDFA(INSTR),< ZZZINS==0 IFNB ,,ABSOLUTE,< IFN <777000000000&>, IFE ,< IFGE ,< IFLE ,< ZZZINS==0 > > > > > IFL , IFE , IFG , > DEFINE $ERDFC(RTN),< ZZZRTN==CALL IFNB ,< .IFN ,EXTERNAL,< IFN <&777000000000>,< ZZZRTN==0 > > > ZZZRTN+RTN PURGE ZZZRTN > SUBTTL Low-level error macro definition DEFINE $ERRMC(OPC,PFX,TXT,RTN,INSTR,DIE),< E..'PFX:! IFNB \RTN\, IFB \DIE\, $ERDFA $ERDFC > IFB \RTN\, IFB \DIE\,> E$$'PFX:EPFX$$!(SIXBIT \PFX\) ASCIZ\TXT\] > ;End of $ERRMC macro DEFINE $PROMPT(AC,SYMBOL,TEXT,KEYWORDS),< IFG , IFNB ,,,< PRINTX ?Cannot give 4th argument "KEYWORDS" here. PASS2>>> PRMPT. AC,1+[XWD SYMBOL,KEYWORDS ASCIZ \TEXT\] > SUBTTL $EXTERN - Set up the correct external references XP I.LUO,1B0 XP I.FLE,1B2 XP I.PRM,1B3 XP I.CHG,1B6 XP I.GTT,1B7 XP I.SAV,1B12 XP E.SYM,1B35 ;Note, inverse significance of bit DEFINE $EXTERN,< IFNDEF $ONLY,<$ONLY=> IFN <$ONLY&I.LUO>,< EXTERN DN.E0 EXTERN LUUO$ EXTERN EREXIT > IFE <$ONLY&I.LUO>,< PFHINI==:.POPJ## USRTRP==:0 $HISEG LUUOX:: ADJSP P,-1 POPJ P, EREXIT: HALT . > IFN <$ONLY&I.FLE>, IFE <$ONLY&I.FLE>,< FLERR$==:EREXIT LERR$==:EREXIT > IFN <$ONLY&I.PRM>, IFE <$ONLY&I.PRM>,< PRMPT$==:EREXIT ISCAN$==:EREXIT QSCAN$==:EREXIT PSCAN$==:EREXIT VSCAN$==:EREXIT REEAT$==:EREXIT $HISEG .PPMFD::XWD 1,1 ;;Keep RDH's SCAN happy > IFN <$ONLY&I.CHG>, IFE <$ONLY&I.CHG>,< CHPPN$==:EREXIT GOD$==:EREXIT UNGOD$==:EREXIT > IFN <$ONLY&I.GTT>, IFE <$ONLY&I.GTT>,< GTTAB$==:EREXIT > IFE <$ONLY&E.SYM>,< .TEXT "/SYMSEG:HIGH/LOCALS " > > SUBTTL Prompting and parsing definitions DEFINE INPUTS,< PARSE %CHARR,,, PARSE %CHARA,,, PARSE %SIXBI,,, PARSE %OCTAL,,, PARSE %DECIM,,, PARSE %ASCII,,, PARSE %SIXST,,, PARSE %DATIM,,, PARSE %DATIP,,, PARSE %DATIF,,, PARSE %VERSI,,, PARSE %CORES,,, PARSE %BLOCK,,, PARSE %FILES,,, PARSE %KEYWR,,, > XP PRMOFF,<777777,,0> ;Mask for input routine offset XP PRMADD,<0,,777777> ;Mask for optional additional data INUM==0 DEFINE PARSE(SYMBOL,ROUTINE,HELPER,RETINS),< XP SYMBOL,INUM INUM==INUM+1 > INPUTS XP PRSMAX,INUM SUBTTL Initialization macros DEFINE $INIT(PFX),< .REQUE REL:DCN,REL:SWIL $SRC PFX $EXTERN $STACK > DEFINE $SRC(PFX),< SALL SEARCH JOBDAT,UUOSYM,MACTEN,SWIL IFNDEF HI$SEG, TWOSEG HI$SEG RELOC HI$SEG RELOC 0 $$.HGH==HI$SEG $$.SEG==-1 ;Default to loseg $$.LOW==0 EPFX$$==> .XCREF F,T1,T2,T3,T4,P1,P2,P3,P4,S1,S2,S3,S4,E,U,P,C,N DEFINE VRSN.(WHO,VER,MIN,EDT),< %%%'PFX==:BYTE (3)WHO(9)VER(6)MIN(18)EDT $ABS 137,%%%'PFX> > DEFINE $SETUP(SCNBLK,USRLUO),< XLIST IFN <$ONLY&I.PRM>,< TDZA F,F ;Note a zero offset start MOVX F,1 ;Note a CCL start MOVEM F,OFFSET ;Save for scan > RESET ;Stop all I/O, go back to scratch. MOVE P,PDL ;Set up stack. IFN <$ONLY&I.LUO>,< $ABS <.JB41==:41>, ;Setup call to LUUO handler PUSH P,[CALL LUUO$] ;get new instruction, in case wiped out by POP P,.JB41 ; an error somewhere. > IFNB \USRLUO\,< PUSH P,[JRST USRLUO] ;Get to user UUO dispatch POP P,USRTRP## ; by telling LUUO what to do > IFN <$ONLY&I.CHG>,< SETZM ORGPPN ;zero original PPN. > IFN <$ONLY&I.PRM>,< $LVAR OFFSET ;Place to save starting offset $LVAR COMNUM ;Command number returned by ISCAN IFNB \SCNBLK\,< ;If he supplied us with a scan block, use it MOVE T1,SCNBLK ;from the user > IFB \SCNBLK\,< MOVE T1,[XWD 1,[XWD 12,%%FXVE]] ;Use defualt if no block given > SETOM WHERAC ;initialize which ac set in use ISCAN. T1, ;Initialize SCAN MOVEM T1,COMNUM ;Save command number for later use > ;END IFN I.PRM LIST > ;END $SETUP MACRO SUBTTL LUUO defintions DEFINE LUUOS,< LUUO $LUUOI,LUUOI$ ;call one of DCN's routines. LUUO GTTAB.,GTTAB$## ;Do a gettab, always doing non-skip return. LUUO PRMPT.,PRMPT$## ;Prompt if necessary, and get typein LUUO $ERMES,ERMES$,1 ;error messages. SUUO DIE. SUUO TCHRI. SUUO TSTRG. SUUO TLINE. SUUO ERROR SUUO ERROR. SUUO ERROR$ SUUO ERROR% SUUO WARN SUUO WARN. SUUO WARN$ SUUO WARN% SUUO INFOR SUUO INFOR. SUUO INFOR$ SUUO INFOR% > SUBTTL LUUOI definitions. INUM==0 DEFINE LUUO(OPNAM,ROUT,FLAG),< INUM==INUM+1 ACNUM==0 OPDEF OPNAM [B8] > DEFINE SUUO(OPNAM),< OPDEF OPNAM [B8 ACNUM,] ACNUM==ACNUM+1 > INUM==0 LUUOS DEFINE LUUOIS,< UUOI CHPPN.,CHPPN$ ;Change PPN UUOI FLERR.,FLERR$ ;Type out a file spec and error code. UUOI LERR.,LERR$ ;Type out a lookup error code. UUOI GOD.,GOD$,1 ;Pivot to [1,2], saving current PPN UUOI UNGOD.,UNGOD$,1 ;Pivot back. Clear pivoted flag. UUOI TSIXN.,.TSIXN,1 ;Type out a sixbit value UUOI TDTTM.,.TDTTM,1 ;Type out a given date and time UUOI TDATE.,.TDATE,1 ;Type given date out. UUOI TTIME.,.TTIME,1 ;Type given time UUOI TDECW.,.TDECW,1 ;Type out decimal number UUOI TOCTW.,.TOCTW,1 ;Type number in octal UUOI TXWDW.,.TXWDW,1 ;Type number in octal halfword format UUOI TVERW.,.TVERW,1 ;Type version number UUOI TPPNW.,.TPPNW,1 ;Type a PPN. UUOI TDATN.,.TDATN,1 ;Type the current date. UUOI TTIMN.,.TTIMN,1 ;Type the current time UUOI TCRLF.,.TCRLF,1 ;Type out a carriage return UUOI ISCAN.,ISCAN$ ;Initialize scanning routines UUOI QSCAN.,QSCAN$,1 ;initialize a new line for partial scan UUOI PSCAN.,PSCAN$,1 ; ditto UUOI VSCAN.,VSCAN$,1 ;Verb scanner. Think about this for a while. UUOI REEAT.,REEAT$,1 ;Re-eat a character in SCAN context UUOI GTNOW.,.GTNOW ;Get current date/time > DEFINE UUOI(OPNAM,ROUT,FLAG),< INUM==INUM+1 OPDEF OPNAM [$LUUOI INUM] > INUM==0 LUUOIS PRGEND TITLE LUUOX Luuo handler. ENTRY DN.E0 ;entry point to ask for to get this loaded. SEARCH DCN $SRC LUO SUBTTL LUUO handler. Dispatch to correct routine XP DN.E0,0 ;; LUUOX - LUUO handler. Will dispatch to internal LUUOs, or call user ;routine if user has supplied a dispatching instruction at USRTRP ;At dispatch time, stack looks like ;-10(P) PC at time of LUUO ; -7(P) E ; -6(P) U ; -5(P) P (Reconstructed) ; -4(P) T1 ; -3(P) T2 ; -2(P) T3 ; -1(P) T4 ; 0(P) Return address, UUORET. ;Acs contain - ; T1/ contents of AC specified in LUUO ; E/ Dispatch address - Either the opcode, or the EA (If LUUOI) ; U/ The LUUO as retrieved from .JBUUO - EA has been resolved. ;On return, T1 will be stored into the AC used in the LUUO call, ; the rest will be restored to original values. EXTERN .TYOCH $GVAR USRTRP ;User LUUO trap - execute if not ours. $LVAR SAVEPC ;Location to save recovery PC when we halt. $LVAR SAVELU ;Location to save LUUO dipatch instruction XP ER$EXT, ;Bit indicating extended error message. XP ER$DIE, ;Bit indicating message has a die routine. $HISEG SUBTTL Definitions for LUUO handler DEFINE LUUO(OPNAM,ROUT,FLAG<0>),<B0!ROUT> DEFINE SUUO(OPNAM),<> DISP: LUUOS XLIST REPEAT <<37+DISP>-.>, ;Define unused opcodes to be illegal. LIST DEFINE UUOI(OPNAM,ROUT,BIT),<B0!ROUT'##> DISP2: LUUOIS ERRTYP: POINT 2,U,10 ;Error code. error,warn,inform UUOAC:: POINT 4,U,12 ;Ac field within LUUO UUOOPC::POINT 9,U,8 ;Get the opcode SUBTTL Dispatch on LUUO LUUO$:: PUSH P,.JBUUO ;; JRST LUUOX LUUOX:: PUSH P,U ;Save old LUUO MOVE U,-1(P) ;Get new opcode. MOVEM E,-1(P) ;Save old dispatch on stack MOVE E,P ;Get current copy of stack pointer SUB E,[3,,3] ;Make it look like P at time of LUUO PUSH P,E ;Save it on stack CALL .PSH4T## ;Save 4 ACs for scratch use. LDB E,UUOAC ;Get the AC field CAIL E,E ;Is AC one of the zapped ones? ADDI E,-E-6(P) ;Adujst pointer to stack instead of ACs MOVE T1,(E) ;Get the AC contents into T1. LDB E,UUOOPC ;Get the opcode. CALL @DISP-1(E) ;Dispatch to user routine. UUORET: SKP ;Normal return. AOS -7(P) ;Skip return, bump the uuo return PC SKIPG DISP-1(E) ;Does this have the 'no ac' bit? JRST [CALL .POP4 ;Yep - don't screw him over. JRST UUORE0] ;And join common code below. LDB E,UUOAC ;AC field MOVE U,T1 ;Save value returned by routine CALL .POP4 CAIL E,E ;Is AC one of the zapped ones? ADDI E,-E-2(P) ;Adujst pointer to stack instead of ACs MOVEM U,(E) ;Store value returned in AC UUORE0: POP P,(P) ;Skip over junk P (Add code to compare?) POP P,U POP P,E RET LUUOI$: HRRZ E,U ;Get UUOI number CAIG E,INUM ;Range check CAIG E,0 JRST [MOVE U,[$ERROR(ILU,,.TOCTW##,)] JRST ERMES$] ;Make this an error message. ADDI E,DISP2-DISP ;Add in the offset between the two tables. JRST @DISP-1(E) ;Dispatch USRUUO: SKIPN USRTRP ;Did the user set up for trapping LUUOs? JRST [MOVE E,U ;Save the UUO itself. MOVE U,[$ERROR(ILL,,.TXWDW##,)] JRST ERMES$] ;Make this an error message XCT USRTRP ;Execute the user trap instruction. JRST UUORET ;Return from user LUUO JRST UUORET+1 ;Skip return from user LUUO EREXIT::HALT . ;Error exit for undefined things. .SAVUE:: EXCH U,(P) ;save U, get calling PC PUSH P,E ;save E PUSH P,U ;Save calling PC MOVE U,-2(P) ;get u back PUSHJ P,SAVJMP ;call calling routine SKP AOS -2(P) POP P,E ;restore e POP P,U POPJ P, ;Return .SAVET:: EXCH T1,(P) ;save current value of T1, get calling PC PUSH P,T2 PUSH P,T3 PUSH P,T4 PUSH P,T1 ;push calling PC MOVE T1,-4(P) ;restore original value of T1 PUSHJ P,SAVJMP ;return to caller, with stack fixed up SKP ;non skip return AOS -4(P) ;skip return, bump higher level return pc POP P,T4 POP P,T3 POP P,T2 POP P,T1 RET .POP4:: POP P,T1 ;Pop return PC POP P,T4 ;pop ac POP P,T3 POP P,T2 EXCH T1,(P) ;pop last ac, leave return PC POPJ P, ;return SAVJMP: EXCH F,-1(P) ;Swap things around a bit EXCH F,(P) ;muddy the water a bit EXCH F,-1(P) ;make things confusing POPJ P, ;return to caller with stack set up SUBTTL Error message typeout ;; ERMES$ - Type out a message, usually an error message. ; Form: , Where AC = CODE,ER$EXT,ER$DIE: ; ER$EXT Means extended error - has extra routine dispatch. ; ER$DIE Means block has a return address. ; CODE=0 Means no error - Type out routine. ; CODE=1 Means ERROR (Prefix ?) ; CODE=2 Means WARN (Prefix %) ; CODE=3 Means INFORM(Prefix [) ; ADDR points to block: (Negative offsets only if ER$EXT or ER$DIE) ; -3 or -1) Return address (Known as DIE address) ; -2) Instruction to execute before calling below ; -1) Routine to call after printing text, before returning. ; 0) Sixbit text (3 chars prog, 3 chars error) ; 1) Start of ASCIZ text ; ; At the time the instruction to execute is executed, E,U, and P have ; changed, so don't use them as indexes. ;Returns with all acs unchanged. ERMES$: LDB T2,ERRTYP ;Get error type, to get start character JUMPE T2,ERMSPC ;No error type, special cases MOVE T2,[EXP <"?",,0>,<"%",,0>,<"[",,0>]-1(T2) HRRI T2,1(U) ;Char and text MOVE T3,-8(P) ;And the error pc MOVE T1,0(U) ;Prefix CALL .ERMSA## ;Type error stuff TXNE U,ER$EXT ;Did user request a routine? TXNN T1,JWW.FL ;And is first set? JRST ERMES4 ;No, don't even bother DMOVE T1,-4(P) ;Get back original values for T registers. DMOVE T3,-2(P) ; so we can print out correct values. SKIPN -2(U) ;Did user give an address? JRST ERMES3 ;No, skip over pre-routine instruction XCT -2(U) ;Execute pre-routine instruction. (Load t1?) NOOP ;In case of skip return from instruction ERMES3: XCT -1(U) ;Execute user routine. (PUSHJ P,X?) ERMES4: LDB T1,ERRTYP ;Get error type. CAIN T1,3 ;Was it an informational message? ([) CALL .TRBRK## ;Yes, cap it off CALL .TCRLF## ;End the line of text TXNE U,ER$DIE ;Did the user specify a die address? JRST ERMRTA ;Yes - go get the address. LDB T1,ERRTYP ;No return address - default per error type. CAIL T1,2 ;Is this a severe error type? JRST ERMRET ;Nope - just return normally ERMES5: MOVE T1,[HALT ERMCON] ;HALT continuing at ERMCON EXCH T1,.JB41 ;Make it the effect of an LUUO. MOVEM T1,SAVELU ;Save luuo dispatch instruction POP P,(P) ;Don't need normal return address. POP P,T4 ;Restore T acs POP P,T3 POP P,T2 POP P,T1 POP P,(P) ;Don't need reconstructed P POP P,U ;... U SOS E,-1(P) ;Point return back at LUUO itself. MOVEM E,SAVEPC ;Save PC of LUUO. POP P,E ;Restore real value to E POPJ P, ;This will re-execute the LUUO, halting. ERMCON: PUSH P,SAVEPC ;Get address of LUUO .. PUSH P,SAVELU ;Instruction to execute an LUUO POP P,.JB41 ; Turn back on LUUO handler. SETZM SAVEPC ;Wipe out old saved address RETSKP ;Return skipping over LUUO. ERMRTA: TXNN U,ER$EXT ;Did he have routine and addr as well? SKIPA T1,-1(U) ;Nope, alternate position MOVE T1,-3(U) ;Yes, maximum position MOVEM T1,-8(P) ;Make UUO return go there. ERMRET: RET ;And "resume" processing ;Special cases of $ERMES - Absolute DIE., and ordinary ;non-error type-out routines ERMSPC: MOVEI T1,(U) ;Get effective address into T1 TXNN U,ER$DIE!ER$EXT ;Both bits off? JRST ERMDIE ;Absolute die. TXNN U,ER$EXT ;Is the extended bit on? JRST .TCHAR## ;Nope, merely a character type-out CALL .TSTRG## ;And call scan's string typeout routine. TXNE U,ER$DIE ;Die bit here means give CRLF. at end CALL .TCRLF## ;Set - this means give a free CRLF RET ;Return. ERMDIE: OUTSTR [ ASCIZ \Stopcd\] ;Wake up the OPR CALL .TSIXN ;Type out the stopcode name (EA) in sixbit OUTSTR [ASCIZ \. Aborting job!\] JRST ERMES5 ;Pop stuff off stack, and halt. PRGEND TITLE FLERR Filop error code routines ENTRY DN.E2 SEARCH DCN $SRC FLE SUBTTL Type out filop error codes XP DN.E2,0 ;;FLERR$ - Type out a FILOP. error code in english ;Call with: ; T1/ Pointer to FILOP block ; ;LERR$ - Type out an error code without typing a file spec ;Call with ; T1/ Error code. $HISEG FLERR$::PUSH P,T1 ;Save for later use, also HRRZ T2,.FOLEB(T1) ;Get address of lookup enter block. MOVEI T1,1(T1) ;Point to open block within filop block CALL .TOLEB## ;Type out filename CALL .TSPAC## ;Separator character POP P,T1 ;Get back pointer to filop block MOVE T1,.FOLEB(T1) ;Get pointer to lookup block MOVE T2,(T1) ;Get first word of lookup block TLNN T2,-1 ;Extended block? ADDI T1,.RBEXT-1 ;Increment pointer to compensate. HRRZ T1,1(T1) ;Get right half of extension word - error code. LERR$:: CAIG T1,FILLEN ;Is it an error we know of ? JUMPGE T1,KERR ;Yup - known error. PUSH P,T1 ;Save error MOVEI T1,[ASCIZ /ERUNK%(/] CALL .TSTRG## ;Unknown error - tell him POP P,T1 ;Get error code back CALL .TOCTW## ;Type error code MOVX T1,-1 ;Error -1 = unknown KERR: MOVE T1,FILERR(T1) ;Get address of string CALL .TSTRG## ;Type out the error code name CALL .TCRLF## ;End the line RET ;Go back SUBTTL Filop error codes [ASCIZ /) Unknown error for filop/] FILERR: [ASCIZ /ERFNF%(0) File not found/] [ASCIZ /ERIPP%(1) Incorrect PPN/] [ASCIZ /ERPRT%(2) Protection failure/] [ASCIZ /ERFBM%(3) File being modified/] [ASCIZ /ERAEF%(4) Already existing file name/] [ASCIZ /ERISU%(5) Illegal sequence of UUOS/] [ASCIZ /ERTRN%(6) Transmission error/] [ASCIZ /ERNSF%(7) Not a save file/] [ASCIZ /ERNEC%(10) Not enough core/] [ASCIZ /ERDNA%(11) Device not available/] [ASCIZ /ERNSD%(12) No such device/] [ASCIZ /ERILU%(13) Illegal monitor call for GETSEG a filop/] [ASCIZ /ERNRM%(14) No room or quota exceeded/] [ASCIZ /ERWLK%(15) Write-locked/] [ASCIZ /ERNET%(16) Not enough table space/] [ASCIZ /ERPOA%(17) Partial allocation/] [ASCIZ /ERBNF%(20) Block not free/] [ASCIZ /ERCSD%(21) Can't supersede a directory/] [ASCIZ /ERDNE%(22) Can't delete non-empty directory/] [ASCIZ /ERSNF%(23) SFD not found/] [ASCIZ /ERSLE%(24) Search list empty/] [ASCIZ /ERLVL%(25) SFD nest level too deep/] [ASCIZ /ERNCE%(26) No-create for all search list/] [ASCIZ /ERSNS%(27) Segment not on swap space/] [ASCIZ /ERFCU%(30) Can't update file/] [ASCIZ /ERLOH%(31) Low seg overlaps hi seg (getseg)/] [ASCIZ /ERNLI%(32) Not logged in (run)/] [ASCIZ /ERENQ%(33) File still has outstanding locks set/] [ASCIZ /ERBED%(34) Bad .exe file directory (getseg,run)/] [ASCIZ /ERBEE%(35) Bad extension for .exe file(getseg,run)/] [ASCIZ /ERDTB%(36) .Exe directory too big(getseg,run)/] [ASCIZ /ERENC%(37) TSK - Exceeded network capacity/] [ASCIZ /ERTNA%(40) TSK - Task not available/] [ASCIZ /ERUNN%(41) TSK - Undefined network node/] [ASCIZ /ERSIU%(42) Rename - SFD is in use/] [ASCIZ /ERNDR%(43) Delete - file has an ndr lock/] [ASCIZ /ERJCH%(44) Job count high (a.t. read count overflow)/] [ASCIZ /ERSSL%(45) Cannot rename SFD to a lower level/] FILLEN==.-FILERR PRGEND TITLE PROMPT Input and prompting routines ENTRY DN.E3 SEARCH DCN $SRC PRM SUBTTL PRMPT$ - SCAN typein interface. XP DN.E3,0 EXTERN .ISCAN ;PRMPT$ - Read typing, prompting if necessary. Type out definition ; of allowable input on an altmode. ;Call ; (U)-1/ offset in PRMROU to call,,optional extra arg (for keywords) ; (U)/ start of prompt string ;Return ; T1/ Value of N after calling routine. $LOSEG SCNACS::BLOCK 4 ;Swap the 4 P acs, since SCAN trashes them. WHERAC::BLOCK 1 ;which ac set is in use? $HISEG DEFINE PARSE(SYMBOL,ROUTINE,HELPER,RETINS), PRMINP: INPUTS ;Define input instructions DEFINE PARSE(SYMBOL,ROUTINE,HELPER,RETINS), PRMHLP: INPUTS ;Define helper instructions DEFINE PARSE(SYMBOL,ROUTINE,HELPER,RETINS), PRMRET: INPUTS ISCAN$::CALL SCANAC ;Get us scans acs for this routine SETO C, ;Pretend EOL character CALL .ISCAN## ;call ISCAN (t1 is loaded with user's AC) RET ;return to user QSCAN$::CALL SCANAC ;Set up scan's ACs JRST .QSCAN## ;call qscan PSCAN$::CALL SCANAC ;set up scan's ACs JRST .PSCAN## ;call pscan VSCAN$::CALL SCANAC ;Set up scan's ACs CALL .VSCAN## ;call VSCAN (never to return) NOOP $ERROR IDN, REEAT$::CALL SCANAC ;Get us in SCAN context MOVE P3,T1 ;character to re-eat JRST .REEAT## ;Re-eat it PRMPT$::CALL .SAVUE## ;save for luuo handler CALL SCANAC ;Get us the scan acs for this routine JUMPG P4,PRMPT4 ;If still stuff in buffer, don't prompt PRMPT0: JUMPL P4,PRMPT2 ;If non-altmode end of line, skip help LDB T1,[POINTR -1(U),PRMOFF] ;get offset of help instruction XCT PRMHLP(T1) ;type out options for user. CALL .TCRLF## ;put prompt on new line PRMPT2: CAXN P4,.CHEOF ;If eof, EXIT ; crap out here and now XMOVEI T1,(U) ;get address of prompt string CALL .TSTRG## ;type it out. CALL .CLRTI## ;re-initialize for another line PRMPT4: CALL .TIALT## ;get a character from input JUMPLE P4,PRMPT0 ;an altmode? he wants list of options, then. CALL .REEAT## ;give scan the character back. LDB E,[POINTR -1(U),PRMOFF] ;Get offset of input instruction XCT PRMINP(E) ;go do the input required NOOP ;ignore possible skip return SKIPN E ;do a re-eat? CALL .REEAT## ;Yes. XCT PRMRET(E) ;get return value from where it is RET ;return to user, with value in ac PREXIT: EXIT 1, ;Return to monitor mode, now. SETZ P4, ;forget the EOF RET ;and return SCANAC::AOSE WHERAC ;increment which AC set we are using JRST [SOS WHERAC ;already using SCAN acs, don't worry RET] CALL SWPACS ;swap in the scan acs POP P,P1 ;P1 is only trash, anyway. CALL (P1) ;call main routine, returning here. SKP ;Non skip return AOS (P) ;bump higher level routine PC CALL SWPACS ;Swap the ACs back to the user ACs SOSL WHERAC ;decrement which ac set in use $ERROR WAU, RET ;and return to higher level routine SWPACS::EXCH P1,SCNACS+0 ;start swapping the P acs EXCH P2,SCNACS+1 EXCH P3,SCNACS+2 EXCH P4,SCNACS+3 RET ;finished swapping. .CHARH: LDB T1,[POINTR -1(U),PRMADD] ;Get pointer to additional info SKIPN T1 ;if we got something MOVEI T1,[ASCIZ \Processor type (Undefined format)\] JRST .TSTRG## ;type it out .KEYWR: CALL .SIXSW## ;Get a sixbit word. LDB P1,[POINTR -1(U),PRMADD] ;get pointer to additional info MOVE T1,(P1) ;This should be a pointer to the keyword table MOVE T2,P3 ;look in table to find word. CALL .LKNAM## ;ask scan if he can find the word. JRST KEYWRE ;No such word. Ooops. HRRZ T2,(P1) ;Get addr of first word in table SUB T1,T2 ;make T1 be the offset of the keyword HRRZI T1,-1(T1) ;return only right half, and make it 0-n. RET ;return, finished KEYWRE: SKIPL T1 ;differentiate between ambiguous and unknown $WARN AMB,,.TSIXN##,P3,PRMPT2 $WARN UNK,,.TSIXN##,P3,PRMPT2 .KEYWH: OUTSTR [ASCIZ\Keywords are:\] LDB P1,[POINTR -1(U),PRMADD] ;pointer to table pointer MOVE P1,(P1) ;get the table aobjn pointer KEYWH2: CALL .TCRLF## ;get us a new line MOVEI P2,^D8 ;allow 8 keywords per line SKP ;Don't start off the line with a tab KEYWH4: CALL .TTABC## ;separate keywords with a tab MOVE T1,1(P1) ;get the keyword. CALL .TSIXN## ;type the keyword out AOBJP P1,.POPJ## ;if no more keywords, exit SOJLE P2,KEYWH2 ;keep track of number of keywords per line JRST KEYWH4 ;type another keyword on this line PRGEND TITLE CHPPN PPN changing ENTRY DN.E6 SEARCH DCN $SRC CHP SUBTTL Change PPN and get privs uuos XP DN.E6,0 ;;CHPPN$ - Change PPN. ; This routine expects to be called with U loaded with an LUUO calling ; this routine, the AC having the destination PPN loaded. ; Returns skip if successful, non-skip if neither CHGPPN nor POKE. succeeds $BLOCK POKEBK,3 $HISEG CHPPN$::CALLI T1,74 ;Calli for chgppn - We have opdefed it. SKP ;didn't work - now we have to work RETSKP ;Worked. Return success. MOVEM T1,POKEBK+2 ;save for poke. GETPPN T1, ;get our real ppn NOOP MOVEM T1,POKEBK+1 ;what we used to be MOVE T1,[.GTPPN,,.GTSLF];Address of PPN table GETTAB T1, ;find out address $DIE CFP, HRRZM T1,POKEBK ;address we want to change PJOB T1, ADDM T1,POKEBK ;we want to do this job's ppn MOVE T1,[3,,POKEBK] ;argument block POKE. T1, ;poke it! RET ;Both failed. Return failure RETSKP ;Hah! the poke. succeded. ;GOD. UUO - PIVOT to [1,2], and save current PPN away so we can change ; back. Takes no arguments. $GVAR ORGPPN ;Original PPN. $HISEG GOD$:: HRROI T1,.GTSTS ;Get jbtsts for us. GETTAB T1, $DIE CGJ, TLNE T1,1 ;Do we have JACCT? RET ;Don't do anything else, we are PRVJ GETPPN T2, ;Get out current PPN NOOP CAMN T2,[XWD 1,2] ;Are we god already? RET ;Yes, Don't bother setting SKIPN ORGPPN ;Did we store a PPN away before? MOVEM T2,ORGPPN ;Nope - save this one. MOVE T2,[XWD 1,2] ;GOD ppn. Full privs. CHGPPN T2, ;Try to change our PPN SKP ;No chgppn on this monitor, try poking RET ;Set, return MOVEM T1,POKEBK+1 ;store as what we used to be TLO T1,1 ;Turn on JACCT MOVEM T1,POKEBK+2 ;Store as what we want to be MOVE T1,[XWD .GTSTS,.GTSLF] ;Get address of JBTSTS table GETTAB T1, ; by getting numtab entry for it $DIE GCA, PJOB T2, ;Get our job number ADDI T2,(T1) ;use our job number as index within JBTSTS HRRZM T2,POKEBK+0 ;Address we are going to poke MOVE T1,[XWD 3,POKEBK] ;Arg block for POKE POKE. T1, ;Poke it away! $ERROR CSP, RET UNGOD$:: MORTAL: SKIPN T1,ORGPPN ;Did we GOD ourselves first? RET ;Nope - just return quietly SETZM ORGPPN ;Yep, zero it out, since we are now peasants CALL CHPPN$ ;Go do the change NOOP ;Ignore. RET ;Return to user. PRGEND TITLE GTTAB Gettab luuos ENTRY DN.E7 SEARCH DCN $SRC GTT SUBTTL GTTAB. - Do a gettab, and do not give an error return XP DN.E7,0 $HISEG ;GTTAB. - Do a gettab, and always return non-skip. Blow up with error ;message if the gettab fails. GTTAB$::MOVE T1,(U) ;Get numbers for gettab. GTTAB%::GETTAB T1, ;Try to get the information. $ERROR GTF,,.TXWDW##,T1 RET END