.TITLE DCL - WECO Command Line Interpreter and Process dispatcher .IDENT /V1.00/ .ENABL LC ;+ ; M. Stewart, Western Electric, Lisle Illinois ; 25-Sep-80 ; ; This task implements the following processes by spawning appropriate ; tasks installed in the RSX11M system. ; ; TYP [E] ; DEL [ETE] ; DIR [ECTORY] ; UIC [XXX,YYY] ; COP [Y] ; PRO [TECT] ; TRU [NCATE] ; REN [AME] ; PUR [GE] ; APP [END] ; CLO [SE] ; FRE [E] ; ; The DIRectory command may be modified by using the switches ; "/BR", "/TB", "/FU", or "/SO". The switch "/SO" spawns SRD ; and is equivalent to the MCR command "SRD /NA/WB". ; The "/SD" switch is also supported. ;- ; MODIFIED: ; .MCALL DIR$,SPWN$,ISTAT$,STATE$,TRAN$,EXIT$S,GMCR$,QIOW$ .MCALL WSIG$S,STSE$,ASTX$S,SETF$S,OPEN$R,CLOSE$,FDBDF$,FSRSZ$ .MCALL FDOP$A FSRSZ$ 1 .PAGE .SBTTL STATE TABLE ; ; TPARS STATE TABLE ; $RONLY=1 ISTAT$ STB,KTB ; Initial state STATE$ STATE1 TRAN$ $EOS,$EXIT TRAN$ "APPEND",CHAR,APD,D.TAF,DCLFW TRAN$ "COPY",CHAR,COPY,D.TAF+D.NOK,DCLFW TRAN$ "FREE",CHAR,FRE TRAN$ "TYPE",CHAR,TYPE,D.FIL+D.NOK,DCLFW TRAN$ "DIRECTORY",CHAR,DIRECT,D.DIR,DCLFW TRAN$ "DELETE",CHAR,DELET,D.FIL,DCLFW TRAN$ "PROTECT",CHAR,PROT,D.FIL,DCLFW TRAN$ "TRUNCATE",CHAR,TRUN,D.FIL,DCLFW TRAN$ "RENAME",CHAR,RENAM,D.TAF,DCLFW TRAN$ "PURGE",CHAR,PURGE,D.FIL,DCLFW TRAN$ "CLOSE",CHAR,UNLK,D.FIL,DCLFW TRAN$ "UIC",CHAR,SETUIC,D.SET,DCLFW TRAN$ $STRNG,$EXIT,PROCES ; CHARACTER TRANSFER STATE STATE$ CHAR TRAN$ $EOS,$EXIT,SPAWN TRAN$ $ANY,CHAR,ADDON STATE$ .PSECT ; ; Some constants and storage ; ER.ABO=1 ; Aborting ER.ESC=2 ; Escaping DCL ER.BIG=201 ; Command line too long ER.NLP=202 ; No logical process defined ER.NNS=203 ; Network function not supported ER.STX=204 ; Syntax error D.DIR=1 ; Getting directory information D.EQU=2 ; Equal detected D.EXT=4 ; File extension given D.FIL=10 ; File prompt if required D.SET=20 ; Setting uic D.NOK=40 ; Network functions ok D.RNS=100 ; Remote node specified D.SPC=200 ; Space detected D.TAF=400 ; To and From prompt if required D.UIC=1000 ; UIC started D.UIE=2000 ; UIC ended D.FNG=4000 ; Filespec given in input stream D.SWP=10000 ; Swap source and destination D.QMK=20000 ; Question mark seen. D.DEV=40000 ; Device given D.SWC=100000 ; Real switch seen in command DONE=5 ; Event flag for process done COMAND: .BLKB 100. DCLFW: .WORD 0 CMDPTR: .WORD 0 SAVR4: .WORD 0 IOST: .WORD 0,0 ; I/O status HERECT: .WORD 0 ERROR: .WORD 0 TOTAL: .WORD 0 APPND: .WORD 0 .NLIST BEX TASKS: .ASCII /PIP / .ASCII /NFT / .ASCII /=/ ; The = sign is free HERE: .BLKB 59. THERE: .BLKB 60. ; Must be before GMCR .PAGE .SBTTL DPB's and things GMCR: GMCR$ GBUF=GMCR+G.MCRB MCR: SPWN$ MCR...,,,,,DONE,,,COMAND,79. WAIT4: STSE$ DONE TTYIN: QIOW$ IO.RPR,1,1,,IOST,, SQWAK: QIOW$ IO.WVB,1,1,,,,<0,0,40> PROFIL: FDBDF$ FDOP$A 2,DSDB DSDB: .WORD 3,SY .WORD 0,0 DSNCT: .WORD 3,HERE ; ; Some strings and things... ; DEXT: .ASCIZ /.PRO/ LBYTE: .BYTE 33 ; Assume FIX: .BYTE 0 ; On truncate and purge set this byte SY: .ASCII /SY:/ INDP: .ASCII /@/ LB: .ASCII /LB:/ LBSIZ=.-LB SUIC: .ASCII /[1,2]/ SUICSZ=.-SUIC TO: .ASCII /To:/ TOCT=.-TO FROM: .ASCII /From:/ FROMCT=.-FROM FILE: .ASCII /File:/ FILECT=.-FILE UICDFT: .ASCIZ \SET /UIC\ TYPMSG: .ASCIZ \TI:=\ DELMSG: .ASCIZ \/DE/LD\ SELDEL: .ASCIZ \/SD\ DIRMSG: .ASCIZ \/LI\ SRDMSG: .ASCII \SRD NL:=\ SRDMEX: .BLKB 16 SRDEND: .ASCII \/NA/WB\ .BYTE 33 APPMSG: .ASCIZ \/AP\ FREMSG: .ASCIZ \/FR\ UNKMSG: .ASCIZ \/UN\ TRUMSG: .ASCIZ \/TR\ PURMSG: .ASCIZ \/PU/LD\ PROMSG: .ASCIZ \/PR\ RENMSG: .ASCIZ \/RE\ ASCII: .ASCIZ \/AS\ QMKMSG: .ASCIZ \/SE:\ .BLKB 20. STXER: .ASCII /DCL -- Syntax error/ STXECT=.-STXER NNSUP: .ASCII /DCL -- Network function not supported/ NNSUCT=.-NNSUP BIGER: .ASCII /DCL -- Command line too long/ BIGCT=.-BIGER LPERR: .ASCII /DCL -- Unknown process/ LPECT=.-LPERR ESCSEQ: .ASCII <15> ESCSCT=.-ESCSEQ FCSER: .ASCII /DCL -- FCS error number / FCSCT=.-FCSER .BLKB 10 DIRER: .ASCII /DCL -- Directive error number / DIRCT=.-DIRER .BLKB 10 .EVEN .LIST BEX .PAGE .SBTTL Main task code DCL: DIR$ #GMCR ; Fetch the command line BCS 20$ ; Ignore the SOB. MOV $DSW,R3 ; Character count MOV R3,TOTAL ; Total count in input buffer MOV #GBUF,R4 ; Input command string MOV R4,R2 ; Copy for terminating character pointer ADD R3,R2 ; We now have the pointer CMPB #15,(R2) ; terminator? BEQ 10$ ; will do MOVB #15,LBYTE ; then the spawned task will do his thing MOV #ER.ESC,ERROR ; Say we are escaping CALL ERRPRT ; Print message CLR ERROR ; Now we have done it 10$: MOV #<<400*3>+1>,R1 ; Enable space as character ; And 3 bytes as key match MOV #KTB,R2 ; Key table pointer MOV #STATE1,R5 ; Init state table pointer MOV #COMAND,CMDPTR ; Initialize pointer CALL .TPARS ; Parse the command BCS 30$ ; Syntax error 20$: TSTB ERROR ; Fatal error? BPL 25$ ; Yes 22$: CALL ERRPRT ; Report error 25$: EXIT$S ; No then exit this task 30$: MOV #ER.STX,ERROR BR 22$ .PAGE .SBTTL PROCESS ACTIONS COPY:: MOV CMDPTR,R0 ; Setup R0 CLR APPND ; No append default MOV #TASKS,R1 CALL STUFF RETURN TYPE:: CALL COPY MOV #TYPMSG,R1 CALL STUFF RETURN DELET:: CALL COPY MOV #DELMSG,APPND RETURN DIRECT:: CALL COPY MOV #DIRMSG,APPND RETURN PROT:: CALL COPY MOV #PROMSG,APPND RETURN TRUN:: CALL COPY MOV #TRUMSG,APPND TRUN0: MOVB #1,FIX ; We need to fix empty lines RETURN RENAM:: CALL COPY MOV #RENMSG,APPND RETURN PURGE:: CALL COPY MOV #PURMSG,APPND BR TRUN0 APD:: CALL COPY MOV #APPMSG,APPND RETURN FRE:: CALL COPY MOV #FREMSG,APPND RETURN UNLK:: CALL COPY MOV #UNKMSG,APPND RETURN SETUIC:: MOV CMDPTR,R0 ; Init R0 MOV #UICDFT,R1 CALL STUFF ; Stuff the first ; Fall thru to stuff the rest STUFF: MOVB (R1),(R0)+ ; Stuff the bytes CMPB #' ,(R1)+ ; Space terminator? BEQ 10$ ; Yes TSTB (R1) ; End of ASCIZ string? BNE STUFF ; No - Keep stuffing 10$: MOV R0,CMDPTR ; Restore pointer RETURN ADDON:: CMPB #'.,.PCHAR ; Extension follows BNE 1$ ; Not a . BIS #D.EXT,DCLFW ; Set the extension coming bit BR 95$ ; Then store it 1$: CMPB #'=,.PCHAR ; = There? BNE 2$ ; No BIS #D.EQU,DCLFW ; Yes - then say we have it BR 9$ ; Then continue 2$: CMPB #' ,.PCHAR ; A space then? BNE 3$ ; Nope BIT #D.SPC,DCLFW ; Have we seen a space? BNE 25$ ; Yes then do whatever BIS #D.SPC,DCLFW ; A space has been seen BR 10$ ; Oh well! 25$: MOVB #'=,@CMDPTR ; Substitute an = INC CMDPTR ; For the space BIS #D.SWP,DCLFW ; Set to swap stuff? BR 10$ ; Then get out 3$: CMPB #'_,.PCHAR ; Nodename follows? BNE 4$ ; No! BIS #D.RNS,DCLFW ; We are trying BIT #D.NOK,DCLFW ; Network ok? BNE 95$ ; Yes MOV #ER.NNS,ERROR ; We have an error BR 95$ ; Then continue 4$: CMPB #':,.PCHAR ; Possible nodename? BNE 5$ ; No way BIC #D.FNG,DCLFW ; Reset filespec seen bit BIS #D.DEV,DCLFW ; Set device name seen CMPB #':,(R4) ; Is it really a nodename? BNE 95$ ; No then continue BIC #D.DEV,DCLFW ; Reset device given INC R4 ; Bump .TPARS pointer DEC R3 ; One less byte MOVB #'_,.PCHAR ; Lie about character just seen BR 3$ ; And do node thing 5$: CMPB #'/,.PCHAR ; switch? BNE 6$ ; Not this time CALL SWITCH ; Process the switch BR 10$ ; Ok skip the rest 6$: CMPB #'[,.PCHAR ; Start of UIC BNE 7$ ; No BIS #D.UIC,DCLFW ; Yes then say so BIT #D.SET,DCLFW ; Are we setting the UIC? BEQ 9$ ; Nope! MOVB #'=,@CMDPTR ; Yes then we need an = sign INC CMDPTR ; Before we save the rest BR 9$ ; Then fill it up 7$: CMPB #'],.PCHAR ; End of UIC? BNE 8$ ; No! BIS #D.UIE,DCLFW ; Set end of UIC seen 8$: CMPB #'?,.PCHAR ; ? Seen? BNE 9$ ; Nope BIS #D.QMK,DCLFW ; We have a question. 9$: BIT #D.UIC,DCLFW ; Do we have uic started? BEQ 94$ ; No - then this counts BIT #D.UIE,DCLFW ; Did it end? BEQ 95$ ; Not yet 94$: CMPB #'],.PCHAR ; Just got ] ? BEQ 95$ ; Yes BIS #D.FNG,DCLFW ; A Filespec i suspect 95$: MOVB .PCHAR,@CMDPTR ; Move it in INC CMDPTR ; Next 10$: RETURN .PAGE .SBTTL SPAWN TASK SPAWN:: TST ERROR ; Do we have an error? BEQ 5$ ; Yes then get out of here. RETURN ; Nothing to do here... 5$: BIT #D.SET,DCLFW ; Are we doing set function? BEQ 6$ ; Not this time JMP CKUIC ; Yes then do it! 6$: MOV R4,SAVR4 ; Save R4 for string pointer MOV CMDPTR,R0 ; Set current pointer MOV R0,R1 ; Calculate length of command SUB #COMAND,R1 ; That does it BIT #D.DIR,DCLFW ; Getting directory? BEQ 10$ ; No something else BIT #D.QMK,DCLFW ; Wild character seen? BEQ 7$ ; No! 600$: DEC R0 ; Look back for a delimiter CMPB #' ,(R0) ; A space will do. BEQ 661$ ; A ha! CMPB #':,(R0) ; A : will also do BEQ 661$ ; Not yet CMPB #'],(R0) ; This is the final check BEQ 661$ ; Ok! CMPB #'=,(R0) ; The = sign also qualifies BEQ 661$ ; We have it SOB R1,600$ ; Try some more MOV #ER.STX,ERROR ; Dam!!!! JMP 48$ ; Punt... 661$: MOV #QMKMSG,R2 MOV R2,APPND ; We have a new ball game ADD #4,R2 ; Where the stuff goes 662$: INC R0 ; Past the good stuff MOV R0,-(SP) ; Save for later 663$: MOVB (R0)+,(R2)+ ; Stuff the junk CMP R0,CMDPTR ; Are we back from whence we came. BNE 663$ ; Not yet MOV (SP)+,R0 ; Restore the shorter version. MOV #"SR,COMAND ; And say we're after SRD MOVB #'D,COMAND+2 ; That does it BR 8$ ; Then continue 7$: CMP #4,R1 ; Min command? BEQ 8$ ; Yes then spawn it CMPB #'/,COMAND+4 ; Just switches? BEQ 8$ ; Ok - do your thing BIT #D.EXT,DCLFW ; Extension defined? BNE 8$ ; YES - append stuff and spawn BIT #D.FNG,DCLFW ; Did we get a filespec? BNE 9$ ; Yes then add .* BIT #D.UIC,DCLFW ; UIC started? BEQ 8$ ; No BIT #D.UIE,DCLFW ; Final ]? BNE 8$ ; Yes! MOVB #'],(R0)+ ; No we have to add it BR 8$ ; And continue 9$: BIT #D.SWC,DCLFW ; Do we have switches? BNE 30$ ; Yes then punt MOVB #'.,(R0)+ ; Add the wild stuff MOVB #'*,(R0)+ ; That does it! ADD #2,R1 ; Adjust the count 8$: BR 30$ ; Now we can proceed 10$: BIT #D.TAF,DCLFW ; To and from for min command? BEQ 20$ ; No BIT #D.EQU,DCLFW ; Equal seen? BNE 20$ ; Yes - then we have everything we need CMP #4,R1 ; Min command? BEQ 100$ ; Yes prompt for everything CALL SWAP ; Ok swap junk BR 11$ ; Then go back 100$: MOV #FROM,R2 ; Setup to input with prompt MOV #HERE,R4 ; Put the input here MOV #FROMCT,TTYIN+Q.IOPL+10 ; Length of prompt 101$: CALL INTTY ; Input the string BCC 11$ CALL CKPOOL ; Check the pool BR 101$ ; Retry 11$: TST ERROR ; Are we exiting? BEQ 111$ ; No! JMP 48$ ; Yes - then get out 111$: MOV IOST+2,HERECT ; This is the from count BEQ 101$ ; We must have a from... INC HERECT ; Count the = sign CMP #4,R1 ; Bare copy? BNE 14$ ; No then put in the from MOV #TO,R2 MOV #THERE,R4 ; Store it there MOV #TOCT,TTYIN+Q.IOPL+10 ; Length of to prompt 145$: CALL INTTY ; Input the string BCC 146$ ; Ok! CALL CKPOOL ; Check the pool. BR 145$ ; Re-try 146$: TST ERROR ; Are we exiting? BEQ 147$ ; Not this time.. JMP 48$ ; Yes - then exit mess 147$: MOV #THERE,R4 ; Now put it there MOV IOST+2,R2 ; Bytes in to string BEQ 14$ ; A null to string ADD R2,R1 ; Adjust byte count 12$: MOVB (R4)+,(R0)+ ; Move in the too info SOB R2,12$ ; All bytes 14$: MOV HERECT,R2 ADD R2,R1 ; Add in the filespec byte count MOV #HERE-1,R4 ; From here 16$: MOVB (R4)+,(R0)+ ; Move in the from string SOB R2,16$ ; More.. 20$: BIT #D.FIL,DCLFW ; File if not given? BEQ 30$ ; No file prompt needed BIT #D.FNG,DCLFW ; A filespec seen? BEQ 201$ ; No CMPB #'/,COMAND+4 ; Only switches? BNE 30$ ; Must be a filename... 201$: TSTB FIX ; Are we truncate or purge? BEQ 202$ ; Nope MOVB #'*,(R0)+ ; Yes then add the wild stuff MOVB #'.,(R0)+ MOVB #'*,(R0)+ ; Before proceeding BR 30$ ; Then do your thing... 202$: MOV #FILE,R2 ; Prompt for file MOV #THERE,R4 ; Put'er there MOV #FILECT,TTYIN+Q.IOPL+10 ; Length of file prompt 21$: CALL INTTY ; Input the string BCC 211$ CALL CKPOOL ; Check for allocation BR 21$ ; Then try again if we come back 211$: TST ERROR ; Should we contiue... BNE 48$ ; No need we are exiting MOV IOST+2,R2 ; Null filespec? BEQ 201$ ; We don't accept a null. ADD R2,R1 ; Adjust the count. 22$: MOVB (R4)+,(R0)+ ; Define the filespec SOB R2,22$ ; Keep it up 30$: BIT #D.RNS,DCLFW ; Do we need nft? BEQ 34$ ; Not this time MOV TASKS+4,COMAND ; Substitute NFT name MOVB TASKS+6,COMAND+2 ; That should do it CMP #"TY,GBUF ; Typ from remote? BNE 34$ ; No MOV #ASCII,APPND ; Append ascii switch /AS 34$: TST APPND ; Are we appending anything? BEQ 40$ ; No - then proceed MOV APPND,R1 ; Set to stuff CALL STUFF ; Stuff it in 40$: MOVB LBYTE,(R0)+ ; Fill in the for mcr MOV R0,R1 ; Recalculate length SUB #COMAND,R1 ; That should do it CMP #79.,R1 ; Max length BLT 58$ ; Line too big to send MOV #COMAND,MCR+S.PWCA ; Command to ship MOV R1,MCR+S.PWCL ; Fix the length 45$: DIR$ #MCR ; Send the command to MCR BCC 47$ ; Ok! CALL CKPOOL ; Check the pool BR 45$ ; And try again 47$: CMPB #15,-1(R0) ; Should we wait? BEQ 48$ ; No! DIR$ #WAIT4 ; Wait here for task to complete 48$: MOV SAVR4,R4 ; Restore R4 CLR SAVR4 ; Save no more 50$: MOV CMDPTR,R0 ; Restore pointer RETURN ; All done with this mess 58$: MOV #ER.BIG,ERROR ; Line too long! BR 48$ ; Exit this mess SWAP: CLR IOST+2 ; Start fresh MOV #COMAND+4,R2 ; setup pointer MOV #HERE,R0 ; For stuffing junk SUB #4,R1 ; Now for the hard stuff BGT 10$ ; OK 5$: MOV #ER.STX,ERROR ; Syntax error RETURN ; Exit with error 10$: CMPB #'=,(R2) ; To the = yet? BEQ 12$ ; Yes MOVB (R2)+,(R0)+ ; Nope INC IOST+2 ; One more byte SOB R1,10$ ; More BIT #D.SWP,DCLFW ; Are we swapping to the =? BEQ 13$ ; Our luck BR 5$ ; Oops 12$: INC R2 ; Slip past the = DEC R1 ; One less now 13$: MOV #COMAND+4,R0 ; Reset to collapse the line MOV R1,-(SP) ; Save the current count BEQ 16$ ; Nothing there 14$: MOVB (R2)+,(R0)+ ; Collapse the line SOB R1,14$ ; Until done 16$: MOV (SP)+,R1 ; Then return the count ADD #4,R1 ; Fix all RETURN .PAGE .SBTTL PROCESS THE SWITCH SWITCH: BIT #D.DIR,DCLFW ; Are we doing a directory? BNE 1$ ; Branch if it is BIT #D.FIL,DCLFW ; Maybe its a delete function? BEQ 10$ ; No sense checking for /SO or /SD 1$: CMPB #'S,(R4) ; Sort switch? BNE 10$ ; Not a sort switch CMPB #'O,1(R4) ; May be a sort switch BEQ 2$ ; Branch if it is CMPB #'D,1(R4) ; May be SELECTIVE Delete? BNE 10$ ; Probably a syntax error BIT #D.FIL,APPND ; Is it allowed? BEQ 10$ ; Branch if not MOV #SELDEL,APPND ; Point to the right switch BR 5$ ; Now leave... 2$: BIT #D.DIR,DCLFW ; Are we doing a directory? BEQ 10$ ; Branch if not CALL SORT ; Ok sort the directory 5$: CMPB #'/,(R4) ; Suck up rest BEQ 7$ ; I got it all INC R4 ; Next character SOB R3,5$ ; Until all gone 7$: RETURN ; Then leave 10$: BIS #D.SWC,DCLFW ; Set flag for switch seen MOV CMDPTR,R0 ; Get where we need to stuff things MOVB .PCHAR,(R0)+ ; Stuff it 12$: CMPB #'/,(R4) ; Have we finished this switch? BEQ 20$ ; Yes CMPB #' ,(R4) ; Another terminator! BEQ 20$ ; Yes then we are done CMPB #'=,(R4) ; Yet another way to quit BEQ 20$ ; Quit then MOVB (R4)+,(R0)+ ; Move them out SOB R3,12$ ; More to do? 20$: MOV R0,CMDPTR ; Restore thyself BR 7$ ; Then get out SORT: MOV #SRDMSG,MCR+S.PWCA MOV #SRDEND,R0 ; The end if no one asks MOVB #33,-(SP) ; The end of the world. MOV TOTAL,R1 ; How many bytes to look at MOV #SRDMEX,R2 ; Where we extend SRD's message BIT #D.UIC,DCLFW ; Do we have a UIC? BEQ 10$ ; No MOVB #'],(SP) ; This is what we end with then BIT #D.UIE,DCLFW ; ] seen? BNE 12$ ; Ok we are setup MOV TOTAL,R0 ; Ok insert it... ADD GBUF,R0 ; Here MOVB (SP),(R0) ; That there it is INC R1 ; We now look at this many bytes BR 12$ ; Now continue... 10$: BIT #D.DEV,DCLFW ; Device given? BEQ 16$ ; Only the last stuff MOVB #':,(SP) ; here is what we want 12$: MOV #GBUF,R0 ; Start here for finding a space 13$: CMPB #' ,(R0)+ ; Space seen? BEQ 14$ ; Got it! SOB R1,13$ ; Keep looking! BR 18$ ; We should not have to do this 14$: DEC R1 ; Account for the space 16$: MOVB (R0),(R2)+ ; Move in the bytes CMPB (R0)+,(SP) ; Until the terminator BNE 16$ ; That does it then CMPB #33,(SP)+ ; Are we ending? BEQ 20$ ; So it appears 18$: MOV #33,-(SP) ; We will next time MOV #SRDEND,R0 ; For sure BR 16$ 20$: SUB #SRDMSG,R2 ; How many bytes to send MOV R2,MCR+S.PWCL ; To MCR MOV CMDPTR,R0 ; Save where we were SORT0: DIR$ #MCR ; Spawn SRD via MCR BCC 10$ ; Ok! CALL CKPOOL ; Room to wade? BR SORT0 ; Then try again! 10$: DIR$ #WAIT4 ; Wait for SRD to complete MOV R0,CMDPTR ; In case we need it! RETURN ; That does it! CKUIC: MOV CMDPTR,R0 ; Set current pointer BIT #D.UIC,DCLFW ; UIC given? BEQ 10$ ; No - asking then BIT #D.UIE,DCLFW ; End ] seen? BNE 10$ ; Yes then set UIC to one given MOVB #'],(R0)+ ; Move in the trailer for the user 10$: MOVB LBYTE,(R0)+ ; Send a MOV R0,R1 ; Calculate length of string. SUB #COMAND,R1 ; That does it MOV R1,MCR+S.PWCL ; Tell MCR the length JMP SORT0 ; Spawn MCR CKPOOL: CMP #IE.UPN,$DSW ; Out of pool? BNE 20$ ; No we have a real problem WSIG$S ; Wait at the edge RETURN ; And try again 20$: MOV $DSW,ERROR ; Indicate error type TST (SP)+ ; Pop the stack TST SAVR4 ; Do we need to restore R4 BEQ 22$ ; Nope! MOV SAVR4,R4 ; Yes - then do it... 22$: RETURN ; Return for caller INTTY: MOV R4,-(SP) ; Save buffer pointer MOV R2,-(SP) ; And prompt pointer MOV R2,TTYIN+Q.IOPL+6 ; Define prompt string pointer MOV R4,TTYIN+Q.IOPL ; Input goes here 5$: DIR$ #TTYIN ; Input the string BCS 30$ ; Return with C set CMPB #IS.SUC,IOST ; Input ok? BEQ 12$ ; Yes CMPB #IE.EOF,IOST ; ^Z implies stoping BNE 10$ ; No then the error is serious MOV #ER.ABO,ERROR ; Say we are quiting CLC ; No carry please BR 30$ ; Then get out 10$: MOVB IOST,ERROR ; Define the error. SEC ; Set the carry BR 30$ ; Then leave 12$: MOV R4,R2 ; Dual pointer TST IOST+2 ; Any bytes? BEQ 30$ ; No MOV R3,-(SP) ; Burrow R3 MOV IOST+2,R3 14$: MOVB (R4)+,(R2) CMPB #40,(R2) ; Was it a space BNE 15$ ; No - then continue DEC IOST+2 ; And byte count BR 20$ ; Skip the rest 15$: CMPB #'_,(R2) ; Implied nodname? BNE 17$ ; No way BIT #D.NOK,DCLFW ; Is Network function ok? BNE 16$ ; Yes - then set the bit MOV #ER.NNS,ERROR ; Set error 155$: CALL ERRPRT ; Report it CLR ERROR ; We handled the error BR 5$ ; Then re-prompt. 16$: BIS #D.RNS,DCLFW ; Ok - set network request 17$: CMPB #':,(R2) ; Check :: BNE 18$ ; No way CMPB #':,(R4) ; Another : follows? BNE 18$ ; No MOVB #'_,(R2) ; Replace with "_" INC R4 ; Past the second : DEC IOST+2 ; One less byte then DEC R3 ; To wory about BNE 15$ ; Ok! - rescan MOV #ER.STX,ERROR ; Syntax error BR 155$ ; Say syntax error - then reprompt 18$: CMPB #140,(R2) ; Convert to lower? BPL 19$ ; No need MOVB (R2),-(SP) ; Pop on lower case SUB #40,(SP) ; Make it lower case MOVB (SP)+,(R2) ; Replace with upper case 19$: INC R2 ; Next place 20$: SOB R3,14$ ; Do them all! MOV (SP)+,R3 ; Give back R3 30$: MOV (SP)+,R2 ; Restore regs MOV (SP)+,R4 ; That does it RETURN .PAGE .SBTTL PROCES - Look for command file. ; Looks for a command file to submit to ...AT., first in the login ; UIC, then on LB:[1,2]. If the process file is found, then an @ ; is placed before the user input and MCR is spawned with that command ; line. PROCES:: MOV TOTAL,APPND ; Use this location for counting MOV #HERE,R0 MOV #GBUF,R1 MOV #4,R2 ; Start with extension count 10$: CMPB #40,(R1) ; Space? BEQ 12$ ; Next MOVB (R1)+,(R0)+ ; Store the filename INC R2 ; One more byte DEC APPND ; One less byte now BNE 10$ ; Keep plugging 12$: MOV #DEXT,R1 ; Now the default extension CALL STUFF ; Stuff in extension MOV R2,DSNCT ; To dataset name count CALL OPNFIL ; Use default UIC BCC 30$ ; We did it... MOV #LBSIZ,DSDB ; Now try LB:[1,2] MOV #LB,DSDB+2 MOV #SUICSZ,DSDB+4 ; UIC byte count MOV #SUIC,DSDB+6 ; And pointer CALL OPNFIL ; See if logical process defined BCC 20$ MOV #ER.NLP,ERROR ; No logical process RETURN 20$: MOV #11,R2 ; We need 11 bytes MOV #GBUF-11,R0 ; Where to put them BR 32$ ; Skip to stuff MCR 30$: MOV #1,R2 ; Only one byte MOV #GBUF-1,R0 32$: TST ERROR ; Do we have an error? BNE 40$ ; Yes - then skip it... MOV R0,MCR+S.PWCA ; This is the spawning bit MOV R2,MCR+S.PWCL ; This is the start of length MOV #INDP,R1 ; Where to get the bytes 34$: MOVB (R1)+,(R0)+ ; Stuff them SOB R2,34$ CLOSE$ #PROFIL ; Close process file ADD TOTAL,MCR+S.PWCL ; Add on the rest of the buffer MOV MCR+S.PWCL,R2 ; The byte count... MOV MCR+S.PWCA,R1 ; And the current buffer MOV #COMAND,R0 ; Now move the command to its reg place MOV R0,MCR+S.PWCA ; The command to spawn 35$: CMPB #' ,(R1) ; Space? BEQ 36$ ; Yes then save our place and switch MOVB (R1)+,(R0)+ ; Save a byte SOB R2,35$ ; More to come! 36$: MOV R1,-(SP) ; Save where we are. MOV #DEXT,R1 ; Now the default extension 37$: TSTB (R1) ; Done? BEQ 38$ ; Yes - then finish up MOVB (R1)+,(R0)+ ; Default extension BR 37$ ; More 38$: MOV (SP)+,R1 ; Restore where we were TST R2 ; Any left? BEQ 395$ ; No - then skip 39$: MOVB (R1)+,(R0)+ ; And continue SOB R2,39$ ; Unitl done 395$: MOVB LBYTE,(R0)+ ; No prompt please MOV R0,R1 ; Calculate size of string SUB #COMAND,R1 ; This is it... CMP #79.,R1 ; OK? BPL 42$ ; Yes! MOV #ER.BIG,ERROR 40$: RETURN 42$: MOV R1,MCR+S.PWCL ; Put in the length JMP SORT0 ; And spawn MCR OPNFIL: MOV R0,-(SP) ; Save for later OPEN$R #PROFIL BCC 12$ ; We're a hit CMPB #IE.NSF,F.ERR(R0) ; No such file? BEQ 10$ ; Branch if so CMPB #IE.BNM,F.ERR(R0) ; String too long? BNE 11$ ; Branch if not MOV #ER.BIG,ERROR ; Set the appropriate bit BR 13$ ; Skip rest 11$: MOV F.ERR(R0),ERROR ; Set FCS error BIC #177400,ERROR ; Clear the high byte 13$: CLC ; And the carry BR 12$ ; Then leave! 10$: SEC ; Set file not found bit 12$: MOV (SP)+,R0 ; Restore R0 RETURN ; Then get out .PAGE .SBTTL ERRPRT - Errors printed ERRPRT: CMP #ER.STX,ERROR ; Syntax error? BNE 10$ ; No! MOV #STXER,SQWAK+Q.IOPL MOV #STXECT,SQWAK+Q.IOPL+2 ; This many bytes 5$: DIR$ #SQWAK ; Type the error RETURN ; And continue 10$: CMP #ER.NNS,ERROR ; Network function error BNE 12$ ; No! MOV #NNSUP,SQWAK+Q.IOPL MOV #NNSUCT,SQWAK+Q.IOPL+2 ; This many bytes BR 5$ ; Report it 12$: CMP #ER.NLP,ERROR ; No such process? BNE 14$ ; Not this time MOV #LPERR,SQWAK+Q.IOPL ; No such logical process MOV #LPECT,SQWAK+Q.IOPL+2 ; Byte count BR 5$ ; Report it... 14$: CMP #ER.BIG,ERROR ; Line too long? BNE 16$ ; No! MOV #BIGER,SQWAK+Q.IOPL ; Yes MOV #BIGCT,SQWAK+Q.IOPL+2 ; So tell user BR 5$ 16$: CMP #ER.ESC,ERROR ; Are we escaping? BNE 18$ ; No MOV #ESCSEQ,SQWAK+Q.IOPL ; ESC sequence MOV #ESCSCT,SQWAK+Q.IOPL+2 ; This many bytes BR 5$ ; Print it 18$: TSTB ERROR+1 ; FCS or Directive error? BEQ 20$ ; FCS error MOV #DIRER,R0 ; Setup to convert MOV R0,SQWAK+Q.IOPL ; Setup to write ADD #DIRCT,R0 ; Adjust pointer BR 24$ 20$: MOV #FCSER,R0 ; FCS error MOV R0,SQWAK+Q.IOPL ; Define message pointer ADD #FCSCT,R0 ; Add in the offset 24$: MOVB ERROR,R1 ; Sign extend into R1 MOV #1,R2 ; Suppress leading zero's CALL $CBDSG ; Convert number SUB SQWAK+Q.IOPL,R0 ; Calculate bytes MOV R0,SQWAK+Q.IOPL+2 ; And save result BR 5$ ; Then go print it .END DCL