Trailing-Edge
-
PDP-10 Archives
-
bb-d868a-bm
-
3-sources/mail.mac
There are 20 other files named mail.mac in the archive. Click here to see a list.
;<3-UTILITIES>MAIL.MAC.7, 8-Nov-77 10:47:39, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-UTILITIES>MAIL.MAC.6, 26-Oct-77 11:07:12, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-UTILITIES>MAIL.MAC.5, 30-Sep-77 11:23:06, EDIT BY MILLER
;<3-UTILITIES>MAIL.MAC.4, 30-Sep-77 11:05:19, EDIT BY MILLER
;MORE HELP TEXT IMPROVEMENTS
;<3-UTILITIES>MAIL.MAC.3, 30-Sep-77 11:00:53, EDIT BY MILLER
;FIX HELP TEXT TO SAY "CTRL/Z"
;<3-UTILITIES>MAIL.MAC.2, 25-Aug-77 11:35:22, EDIT BY KIRSCHEN
;FIX VERSION NUMBERS FOR RELEASE 3
;<3-UTILITIES>MAIL.MAC.1, 19-Jul-77 13:05:03, EDIT BY MILLER
;TCO 1842. ALLOW PARTIAL RECOGNIITON OF USER NAMES
;<2-UTILITIES>MAIL.MAC.21, 20-Jan-77 14:21:00, EDIT BY HURLEY
;FIX HELP MESSAGE
;<2-UTILITIES>MAIL.MAC.20, 27-Dec-76 17:06:24, EDIT BY HURLEY
;<2-UTILITIES>MAIL.MAC.19, 8-Oct-76 10:14:22, EDIT BY MILLER
;FIX FILE NAME ERROR RECOVERY
;<2-UTILITIES>MAIL.MAC.18, 28-Sep-76 15:19:12, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.17, 28-Sep-76 10:24:43, EDIT BY MILLER
;INIT USRBLK CORRECTLY
;<2-UTILITIES>MAIL.MAC.16, 27-Sep-76 13:35:28, EDIT BY MILLER
;ALWAYS RETRY ON ERRORS
;<2-UTILITIES>MAIL.MAC.15, 23-Sep-76 09:13:19, EDIT BY MILLER
;MORE RELEASE 2
;<2-UTILITIES>MAIL.MAC.14, 22-Sep-76 16:59:17, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.13, 22-Sep-76 11:37:07, EDIT BY MILLER
;FIX UP OUTPUT
;<2-UTILITIES>MAIL.MAC.12, 21-Sep-76 13:42:31, EDIT BY MILLER
;FIX CHKSLF
;<2-UTILITIES>MAIL.MAC.11, 20-Sep-76 11:48:38, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.10, 20-Sep-76 11:30:07, EDIT BY MILLER
;MAKE COUNT CORRECT WHEN RECOGNIZING NAMES
;<2-UTILITIES>MAIL.MAC.9, 20-Sep-76 11:18:34, EDIT BY MILLER
;<2-UTILITIES>MAIL.MAC.8, 20-Sep-76 11:17:54, EDIT BY MILLER
;MAKE SPECIAL CHECK FOR SYSTEM
;<2-UTILITIES>MAIL.MAC.7, 14-Sep-76 12:25:00, EDIT BY MILLER
;MORE,MORE,MORE
;<2-UTILITIES>MAIL.MAC.6, 13-Sep-76 17:05:06, EDIT BY MILLER
;FIX TYPOS
;<2-UTILITIES>MAIL.MAC.5, 13-Sep-76 17:03:51, EDIT BY MILLER
;MORE FIXES
;<2-UTILITIES>MAIL.MAC.4, 13-Sep-76 15:15:11, EDIT BY MILLER
;MORE OF THE SAME
;<2-UTILITIES>MAIL.MAC.3, 10-Sep-76 12:00:57, Edit by HESS
;TCO 1523 - CONVERT FOR RELEASE 2
;<1A-UTILITIES>MAIL.MAC.23, 6-MAY-76 10:57:39, EDIT BY HURLEY
;<1A-UTILITIES>MAIL.MAC.19, 8-APR-76 11:12:02, EDIT BY HURLEY
;TCO 1244 - ADD .DIRECT .XTABM FOR MACRO 50 ASSEMBLIES
;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 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
TITLE MAIL
SEARCH MONSYM,MACSYM
SALL
IFNDEF .PSECT,<
.DIRECT .XTABM>
;PROGRAM VERSION DEFINITIONS
PRGVER==3 ;VERSION 2
PRGEDT==4 ;EDIT 3
PRGMIN==0 ;MINOR VERSION
PRGCST==0 ;CUSTOMER ID
DEFINE ASSIGN(A,B,C)
<A=B
B==B+C
>
;DEFINE REGISTERS
F==0
A==1
B==2
C==3
D==4
W==5
W1==6
W2==7
W3==10
P==17
;DEFINE VALUES IN F
S.PRF==1
S.END==2
S.SAW==4
S.BLA==10
S.ERR==20
NACK1==2 ;TOATL WIPEOUT FORM MAILER
NACK2==3 ;QUOTA EXCEEDED
;LOCAL STORAGE
ARG: 6 ;TEXTI ARG BLOCK
RD%RBF+RD%JFN+RD%BEL+RD%BRK+RD%PUN
.PRIIN,,.PRIOU
OBUF: -1,,BIGBUF
SIZE*5 ;CHAR COUNT
-1,,BIGBUF ;TOP OF BUFFER
RBUFF: 0 ;^R DISJOINT BUFFER
DATA==10000
USERS==^D100
ASSIGN USRBLK,DATA,USERS+1
PDSL==^D20 ;SIZE OF PDL
SAVW: Z 0
PARTRM: Z 0
SAVCNT: Z 0
SYSCOD==-2 ;SPECIAL SYSTEM CODE
NOACKB==0 ;DEFAULT MESSAGE TYPE
MINMSG==1 ;FIRST ERROR MESSAGE
MSGTBL: [ASCIZ / Quota exceeded/]
MAXMSG==.-MSGTBL+MINMSG ;LAST MESSAGE +1
PIDGET: IP%CPD ;GET PID
0
0 ;TO INFO
ENDMSG-.,,.+1 ;FOR INFO
1,,1 ;GET PID FOR NAME
0 ;NO COPY
ASCIZ /[SYSTEM]MAILER/
ENDMSG:
CPYJFN: BLOCK 1
PDL: BLOCK PDSL
SIZE==1000*^D50 ;STRING AREA
ASSIGN BIGBUF,DATA,SIZE
CURR: Z 0 ;SAVE CURRENT STRING POINTRE
DIRSTR: BLOCK ^D32 ;FOR FILE NAME
ASSIGN HOLD,DATA,100000 ;FOR OLD MESSAGES
;DEFINE ENTRY VECTOR
ENTVEC: JRST START ;MAIN ENTRY
JRST RETRY ;REENTER POINT
PRGVER_^D24+PRGMIN_^D18+PRGEDT+PRGCST_^D33
;CODE
RELOC 1000-140 ;ON A CLEAN PAGE
START: RESET ;CLEAR THE WORLD
MOVE P,[IOWD PDSL,PDL] ;STACK
MOVEI A,100
RFCOC
TRZ C,3B19 ;DONT ECHO ESC
SFCOC
MOVE A,[ASCII /PS:</] ;GET DEVICE STRING
MOVEM A,BIGBUF ;PUT IT IN THE BUFFER
GJINF ;GET LOGGED IN DIRECTORY
MOVE B,A ;GET USER NUMBER
MOVE A,[POINT 7,BIGBUF,27] ;WHERE TO PUT USER NAME
DIRST ;GET THE NAME
JFCL
HRROI B,[ASCIZ />MAIL.CPY/] ;THE FILE NAME
SETZ C,
SOUT ;MAKE NAME
MOVX A,GJ%FOU!GJ%SHT
HRROI B,BIGBUF ;WHERE NAME IS
GTJFN ;GET A JFN
JRST CANT ;OOPS. FAILED
MOVEM A,CPYJFN ;SAVE IT FOR LATER
MOVE B,[440000,,300000]
OPENF ;MAKE SURE IT WILL OPEN
JRST CANT ;WON'T
MOVSI A,(RD%RBF!RD%JFN!RD%BEL!RD%BRK!RD%PUN)
MOVEM A,ARG+1 ;SET UP FLAGS
HRROI A,BIGBUF
MOVEM A,ARG+5 ;TOP OF BUFFER VALUE
HRROI A,[ASCIZ /To: /]
MOVEM A,RBUFF ;^R MESSAGE
PSOUT
SETZ F, ;NO FLAGS
PUSHJ P,INDIR1 ;GET LIST OF TO NAMES
JRST START ;MUST HAVE SOME
TRYTO: JUMPE A,START ;SAME HERE
;GOT USER LIST . VERIFY AND PUT IN USRBLK
MOVE W,[-USERS,,USRBLK] ;WHERE THEY ARE GOING
MOVEI W3,USRBLK ;PURGE THEM
PUSHJ P,REAL ;CONVERT TO NUMBERS
JRST [ CALL INDIR2 ;TR,TRY AGAIN
JRST START
JRST TRYTO] ;AGAIN
SKIPN USRBLK ;GOT AT LEAST ONE?
JRST START ;NO. ASK FOR MORE
ADD W,[1,1] ;MOVE TO NEXT
CCAGN: HRROI A,[ASCIZ /CC: /]
MOVEM A,RBUFF ;MAKE THIS ^R BUFFER
PSOUT ;GET COPIES TO
PUSH P,W ;SAVE USRBLK POINTER
PUSHJ P,INDIR1 ;GET THEM
JRST [ POP P,W
JRST CCAGN] ;MUST TYPE SOMETHING
POP P,W
TRYCC: MOVEI W3,USRBLK ;PURGE DUPLICATES
JUMPE A,TRYCC1
PUSHJ P,REAL ;YES. CONVERT EM
JRST [ PUSH P,W
CALL INDIR2
JRST [ POP P,W
JRST CCAGN]
POP P,W
JRST TRYCC]
TRYCC1: ADD W,[1,,1]
MOVE A,[USRBLK,,BIGBUF+1]
BLT A,BIGBUF-USRBLK+1(W) ;NAMES TO MESSAGE BUFFER
SUBI W,USRBLK ;RELATIVE POINT IN BLOCK
MOVEI B,BIGBUF+1(W) ;WHERE TO START IN BIGBUF
SETZM BIGBUF ;NO FLAGS BY DEFAULT
HRLI B,440700 ;SP FOR TEXT
JRST DOSTUF ;AND GO DI IT
;SUBROUTINE TO PROCESS USER NAMES
INDIR2: MOVE D,[POINT 7,BIGBUF]
MOVE B,D
MOVEI C,SIZE*5
INDIR3: ILDB A,B ;GET A BYTE
JUMPE A,INDIR4 ;IF AT THE END, DONE
MOVE D,B ;COPY IT
SOJA C,INDIR3 ;DO ALL OF IT
INDIR1: MOVE D,[POINT 7,BIGBUF] ;BUFFER HEAD
MOVEI C,SIZE*5 ;INITAIL SIZE FOR RDTXT
INDIR4: MOVEM D,CURR
INDIR: MOVE B,CURR
MOVEM B,OBUF ;START OF BUFFER
HRRZM C,ARG+4 ;PUT IN CUREENT COUNT
MOVEI A,ARG ;BLOCK ADDRESS
TEXTI ;GET THE INPUT
JRST [ MOVEI A,"?" ;IMPOSSSIBLE FAILURE
PBOUT
HALTF] ;GIVE UP
MOVE C,ARG+1 ;PICK UP THE FLAGS
HRR C,ARG+4 ;AND THE COUNT
MOVE B,OBUF ;AND BUFFER POINTER
TLNN C,(RD%BTM) ;SAW A BRAEK?
POPJ P, ;NO. GIVE IT UP
;GOT A BREAK. NOW PROCESS THE NAME
LDB W,B ;GET THE BREAK
HRRZ W1,C ;GET COUNT
CAIN W1,SIZE*5-1 ;FIRST CHARACTER?
CAIE W,"?" ;YES. DOES HE WANT HELP?
SKIPA ;NO
JRST HLPHIM ;YES. GO DO IT
AFTER: CAIE W,"@" ;POSSIBLE FILE NAME?
JRST AFTER1 ;NO
MOVE A,B ;YES. LOOK AT THE PREVIOUS
BKJFN ;DO IT
JFCL
LDB W1,A ;GET PREVIOUS
MOVEI W,(A) ;GET WORD POSITION
CAIE W1,"," ;UP TO A TERMINATER?
CAIGE W,BIGBUF ;NO. AT START OF BUFFER?
SKIPA B,A ;YES. DO A FILE
JRST COMMON ;NO. USE THE CHARACTER
PUSHJ P,GETFIL ;GET THE FILE THEN
JRST [ MOVEM B,CURR ;UPDATE POINTER
CALL RETYPE ;PUT OUT THE LINE AGAIN
AOS C ;DISCOUNT THE CHARACTER
JRST INDIR] ;AND PROCEED
JRST EOL ;WRAP UP,BUT ALLOW CONTINUATION
AFTER1: CAIN W,"," ;COMMA?
JRST COMMA ;YES. GO DO IT
CAIN W,33 ;ESCAPE?
JRST RECOG ;YES. GO DO SOME WORK
CAIN W,12 ;EOL?
JRST EOL ;YES.
COMMON: MOVEM B,CURR ;SAVE CURRENT
JRST INDIR ;GO GET MORE
;BREAK CHARACTRE PROCESSING ROUTINES
COMMA: JRST COMMON ;GO DO MORE
EOL: HRRZ W,C ;AN EOL. SEE IF ANYTHING AROUND
SETZ A, ;NULL RETUHRN
CAIL W,SIZE*5-2 ;EMPTY?
JRST CPOPJ1 ;YES. GO BACK
MOVE A,B ;GET POINTER
BKJFN ;OVER THE LF
JFCL
LDB W,A ;LOOK AT PREVIOUS
CAIN W,15 ;CR THER3 TOO?
BKJFN ;YES. ZAP IT TOO
JFCL
MOVEI B,(A) ;SEE IF BUFFER IS NULL
CAIGE B,BIGBUF ;STILL IN THE BUFFER?
POPJ P, ;NO. MUST BE NULL THEN
LDB B,A ;GET PREVIOUS
CAIE B,"," ;CONTINUATION?
JRST CPOPJ1 ;NO. GO BACK
MOVEM A,CURR ;NEW CURRENT
JRST INDIR ;GO DO MORE THEN
RECOG: SETZ A,
DPB A,B ;TIE OFF STRUNG
MOVE A,B
BKJFN ;OVER THE NULL
JFCL
MOVE W,A ;SAVE END OF STRING
MRBAK: LDB W1,A ;LOOK AT BYTE
CAIE W1," " ;UP TO PREVIUOS?
CAIN W1,"," ;UP TO PREVIOUS?
JRST ATIT ;YES
CAIN W1," " ; A TAB?
JRST ATIT ;YES. BREAK THEN
HRRZ W1,A ;NO. SEE IF IN BIGBUF
CAIGE W1,BIGBUF
JRST ATIT1 ;TOO FAR
BKJFN
JFCL
JRST MRBAK
ATIT1: MOVE A,[POINT 7,BIGBUF]
ATIT: MOVEM A,CURR ;NEW CURR
MOVE B,CURR ;WHERE IT STRTS
MOVX A,RC%PAR ;DO PARTIAL RECOGNITION
MOVE D,C ;SAVE COUNT
RCUSR ;GET THE NAME
ERJMP NOREC ;BAD NAME STRING
MOVE C,D ;RESTORE COUNT
TXNE A,RC%NOM ;MATCH?
JRST NOREC ;NO - TRY NOREC
TXNE A,RC%AMB ;AMBIGUOUS
JRST [ MOVE A,W ;YES. GET PREVIOUS TAIL
PSOUT ;FINISH OFF STRING
MOVEI A,7
PBOUT ;SAY SO
MOVEM B,CURR ;SAVE PARTIAL NAME
JRST INDIR] ;GO BACK TO GET MORE
;GOT NAME
MOVEM B,CURR ;UPDATE POINTER
MOVE A,W ;WHERE THE USER STOPPED
PSOUT ;PRINT THE REST FOR HIM
JRST INDIR ;GO GET MORE
CPOPJ1: AOS (P)
POPJ P, ;GOOD RETURN
NOREC: MOVE B,CURR
MOVEI A,[1,,1
[ASCIZ /SYSTEM/],,0]
TBLUK ;SEE IF THIS IS SYSTEM
ERJMP NOREC1 ;IF ERROR, IT ISN'T
TXNE B,TL%EXM ;EXACT MATCH?
JRST [ MOVEM W,CURR ;YES. SAVE END OF STRING
MOVE C,D ;RESTORE COUNT
JRST INDIR] ;AND DONE
TXNN B,TL%ABR ;AN SUBSTIRNG?
JRST NOREC1 ;NO. ERROR THEN
MOVE A,C ;YES.
PSOUT ;OUTPUT THE REST
MOVE A,CURR ;THE START OF IT ALL
HRROI B,[ASCIZ /SYSTEM/]
SETZ C,
SOUT ;FILL IN THE STRING
MOVE C,D ;RESTORE COUNT
MOVEM A,CURR ;UPDATE TEXTI BLOCK
JRST INDIR ;AND DONE
NOREC1: HRROI A,[ASCIZ / ?
/]
PSOUT
CALL RETYPE
MOVE C,D
JRST INDIR
RETYPE: MOVE A,RBUFF ;GET ^R STRING
PSOUT
SETZ A,
MOVE B,CURR ;APPEND NULL TO CURRENT STRING
IDPB A,B
HRROI A,BIGBUF ;STRING SO FAR
PSOUT
RET ;AND DONE
REAL: SETZ F, ;NO FLAGS
MOVEM W,SAVW ;SAVE ENTRY VALUE
MOVE D,[POINT 7,BIGBUF]
LOOP: PUSHJ P,BLKOUT ;GET RID OF BLANKS
MOVEM D,CURR ;TOP OF PROCESSING LOOP
TRZ F,S.BLA ;NO BLANK
LOOP1: ILDB A,D ;GET BYTE
JUMPE A,EOL1 ;FAKE EOL IF AT NULL BYTE
CAIE A," " ;TAB?
CAIN A," " ;A BLANK
JRST [ SETZ A, ;YES. GET A NULL
DPB A,D ;TIE OFF THIS NAME
PUSHJ P,BLKOUT ;PURGE BLANKS
ILDB A,D ;GET REAL TERMONATOR
TRO F,S.BLA ;REMEMBER THE BLANK
JRST .+1] ;AND PROCEED
CAIN A,"," ;END OF NAME/
JRST ENDOF ;YES
CAIE A,15
CAIN A,12 ;ENDOF THEM ALL?
JRST [ TRZN F,S.SAW ;JUST SAW A COMMA?
JRST EOL1 ;NO. GO DO THE NAME
CAIN A,15 ;WAS IT A CR?
IBP D ;YES. SKIP THE LF
JRST LOOP] ;GO TRY ANOTHER NAME
TRZ F,S.SAW ;SAY NOT ON A TWRMNAOER
TRNN F,S.BLA ;BLANK WAS LAST?
JRST LOOP1 ;GET MORE BYTES
MOVE A,D ;YES
BKJFN ;MUST SEE THIS AGAIN
JFCL
MOVE D,A ;GET THIS BACK
JRST ENDOFF ;AND GO DO IT
EOL1: TRO F,S.END ;NO MORE
ENDOF: TRO F,S.SAW ;SAW A COMMA
ENDOFF: SETZ A,
MOVE B,CURR ;STRINF POINTER
LDB C,D ;SAVE TERMINATER
MOVEM C,PARTRM ;SAVE TERMINATER
MOVE C,D ;COPY PTR
DPB A,D ;TIE OFF OLD STRING
TRNE F,S.END ;AT THE END YET?
IDPB A,C ;YES. ANOTHER NULL FOR GOOD KEEPING
PUSHJ P,CHKSLF ;CHECK FOR SELF
JUMPN C,SELF1 ;NON-0 MEANS SELF
MOVX A,RC%EMO ;EXACT MATCH ONLY
RCUSR ;GET NAME
ERJMP BADUSR ;BAD NAME STRING
TXNE A,RC%AMB!RC%NOM
JRST BADUSR ;NO MATCH
SELF1: JUMPE W3,NOPURG ;PURGING?
MOVEI W2,(W3) ;YES. GET START OF PURGE LIST
CUSER: CAIN W2,0(W) ;IS THIS THE END?
JRST NOPURG ;YES. ALL DONE
CAME C,(W2) ;THIS A MATCH?
AOJA W2,CUSER ;NO. GO DO THE NEXT
HRROI A,[ASCIZ /%Duplicate name purged - /]
PSOUT ;YES. PURGE IT
JRST NOUSR ;AND GO WRAP UP
NOPURG: MOVEM C,(W) ;STORE NUMBER
TRNE F,S.END ;MORE TO DO?
JRST FINNAM ;YES. GO FINISH IT UP
MOVE C,PARTRM ;GET TERMINATER
DPB C,D ;RESTORE IT
AOBJN W,LOOP ;GET MORE
HRROI A,[ASCIZ /
%Too many user names. 100 is maximum.
/]
PSOUT ;TOO MANY. SSAY SO
POPJ P, ;ALL DONE
BADUSR: MOVE B,CURR ;GET THE STRING
MOVEI A,[1,,1
[ASCIZ /SYSTEM/],,0]
TBLUK ;SEE IF THIS IS SYETEM
MOVE C,[SYSCOD] ;ASSUME IT IS SYSTEM
TXNE B,TL%EXM ;IS IT?
JRST SELF1 ;YES. GO USE IT
HRROI A,[ASCIZ /?Illegal user name - /]
PSOUT ;VAD NAME
TRO F,S.ERR ;REMEMBER AN ERROR
NOUSR: MOVE A,CURR ;POINTER TO THE NAME
PSOUT
HRROI A,[ASCIZ /
/]
PSOUT ;CLEAN UP THE TYPESCRIPT
MOVE A,CURR
NOUSR1: ILDB C,D ;GET NEXT BYTE
IDPB C,A ;COPY
JUMPN C,NOUSR1 ;DO ALL OF STRING
MOVE D,CURR ;NEW BEGINNING
TRNN F,S.END ;MORE/
JRST LOOP ;YES
SKIPA
FINNAM: ADD W,[1,,1] ;MOVE TO THE NEXT
MOVEM D,CURR ;SAVE CURRENT INSERT POINT
TRNE F,S.ERR ;FOUND AN ERROR?
JRST [ MOVE W,SAVW ;YES
CALL RETYPE ;OUTPUT THE STUFF
JRST FINN1] ;GO ARRANGE FOR REPARSE
AOS 0(P)
FINN1: SETZM (W) ;TIE IT OFF
POPJ P,
;CHECK FOR USER NAME OF "." - MEANS SAME AS PRESENTLY LOGGED IN
CHKSLF: PUSH P,B ;SAVE ORIG STRING PTR
ILDB A,B ;GET FIRST CHAR
CAIE A,"." ;DOT?
JRST CHKS1 ;NO, NOT SELF
ILDB A,B ;SECOND CHAR
JUMPN A,CHKS1 ;NULL?
MOVEM B,0(P) ;UPDATE STRING PTR
PUSH P,D
GJINF ;GET CURRENT USER NUMBER IN A
POP P,D
MOVE C,A ;GET LOGGED IN USER NUMBER
POP P,B ;RESTORE STRING PTR
POPJ P,
CHKS1: POP P,B ;RESTORE ORIG STRING PTR
SETZ C, ;SAY NOT SELF
POPJ P,
;PURGE BLANKS
BLKOUT: ILDB A,D ;GET A BYTE
CAIE A," " ;BLANK
CAIN A," " ;OR TAB?
JRST BLKOUT ;YES. KEEP GOING
MOVE A,D
BKJFN
JFCL
MOVE D,A ;KEEP THIS ONE
POPJ P, ;DONE
;DO MESSAGE STUFF
DOSTUF: HRROI A,[ASCIZ /Subject: /]
PSOUT
MOVEI A,100
PUSH P,B ;SAVE SP
RFCOC
TLZ C,(3B2) ;TURN OFF ^R ECHO
TRO C,3B19 ;TURN ON ECHO FOR ESC
SFCOC
POP P,B
HRROI A,[ASCIZ /Subject: /]
SETZ C,
SIN ;PUT IT IN
DOSBJ: PBIN ;GET HIS BYTE
CAIN A,"R"-100 ;WANT RETYPE?
SUBCR: JRST [ HRROI A,[ASCIZ /
Subject: /]
PSOUT ;YES. DO IT
JRST DOSBJ] ;AND TRY AGAIN
CAIN A,"?" ;WANT HELP?
JRST [ HRROI A,[ASCIZ /
Type a single line terminated with a <CR> which summarizes
the message you are sending.
Subject: /]
PSOUT ;HELP HIM
JRST DOSBJ] ;GO DO IT AGAIN
MOVEI A,100 ;PRIMARY
BKJFN ;RE EAT THAT BYTE
JFCL
MOVE A,B ;BUFFER
MOVE B,[RD%RBF+RD%BEL+SIZE*5] ;FLAGS AND COUNT
HRROI C,[ASCIZ /Subject: /]
RDTTY ;GET THE SUBJECT MATTER
JFCL ;????
TLNN B,(RD%BTM) ;GOT A REAL BREAK CHARACTER?
JRST [ MOVE B,A ;NO. SAVE BUFFER
JRST SUBCR] ;GO DO IT
MOVE D,B ;SAVE FLAGS AND COUNT
MOVE B,A ;MOVE BUFFER POINTER
HRROI A,[ASCIZ /
/]
SETZ C,
SIN ;PUT IN SPACING
MOVE W2,B ;SAVE WHERE MESSAGE STARTS
MOVE W3,D ;SAVE THIS TOO
STUFF2: HRROI A,[ASCIZ 'Message (Terminate with ESC or CTRL/Z):
']
PSOUT ;PRIOM@T FOR MESSAGE
STUFF3: MOVE A,B ;BUFFER ADDRESS
MOVE B,D
HRLI B,(RD%JFN+RD%BRK+RD%PUN) ;BREAK STUFF
HRRZS D ;SAVE COUNT FOR INDIRECT STUFF
SETZ C, ; NO ^R BUFFER
SETZM RBUFF ; NO ^R BUFFER
RDTTY ;GET HIS MESSAGE
JFCL
LDB W,A ;GET TERMINATOR
HRRZ W1,B ;GET NEW COUNT
CAIE W1,-1(D) ;FIRTS CHAR WAS @?
JRST GETMSG ;NO. GO ON
CAIN W,"?" ;WANT HELP?
JRST HLPHLP ;YES
CAIE W,"@" ;INDIRECT FILE?
JRST GETMSG ;NO. GO ON
BKJFN ;YES. IGNORE IT
JFCL
MOVE B,A
PUSHJ P,GETFIL ;GET THE GUY'S FILE
JRST [ MOVE B,W2 ;WHERE END OF SUBJ ISS
MOVE D,W3 ;COUNT FIELD TOO
JRST STUFF2]
JRST READY
GETMSG: CAIE W,"Z"-100 ;TERMINATOR?
CAIN W,33 ;""
JRST [ MOVE B,A ;BUFFER TO B
JRST READY1] ;DONT READ ANY MORE
HRLI B,(RD%JFN+RD%BRK+RD%BBG!RD%RND) ;FOR THE REST
HLLZM B,ARG+1 ;MUST USE TEXTI
HRRZM B,ARG+4 ;COUNT
MOVEM W2,ARG+5 ;TOP OF BUFFER
MOVEM A,OBUF ;THE BUFFER POINTER
MOVEI A,ARG ;THE ARG BLOCK
TEXTI ;GET IT
JFCL
MOVE C,ARG+1 ;FLAGS
TLNN C,(RD%BTM) ;GOT GOOD STUFF?
JRST [ HRRZ D,ARG+4 ;COUNT
MOVE B,OBUF ;THE BUFFER POINTER
JRST STUFF3] ;GO DO IT ALL AGAIN
MOVE B,OBUF
READY1: ADD B,[07B5] ;DECREMENT BYTE POINTER OVER TERMINATOR
TLNE B,(40B5) ;OVER WORD BOUNDARY?
SUB B,[43B5+1] ;YES. ADJUST
MOVEI A,0
READY2: TLNN B,700000 ;AT THE END OF A WORD?
JRST READY ;YES. GO PROCESS THE MESSAGE
IDPB A,B ;NO. PAD
JRST READY2 ;GO TEST SOME MORE
GETFIL: MOVSI A,120003 ;OLD FIL FORM TTY
MOVE W1,B ;SAVE SP
MOVE B,[100,,101]
GTJFN ;GET IT
JRST NOFIL
PUSH P,A ;SAVE JFN
MOVE B,[070000,,200000]
OPENF
JRST [ POP P,A
RLJFN
JFCL
JRST NOFIL] ;COULDNT GET IT
POP P,(P)
MOVNI B,1 ;SET FILE POINTER TO EOF
SFPTR ;DO IT
JFCL ;IT BETTER DO IT!
RFPTR ;NOW SEE WHAT THE BYTE VALUE IS
JFCL ;AGAIN, NO QUARTER FOR SLAGGARDS
SUBI C,(B) ;COUNT DOWN RDTXT COUNTER
PUSH P,C ;SAVE COUNT OF BIGBUF
MOVN C,B ;GET NEGATIVE OF BYTE COUNT
SETZ B, ;GET IT BACK TO THE BEGINNING
SFPTR ;AT LAST. WHAT A HACK.
JFCL
MOVE B,W1 ;GET BACK POINTER
SIN ;RAED IN WHOLE FILE
POP P,C ;RESTORE COUNT
AOS (P)
CLOSF ;CLOSE THE FILE
JFCL
POPJ P, ;AND GO BACK
NOFIL: HRROI A,[ASCIZ /
?Could not find file
/]
PSOUT
MOVE B,W1 ;RESTORE POINTER
POPJ P, ;RETURN BAD
HLPHIM: HRROI A,[ASCIZ /
Type user names separated by commas. The list is terminated
by a <CR>. The entire list may be read from a file by typing:
@FILESPEC
Typing a "?" gives this message.
/]
PSOUT
POPJ P, ;RETURN
HLPHLP: HRROI A,[ASCIZ '
Type message and terminate with a CTRL/Z or an ESC. The message
may be read from a file by typing:
@FILESPEC
Typing a "?" gives this message.
']
PSOUT
MOVE B,W2 ;CLOBBER "?"
JRST STUFF2
;MESSAGE IS IN BIGBUF. NOW SEND IT
READY: SUBI B,BIGBUF ;BEGINNING OF MESSAGE
MOVNI C,1(B) ;COUNT OF WORDS TO MOVE
MOVE B,[POINT ^D36,BIGBUF] ;WRITE BY WORDS
MOVE A,CPYJFN ;THE FILE TO PUT IT IN
SOUT ;WRITE THE FILE
TLO A,(1B0)
CLOSF ;CLOSE THE FILE TO PRESERVE IT
JFCL
;NOW SEND IPCF MESSAGE TO MAILER
;GET PID OF MAILER
RDYN: PUSH P,A ;SAVE JFN
SETZ W1, ;RETRY FLAG
MOVSI A,(IP%CPD) ;CREATE PID
MOVEM A,PIDGET ;REQUEST THIS FUNCTION
MALER: SETZM PIDGET+1 ;NO SENDER'S PID
RDYN1: MOVEI B,PIDGET ;GET MAILER'S PID
SETZM PIDGET+2 ;NO RECEIVER'S PID
MOVEI A,4 ;THE COUNT
MSEND
JRST [ SKIPN W1 ;FIRST TRY?
PUSHJ P,[MOVEI A,101 ;YES. PRINT SOME STUFF
MOVE B,[400000,,-1] ;LAST ERROR
SETZ C, ;NO FLAGS
ERSTR ;TELL HIM
JFCL
JFCL
HRROI A,[ASCIZ / Waiting...
/]
PSOUT ;TELL HIM WE ARE STILL HANGING IN THERE
POPJ P,] ;GO BACK IN LINE
AOS W1 ;COUNT TRIES
MOVEI A,^D500 ;SLEEP TIME
DISMS
JRST MALER] ;GO TRY IT AGAIN
MOVSI B,(IP%CPD) ;CREATE PID BIT
ANDCAM B,PIDGET ;NOW HAVE A PID
GETAGN: SETZB W,W1 ;NO FLAGS,NO SENDER
MOVE W2,PIDGET+1 ;MY TEMP ID
MOVE W3,[10,,BIGBUF] ;USE BUFFER
MOVEI B,W ;WHERE RECIVE WILL BE
MRECV ;GET IT PLEASE
JFCL ;HOW CAN THIS HAPPEN PMH?
MOVE W1,W ;SAVE HEADER
ANDI W,7B32 ;ISOLATE FILED
CAIE W,1B32 ;SENT BY MONITOR?
CAIN W,2B32 ;SENT BY INFO?
SKIPA
JRST GETAGN ;NO GET IT AGAIN
TRNE W1,7 ;WAS THE PACKET UNDELIVERABLE?
JRST RDYN1 ;YES. SO SEND IT AGAIN
ANDI W1,77B29 ;ISOLATE THE ERROR FIELD
JUMPE W1,GETAS1 ;GOT IT.
CAIN W1,<.IPCSN>B29 ;DID INFO CRASH AND RESTART?
JRST GETAGN ;YES. WAIT FOR SOME OTHER NEWS THEN
HRROI A,[ASCIZ /
?Could not send to MAILER
/]
PSOUT
HALTF ;GIVE UP
GETAS1: MOVE W2,BIGBUF+1 ;SAVE MAILER'S PID
MOVEM W2,PIDGET+2 ;FOR LATER
SETZM BIGBUF ;TO GET FILE NAME
POP P,B
HRRZS B ;JFN
HRROI A,BIGBUF+1 ;WHERE NAME IS GOING
MOVE C,[1B2!1B5!1B8!1B11!1B14+1] ;GET FULL NAME
JFNS ;GET THE NAME
SETZ C,
IDPB C,A ;TIE IT OFF
MOVEI W3,(A)
SUBI W3,BIGBUF ;SIZE OF STRING
HRLZS W3 ;TO THE LEFT HALF
HRRI W3,BIGBUF+1 ;WHERE IT IS
SETZ W, ;NO BITS
MOVE W1,PIDGET+1 ;WHERE INFO PUT IT
SENDIT: MOVEI A,4
MOVEI B,W ;FOR MAILER
MSEND ;SEND IT OFF
JRST [ MOVEI A,^D500 ;SLEEP FOR A WHILE
DISMS
JRST SENDIT] ;TRY AGAIN
HRROI A,[ASCIZ /
Processing mail.../]
PSOUT
AGAIN: MOVEI A,4
MOVEI B,W ;SET UP FOR MAILER'S REPLY
SETZB W,W1
MOVE W2,PIDGET+1 ;MY PID
MOVE W3,[1000,,BIGBUF+1000] ;MESSAGE SPACE
MRECV ;GET IT
JFCL ;?????
TRNN W,7B32 ;FROM INFO OR THE MONITIOR?
JRST OK ;NO. MUST BE FROM AMILER
MOVE B,W ;THE HEADER
ANDI B,7B32 ;SEE WHO IT IS
CAIE B,2 ;FROM INFO?
CAIN B,3 ;OR PRIVATE INFO?
JRST AGAIN ;YES. GET ANOTHER MESSAGE
HRROI A,[ASCIZ /
?MAILER is not running. Messages not sent.
/]
PSOUT ;WAS FROM MONITOR
HALTF
OK: CAME W1,PIDGET+2 ;FROM MAILER?
JRST AGAIN ;NO. OGNOTR IT
TRNE W,77B29 ;ANY ERRORS?
JRST ERRORS ;YES. GO ANALYZE THEM
HRROI A,[ASCIZ /
No errors.
-DONE-
/]
PSOUT
HALTF
ERRORS: ANDI W,77B29
CAIE W,<NACK1>B29 ;TOTAL WIPEOUT?
JRST SOME ;NO. PRINT ERRORS
HRROI A,[ASCIZ /
?Processing errors occured. No mail sent.
/]
PSOUT ;YES. COULDNT DO IT
HALTF
SOME: HLRZS W3 ;GET COUNT
IMUL W3,[-1,,0]
HRRI W3,BIGBUF+1000 ;BUFFER
SOME1: MOVE B,1(W3) ;BAD GUY
CAMN B,[SYSCOD] ;IS THIS SYSTEM?
JRST [ HRROI A,[ASCIZ /SYSTEM/]
PSOUT
JRST SOME2]
MOVEI A,.PRIOU
DIRST ;PRINT HIS ID
JFCL
SOME2: HRROI A,[ASCIZ / not sent /]
PSOUT
HLRZ B,0(W3) ;GET MACRO CODE
CAIN B,NOACKB ;DEFAULT ERROR CONDITION?
JRST [ HRRZ B,0(W3) ;YES. GET MONITOR CODE
JUMPE B,NSTRNG ;IF ZERO, NO MORE INFORMATION
HRLI B,.FHSLF
HRROI A,[ASCIZ /BECAUSE:
/]
PSOUT
MOVEI A,.PRIOU ;OUTPUT REASON
SETZ C,
ERSTR ;PRODUCE MONITOR ERROR
JFCL
JFCL
JRST NSTRNG] ;AND DONE
CAIL B,MINMSG ;HAVE A STRING FOR THIS?
CAIL B,MAXMSG ;STILL?
JRST NSTRNG ;NO. GO ON
HRRO A,MSGTBL-MINMSG(B) ;YES. GET THE STRING
PSOUT ;AND PRINT IT
NSTRNG: HRROI A,[ASCIZ /
/]
PSOUT ;CLEAN UP THE LINE
AOBJN W3,.+1 ;ADVANCE TWICE
AOBJN W3,SOME1 ;DO ALL BADDIES
HRROI A,[ASCIZ /
-Done-
/]
PSOUT ;TELL HIM IT'S OVER
HALTF
CANT: RESET ;CLEAN UP
HRROI A,[ASCIZ /
?MAIL.CPY Failure
/]
PSOUT
MOVEI A,101
MOVE B,[400000,,-1]
SETZ C,
ERSTR ;LET MONITOR TELL HIM WHAT
JFCL
JFCL
HALTF
JRST .-1 ;DON'T CONTINUE
;THIS CODE IS GOTTEN TO BY THE REENTER COMMAND. IT IS USED
;EXCLUSIVELY TO TRY TO SEND A MESSAGE.COPY FILE WHICH ALREADY EXISTS
;BUT WHICH COULD NOT BE SENT PREVIOUSLY.
RETRY: RESET ;CLEAR CONTEXT
MOVE P,[IOWD PDSL,PDL] ;STACK
HRROI A,[ASCIZ /
File name of message file:/]
PSOUT ;PROMPT FOR THE NAME
MOVSI A,120003 ;OLD FILE ONLY
MOVE B,[.PRIIN,,.PRIOU] ;FROM PRIMARIES
GTJFN ;GET FILE NAME
JRST [ MOVEI A,.PRIOU
MOVE B,[.FHSLF,,-1]
SETZ C,
ERSTR ;TELL HIM OF THE FAILURE
JFCL
JFCL
JRST RETRY] ;DO IT AGAIN
JRST RDYN ;ALL SET
END <3,,ENTVEC> ;ESTABLISH THE ENTRY VECTOR