;[toed.xkl.com]DXX:<MM>GRIPE.MAC.2, 12-Nov-96 17:32:03, Edit by ALDERSON ; Add "COMMENT" as third entry name for this program ; GRIPE parses a topic name, and calls MM using RSCAN%, to mail to ; BUG-<topic> with the subject TOPIC [GRIPE, TTYnn]. The list of topics ; is built from the system mailing list file. If invoked as SUGGEST ; it will put "Suggestion" in the subject line, and mail to the same list. TITLE GRIPE SEARCH MONSYM,MACSYM .TEXT "GRIPE/SAVE" .TEXT "/NOINITIAL" ;Suppress loading of JOBDAT ASUPPRESS A=:1 ;Scratch registers B=:2 C=:3 D=:4 GRIPTR=:7 ;Pointer to gripe topic keyword GRIPNM=:10 ;Pointer to subject line P=:17 ;Main stack pointer DEFINE ERNOP <ERJMP .+1> ; Constants and data for system mailing-list file ; These must match the definitions in MMAILBOX! BINPAG==100 ;Where <SYSTEM>MAILING.LISTS-BIN mapped FREPAG==200 ;Where to start making strings BINADR=BINPAG*1000 BINFID=BINADR ;Should contain SIXBIT /MMLBX/ WRTTIM=BINFID+1 ;Time of last write on text file HSHMOD=WRTTIM+1 ;Hash modulus HSHTAB=HSHMOD+1 ;The hash table itself HSHEND=BINADR+111777 ;End of hash table ; Impure data PDLEN==10 ;Length of the stack PDL: BLOCK PDLEN ;The stack itself RBUF: BLOCK 40 ;RSCAN buffer for mail program NPAGES: 0 ;Number of pages in MAILING-LISTS.BIN BINJFN: 0 ;Place to save JFN on bin file FREPTR: 0 ;Address of next word in string space BUFLEN==20 ;Length of main command buffer CSBUF: BLOCK BUFLEN ;Command buffer ATMBF: BLOCK BUFLEN ;Atom buffer CSB: 0 ;COMND state block for gripe topics .PRIIN,,.PRIOU ;Command JFNs 0 ;Prompt - filled in later POINT 7,CSBUF ;Command buffer POINT 7,CSBUF ;Next input BUFLEN*5 ;Space left in buffer 0 ;Unparsed input count POINT 7,ATMBF ;Atom buffer pointer BUFLEN*5 ;Atom buffer size ; COMND stuff for gripe topic ; These topics will be filled in from the ones which appear ; as Bug-TOPIC in MMAILBOX's forwarding file. MAXG==200 ;Maximum expected number of topics GRIPTB: 0,,MAXG ;No keys now, but expandable to MAXG BLOCK MAXG ;Provide space for the table PNTAB: NPNAM,,NPNAM ;Table of program names and strings for them [ASCIZ/COMMENT/],,[ASCIZ/ [Comment/] [ASCIZ/GRIPE/],,[ASCIZ/ [Gripe/] [ASCIZ/SUGGEST/],,[ASCIZ/ [Suggestion/] NPNAM==.-PNTAB-1 START: RESET% ;Initialize the world MOVE P,[IOWD PDLEN,PDL] ;Build a stack CALL BLDTAB ;Build the table of gripe topics CALL GETSUB ;Get the gripe topic. CALL MAKHDR ;Make the RSCAN buffer to pass on to MM TMSG < Enter your gripe, comment, or suggestion. > JRST SNDMAI ;Send this mail by chaining to MM ; Build the table of possible topics ; Table of possible mailing-list binfile names ; Luckily XMAILBOX format is the same as MMAILBOX format. BINFNS: [ASCIZ/MAIL:MAILING-LISTS.BIN/] [ASCIZ/SYSTEM:MAILING-LISTS.BIN/] [ASCIZ/MAIL:MAILING.LISTS-BIN/] [ASCIZ/SYSTEM:MAILING.LISTS-BIN/] NBINFN==.-BINFNS BLDTAB: MOVEI A,FREPAG*1000 ;Get first free string word MOVEM A,FREPTR ;Save it MOVEI A,MAXG ;Get first word for gripe table MOVEM A,GRIPTB ;Save it MOVSI C,-NBINFN ;Set up AOBJN pointer over binfile names DO. MOVX A,GJ%SHT!GJ%OLD ;Old file, short form JFN HRRO B,BINFNS(C) ;With the string at that table position GTJFN% ;Get a JFN on the binfile IFNSK. AOBJN C,TOP. ;Failed, try for another JRST NOBIN ;No more, make up small table ENDIF. ENDDO. MOVEM A,BINJFN ;Save the JFN MOVX B,OF%RD ;Read access OPENF% ;Open the file ERJMP NOBIN SIZEF% ;Get the size (number of pages in C) ERJMP NOBIN MOVEM C,NPAGES ;Save it for unmap HRLZS A ;Move JFN to left half (file page in right) MOVE B,[.FHSLF,,BINPAG] ;Process and process page in B TXO C,PM%CNT!PM%RD ;Multiple page map, read access PMAP% ;Map it in ERJMP NOBIN MOVE A,BINFID ;Get file ID CAMN A,[SIXBIT/MMLBX/] ;Is it MMAILBOX format? IFSKP. TMSG <?Unknown format for binfile -- contact a wizard> JRST UNMAP ;Unmap binfile and go on without it ENDIF. MOVE D,[-<HSHEND-HSHTAB>,,HSHTAB] ;Make AOBJN pointer over hash table DO. HRRZ B,(D) ;Get value at this hash IFN. B ;Make sure there is something there MOVE A,(B) ;Get first word of string TLZ A,201004 ;Capitalize first three letters CAML A,[ASCII/BUG-/] ;Is it in range CAML A,[ASCII/BUG./] ;to be a BUG-FOO name? ANSKP. HRLI B,(POINT 7,,27) ;Turn into a byte pointer HRRO A,FREPTR ;Get pointer to free string space CALL CPYSTR ;Copy it IBP A ;Make space for null MOVEI C,1(A) ;Save updated address HRL B,FREPTR ;Get table entry (string,,0) MOVEM C,FREPTR ;Save new string space pointer CALL ADDKEY ;Add key to topic table ENDIF. AOBJN D,TOP. ;If more, go back and do the next ENDDO. MOVEI A,GRIPTB ;Get address of table HRROI B,[ASCIZ/Random-Program/] TBLUK% ;Look up "Bug-Random-Program" IFNJE. TXNN B,TL%EXM ;Was an exact match found? ANSKP. MOVE B,A ;Move address into B MOVEI A,GRIPTB ;With table again TBDEL% ;Remove that keyword ERNOP ENDIF. UNMAP: SETO A, ;Unmapping MOVE B,[.FHSLF,,BINPAG] ;From binfile page of our own fork MOVE C,NPAGES ;Get number of pages to unmap TXO C,PM%CNT ;Multiple-page unmap PMAP% ;Do it ERNOP CLSBIN: MOVE A,BINJFN ;Get JFN again CLOSF% ;Close and release it ERNOP HRLZI B,[ASCIZ/Other/] ;Always have "Bug-Other" ;Fall through to add it in ADDKEY: MOVEI A,GRIPTB ;Get address of topic table TBADD% ;Add it to the table IFNJE. <RET> MOVX A,.FHSLF ;TBADD failed. On ourself GETER% ;Get error condition ERCAL ERROR HRRZS B ;Flush fork handle CAIN B,TADDX2 ;Is the problem a duplicate entry? RET ;If so, just ignore the error CAIE B,TADDX1 ;Is it table full? CALL ERROR ;No, die horribly TMSG <?Topic table full -- contact a wizard> SETZ D, ;Make AOBJN fail next time RET ; Here when there was no mailing list file or we found an error in it NOBIN: TMSG <?Couldn't find mailing-list binfile -- contact a wizard> JRST CLSBIN ; Get the gripe subject from the terminal ; returns +1/always ; GRIPTR/ pointer to gripe-subject table ; table entry is of form: addr(subject name),,addr(file name) GETSUB: HRROI GRIPNM,[ASCIZ/ [Gripe/] ;Default topic. MOVX A,.RSINI RSCAN% ;Set up to read JCL IFNJE. ANDN. A ;Only read JCL if there are chars in buffer HRROI A,[ASCIZ//] ;Get null prompt CALL CMDINI ;Initialize command parsing MOVEI B,[FLDDB. .CMKEY,,PNTAB] CALL .COMND ;Parse table of possible program names ANSKP. HRRO GRIPNM,(B) ;Yes, get string for topic MOVEI B,[FLDDB. .CMKEY,,GRIPTB] CALL .COMND ;Parse subject ANSKP. MOVE GRIPTR,B ;Yes, save subject MOVEI B,[FLDDB. .CMCFM] CALL CONFRM ;Finish parse RET ;All done ENDIF. DO. HRROI A,[ASCIZ//] ;Point to an empty string RSCAN% ;Clear the RSCAN buffer ERNOP TMSG < Please enter the topic of your suggestion. (type ? for a list of choices) > HRROI A,[ASCIZ/Topic: /] ;Point to prompt CALL CMDINI ;Initialize command parse MOVEI B,[FLDDB. .CMKEY,,GRIPTB,< (Just press the RETURN key if none of the topics seems suitable) >,OTHER] CALL .COMND ;Parse a topic IFSKP. MOVE GRIPTR,B ;Yes, save the pointer MOVEI B,[FLDDB. .CMCFM] CALL CONFRM ;Finish command parse RET ;All done ENDIF. TMSG < ? No topic by that name; type a "?" for a list of topics, or just type RETURN if no topic is suitable. > ;Complain at user LOOP. ;and go re-ask question ENDDO. ; COMND jsys subroutines ; Initialize command parse ; Call with A/prompt string pointer CMDINI: POP P,CSB+.CMFLG ;Save reparse address MOVEM A,CSB+.CMRTY ;And prompt string MOVEI B,[FLDDB. .CMINI] CALL .COMND ;Initialize command parser CALL ERROR ;Can't get a misparse JRST @CSB+.CMFLG ;Now go back and parse it ; Here to finish command parse ; Returns +1/success, +2/failure (note strange return convention) CONFRM: MOVEI B,[FLDDB. .CMCFM] ;FDB to confirm CALL .COMND ;Parse it RETSKP ;Not parsed, return +2 RET ; Here to parse a random FDB ; returns +1/misparse, +2/success .COMND: MOVEI A,CSB ;Get CSB back COMND% ;Parse the FDB TXNE A,CM%NOP ;Parsed? RET ;No, fail RETSKP ; Build a mail command in rescan buffer MAKHDR: GJINF% ;Tty # in D, job # in C, user # in A PUSH P,D ;Save terminal # HRROI A,RBUF HRROI B,[ASCIZ/MAIL Bug-/] CALL CPYSTR ;Put in first part HLRO B,(GRIPTR) ;Get -1,,addr of topic data CALL CPYSTR ;Put topic name after "BUG-" HRROI B,[ASCIZ / /] CALL CPYSTR ;Put in a new line HLRO B,(GRIPTR) ;Point to topic name again CALL CPYSTR ;Add it in as subject MOVE B,GRIPNM ;" [Gripe" or " [Suggestion" CALL CPYSTR HRROI B,[ASCIZ/, TTY/] CALL CPYSTR ;", TTY" POP P,B ;Terminal # to B MOVEI C,10 ;Octal NOUT% ;Add in tty number ERNOP HRROI B,[ASCIZ/:] /] ;Close bracket, ^R so subject line is displayed CALL CPYSTR IDPB C,A ;Tie off with null HRROI A,RBUF RSCAN% ;Set it all up as JCL for MM ERCAL ERROR RET ; Send mail by chaining to MM at the ordinary entry point SNDMAI: MOVX A,GJ%SHT!GJ%OLD ;Short form GTJFN on an old file HRROI B,[ASCIZ/SYS:MM.EXE/] GTJFN% ;Find MM.EXE ERCAL ERROR HRLI A,.FHSLF MOVE D,A ;Save pointer to ourself, JFN of program MOVE B,[STRTCD,,5] BLT B,5+LCD-1 ;Get ready to run in the ACs SETO A, ;Unmapping MOVE B,[.FHSLF,,1] ;From our own first page MOVE C,[PM%CNT!777] ;Multiple page unmap on all pages JRST 5 ;Go do it in ACs STRTCD: PHASE 5 PMAP% ; 5 Do the unmap MOVE A,D ; 6 Into ourself with the JFN on MM GET% ; 7 Load core image into this fork MOVEI A,.FHSLF ; 10 a := our frk handle CLZFF% ; 11 Cleanup outstanding files MOVEI B,0 ; 12 Start at entry vec SFRKV% ; 13 HALTF% ; 14 ??? DEPHASE LCD==.-STRTCD ; CPYSTR -- copy a string. Terminates on 0 byte ; call: A/ destination byte-pointer, or -1,,addr, or JFN ; B/ source byte-pointer, or -1,,addr ; ret: +1 always, with updated string pointers in A and B, and null in C CPYSTR: TLNE A,-1 ;Is left half zero? IFSKP. ;Yes, must be a JFN SETZ C, ;End on a null SOUT ;Do SOUT RET ENDIF. TLC A,-1 ;Convert to real byte pointer if necessary TLCN A,-1 HRLI A,(POINT 7,0) TLC B,-1 ;Same for source pointer TLCN B,-1 HRLI B,(POINT 7,0) DO. ILDB C,B ;Get byte JUMPE C,R ;If null, done IDPB C,A ;Else drop it in LOOP. ;And go back for more ENDDO. ; Here on a fatal (i.e. totally unexpected) jsys error ERROR: EXCH D,(P) ;Save D register, put pushed loc in D PUSH P,A ;Save the other registers PUSH P,B PUSH P,C HRROI A,[ASCIZ/Unexpected error in GRIPE! Please report this by sending MAIL to BUG-GRIPE-PROGRAM. Error was: /] ESOUT% ;Start error message MOVX A,.PRIOU ;To the terminal HRLOI B,.FHSLF ;With last error on our own fork SETZ C, ;No limit ERSTR% ;Print error string ERJMP ERRERR ;Undefined error number ERJMP ERRERR ;Other error TMSG < at location > MOVX A,.PRIOU ;More terminal output HRRZ B,D ;Get caller's address SUBI B,2 ;Subtract two from this to point to JSYS MOVEI C,^D8 ;Radix octal NOUT% ;Output location ERJMP ERRERR POP P,C ;Now restore all saved registers POP P,B POP P,A POP P,D STOP: HALTF% ;Stop HRROI A,[ASCIZ/Can't continue/] ESOUT% ;Complain if continued JRST STOP ;Go back and stop again ERRERR: HRROI A,[ASCIZ/Error within an error/] ESOUT% ;Error handler couldn't do it JRST STOP ;So complain again and die RSKP: AOS (P) ;We don't have macrel, so add these labels R: RET ; Give literals nice disassembly LIT: LIT END START