; *** Edit 313 to ARMAIL.MAC by JROSSELL on 1-Mar-88 (TCO NONE) ; Do not place IPCF messages into absolute location 10000. Instead place at the ; page boundary in buffer MSGBUF. ; Edit 5 to ARMAIL.MAC by MAYO on 15-Aug-85, for SPR #20850 ; Allow underscore in usernames. ; UPD ID= 464, SNARK:<6.UTILITIES>ARMAIL.MAC.6, 8-Feb-84 08:35:25 by EVANS ;Add flag to edit number for EXEC to display it in decimal on I VER. ; UPD ID= 257, SNARK:<6.UTILITIES>ARMAIL.MAC.5, 12-Apr-83 15:56:50 by LOMARTIRE ;TCO 6.1596 - Release JFN if OPENF fails in routine MLTOWN ; UPD ID= 180, SNARK:<6.UTILITIES>ARMAIL.MAC.4, 5-Jan-83 14:35:32 by LOMARTIRE ;TCO 6.1438 - Make first word in arg block point to TO: list after DIRST error ; UPD ID= 171, SNARK:<6.UTILITIES>ARMAIL.MAC.3, 17-Nov-82 17:44:04 by LOMARTIRE ;TCO 6.1383 - Reinstall edit 1 (allow $ and - in user name parse) ; UPD ID= 67, SNARK:<5.UTILITIES>ARMAIL.MAC.4, 14-Jan-82 16:42:48 by KOVALCIN ;TCO 5.1675 - Remove REQUIRE SYS:MACREL so everyone can link and update copyright ; UPD ID= 1674, SNARK:<5.UTILITIES>ARMAIL.MAC.2, 11-Mar-81 22:28:57 by GRANT ;UPDATE COPYRIGHT ;<4.UTILITIES>ARMAIL.MAC.7, 15-Nov-79 14:32:06, EDIT BY R.ACE ;REQUIRE SYS:MACREL ;<4.UTILITIES>ARMAIL.MAC.6, 15-Nov-79 12:21:11, EDIT BY R.ACE ;TCO 4.2567 - ALLEVIATE PROBLEM OF HANGING MAIL.EXE ;<4.UTILITIES>ARMAIL.MAC.5, 19-Oct-79 16:51:59, EDIT BY DBELL ;TCO 4.2537 - HAVE CALLERS OF MTLST SET UP T2 WITH MLTYPE ;<4.UTILITIES>ARMAIL.MAC.4, 18-Oct-79 15:38:06, EDIT BY DBELL ;TCO 4.2533 - EXPUNGE MAIL-SENDING-TEMPORARY.FILE AFTER USE ROUTINE WAIT ;<4.UTILITIES>ARMAIL.MAC.3, 7-Jun-79 06:20:55, EDIT BY R.ACE ;MISCELLANEOUS COSMETIC CLEANUP ;<4.UTILITIES>ARMAIL.MAC.2, 10-Mar-79 13:35:01, Edit by KONEN ;UPDATE COPYRIGHT FOR RELEASE 4 ;ARMAIL.MAC.16, 27-Nov-78 08:47:00, EDIT BY CALVIN ; Cause uses of GJBLK to find deleted files as well as invisible ;ARMAIL.MAC.11, 20-Nov-78 19:50:40, Edit by CALVIN ; FIX UP SAVACS ;[BBN-TENEXD]<3A-CRDAVIS>ARMAIL.MAC.12, 10-Nov-78 19:08:28, Ed: CRDAVIS ; Added code to save and restore all AC's used in ARMAIL. ; Added 2nd arg to specify whether or not to used offline file message file. ;[BBN-TENEXD]<3A-CRDAVIS>ARMAIL.MAC.10, 10-Nov-78 05:41:18, Ed: CRDAVIS ; Change default mail type to DEC. ; Set generation retention count of work file to 0. ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED ; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE. ; ;COPYRIGHT (C) 1976,1977,1978,1979,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. TITLE ARMAIL SUBTTL Mail sending utilities for the Archive/Virtual Disk system SALL .DIRECTIVE FLBLST ;SUPPRESS ASCIZ MACHINE CODE EXPANSION SEARCH MONSYM,MACSYM, MSUNV ; .REQUIRE SYS:MACREL INTERN MLTOWN,MLTLST,MLDONE,MLINIT ARMEDT==VI%DEC+^D313 ;EDIT LEVEL F=0 T1=1 T2=2 T3=3 T4=4 Q1=5 Q2=6 Q3=7 P1=10 P2=11 P3=12 P4=13 P5=14 P6=15 AP=16 P=17 ; Type of mail delivery (value of MLTYPE) .MLNON==0 ; No mail .MLDEC==1 ; DEC mail .MLNET==2 ; ARPANET mail ; Legal values of T2 on entry .MLOFL==:0 ; Use offline file msg file if there .MLNFL==:1 ; No offline file msg file NTOLST==^D100 ; Size of To: list area ;Variables to replace STKVARs. ; STKVAR ,> ; STKVAR <,> ; STKVAR <> IDNUM: BLOCK 1 ; ID number of current page to MX MSGNUM: BLOCK 1 ; Page number of message to MX MSGRCT: BLOCK 1 ; Number of records in current page to MX NUMRPT: BLOCK 1 ; Number of recipients on current line CURPTR: BLOCK 1 ; Pointer to the current line being formed CURPT2: BLOCK 1 ; Updated pointer to the current line USRNAM: BLOCK 1 ; Pointer to the current recipient name PAKSTS: BLOCK 1 ; Flag indicating if last page of message LCLRPT: BLOCK 1 ; Recipient is local ARGPTR: BLOCK 1 IPCFM: BLOCK 15 PDB: BLOCK 4 GTMPDB: BLOCK 4 GTMANS: BLOCK 2 RDAT: BLOCK 3 CURLIN: BLOCK ^D40 ; Current line being formed FILSPC: BLOCK ^D15 ; File spec of message file NODNAM: BLOCK 2 ; ASCIZ name of our node NODPTR: BLOCK 1 ; Pointer to our node DIRNAM: BLOCK ^D39 ; Filespec area DIRPTR: BLOCK 1 ; Ptr to end of directory string TOLST: BLOCK NTOLST ; Area for To: list RECIP: BLOCK ^D10 ; Area for single recipient MLFRK: BLOCK 1 ; Fork handle MLJFN: BLOCK 1 ; JFN of mail program NOOFL: BLOCK 1 ; Nonzero => no offline file msg file CPYSTD: BLOCK 1 ;ASSEMBLY AREA FOR CPYST CPYSTP: BLOCK 1 ;BYTE POINTER TO CPYSTD CPYJFN: BLOCK 1 ;JFN FOR MAIL.CPY MYPID: BLOCK 1 ; PID obtained for talking with MX MLRPID: BLOCK 1 ;PID OF [SYSTEM]MAILER OR -1 IF UNAVAILABLE SAVAC: BLOCK 20 ; Save accumulator block IPCPGS: BLOCK 1 ;Page address of message to send to MX MSGBUF: BLOCK 2000 ;Page buffer of message to send to MX ; GTJFN argument block GJBLK: GJ%OLD+GJ%DEL+GJ%XTN ; Old file, long arg block .NULIO,,.NULIO ; No input/recognition 0 ; Set to default device 0 ; Set to default directory 0 ; Set to default name 0 ; Set to default extension 0 ; No default protection 0 ; No default account 0 ; No JFN G1%IIN ; File may be invisible MLTYPE: .MLDEC ; Type of mail system used OWNFIL: ASCIZ"DIRECTORY.OWNER" ; Name of directory owner file ERRFIL: ASCIZ"SYSTEM:UNDELIVERABLE-OFFLINE-FILE-MSGS.TXT" SNDFIL: ASCIZ"MAIL-SENDING-TEMPORARY.FILE" MSGFIL: ASCIZ"OFFLINE-FILE-MSGS" GVPFIL: ASCIZ"SYSTEM:FAILED.MAIL" CRLF: BYTE (7) 15,12,0,0,0 ; MLTOWN sends mail to the "owner" of a file. ; If a DIRECTORY.OWNER file exists in the same directory as the ; file in question, the contents of DIRECTORY.OWNER is used as the ; recipient list and is passed to MLTLST. Otherwise, a single ; recipient consisting of the un-punctuated directory name is used, ; and passed to MLTLST. ; ; Call: AC 1 = pointer to 3 word block, as follows: ; 0: directory # where file resides (see note below) ; 1: string pointer to Subject: field ; 2: string pointer to Text: field ; AC 2 = .MLOFL (0) to use OFFLINE-FILE-MSGS.TXT if possible, or ; .MLNFL (1) to just use MAIL.TXT. ; ; Note: This routine clobbers word 0 of the arg block pointed to by AC1 MLTOWN: SKIPN MLTYPE ; Want mail at all? RET ; No MOVEM T2,NOOFL ; Save OFL flag CALL SAVACS ; Be transparent PUSH P,T1 ; Save arg ptr MOVE T2,0(T1) ; Get directory # HRROI T1,DIRNAM ; Place for file spec DIRST ; Make a string JRST [ POP P,T1 ; Get arg pointer back HRROI T2,[ASCIZ "UNKNOWN"] ; Setup pointer to new TO: list MOVEM T2,0(T1) ; Store as first arg in arg block PUSH P,T1 ; Replace arg pointer JRST ERRSND ] ; Send to system file if bad dir MOVEM T1,DIRPTR ; Save updated string ptr HRROI T2,OWNFIL ; Name of dir owner file SETZB T3,T4 SOUT ; Append to dir name IDPB T3,T1 ; Finish it off SETZM GJBLK+.GJDEV ; No default device SETZM GJBLK+.GJDIR ; No default directory SETZM GJBLK+.GJNAM ; No default name SETZM GJBLK+.GJEXT ; No default extension MOVEI T1,GJBLK ; Point to GTJFN arg block HRROI T2,DIRNAM ; Point to file spec GTJFN ; Owner file exist? JRST NOOWN ; Nope PUSH P,T1 ; Save JFN MOVX T2, OPENF ; Open for read JRST [ POP P,T1 RLJFN ;Release JFN ERJMP NOOWN ;Ignore error JRST NOOWN] HRROI T2,TOLST ; Space for owner list MOVEI T3,NTOLST*5 ; Max # of bytes MOVEI T4,15 ; Terminate on CR SIN ; Read the owner list SETZ T3, DPB T3,T2 ; Make it ASCIZ POP P,T1 ; Restore JFN CLOSF ; Done with it JFCL POP P,T1 ; Get arg ptr back HRROI T2,TOLST ; Point to owner list MOVEM T2,0(T1) ; Smash 1st arg MOVE T2,MLTYPE ;GET MAIL TYPE JRST MTLST ; Go mail it to that list ; Come here if no "owner" file exists in the directory. We will ; simply use the directory name as the name of the recipient. NOOWN: MOVE T1,[POINT 7,DIRNAM] ; Point to file spec MOVE T2,[POINT 7,TOLST] ; Point to destination SETZ T4, ; Don't copy chars ULOOP: ILDB T3,T1 ; Get a byte CAIN T3,"<" JRST [ SETO T4, ; Start copying JRST ULOOP] CAIN T3,">" JRST UDONE ; Reached end of dir name SKIPE T4 ; Should we copy it? IDPB T3,T2 ; Yes, do so JRST ULOOP ; Back for more UDONE: SETZ T3, IDPB T3,T2 ; Finish off user name POP P,T1 ; Get arg ptr back HRROI T2,TOLST ; Get pointer to user name MOVEM T2,0(T1) ; Smash 1st arg JRST MTLST ; Go mail it ; ; MLTLST sends mail to a specified To: list. If DEC mail is being ; used, the recipient list is fed directly to the MAIL program. If ; ARPANET mail is being used, and the recipient list consists of a ; single, local recipient, an attempt is made to mail to the file ; OFFLINE-FILE-MSGS.TXT in the user's directory. If that fails, ; MAIL.TXT is tried. If that fails, sending to ; SYSTEM:UNDELIVERABLE-OFFLINE-FILE-MSGS.TXT is attempted. In case of ; error while trying to deliver the mail (DEC or ARPANET), the input ; to the mail program is written to the file SYSTEM:FAILED.MAIL. ; ; Call: AC 1 = pointer to 3 word block, where ; 0: String pointer to recipient list ; 1: String pointer to subject field ; 2: String pointer to text field ; AC 2 = .MLOFL or .MLNFL MLTLST: MOVEM T2,NOOFL ; Save OFL flag CALL SAVACS ; Be transparent ; Enter here from MLTOWN MTLST: SKIPN T2,MLTYPE ; Want mail at all? RET ; Just return CAIN T2,.MLDEC ; DEC mail? JRST SEND ; Go send as is HRLI T2,(POINT 7) ; Make string pointer HRR T2,0(T1) ; To recipient list MOVE T3,[POINT 7,RECIP] ; Space for recipient SETZM RECIP ; Initialize SCNLST: ILDB T4,T2 ; Get next character JUMPE T4,ENDSCN ; End of string? CAIE T4,"@" ; Check for characters CAIN T4,"*" ; which force us to JRST SEND ; send as is CAIN T4,"," JRST SEND CAIL T4,"a" ; Uppercase recipient CAILE T4,"z" CAIA TRZ T4,40 IDPB T4,T3 ; Accumulate recipient name JRST SCNLST ENDSCN: PUSH P,T1 ; Save arg ptr SKIPN RECIP ; Anything there? JRST ERRSND ; Bad SETZ T4, IDPB T4,T3 ; Finish off string HRROI T2,[ASCIZ"PS"] ; Default device MOVEM T2,GJBLK+.GJDEV HRROI T2,RECIP ; Default directory MOVEM T2,GJBLK+.GJDIR HRROI T2,[ASCIZ"TXT"] ; Default extension MOVEM T2,GJBLK+.GJEXT HRROI T2,MSGFIL ; Name of offline messages file MOVEM T2,GJBLK+.GJNAM MOVEI T1,GJBLK HRROI T2,CRLF ; Use default SKIPN NOOFL ; Just use MAIL.TXT? GTJFN ; No, try MSGFIL CAIA JRST HAVFIL ; That worked HRROI T1,[ASCIZ"MAIL"] ; Try MAIL.TXT MOVEM T1,GJBLK+.GJNAM MOVEI T1,GJBLK GTJFN JRST ERRSND ; If that fails, send to system file RLJFN ; Don't really need the file JFCL GOSEND: POP P,T1 ; Get arg ptr back HRROI T2,RECIP ; Pointer to recipient MOVEM T2,0(T1) ; Smash 1st arg JRST SEND ; Go mail it HAVFIL: PUSH P,T1 ; Save JFN MOVE T1,[POINT 7,RECIP] ; Place for recipient MOVEI T2,"*" ; Output * for SNDMSG BOUT POP P,T2 ; Get JFN back MOVX T3, SETZ T4, JFNS ; Make *Filespec MOVE T1,T2 RLJFN ; Don't need file anymore JFCL JRST GOSEND ERRSND: MOVE T1,MLTYPE ;GET MAIL TYPE CAIE T1,.MLNET ;NET MAIL? JRST GIVUP1 ;NO, GIVE UP MOVX T1,GJ%OLD+GJ%SHT ; Attempt delivery to system msg file HRROI T2,ERRFIL GTJFN ; Try to get system message file JRST GIVUP1 ; Can't, write message to file JRST HAVFIL ;T1/ POINTER TO ARGUMENT BLOCK (MLTLST STYLE) SEND: PUSH P,T1 ; Save argument pointer MOVE T2,MLTYPE CAIN T2,.MLDEC ;DEC MAIL? JRST [ CALL DECM ;YES, TALK TO MAILER DIRECTLY JRST GIVUP1 ;FAILED ADJSP P,-1 ;SUCCEEDED, ADJUST STACK RET] ;RETURN MOVX T1,GJ%FOU+GJ%NEW+GJ%SHT HRROI T2,SNDFIL ; Temp file for mail program input GTJFN JRST GIVUP1 ; Can't get temp file, write out message MOVX T2, OPENF ; Open for write JRST GIVUP1 HRLI T1,.FBBYV MOVX T2,FB%RET SETZ T3, CHFDB ; Set retention count to 0 HRRZS T1 ; Get rid of FDB offset POP P,AP ; Get arg ptr back CALL OUTMSG ; Stuff message into file MOVE T2,MLTYPE ; Type of mail system CAIN T2,.MLDEC ; DEC mail? SKIPA T2,[POINT 7,[BYTE (7) "Z"-100,0,0,0,0]] HRROI T2,[BYTE (7) "Z"-100,"Q",15,12,0] SOUT ; Terminate the input TXO T1,CO%NRJ ; Please keep JFN CLOSF JRST GIVUP2 TXZ T1,CO%NRJ MOVX T2, OPENF ; Re-open file for read JRST GIVUP2 PUSH P,T1 ; Save JFN SKIPE MLFRK ; Have a fork? JRST SEND1 ; No thanks, I just had one MOVX T1,CR%CAP ; Want same caps SETZ T2, ; No ACs CFORK ; Create a fork JRST GIVUP4 MOVEM T1,MLFRK ; Save fork handle MOVE T2,[.NULIO,,.NULIO] SPJFN MOVE T3,MLTYPE MOVX T1,GJ%OLD+GJ%SHT HRROI T2,[ASCIZ"SYS:SNDMSG.EXE"] CAIN T3,.MLDEC HRROI T2,[ASCIZ"SYS:MAIL.EXE"] GTJFN ; Locate the mail program JRST GIVUP4 MOVEM T1,MLJFN ; Save program's JFN HRL T1,MLFRK ; Get handle,,JFN GET ; Load the fork SEND1: MOVE T1,MLFRK CALL WAIT POP P,T2 HRLS T2 HRRI T2,.NULIO SPJFN SETZ T2, SFRKV RET WAIT: PUSH P,T1 WFORK GPJFN CAMN T2,[.NULIO,,.NULIO] JRST WAIT9 HLRZ T1,T2 TXO T1,CO%NRJ CLOSF JFCL HLRZ T1,T2 TXO T1,DF%EXP DELF JFCL MOVE T1,0(P) MOVE T2,[.NULIO,,.NULIO] SPJFN WAIT9: POP P,T1 RET ; OUTMSG does the work of outputting the fields of a message to a file. ; Call: AC 1 = Destination designator ; AC 16 = Pointer to MLTLST argument block OUTMSG: MOVE T2,0(AP) ; Get recipient list SETZB T3,T4 SOUT ; Output the list ERJMP .+1 ; Error, continue anyway HRROI T2,CRLF SOUT ; End the To: list ERJMP .+1 ; Error, continue anyway HRROI T2,CRLF SOUT ; No Cc: list ERJMP .+1 ; Error, continue anyway MOVE T2,1(AP) ; Get subject string SOUT ERJMP .+1 ; Error, continue anyway HRROI T2,CRLF SOUT ; End the subject ERJMP .+1 ; Error, continue anyway MOVE T2,2(AP) ; Get the text of the message SOUT ; Output that ERJMP .+1 ; Error, continue anyway RET ; MLDONE is used to kill the fork used to run the mail sending program. ; It should be called after all sending is complete. ; MLINIT initializes some data used by the MLTLST and MLTOWN. ; It should be called before any sending is attempted. MLDONE: SKIPE T1,MLJFN ; Have JFN for mail program? CLOSF ; Close the file JFCL SKIPN T1,MLFRK ; Do we have a fork? JRST MLINIT CALL WAIT KFORK MLINIT: SETZM MLFRK ; Handle is invalid now SETZM MLJFN ; So is JFN RET ; Branch to one of the GIVUP routines as a last ditch effort to avoid ; losing the mail, which may contain the only copy of tape pointers ; for archived files. Here we try to write out the input to the ; mail sending program in a file, so that someone can look at it later. GIVUP1: POP P,AP ; Get arg ptr back GIVUP2: MOVX T1,GJ%FOU+GJ%NEW+GJ%SHT HRROI T2,GVPFIL GTJFN ; Locate error file RET MOVX T2, OPENF ; Open it for write RET CALL OUTMSG ; Output the message CLOSF ; Close the file JFCL RET GIVUP3: PUSH P,T1 ; Save JFN of temp file JRST GIVUP5 GIVUP4: MOVE T1,0(P) ; Get JFN TXO T1,CO%NRJ ; Keep the JFN around CLOSF ; Make sure it is closed JFCL GIVUP5: MOVX T1,GJ%FOU+GJ%NEW+GJ%SHT HRROI T2,GVPFIL GTJFN ; Locate error file JRST GIVUP9 MOVE T2,T1 ; Move destination JFN to T2 POP P,T1 ; Get back old JFN RNAMF ; Do the rename JFCL RET GIVUP9: POP P,T1 ; Get JFN of old file RLJFN ; Release it JFCL RET SUBTTL Routines To Send Message Via DEC Mail ;DECM - SEND DEC-STYLE MAIL TO ONE OR MORE USERS ; T1/ ADDRESS OF MLTLST-STYLE ARGUMENT BLOCK ;RETURNS +1: COULD NOT COMMUNICATE WITH MX ; +2: MESSAGE SUCCESSFULLY PASSED TO MX (NOTE THAT THIS ; ROUTINE DOESN'T CARE WHAT HAPPENS AFTER THE MESSAGE ; HAS BEEN PUT IN MX'S HANDS) DECM: MOVEM T1,ARGPTR ;SAVE ADDRESS OF ARGUMENT BLOCK SETZM CPYJFN ;No JFN currently on mail file SETZM MYPID ;SET NO PID OBTAINED FOR ME YET ;SET UP PDB FOR SENDING MESSAGE TO MX CALL GTMLR ;GET MX'S PID JRST DECMX1 ;CAN'T, SO FAIL SETZM IDNUM ;No message ID at this point SETZM MSGNUM ;No message pages sent yet SETZM MSGRCT ;No records in message yet SETZM PAKSTS ;More pages to follow SETZM NUMRPT ;No recipients on current line ;Open the mail file CALL OPNFIL JRST DECMX1 ;Failed to open the file ;Build date line and place in message file MOVEI T1,CURLIN ;Make a pointer to the current line HRLI T1,(POINT 7) ;This will be used alot so save it MOVEM T1,CURPTR MOVEM T1,CURPT2 ;Updated pointer, used in routine BLDRCP CALL BLDDAT ;Build the sender record. CALL BLDSND ;Build the recipient records MOVE T1,ARGPTR ;GET ADDRESS OF ARGUMENT BLOCK MOVE T1,(T1) ;GET POINTER TO USER NAME LIST TLC T1,-1 TLCN T1,-1 ;IN FORM -1,,ADDR ? HRLI T1,(POINT 7) ;YES, CONVERT IT MOVEM T1,USRNAM ;Save in case need to send another page RCPTLP: CALL BLDRCP MOVE T1,USRNAM ;Pick up the status from BLDRCP CAMN T1,[-1] ;Any valid recipients found? JRST [ SKIPG IDNUM ;The first page of the message? JRST DECMX1 ;Yes, so really are no valid recipients JRST SUBRE2] ;No, go build the sender record JUMPE T1,SUBREC ;No more recipients, build sender record CALL SNDMX ;Page is full, send off to MX JRST DECMX1 ;An error occurred, quit JRST RCPTLP ;Get more recipients ;Build the subject record. First make sure there is room SUBREC: CAIG P3,BUFEND ;Still room? JRST SUBRE2 ;Yes, build the subject record CALL SNDMX ;Page is full, send off to MX JRST DECMX1 ;An error occurred, quit SUBRE2: CALL BLDSUB ;Build the subject record ;Build the message ID CALL BLDMID ;Copy the text to the mail file and then close it CALL BLDTXT JRST DECMX1 ;Could not close the mail file, quit ;Build the file spec record last since MX returns an error if the file is ;still open CAIG P3,BUFEND ;Still have room? JRST FSPREC ;Yes, build the file spec record CALL SNDMX ;Not enough room, send this page off JRST DECMX1 ;An error occurred FSPREC: CALL BLDSPC ;Build the file spec record ;Send the last page of the message SETOM PAKSTS ;Indicate that this is the last page CALL SNDMX ;Send the last page off JRST DECMX1 ;An error occurred, quit JRST DECMX2 ;Success ;EXITS FROM DECM: ; DECMX1 - ERROR ; DECMX2 - SUCCESS DECMX1: TDZA Q1,Q1 ;REMEMBER FAILURE DECMX2: MOVEI Q1,1 ;REMEMBER SUCCESS SKIPE T1,CPYJFN ;HAVE JFN ON MAIL.CPY? JRST [ GTSTS ;YES, GET STATUS HRLI T1,(CO%NRJ) ;SET TO KEEP JFN TXNE T2,GS%OPN ;JFN OPEN? CLOSF ;YES, CLOSE IT ERJMP .+1 MOVE T1,CPYJFN ;GET JFN AGAIN HRLI T1,(DF%NRJ) ;SET TO KEEP JFN SKIPN Q1 ;FAILURE RETURN? DELF ;YES, DELETE FILE ERJMP .+1 MOVE T1,CPYJFN ;GET JFN ONE MORE TIME RLJFN ;DISCARD IT ERJMP .+1 JRST .+1] SKIPE T1,MYPID ;DID I HAVE A PID? CALL RELPID ;YES, RELEASE IT JUMPN Q1,RSKP ;SUCCESSFUL RETURN RET ;ERROR RETURN ;GTMLR - GET MX'S PID ;RETURNS +1: ERROR (E.G. PID NOT DEFINED) ; +2: SUCCESS, T1/ MX'S PID GTMLR: ;ASK INFO FOR MX'S PID MOVX T1,IP%CPD ;ASK MONITOR TO CREATE PID MOVEM T1,.IPCFL+GTMPDB SETZM .IPCFS+GTMPDB ;MONITOR WILL SUPPLY SENDER'S PID SETZM .IPCFR+GTMPDB ;RECEIVER IS INFO MOVE T1,[5,,[.IPCIW ;PACKET TO REQUEST PID FOR MX 0 ASCIZ/MXMAIL/]] MOVEM T1,.IPCFP+GTMPDB MOVEI T1,4 ;PDB LENGTH MOVEI T2,GTMPDB ;PDB ADDRESS MSEND ;SEND IT OFF JRST [ MOVE T1,.IPCFS+GTMPDB ;FAILED, GET CREATED PID CALLRET RELPID] ;RELEASE PID AND TAKE ERROR RETURN ;RECEIVE REPLY FROM INFO SETZM .IPCFL+GTMPDB ;NO FLAGS MOVE T3,.IPCFS+GTMPDB ;GET MY PID MOVEM T3,.IPCFR+GTMPDB ;MAKE ME THE RECEIVER MOVSI T3,2 ;GET SIZE OF ANSWER HRRI T3,GTMANS ;GET ADDRESS OF ANSWER MOVEM T3,.IPCFP+GTMPDB ;SET UP POINTER TO ANSWER IN PDB MRECV ;RECEIVE REPLY FROM INFO JRST [ MOVE T1,.IPCFS+GTMPDB ;ERROR CALLRET RELPID] ;RELEASE PID AND FAIL MOVE T1,.IPCFR+GTMPDB ;GET MY PID MOVEM T1,MYPID ;Save for later ;CHECK COMPLETION CODE FROM INFO MOVE T2,.IPCFL+GTMPDB ;GET FLAGS WORD FROM PDB TRNE T2,IP%CFE ;ERROR? RET ;YES, FAIL MOVE T1,1+GTMANS ;GET PID OF MX MOVEM T1,MLRPID ;REMEMBER IT FOR FUTURE REFERENCE RETSKP ;RETURN SUCCESS ;Open the mail file. Save the file spec for the file spec record OPNFIL: GJINF ;Get my user number MOVE T2,T1 ;Place it where DIRST wants it HRROI T1,IPCFM ;Place my user name here DIRST ;Convert user number to user name RET ;Should never fail MOVEI T2,FILSPC ;Where to build the file spec HRLI T2,(POINT 7) ;Make it a pointer MOVE Q1,T2 ;Save for the GTJFN MOVEI T4,[ASCIZ/POBOX:/] HRLI T4,(POINT 7) TRSSTR: MOVEI P1,^D29 ;Invariant byte number in file spec name ILDB T3,T4 ;Transfer the structure name JUMPE T3,TRSDIR ;If finished, transfer the directory name IDPB T3,T2 ;Into the file spec record JRST TRSSTR ;Get the next character TRSDIR: MOVEI T3,"<" ;Get the directory name delimiter IDPB T3,T2 ;Place in the file spec record MOVEI T4,IPCFM ;Address of user name HRLI T4,(POINT 7) ;Make into a pointer DIRREC: ILDB T3,T4 ;Get the next character CAIN T3,0 ;End of the user name JRST FNDDIR ;Finish the directory name IDPB T3,T2 ;Place in the file spec record AOS P1 ;Increment the byte count JRST DIRREC ;Get the next character FNDDIR: MOVEI T3,">" ;Get the directory delimiter IDPB T3,T2 ;Place in the file spec record MOVEI T3,"M" ;Pick up first character of file name IDPB T3,T2 ;Place in the file spec record MOVEI T3,"S" ;Pick up second character of file name IDPB T3,T2 ;Place in the file spec record GETFS: PUSH P,T2 ;Save pointer in case file already exists GTAD ;Get a string AND T1,[070707,,070707] ;Make it SIXBIT numeric ROT T1,^D12 ;Want the four that change most often MOVNI T3,4 ;Need four digits GETFCH: SETZ F, ;Clear out results from previous loop LSHC F,6 ;Get the next SIXBIT character ADDI F,"0" ;Change to ASCII IDPB F,T2 ;Place in the file spec record AOJN T3,GETFCH ;Convert any remaining TRSEXT: MOVE T1,T2 ;SOUT wants pointer in T1 HRROI T2,[ASCIZ/.MAI.1;P770000/] SETZ T3, ;ASCIZ string SOUT ;Copy the extension to the file record ERJMP .+1 ;Should never happen MOVX T1,GJ%SHT+GJ%NEW ;Must be a new file MOVE T2,Q1 ;Point to the file spec GTJFN% ;Get its JFN ERJMP [POP P,T2 ;Restore the pointer CAIE T1,GJFX27 ;Does file already exist? RET ;No, must be another type of error JRST GETFS] ;Yes, try another MOVEM T1,CPYJFN ;Save the JFN for later ADJSP P,-1 ;Don't need the file spec pointer now ;Open the mail file MOVE T1,CPYJFN ;Pick up the JFN MOVE T2,[FLD(7,OF%BSZ)+OF%WR] OPENF ;OPEN FOR OUTPUT JRST [ MOVE T1,CPYJFN ;Error, so release the JFN RLJFN ERJMP .+1 RET] RETSKP ;Succeed ;Build the date field and the first part of the from line. ;Place in the message file BLDDAT: HRROI T2,[ASCIZ/Date: /] SETZ T3, ;Copy ASCIZ string SOUT ;Into the current line buffer ERJMP .+1 ;Shouldn't happen SETO T2, ;Want the entire date MOVX T3,OT%4YR!OT%SPA!OT%NCO!OT%NSC!OT%SCL!OT%TMZ ODTIM% ;Get the formatted dat ERJMP .+1 ;Shouldn't happen HRROI T2,[ASCIZ/ From: /] SETZ T3, ; SOUT ERJMP .+1 ;Shouldn't happen MOVE T1,CPYJFN ;Write out to the message file MOVE T2,CURPTR ;The current line SETZ T3, ;ASCIZ string SOUT ERJMP .+1 ;Shouldn't happen RET ;Build the sender record BLDSND: CALL FINADR ;Pick up the message address MOVEI P3,.HDRSZ ;Number of bytes in message so far MOVE P5,IPCPGS ;Pick up the message address ADDI P5,.HDRSZ ;Find address of the sender record MOVEI T2,IPCFM ;Address of the sender name HRLI T2,(POINT 7) ;Make it into a pointer SETZ P1, ;No bytes in this record yet MOVE T3,P5 ;Address of the current record ADDI T3,.RECTX ;Address of the sender name field HRLI T3,(POINT 7) ;Make into a pointer MOVE Q2,CURPTR ;Point to the current line buffer TRSSND: ILDB T1,T2 ;Get the next character of send name IDPB T1,T3 ;Place into the sender record IDPB T1,Q2 ;Place in the current line buffer AOS P1 ;Increment the byte count CAIE T1,0 ;Finished? JRST TRSSND ;No, get the next character ;Finish up the sender record AOS T1,MSGRCT ;Increment the record count MOVEM T1,.RECNM(P5) ;Place in the sender record MOVEI T1,.SENDR ;Record type MOVEM T1,.RECTY(P5) ;Place in the sender record IDIVI P1,5 ;Number of words in this record SKIPE P2 ;A partial word? AOS P1 ;Yes, count as a full word ADDI P1,.RECHS ;Include the header size MOVEM P1,.RECLN(P5) ;Place in the record ADD P3,P1 ;Add record size to message size ADD P5,P1 ;Address of the next record ;Pick up the node name and append to sender's name MOVEI T1,.NDGLN ;Want our node name MOVEI P1,NODNAM ;Where to place it HRLI P1,(POINT 7) ;Make into a pointer MOVEM P1,NODPTR ;Will need it again MOVEI T2,P1 ;Address of the argument block NODE ;Get our node name ERJMP [ SETZM NODNAM ;No node name JRST CPYFRM ] ;Copy From: string MOVEI T1,"@" ;Pick up an at sign DPB T1,Q2 ;Overwrite the zero MOVE T1,NODPTR ;Point to node name MOVNOD: ILDB T2,T1 ;Get the next character IDPB T2,Q2 ;Place in the current buffer CAIE T2,0 ;Finished? JRST MOVNOD ;No, continue ;Copy the From: string to the mail file CPYFRM: MOVE T1,CPYJFN ;JFN of the mail file MOVE T2,CURPTR ;The string to be written SETZ T3, ;ASCIZ string SOUT ;Copy the from string to the mail file ERJMP .+1 ;Should not happen MOVE T1,CPYJFN HRROI T2,[ASCIZ/ To: /] SETZ T3, ;ASCIZ string SOUT ;Copy to the mail file ERJMP .+1 ;Should not happen RET ;Determine the address of the page to send to MX. Since the relocatable ;value is not known at COMPILE time and since an absolute value cannot ;be used (e.g., ORION's GLXMEM picks up all the free pages), this routine ;must be used. FINADR: MOVEI T1,MSGBUF ;Pick up the message buffer address ANDI T1,777 ;Get rid of the page number MOVEI T2,1000 ;Pick up the size of a page SUB T2,T1 ;Find offset needed to add to buffer adr ADDI T2,MSGBUF ;Find the page address MOVEM T2,IPCPGS ;Save the page address RET ;Return to the caller ;Build the recipient records ;P3 contains the global message word count ;P5 address of current record BLDRCP: MOVE Q1,CURPT2 ;Point to the start of the current line MOVE Q2,USRNAM ;Point to current recipient name MOVE Q3,NUMRPT ;No recipients in current line MOVEI P4,"," ;For convience NXTRCD: SETZ P1, ;No bytes in this record yet SETZM LCLRPT ;Assume local MOVE T4,P5 ;Address of the current record ADDI T4,.RECTX ;Address of recipient field HRLI T4,(POINT 7) ;Make into a pointer MOVE P6,Q1 ;Save position in case recipient is invalid NXTCHR: ILDB T2,Q2 ;Get the next character of recipient name CAIN T2,.CHCNV ;A ^V? JRST [ ILDB T2,Q2 ;Yes, so get the following character JRST DEPCHR] ;And deposit it CAIL T2,"a" ;LOWER CASE? CAILE T2,"z" SKIPA JRST DEPCHR ;Lower case, so deposit it CAIL T2,"A" ;UPPER CASE? CAILE T2,"Z" SKIPA JRST DEPCHR ;Yes, so deposit it CAIL T2,"0" ;NUMERIC? CAILE T2,"9" SKIPA JRST DEPCHR ;Yes, so deposit it CAIE T2,"_" ;UNDERSCORE? CAIN T2,"." ;PERIOD? JRST DEPCHR ;Yes, so deposit it CAIE T2,"$" ;ALLOW DOLLAR SIGNS AND CAIN T2,"-" ; ALLOW DASHES SKIPA ;Deposit this character JRST ENDNAM ;End of the recipient name found DEPCHR: IDPB T2,T4 ;Place character into recipient record IDPB T2,Q1 ;Place character into current line buffer AOS P1 ;Increment the byte count JRST NXTCHR ;Pick up the next character ;The end of a recipient name has been found ;First check if it is valid ENDNAM: SKIPN P1 ;Was there a recipient? JRST [ CAIE T2," " ;No, Another potential recipient? CAIN T2,"," JRST NXTCHR ;Yes, check it out MOVE Q1,P6 ;Reset the pointer JRST LSTRCP] ;No, finished CAIE T2,"@" ;A node name follows? JRST CHKLCL ;No, check if local AOS LCLRPT ;Increment the number of @'s found JRST DEPCHR ;Pick up the node name CHKLCL: PUSH P,T2 ;Save the terminating character SKIPN T1,LCLRPT ;Local recipient? JRST LCLNAM ;Yes, validate the recipient CAIE T1,1 ;Valid node name string? JRST INVUSR ;No, reject this recipient SETZ T2, ;Make the recipient name ASCIZ IDPB T2,T4 ;In the recipient record IDPB T2,Q1 ;VALUSR expects this AOS P1 ;Increment the record byte count JRST VALUSR ;Complete the recipient record LCLNAM: SETZ T2, ;Make the record ASCIZ IDPB T2,T4 IDPB T2,Q1 ;RCUSR needs the string to be ASCIZ AOS P1 ;Include in the byte count MOVX T1,RC%EMO ;Want an exact match MOVE T2,P6 ;One byte before the recipient name RCUSR ERJMP INVUSR ;Assume invalid TXNN T1,RC%NOM ;Valid user name? JRST CHKNDEF ;Yes, add node name to user name ;An invalid user. Reset the pointers and the byte count INVUSR: POP P,T2 ;Pick up the termination character CAIE T2," " ;Perhaps more recipients? CAIN T2,"," SKIPA ;Yes, check it out JRST LSTRCP ;No, finish up MOVE Q1,P6 ;Restore the pointer to where it was JRST NXTRCD ;Add a node name, if there is one CHKNDE: SKIPN NODNAM ;Is there a node name? JRST VALUSR ;No, so complete the recipient record MOVEI T2,"@" ;Pick up an AT sign DPB T2,Q1 ;Place in the current buffer MOVE T1,NODPTR ;Get pointer to the ASCIZ node name NXTNCH: ILDB T2,T1 ;Get the next node name character IDPB T2,Q1 ;Place in the current buffer CAIE T2,0 ;Finished? JRST NXTNCH ;No, get the next character ;A valid user has been found. First complete the current recipient record. VALUSR: AOS T1,MSGRCT ;Increment the record count MOVEM T1,.RECNM(P5) ;Place in the record MOVEI T1,.DESTN ;Type of record is recipient (destination) MOVEM T1,.RECTYP(P5) ;Place in the record IDIVI P1,5 ;Find the number of words in name SKIPE P2 ;A partial word? AOS P1 ;Yes, count as a whole word ADDI P1,.RECHS ;Include the header size MOVEM P1,.RECLN(P5) ;Place length into the record ;Check if the current line should be written to the mail file MOVE AP,Q1 ;Remember position before last comma DPB P4,Q1 ;Place a comma after the name MOVEI T1," " ;Append a blank IDPB T1,Q1 ;To the current line AOS Q3 ;Increment the recipient count CAIE Q3,3 ;Need a new line? JRST CHKLST ;No, check if this is the last recipient MOVEI T1,15 ;Pick up a carriage return DPB T1,Q1 ;Overwrite the null MOVEI T1,12 ;Pick up a line feed IDPB T1,Q1 ;Place in the current line buffer MOVEI T1," " ;Add blanks to the start of the new line MOVNI T2,4 ;Add four blanks ADDBLK: IDPB T1,Q1 ;Add the next blank AOJN T2,ADDBLK ;Do the next SETZ T1, ;Make it ASCIZ IDPB T1,Q1 MOVE T1,CPYJFN ;Write to the mail file MOVE T2,CURPTR ;Point to the current line SETZ T3, ;ASCIZ string SOUT ERJMP .+1 ;Should never happen SETZ Q3, ;Reset current line count MOVE Q1,CURPTR ;Reset pointer to start of current line ;Check if last recipient CHKLST: ADD P3,P1 ;Update the message size ADD P5,P1 ;Point to the next record POP P,T1 ;Get back the terminating character CAIE T1," " ;If blank, there may be more CAIN T1,"," ;IF comma, there may be more SKIPA JRST LSTRCP ;The last recipient has been found ;There may be more recipients. Make sure there's still space in this ;message page. CAILE P3,BUFEND ;Still room? JRST [ MOVEM Q2,USRNAM ;Update user pointer MOVEM Q1,CURPT2 ;Update current line pointer MOVEM Q3,NUMRPT ;Number of recipients on this line RET] ;Go send off this page to MX JRST NXTRCD ;Form the next record ;The last recipient has been found. Make sure there was at least one ;valid recipient LSTRCP: SETOM USRNAM ;Assume no valid users MOVE T1,MSGRCT ;Get the record count SKIPE IDNUM ;First time through? AOS T1 ;No, so no sender record in record count CAIG T1,1 ;More than just the sender record? RET ;No, then no valid users SETZM USRNAM ;Yes, indicate so MOVE T1,CURPTR ;Start of the current line CAMN T1,Q1 ;Same as the updated pointer? JRST OVWCOM ;Yes, overwrite final comma in the file MOVEI T1,15 ;Overwrite the final comma DPB T1,AP ;Making the string ASCIZ MOVEI T1,12 ;Add a line feed IDPB T1,AP ;Place as the last character SETZ T1, ;Make it ASCIZ IDPB T1,AP MOVE T1,CPYJFN ;Write final line out to the mail file MOVE T2,CURPTR ;Point to the start of the line SETZ T3, ;ASCIZ string SOUT ERJMP .+1 ;Should not happen RET OVWCOM: MOVE T1,CPYJFN ;Pick up the message file JFN RFPTR ;Find pointer of the file ERJMP .+1 ;Should not happen SUBI T2,7 ;Back up to the last comma SFPTR ;Position the pointer there ERJMP .+1 ;Should not happen HRROI T2,[ASCIZ/ /] SETZ T3, ;ASCIZ string SOUT ;Write out to the file ERJMP .+1 ;Should not happen RET ;Build the subject record. BLDSUB: MOVE Q1,ARGPTR ;Get the address of the argument block MOVE T2,1(Q1) ;Get the pointer to the subject line TLC T2,-1 TLCN T2,-1 ;OF FORM -1,,ADDR ? HRLI T2,(POINT 7) ;YES, CONVERT TO PDP-10 BYTE POINTER MOVE Q2,T2 ;Save a copy for the mail file SETZ P1, ;No bytes in this record yet MOVE T3,P5 ;Address of this record ADDI T3,.RECTX ;Address of the subject field HRLI T3,(POINT 7) ;Make it into a pointer TRSSUB: ILDB T1,T2 ;Get the next character of the subject IDPB T1,T3 ;Place in the subject record AOS P1 ;Increment the byte count CAIE T1,0 ;Finished? JRST TRSSUB ;No, continue transferring ;Finish the subject record AOS T1,MSGRCT ;Increment the record count MOVEM T1,.RECNM(P5) ;Place in the subject record MOVEI T1,.SJSTR ;Get the record type MOVEM T1,.RECTY(P5) ;Place in the record IDIVI P1,5 ;Get the number of words SKIPE P2 ;A partial word? AOS P1 ;Yes, count as a full word ADDI P1,.RECHS ;Include the header size MOVEM P1,.RECLN(P5) ;Place in the record ADD P3,P1 ;Total byte count of message so far ADD P5,P1 ;Address of the next message ;Copy the subject line to the mail file MOVE T1,CPYJFN ;Get JFN of the mail file HRROI T2,[ASCIZ/Subject: /] SETZ T3, ;ASCIZ SOUT ;Copy the string to the mail file ERJMP .+1 ;Should not happen MOVE T1,CPYJFN ;Get JFN of the mail file MOVE T2,Q2 ;Pointer to the subject line SETZ T3, ;ASCIZ SOUT ;Copy the string to the mail file ERJMP .+1 ;Should not happen RET ;Build and place the message ID in the mail file BLDMID: MOVE T1,CPYJFN ;Get JFN of the message file HRROI T2,[ASCIZ/ Message-ID: <"ARMAIL" /] SETZ T3, ;ASCIZ string SOUT ERJMP .+1 ;Should not happen MOVE Q1,CURPTR ;Where to place the message ID MOVEI Q2,"." ;For convience GTAD ;Get the current date CALL CONVRT ;Convert to ASCIZ IDPB Q2,Q1 ;Add date delimiter GJINF ;Get the job number and user number PUSH P,T1 ;Save user number for awhile MOVE T1,T3 ;Place the job number where CONVRT expects it CALL CONVRT ;Convert job number to ASCIZ IDPB Q2,Q1 ;Add job number delimiter POP P,T1 ;Restore the user number HRRZS T1 ;Want only the right half CALL CONVRT ;Convert user number to ASCIZ IDPB Q2,Q1 ;Add user number delimiter SETO T1, ;For this job MOVE T2,[-1,,Q3] ;Place runtime in Q3 MOVEI T3,.JIRT ;Want the run time GETJI ;Get the run time SETZ Q3, ;Give zero for an error HRRZ T1,Q3 ;Want only the right half CALL CONVRT ;Convert runtime to ASCIZ MOVEI T1," " ;Separate previous info IDPB T1,Q1 ;From the node name MOVEI T2,"a" IDPB T2,Q1 MOVEI T2,"t" IDPB T2,Q1 IDPB T1,Q1 MOVE T1,NODPTR ;Get pointer to the node name NDNAME: ILDB T2,T1 ;Get the next character IDPB T2,Q1 ;Place in the current buffer CAIE T2,0 ;Finished? JRST NDNAME ;No, get the next character MOVEI T1,">" ;Terminate the string DPB T1,Q1 ;Overwrite the null MOVEI T1,15 ;Get a carriage return MOVEI T2,12 ;And a line feed IDPB T1,Q1 ;Add a blank line IDPB T2,Q1 IDPB T1,Q1 IDPB T2,Q1 SETZ T1, ;Make it ASCIZ IDPB T1,Q1 MOVE T1,CPYJFN ;Get the JFN of the mail file MOVE T2,CURPTR ;The string to copy SETZ T3, ;ASCIZ SOUT ;Copy the string to the mail file ERJMP .+1 ;This should not happen CONVRT: IDIVI T1,^D10 ;Pick off a digit PUSH P,T2 ;Save for awhile SKIPE T1 ;Finished? CALL CONVRT ;No, get the next digit POP P,T1 ;Yes,pick up the next digit from the stack ADDI T1,"0" ;Make it ASCII IDPB T1,Q1 ;Place in the buffer RET ;Place the text into the mail file. Add a delimiter and close the mail file BLDTXT: MOVE T1,ARGPTR ;Get the argument block MOVE T2,2(T1) ;Get the pointer to the text TLC T2,-1 TLCN T2,-1 ;Of form -1,,ADDR ? HRLI T2,(POINT 7) ;Yes, convert to PDP-10 byte pointer MOVE T1,CPYJFN ;Get the JFN of the mail file SETZ T3, ;ASCIZ string SOUT ;Copy the text to the mail file ERJMP .+1 ;Should not happen MOVE T1,CPYJFN ;Get the JFN of the mail file HRROI T2,[ASCIZ/ -------- /] SETZ T3, ;ASCIZ SOUT ;Copy the delimiter over ERJMP .+1 ;Should not happen MOVE T1,CPYJFN ;Get the JFN of the mail file TXO T1,CO%NRJ ;Do not release the JFN CLOSF ;Close it ERJMP [RET] ;Can't close the mail file, quit RETSKP ;Build the file spec record BLDSPC: SETZ P1, ;No bytes in this record yet MOVEI T2,FILSPC ;Address of the file spec HRLI T2,(POINT 7) ;Make into a pointer MOVE T4,P5 ;Address of the record ADDI T4,.RECHS ;Address of the file spec field HRLI T4,(POINT 7) ;Make it into a pointer TRSFIL: ILDB T1,T2 ;Get the next character IDPB T1,T4 ;Place in the file spec record AOS P1 ;Increment the byte count CAIE T1,0 ;End of the string? JRST TRSFIL ;No, continue IDIVI P1,5 ;Find the number of words SKIPE P2 ;A partial word? AOS P1 ;Yes, count as a word ADDI P1,.RECHS ;Include the header size MOVEM P1,.RECLN(P5) ;Place length in record AOS T1,MSGRCT ;Increment the record count MOVEM T1,.RECNM(P5) ;Place in record MOVEI T1,.FLSPC ;Get record type MOVEM T1,.RECTY(P5) ;Place in the record RET ;Send the message page to MX SNDMX: CALL SNDOFF ;Page is full, send off to MX RET ;An error occurred, quit RETSKP ;No errors ;Build the message header record then send off to MX SNDOFF: MOVE P5,IPCPGS ;Address of header record MOVEI T1,.POST ;Assume first page SKIPE IDNUM ;First page? MOVEI T1,.CONT ;No, indicate so MOVEM T1,.PKTYP(P5) ;Place in the header record MOVE T1,IDNUM ;Pick up the message ID MOVEM T1,.PKID(P5) ;Place in the message AOS T1,MSGNUM ;Increment the message page number MOVEM T1,.PKSEQ(P5) ;Place in the message MOVEI T1,.DONE ;Assume no more pages SKIPN PAKSTS ;Is this true? MOVEI T1,.MORE ;No, more to follow MOVEM T1,.PKSTS(P5) ;Store in the message MOVE T1,MSGRCT ;Pick up the number of records MOVEM T1,.PKRCT(P5) ;Place in the message ;Send the message off to MX MOVX T1,IP%CFV ;Page mode MOVEM T1,PDB+.IPCFL ;Place in the flag word MOVE T1,MYPID ;Pick up our PID MOVEM T1,PDB+.IPCFS ;Place in the sender word MOVE T1,MLRPID ;Pick up MX' PID MOVEM T1,PDB+.IPCFR ;Place in the receiver word MOVE T1,IPCPGS ;Address of the message LSH T1,-^D9 ;Change to page number HRLI T1,1000 ;Size of the message MOVEM T1,PDB+.IPCFP ;Place in the packet address word MOVEI T1,4 ;Size of the packet descriptor block MOVEI T2,PDB ;Address of the PDB MSEND ;Send the message to MX ERJMP GIVUP ;Can't, so give up ;Get the reply from MX MOVEI Q1,10 ;Retry count MOVX T1,IP%CFB!IP%CFV ;Do not block, expecting a page MOVEM T1,PDB+.IPCFL ;Store in the flag word MOVE T1,MYPID ;Pick up our PID MOVEM T1,PDB+.IPCFR ;Place in the receiver word NOTFMX: SETZM PDB+.IPCFS ;INFO will fill in the sender's PID TRYMOR: MOVEI T1,4 ;Length of the PDB MOVEI T2,PDB ;Address of the PDB MRECV ;See if we have a message ERJMP [ SOJLE Q1,GIVUP ;Time to give up? MOVEI T1,^D1000 ;No, sleep a second DISMS JRST TRYMOR] ;Try again MOVE T1,PDB+.IPCFS ;Get the PID of the sender CAME T1,MLRPID ;From MX? JRST NOTFMX ;Try again HRRZ P5,PDB+.IPCFP ;Get the message page number LSH P5,^D9 ;Make it into an address MOVE T1,.PKSTS(P5) ;Get the status word CAIN T1,.STABD ;Did MX abort it? JRST GIVUP ;Yes, give up SKIPE PAKSTS ;More pages to follow JRST FINSND ;No, return success ;Set up for the next page MOVE T1,.PKID(P5) ;Get the message ID MOVEM T1,IDNUM ;Save for later SETZM MSGRCT ;No records yet in this message MOVEI P3,.HDRSZ ;Global word count for this message MOVE P5,IPCPGS ;Pick up the message address ADDI P5,.HDRSZ ;Find address of the current record FINSND: RETSKP GIVUP: RET ;RELPID - RELEASE A PID ; T1/ PID (IF PID IS ZERO, NO ACTION IS TAKEN) ;RETURNS +1: ALWAYS RELPID: SKIPN T4,T1 ;IS THE PID ZERO? RET ;YES, NO ACTION MOVEI T3,.MUDES ;MUTIL FUNCTION CODE MOVEI T2,T3 ;ARGUMENT BLOCK ADDRESS MOVEI T1,2 ;ARGUMENT BLOCK LENGTH MUTIL ;RELEASE THE PID ERJMP .+1 RET ; Routine to save and restore the AC's. SAVACS: MOVEM P,SAVAC+17 ; Save all accumulators MOVEI P,SAVAC BLT P,SAVAC+16 MOVE P,SAVAC+17 ; Get back the stack pointer POP P,T3 ; Get the return address MOVEM P,SAVAC+17 ; Save original stack before call to ARMAIL PUSH P,[SVACRT] ; Routine to restore the accumulators PUSH P,T3 ; Go back to caller of this routine RET SVACRT: SKIPA ; If RET return, skip adding to the PC AOS SAVAC+17 ; RETSKP MOVSI P,SAVAC ; Restore the accumulators BLT P,P RET ;Some hacks do not need MACREL RSKP: AOS 0(P) R: POPJ P, END