	TITLE SYSMSG - ITS SYSTEM MESSAGE PRINTER

.INSRT SYSENG;CALRET >

;;; DEFINE MACROS SO THAT SYSTEM VARIABLES ACCESSED
;;; THROUGH ABS PAGES CAN BE REFERENCED IN A NATURAL WAY

DEFINE CONC A,B
A!B!TERMIN

DEFINE ABSREF SYMS
DEFINE ABSTAB
IRPW SYM,,[SYMS]
IFSE [SYM]----, IMMEDS:	;FROM HERE DOWN ARE NOT ADDRESSES
.ELSE [  SQUOZE 0,SYM
  CONC ABSRF",\.IRPCNT,ABS
  CONC [EXPUNGE ABSRF"]\.IRPCNT,ABS
]
TERMIN
TERMIN
IRPW SYM,,[SYMS]
IFSN [SYM]----, ABSRF. SYM,\.IRPCNT
TERMIN
TERMIN

DEFINE ABSRF. SYM,CT
ABSRF"!CT!ABS==0
IF1,[DEFINE SYM ?MOD
(MOD)[.,,ABSRF"!CT!ABS]TERMIN
]
IF2,[DEFINE SYM ?MOD
(MOD)<ZZZ==ABSRF"!CT!ABS ? ABSRF"!CT!ABS==[.,,ZZZ] ? ZZZ>TERMIN
]
TERMIN

.BEGIN ABSRF		;PLACE TO KEEP NNNABS SYMBOLS
.END

ABSREF [SYSMBF		;SYSTEM MESSAGE BUFFER
	TOIP		;TTY OUTPUT PTR
	TOBEP		;.., END OF BUFFER
----
	TOBL		;TTY OUTPUT BUFFER LENGTH
	SYSCON		;SYSTEM TTY NUMBER
	SYSMLNG		;LOG 2 OF NUMBER OF 4-WORD BLOCKS
]

DOWTAB:	SIXBIT/SUN/
	SIXBIT/MON/
	SIXBIT/TUE/
	SIXBIT/WED/
	SIXBIT/THU/
	SIXBIT/FRI/
	SIXBIT/SAT/

; SYSTEM MESSAGE BUFFER CONTAINS 8-WORD ENTRIES AS FOLLOWS:
;	ABCDEF,,ASCIZ
;	ARG1
;	...
;	ARG6
;	TIME
; A..F = FORMAT OF ARG1..ARG6 RESPECTIVELY, CODED:
FMTBL:	0	;0 END OF MESSAGE
	TYPOCT	;1 FULL WORD OCTAL
	TYPDEC	;2 FULL WD DECIMAL
	TYPHAF	;3  " WITH COMMAS
	TYCRLF	;4 DO CR
	CPOPJ	;5 ?
	TYPSIX	;6 SIXBIT
	TYPASZ	;7 ASCIZ

CPOPJ:	POPJ P,

CLSCRN:	ASCIZ/C/
CRLF:	ASCIZ/
/

CMACMA:	ASCIZ/,,/

SEP:	ASCIZ/-----
/

MEMHOL:	ASCIZ\
WARNING: THERE IS A HOLE IN MEMORY
\

TYIC==2			;TTY INPUT CHANNEL
TYOC==1			;TTY OUTPUT CHANNEL
TYO=<.IOT TYOC,>	;INSTRUCTION TO OUTPUT A CHAR
;;; MAIN PROGRAM

PROGRAM SYSMSG

	REGISTER A,B,C,F,PT,CH,COUNT

	.OPEN TYIC, [.UAI,,'TTY]	;JUST SO CAN GET INTERRUPTS ??
	 .VALUE
	.OPEN TYOC, [20+.UAO,,'TTY]
	 .VALUE

	CALL RITUAL		;ASSURANCE OF PURITY

	SETZM JCL		;GET JCL (MESSAGE PREFIX)
	MOVE A,[JCL,,JCL+1]
	BLT A,JCLP-1
	.BREAK 12,[5,,JCL]
	MOVE A,[440700,,JCL]
	MOVEM A,JCLP
JCHACK:	ILDB B,A		;MAKE ASCIZ WITH NO LINE TERMINATOR
	CAIL B,"a		;ALSO UPPER-CASE IT
	 SUBI B,40
	CAIG B,"Z
	 DPB B,A
	CAIL B,40
	 JRST JCHACK
	MOVEI B,0
	DPB B,A

	.RDTIME A,
	MOVEM A,.M"TIME'	;SYSTEM TIME NUMBER
	.RLPDTM A,
	LDB B,[320300,,B]
	MOVEM B,.M"DOW'		;CORRESPONDING DAY OF WEEK
	IDIVI A,86400.
	MOVEM B,.M"TOD'		;OFFSET FROM MIDNIGHT IN SECONDS
	CALL TYPE,CLSCRN	;CLEAR SCREEN
	MOVEI COUNT, 1		;SET UP COUNT OF MESSAGE SLOTS
	LSH COUNT, SYSMLNG	;..
	CAILE COUNT,BUFL*8
	 .LOSE			;SYSTEM BUFFER GOT BIGGER
	MOVSI A,SYSMBF		;COPY SYSTEM BUFFER
	HRRI A,BUF
	BLT A,BUF+BUFL-1
	MOVE C,COUNT
SORT:	MOVEI CH,-1(COUNT)	;THEN SORT BY TIME
	MOVEI PT,BUF
SORT1:	MOVE A,7(PT)
	CAMG A,7+8(PT)
	 JRST SORT2
	REPEAT 8,[
	 MOVE A,.RPCNT(PT)
	 EXCH A,.RPCNT+8(PT)
	 MOVEM A,.RPCNT(PT) ]
SORT2:	ADDI PT,8
	SOJG CH,SORT1
	SOJG C,SORT
	MOVEI PT,BUF		;SET UP POINTER TO BUFFER
LOOP:	UNTIL [SOJLE COUNT,][	;PRINT ALL MESSAGES
	 SKIPN A, (PT)		;PICK UP HEADER WORD
	  JRST NXLOOP		;ZERO => NO MSG HERE
	 HLLZ F,A		;F ARG FORMAT BITS 
	 HRLI A,440700		;A ASCIZ POINTER
	 CALL PRINTP,A		;SHOULD THIS MESSAGE BE PRINTED?
	 JUMPE T,NXLOOP
	 MOVEI C,1(PT)		;C PNTR TO NEXT ARG
LOOP1:	 ILDB B,A
	 JUMPE B,LOOP2
	 IF [CAILE B,7][PUSHJ P,ARGSOT]
	 ELSE [TYO B]
	 JRST LOOP1

LOOP2:	 WHILE [SKIPN F][	;DISPLAY THE ARGUMENTS
	  TYO [40]		;PUT A SPACE BETWEEN ARGS
	  PUSHJ P,ARGOT
	  ]
	 TYO [40]
	 CALL PTIME,7(PT)	;PRINT THE TIME
	 CALL TYPE,CRLF
NXLOOP:	 ADDI PT, 8		;ADVANCE TO NEXT MESSAGE
	 ];END UNTIL LOOP

; Display any lines that are on the system job console

	CALL TYPE,SEP
	MOVEI C, SYSCON		;-> SYSTEM JOB TTY
	MOVE PT, TOIP(C)	;SCAN THROUGH
SYFNDL:	PUSHJ P, SYGET		;FIND FIRST FULL LINE
	CAIE A, 15
	 JRST SYFNDL

SYTYPE:	PUSHJ P, SYGET		;NOW DISPLAY WHAT'S THERE
	CAIN A,175		;FLUSH OLDE ALTMODES KEEPING TTY WARM
	 JRST SYTYPE
	TYO A
	JRST SYTYPE

SYGET0:	CAMN PT, TOBEP(C)	;GET CHR FROM TTY BUF
	 SUBI PT, TOBL		; WITH WRAP-AROUND
	ILDB A, PT		;GET CHAR
	CAMN PT, TOIP(C)	;KILL RETURN IF DONE
	 JRST KILL
	POPJ P,

SYGET:	PUSHJ P, SYGET0		;ROUTINE TO GET CHR AND DO %TD HACKS
	CAIN A,%TDFS
	 MOVEI A,40
	CAIN A,%TDCRL
	 MOVEI A,15
	TRNN A, 200		;AND DO SPECIAL CHAR PROCESSING
	 POPJ P,		; NORMAL CHAR JUST RETURN
	CAIE A,%TDMV1
	 CAIN A,%TDMV0
	  JRST SYGET1
	CAIE A,%TDMOV
	 JRST SYGET		;1-CHAR SEQ IGNORE
	PUSHJ P, SYGET0		;GOBBLE CURSOR MOTION
	PUSHJ P, SYGET0		;ASSUMING INTR LEVEL HAS PROCESSED
SYGET1:	PUSHJ P, SYGET0		;GOBBLE CURSOR MOTION
	PUSHJ P, SYGET0		;ASSUMING INTR LEVEL HAS PROCESSED
	CAIE A, 0		;SKIP IF IS PROBABLY CRLF
	 SKIPA A, [40]		;OTHERWISE IS PROBABLY SPACE
	MOVEI A, 15		;NOW CHANGE CURSOR MOTION TO CRLF
CPOPJ:	POPJ P,

KILL:	.BREAK 16, 040000

ARGSOT:	PUSH P,A
	PUSH P,B
	MOVE A,B		;COUNT OF ARGS TO OUTPUT
ARGSO1:	PUSHJ P,ARGOT
	TYO [40]
	SOJG A,ARGSO1
	POP P,B
	POP P,A
	POPJ P,

ARGOT:	LDB B,[410300,,F]	;PICK UP ARG TYPE CODE
	CALL @FMTBL(B),@C	;DISPLAY THE ARGUMENT
	LSH F,3			;ADVANCE TO NEXT TYPE CODE
	AOJA C,CPOPJ		;ADVANCE TO NEXT ARG

.END

PRINTP:	PROCEDURE AMBP		;RETURN NON-ZERO IN T IF MSG MATCHES JCL

	REGISTER MBP,JBP,MCH,JCH

	MOVE MBP,AMBP
	MOVE JBP,JCLP
LP:	ILDB MCH,MBP
	ILDB JCH,JBP
	JUMPE JCH,WIN
	CAMN JCH,MCH
	 JRST LP
LOSE:	MOVEI T,0
	RETURN

WIN:	MOVEI T,1
	RETURN

	.END
;;; TIME PRINTING
PTIME:	PROCEDURE TIM

	REGISTER A,B,C,D,E

	MOVE A,TIM
	SUB A,TIME
	IDIVI A,30.		;OFFSET IN SECONDS FROM KNOWN TIME
	ADD A,TOD		;CONVERT TO OFFSET FROM MIDNIGHT TODAY
	IDIVI A,86400.		;A DAYS, B SECONDS
	IF [SKIPL B][		;FIX DIVISION FOR POSITIVE REMAINDER
	 SUBI A,1
	 ADDI B,86400. ]
	PUSH P,B
	ADD A,DOW		;FIND DAY OF WEEK OF THAT DAY
	IDIVI A,7
	SKIPGE B		;FIX DIVISION FOR POSITIVE REMAINDER
	 ADDI B,7
	CALL TYPSIX,DOWTAB(B)
	TYO [40]
	POP P,A
	IDIVI A,60.		;A MINUTES, B SECONDS
	MOVE C,B
	IDIVI A,60.		;A HOURS, B MINUTES
	CALL TYPDC2,A
	TYO [":]
	CALL TYPDC2,B
	TYO [":]
	CALL TYPDC2,C
	RETURN

.END
;;; ROUTINE TO TYPE AN ASCIZ STRING

TYPE:  PROCEDURE STRING

	REGISTER PT,CH

	MOVEI PT, STRING	;SET UP B.P. TO STRING
	TLOA PT, 440700		;..
LOOP:	TYO CH
	ILDB CH, PT		;GET NEXT CHAR
	JUMPN CH, LOOP		;AND IF NOT DONE, TYPE IT
	RETURN
.END

;;; ROUTINES TO FORMAT DATA IN WONDROUS WAYS

TYPOCT:  PROCEDURE DATA

	REGISTER LH,RH

	HLRZ LH,DATA
	HRRZ RH,DATA
	IF [JUMPN LH,][
		CALL TYPNUM,LH,[8.]
		CALL TYPE,CMACMA
		      ]
	CALL TYPNUM,RH,[8.]
	RETURN
.END

TYPDEC:  PROCEDURE DATA

	REGISTER DAT

	IF [SKIPL DAT, DATA][	;PUT MINUS SIGN IF NEEDED
	   TYO ["-]
	   MOVMS DAT
	   ]
	CALL TYPNUM,DAT,[10.]
	RETURN
	.END

TYPDC2:  PROCEDURE DATA

	REGISTER DAT

	IF [SKIPL DAT, DATA][	;PUT MINUS SIGN IF NEEDED
	   TYO ["-]
	   MOVMS DAT
	   ]
	CAIGE DAT,10.
	 TYO ["0]
	CALL TYPNUM,DAT,[10.]
	RETURN
	.END

TYPNUM:  PROCEDURE DATA,RADIX

	REGISTER NUM,REM

	MOVE NUM, DATA
	PUSHJ P, FROB
	RETURN

FROB:	IDIV NUM, RADIX
	HRLM REM, (P)
	SKIPE NUM
	 PUSHJ P, FROB
	HLRZ REM, (P)
	ADDI REM, "0
	TYO REM
	POPJ P,
	.END

TYPHAF:  PROCEDURE DATA

	REGISTER DAT,LH

	MOVE DAT, DATA
	IF [TLNN DAT,-1][	;IF HAS LEFT HALF
	   HLRZ LH, DAT
	   CALL TYPOCT,LH
	   TYO [",]
	   TYO [",]
	   ]
	HRRZS DAT
	CALL TYPOCT,DAT
	RETURN
	.END

TYCRLF:  PROCEDURE IGNORED

	CALL TYPE,CRLF
	RETURN
	.END

TYPSIX:  PROCEDURE DATA

	REGISTER CH,WRD

	MOVE WRD, DATA
6LOOP:	SETZ CH,
	LSHC CH, 6
	ADDI CH, 40
	TYO CH
	JUMPN WRD, 6LOOP
	RETURN
	.END

TYPASZ:  PROCEDURE PT

	REGISTER A

	MOVE A,PT		;CAN'T INDIRECT PARAM
	CALL TYPE,@A
	RETURN
	.END
;;; PURIFICATION RITUAL

OITSVRS:0			;ITS VERSION PURIFIED FOR
OUSRSTG:0			;EXTRA Check

RITUAL:  PROCEDURE

	.RSYSID TT,
	MOVE T, [SQUOZE 0,USRSTG]	;SEE IF SYSTEM CHANGED
	.EVAL T,
	 JFCL
	CAMN TT, OITSVRS
	CAME T, OUSRSTG
	JRST NOGOOD
	RETURN	

NOGOOD:	CALL PURIFY			;WRONG SYS VERSION OR NOT PURE
	RETURN				;YET SO REPURIFY

.END

ABSTB1:	ABSTAB
ABSTB2:

PURIFY:  PROCEDURE 

	REGISTER I,L,V,LIM

	.VALUE [ASCIZ\:New system version; must repurify.
Take paws off keys and wait.

p\]
	MOVEI LIM, IMMEDS-ABSTB1	;LIMIT ON REMAPPABLENESS
	MOVSI I, <ABSTB1-ABSTB2>/2	;SCAN ABSTAB
EVLOOP:	MOVE V, ABSTB1(I)		;GET SYMBOL
	.EVAL V,			;EVALUATE IT
	 .VALUE				;NOT THERE???
	CAIG LIM, (I)			;SKIP FOLLOWING CODE
	 JRST EVLP00			; IF IMMEDIATE SYMBOL
	CAIGE V, REMAPT			;REMAP LOW CORE
	 SUBI V, REMAPT			;INTO HIGH CORE
EVLP00:	ADDI I, 1
	MOVE TT, ABSTB1(I)		;FOLLOW PATCH LIST
PLOOP:	JUMPE TT,EVLPNX			;JUMP IF END OF LIST
	MOVE L,TT
	HLRZ TT,(L)			;LOC TO PATCH
	HRRM V,(TT)			;PATCH IT
	HRRZ TT,(L)			;LINK TO NEXT
	JRST PLOOP			;AND TRY AGAIN

EVLPNX:AOBJN I, EVLOOP			;NEXT SYMBOL

; HAVING PATCHED, SET UP PAGE TABLE
; FOR NOW, WE DON'T ACTUALLY PURIFY ANY PAGES...

	.RSYSID V,			;REMEMBER ITS VERSION
	MOVEM V, OITSVRS
	MOVE V, [SQUOZE 0,USRSTG]	;AND A KLUDGEY MACHINE CHECK
	.EVAL V,
	 .VALUE
	MOVEM V, OUSRSTG

	SETZM V
	MOVEI TT, REMAPT_-10.		;GET ABS PAGES
	HRLI TT, <REMAPT-400000>_-10.	;FROM 0 TO 400000
	MOVE T, TT
GETMOR:	.CALL CORBLK,[#210000,#-1,TT,#400000,T]
	 JRST .+2		;ERROR RETURN
	 JRST GOTIT
	.SUSET [.RBCHN,,V]	;FIND OUT WHAT LOST
	.CALL STATUS,V,V	;GET ERROR CODE
	 .VALUE
	LDB V, [270600,,V]	;..
	CAIE V, 32		;CAN'T GET THAT ACCESS
	 .VALUE			;NO - UNCLEAR
	ADD TT, [40,,40]	;YES - BITING MD10'S HAVE A 32K HOLE!
	MOVE T, TT
	JUMPL TT, GETMOR

GOTIT:	JUMPE V,GOTIT1
	 CALL TYPE,MEMHOL
GOTIT1:	MOVEI TT, <1000000-REMAPT>_-10.	;DO REMAPPAGE
	HRLI TT, -<REMAPT_-10.>
	SETZ T,
	.CALL CORBLK,[#210000,#-1,TT,#400000,T]
	 .VALUE
	.VALUE [ASCIZ\:PDUMP SYS1;TS SYSMSG
P\]
	RETURN
.END PURIFY

BUFL==400
BUF:	BLOCK BUFL

JCL:	BLOCK 20
JCLP:	440700,,JCL

CONSTANTS
VARIABLES

REMAPT=<.+1777>&776000	;FIRST NON USED PAGE

END SYSMSG
