Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/armail.mac
There are 40 other files named armail.mac in the archive. Click here to see a list.
; *** 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
;<ARC-DEC>ARMAIL.MAC.16, 27-Nov-78 08:47:00, EDIT BY CALVIN
; Cause uses of GJBLK to find deleted files as well as invisible
;<ARC-DEC>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 <ARGPTR,<IPCFM,15>,<PDB,4>>
; STKVAR <<GTMPDB,4>,<GTMANS,2>>
; STKVAR <<RDAT,3>>
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,<FLD(7,OF%BSZ)+OF%RD>
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,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+JS%PAF>
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,<FLD(7,OF%BSZ)+OF%WR>
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,<FLD(7,OF%BSZ)+OF%RD>
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,<FLD(7,OF%BSZ)+OF%WR>
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 <SYSTEM>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 <SYSTEM>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