.TITLE PIN -- PROCEDURE INTERPRETER .IDENT /01.1/ .ENABLE LC ;+ ; WRITTEN BY: ; JAMES G. DOWNWARD ; KMS FUSION, INC. ; 3941 RESEARCH PARK DR ; ANN ARBOR, MICH. 48104 ; (313)-769-8500 ; 07-JUN-79 ; ; PIN IS A PROCEDURE INTERPRETER FOR RSX11M V3.2 WITH SPAWNING AND ; STOP BIT DIRECTIVE SUPPORT. NORMALLY THE INDIRECT FILE PROCESSOR IS ; USED TO CONTROL ASSEMBLY AND TASK BUILDS. ITS SIZE IS OVER 8K. NOW ; THAT SPAWNING EXISTS, A SIMPLE SMALLER TASK COULD READ A COMMAND FILE, ; SPAWN THE MCR COMMANDS, CHECK EXIT STATUS, ETC. THIS IS THE FUNCTION ; OF PIN. WITH PIN IT IS POSSIBLE TO CONTROL AN ASSEMBLY/COMPILE/TASKBUILD ; USING ONLY ABOUT 1/3 THE CORE USED BY ...AT. ; ; Modified by P.A. Stephensen-Payne 18-Jun-80 ; c/o Systime Ltd., ; Concourse Computer Centre, ; 432 Dewsbury Road, ; LEEDS LS11 7DF, ; England. ; ; The version we built was nowhere near 1/3 the size of AT. ; (6KW against 8KW) because of all the FCS routines. It was ; therefore modified to use GMCR instead of GCML, Direct QIOs ; instead of FCS, and CSI$ was eliminated altogether. This ; cut the size down to 2KW. ; To make it smaller still you could remove all the lovely ; error messages. ; ;- .MCALL QIOW$,EXIT$S,DIR$,EXST$S,STSE$,SPWN$,GLUN$,NMBLK$ .MCALL GMCR$,GTSK$S,ALUN$S ; ; ; LUN VALUES ARE SET UP AT TASK BUILD ; FOR PROGRAM TO WORK ; LUN=1 =>SY: THE .CMD FILE ; LUN=2 =>TI: THE TERMINAL(OR VT:) I/O ; BLKBUF: .BLKB 512. ; Buffer for deblocking UIC: .WORD 0 ; UIC of Command File FNB1: .BLKW 3 ; File ID DIR: .RAD50 /000000/ ; Directory Name (to be filled in) .WORD 0 ; .RAD50 /DIR/ ; .WORD 1 ; File Version .WORD 0,0 ; Status and next .WORD -1,-1,0 ; Directory ID of MFD GETLUN: GLUN$ 2,BLKBUF+2 ; GET TERMINAL INFORMATION ; FATT: .BYTE -4,16 ; Read File Attributes .WORD ATTR .WORD 0 IEXBLK: ; Can reuse space when file is open ATTR: .BLKB 16 ; Room for File Attributes IOST: .BLKW 2 ; I/O Status Block BLOCK: .WORD 0 ; Current Block Number BLKADD: .WORD ; Address of record in buffer BLKLEN: .WORD 0 ; Amount of space left in buffer FNB2: NMBLK$ ,CMD,0,SY,0 ; Default to .CMD on SY0: GMCR: GMCR$ BUFFER=GMCR+G.MCRB ; Reuse buffer space QIODPB: QIOW$ IO.WVB,2,2,,,,<0,0,40> ; WRITE TO TERMINAL QIOFIL: QIOW$ IO.FNA,1,1,,IOST ; Access File SPAWN1: SPWN$ ...MCR,,,,,1,,IEXBLK,BUFFER ; SPAWN TO TI: SPAWN2: SPWN$ MCR...,,,,,1,,IEXBLK,BUFFER ; SPAWN TO TI: VIA MCR...(FINAL V3.2) STOP: STSE$ 1 ; STOP FOR EVENT FLAG PARAM: .WORD 5 ; Parameter Block for ASCFNM .WORD GMCR+G.MCRB+4 ; Address of String .WORD INPLEN ; Input Length .WORD FNB2 ; Filename Block .WORD UIC ; Word for the UIC .WORD ERR ; Error Return PARAM1: .WORD 2 ; Parameter block for CNVTUC .WORD INPLEN ; Length .WORD BUFFER ; Address of input line INPLEN: .WORD ; Length of input string ERR: .WORD 0 VTFLAG: .BYTE 0 ; IF FLAG SET , TERMINAL IS A VT: TRAFLG: .BYTE 0 ; TRACE FLAG(=1 PRINT EACH COMMAND) DELFLG: .BYTE 0 ; DELETE FLAG(=1 DELETE COMMAND FILE AT CLOSE) ; ; ERROR MESSAGES ; .NLIST BEX ERM1: .BYTE ERM1L .ASCII /PIN - SYNTAX ERROR/ ERM1L=.-ERM1-1 ERM2: .BYTE ERM2L .ASCII /PIN - ILLEGAL FILE NAME/ ERM2L=.-ERM2-1 ERM3: .BYTE ERM3L .ASCII /PIN - FILE OPEN ERROR/ ERM3L=.-ERM3-1 ERM4: .BYTE ERM4L .ASCII /PIN - NO SUCH FILE/ ERM4L=.-ERM4-1 ERM5: .BYTE ERM5L .ASCII /PIN - SPAWN FAILURE/ ERM5L=.-ERM5-1 ERM6: .BYTE ERM6L .ASCII /PIN - STOP FOR EVENT FLAG FAILED/ ERM6L=.-ERM6-1 ERM7: .BYTE ERM7L .ASCII /PIN - WARNING, EXIT WITH NON-FATAL ERROR/ ERM7L=.-ERM7-1 ERM8: .BYTE ERM8L .ASCII /PIN - FATAL, EXIT WITH SEVERE ERROR/ ERM8L=.-ERM8-1 ERM9: .BYTE ERM9L .ASCII /PIN - CMD FILE READ ERROR/ ERM9L=.-ERM9-1 ERM10: .BYTE ERM10L .ASCII /PIN - CMD FILE CLOSE ERROR/ ERM10L=.-ERM10-1 ERM11: .BYTE ERM11L .ASCII /PIN - EOF/<7> ERM11L=.-ERM11-1 ERM12: .BYTE ERM12L .ASCII /@ / ERM12L=.-ERM12-1 ERM13: .BYTE ERM13L .ASCII /PIN - ONLY SINGLE LINE MCR COMMANDS ALLOWED/ ERM13L=.-ERM13-1 ERM14: .BYTE ERM14L .ASCII /PIN - UNKNOWN INTERNAL COMMAND/ ERM14L=.-ERM14-1 .LIST BEX .EVEN ; ; READ AND DECODE THE COMMAND LINE ; PIN:: DIR$ #GMCR ; Get the Command Line MOV $DSW,INPLEN ; Get number of characters SUB #4,INPLEN ; Discount the "PIN " and the terminator BGT CONTIN ; If GT OK - Continue ; SERR: MOV #ERM1,R0 ; SYNTAX ERROR JMP XIT1 ; CONTIN: GTSK$S #BLKBUF+2 ; Get task parameters MOV BLKBUF+16.,UIC ; Set the default UIC DIR$ #GETLUN ; FIND OUT WHAT KIND OF TERMINAL WE HAVE CMP #"VT,BLKBUF+2 ; IS IT A VT BNE START ; IF NE,NO INCB VTFLAG ; SHOW IT'S A VT: ; START: CLRB TRAFLG ; Clear status flags CLRB DELFLG ; CLR BLOCK ; Initialize file buffer pointers CLR BLKLEN ; CLR FNB2+N.FVER ; Clear any previous version number MOV #PARAM,R5 ; Set up parameter list CALL ASCFNM ; Convert the Filename TST ERR ; Was there an error? BEQ 10$ ; If EQ no - carry on MOV #ERM2,R0 ; ILLEGAL FILE NAME JMP XIT1 ; AND EXIT WITH SEVERE ERROR ; 10$: ; ; We now have the filename set up in FNB2, but we must finish setting ; up FNB1 by setting up the UIC correctly ; ALUN$S #1,FNB2+N.DVNM,FNB2+N.UNIT ; Assign the device MOV #BUFFER,R0 ; Convert UIC MOVB UIC+1,R1 ; Group first MOV #1,R2 ; Don't suppress zeroes CALL $CBTMG ; Do it MOVB UIC,R1 ; Now the member MOV #1,R2 ; CALL $CBTMG ; MOV #BUFFER,R0 ; Then back to RAD50 CALL $CAT5 ; MOV R1,DIR ; And stored in the directory CALL $CAT5 ; MOV R1,DIR+2 ; ; ; Now we find the directory in the MFD ; MOV #IO.FNA,QIOFIL+Q.IOFN ; Function Code CLR QIOFIL+Q.IOPL ; Clear Previous Parameter CLR FNB1 ; CLR FNB1+2 ; CLR FNB1+4 ; MOV #FNB1,QIOFIL+Q.IOPL+10. ; Stuff in address of filename block DIR$ #QIOFIL ; Find the directory ; QIOW$S #IO.FNA,#1,#1,,#IOST,,<,,,,,#FNB1> TSTB IOST ; OK? BMI 20$ ; If MI no - error MOV FNB1+N.FID,FNB2+N.DID ; Copy file ID of directory.. MOV FNB1+N.FID+2,FNB2+N.DID+2 ; ..to be directory ID of file MOV FNB1+N.FID+4,FNB2+N.DID+4 ; MOV #FNB2,QIOFIL+Q.IOPL+10. ; Replace with file filename block DIR$ #QIOFIL ; Find the file ; QIOW$S #IO.FNA,#1,#1,,#IOST,,<,,,,,#FNB2> TSTB IOST ; OK? BPL 30$ ; If PL OK - carry on ; 20$: CMPB #IE.NSF,IOST ; IS IT NO SUCH FILE? BEQ 25$ ; YES ; 23$: MOV #ERM3,R0 ; FILE OPEN ERROR BR 26$ ; ; 25$: MOV #ERM4,R0 ; NO SUCH FILE ; 26$: JMP XIT1 ; SO ERRXIT ; ; OPEN THE FILE AND LOOK AT IT. ; 30$: MOV #IO.ACR,QIOFIL+Q.IOFN ; Function code MOV #FNB2,QIOFIL+Q.IOPL ; Filename Block MOV #FATT,QIOFIL+Q.IOPL+2 ; File Attributes List MOV #100000,QIOFIL+Q.IOPL+8.; Access Control CLR QIOFIL+Q.IOPL+10. ; Left from IO.ACR DIR$ #QIOFIL ; QIOW$S #IO.ACR,#1,#1,,#IOST,,<#FNB2,#FATT,,,#100000> TSTB IOST ; Access OK? BMI 20$ ; If MI no - log error CMP ATTR,#1002 ; Right sort of file? BNE 23$ ; If NE no - error ADD #BLKBUF,ATTR+12. ; Offset First Free Byte Value MOV #IO.RVB,QIOFIL+Q.IOFN ; Function Code MOV #BLKBUF,QIOFIL+Q.IOPL ; Parameters MOV #512.,QIOFIL+Q.IOPL+2 ; CLR QIOFIL+Q.IOPL+6 ; ; 40$: CALL GETREC ; Get the Next Record BCC 45$ ; If CC OK - Handle it JMP SUCXIT ; Else Exit Successfully ; 45$: MOV R3,INPLEN ; Insert length MOV #PARAM1,R5 ; Get parameter block address CALL CNVTUC ; Convert record to upper case MOVB BUFFER,R2 ; Get the First Character CMPB R2,#'@ ; IS FIRST CHARACTER BGE 60$ ; OK IF >= AN 'A' CMPB R2,#'; ; OR MAYBE A COMMENT BEQ 60$ ; OK IF A ';' CMPB R2,#'$ ; IS IT AN INTERNAL COMMAND BNE 50$ ; IF NE, NO CALL CHKCMD ; SEE IF ITS A COMMAND BR 40$ ; GO BACK AND LOOK FOR MORE TO DO ; 50$: MOV #ERM13,R0 ; ELSE WARN USER OF ILLEGAL RECORD FORMAT ; 55$: JMP XIT2 ; AND EXIT ; 60$: CMPB R2,#'Z ; IS IT <='Z' BLE 70$ ; If LE OK - Carry On CMPB R2,#'a ; Lower-case Alphabetic? BLT 50$ ; If LT no - error CMPB R2,#'z ; Sure? BGT 50$ ; If GT no - error ; 70$: BGT 50$ ; If GT No - Error TSTB TRAFLG ; IS TRACE SET BEQ 80$ ; IF EQ 0, NO CALL WRTCMD ; GO DISPLAY COMMAND ; 80$: MOV R3,SPAWN1+S.PWCL ; GET LENGTH MOV R3,SPAWN2+S.PWCL ; SET LENGTH HERE ALSO DIR$ #SPAWN2 ; FIRST TRY SPAWNING TO MCR... BCC 90$ ; IF CC, WE GOT IT DIR$ #SPAWN1 ; THEN TRY SPAWNING TO ...MCR BCC 90$ ; IF CC IS OK MOV #ERM5,R0 ; SPAWN FAILURE JMP XIT2 ; 90$: DIR$ #STOP ; STOP FOR EFN 1 BCC 100$ ; IF CC ALL OK MOV #ERM6,R0 ; STOP FOR EVENT FLAG FAILURE JMP XIT2 ; ERRXIT ; 100$: CMP #2,IEXBLK ; IS IT A WARNING BNE 110$ ; NO MOV #ERM7,R0 ; WARNING, EXIT WITH NON-FATAL STATUS CALL PNTLIN ; CALL WRTCMD ; WRITE OUT OFFENDING COMMNAD BR 120$ ; CONTINUE ; 110$: CMP #4,IEXBLK ; IS IT A SEVERE ERROR BNE 120$ ; IF NE , NO CALL WRTCMD ; WRITE OUT OFFENDING COMMAND MOV #ERM8,R0 ; EXIT WITH SEVERE ERROR JMP XIT1 ; ERRXIT ; 120$: JMP 40$ ; AGAIN ;+ ; WRTCMD -- ISSUE QIO TO WRITE OUT OFFENDING COMMAND ; ;- WRTCMD: ; MOV #BUFFER,QIODPB+Q.IOPL ; GET ADDRESS OF COMMAND MOV R3,QIODPB+Q.IOPL+2 ; SET COMMAND LENGTH DIR$ #QIODPB ; ISSUE QIO RETURN ; ; ;+ ; CHKCMD ; A COMMAND BEGINNING WITH '$' IS AN INTERNAL PIN COMMAND ; SO SEE IF THE ENTERED LINE IS SUCH A COMMAND ; IF IT IS, DO WHAT IS NEEDED AND RETURN ; IF IT ISN'T PRINT A NASTY MESSAGE, AND RETURN ; ; ALLOWED COMMANDS ; $DE - DELETE THIS COMMAND FILE ON EXIT ; $TR - PROVIDE A TRACING OF THE COMMANDS SPAWNED ; $NODE - DON'T DELETE THE FILE(IS INITIAL DEFAULT) ; $NOTR - NO TRACE(SET BY DEFAULT) CHKCMD: MOV #BUFFER+1,R4 ; Get address of next character MOV #1,R0 ; Initialise to 'Set' CMPB (R4),#'N ; MAYBE A 'NO' BNE 10$ ; IF NE, NO INC R4 ; MAYBE EITHER A NOTR OR NODE CMPB (R4)+,#'O ; IS IT NO BNE 40$ ; IF NE, ERROR RETURN WITH NASTY MESSAGE CLR R0 ; Is 'NO' - Change flag to 'Clear' ; 10$: CMPB (R4),#'D ; IS IT DELETE BNE 20$ ; IF NE, CHECK 'NOTR' INC R4 ; SEE IF 'E' CMPB (R4),#'E ; AN 'E' PERHAPS BNE 40$ ; NO, ERROR RETURN MOVB R0,DELFLG ; Set/Clear delete Flag RETURN ; AND RETURN ; 20$: CMPB (R4),#'T ; IS IT 'NOTR' BNE 30$ ; IF NE, NO, ERROR INC R4 ; SEE IF 'R' CMPB (R4),#'R ; IS IT 'TR' BNE 40$ ; IF NE, NO , ERROR MOVB R0,TRAFLG ; Set/Clear Trace Flag RETURN ; 30$: CMPB (R4),#'C ; Is it 'CH'? BNE 40$ ; If NE no - error INC R4 ; See if 'H' CMPB (R4),#'H ; Is it 'CH'? BNE 40$ ; If NE no INC ERR ; Set chain flag SUB #4,INPLEN ; Set length for ASCFNM TST (SP)+ ; Remove return address JMP COMXIT ; And deaccess the file ; 40$: CALL WRTCMD ; WRITE IT OUT MOV #ERM14,R0 ; PRINT OUT WARNING THAT IT IS AN UNKNOWN COMMAND CALL PNTLIN ; RETURN ; ; ; EXIT AND ERROR ROUTINES ; ; XIT2: CALL WRTCMD ; Output Offending Line ; XIT1: CALL PNTLIN ; Output Error Message CLR ERR ; Clear Chain Flag ; XIT: ; MOV #4,R2 ; Set Exit Status as Severe error BR COMXIT ; And take Common Exit ; SUCXIT: MOV #1,R2 ; Set Exit Status as Success ; COMXIT: MOV #IO.DAC,QIOFIL+Q.IOFN ; Function is Deaccess CLR QIOFIL+Q.IOPL+2 ;Clear Previous Parameters CLR QIOFIL+Q.IOPL ; CLR QIOFIL+Q.IOPL+6 ; CLR QIOFIL+Q.IOPL+8.; DIR$ #QIOFIL ; ; QIOW$S #IO.DAC,#1,#1 ; Deaccess the file TSTB DELFLG ; Delete the file? BEQ 30$ ; If EQ no - just exit MOV #IO.DEL,QIOFIL+Q.IOFN ; Function Code MOV #FNB2,QIOFIL+Q.IOPL ; Parameter DIR$ #QIOFIL ; ; QIOW$S #IO.DEL,#1,#1,,#IOST,,<#FNB2> TSTB IOST ; Deletion OK? BPL 20$ ; If PL Yes - carry on MOV #ERM10,R0 ; No - say so CALL PNTLIN ; BR 30$ ; ; 20$: MOV #IO.RNA,QIOFIL+Q.IOFN ; Function Code CLR QIOFIL+Q.IOPL ; Clear Previous Parameter MOV #FNB2,QIOFIL+Q.IOPL+10. ; DIR$ #QIOFIL ; ; QIOW$S #IO.RNA,#1,#1,,,,<,,,,,#FNB2> ; 30$: TST ERR ; Exit or chain BEQ 35$ ; If EQ exit JMP CONTIN ; Chain - do it ; 35$: MOV #ERM11,R0 ; Initialise to ordinary message TSTB VTFLAG ; IS TI: A VT:? BEQ 40$ ; IF EQ,NO MOV #ERM12,R0 ; IT IS A VT:, PRINT @ ON EXIT ; 40$: CALL PNTLIN ; EXST$S R2 ; EXIT WITH Status ;+ ; PNTLIN ; ; THIS ROUTINE WILL PRINT AN ASCIZ LINE ;- PNTLIN: MOVB (R0)+,R1 ; Get Message Length MOV R0,QIODPB+Q.IOPL ; STORE BUFFER ADDRESS MOV R1,QIODPB+Q.IOPL+2 ; STORE BYTE COUNT DIR$ #QIODPB RETURN ; ; GETREC - This routine gets the next record from a variable-length ; command file. ; GETREC: TST BLKLEN ; Owt in Buffer? BNE 5$ ; If NE Yes - Go look at it CALL GETBLK ; No - Get a Block ; 5$: CMP BLOCK,ATTR+10. ; Processing last block in file BLO 10$ ; If LO no - carry on BHI 40$ ; If HI too late already - exit at once CMP BLKADD,ATTR+12. ; Yes - got to First Free Byte? BHIS 40$ ; If HIS yes - exit at once ; 10$: MOV @BLKADD,R3 ; Get Length of Next Record ADD #2,BLKADD ; Allow for it SUB #2,BLKLEN ; TST R3 ; Zero-length record? BEQ GETREC ; If EQ Yes - OK, but ignore it MOV R3,R0 ; Save actual length CMP R3,#79. ; More than 79 characters? BLOS 15$ ; If LOS no - carry on MOV #79.,R3 ; Yes - only use 79 of them ; 15$: MOV #79.,R5 ; Get maximum copy count MOV R0,R1 ; Save actual length MOV #BUFFER,R2 ; Get destination address MOV BLKADD,R4 ; Get Source address CMP R0,BLKLEN ; Room for whole record in block? BLE 30$ ; If LE yes - carry on MOV BLKLEN,R0 ; No - reset to what there is BEQ 25$ ; If EQ nothing - get it at once SUB BLKLEN,R1 ; Something - reset for rest ; 20$: CALL COMMOV ; Do the move with overrun checks ; 25$: CALL GETBLK ; get the next block MOV R1,R0 ; Reset amount needed MOV BLKADD,R4 ; And source address ; 30$: CALL COMMOV ; Do the move with overrun checks INC R1 ; Round R1 to even number BIC #1,R1 ; ADD R1,BLKADD ; Adjust Buffers SUB R1,BLKLEN ; CLC ; Success RETURN ; 40$: SEC ; Error RETURN ; ; COMMOV: DEC R5 ; Another transferred BLT 10$ ; If LT ignore the rest MOVB (R4)+,(R2)+ ; No - copy it over ; 10$: SOB R0,COMMOV ; Check for more RETURN ; Exit ; GETBLK: INC BLOCK ; set to next block MOV BLOCK,QIOFIL+Q.IOPL+8. ; DIR$ #QIOFIL ; ; QIOW$S #IO.RVB,#1,#1,,#IOST,,<#BLKBUF,#512.,,#0,BLOCK> MOV #BLKBUF,BLKADD ; MOV #512.,BLKLEN ; RETURN .END PIN