PDP-10 Archive: 7-sources/msuuo.mac from bb-h138f-bm

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-sources/msuuo.mac

There are 7 other files named msuuo.mac in the archive. Click here to see a list.

;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
;	       1983,1984,1985,1986    Maynard, Massachusetts, USA


	TITLE MSUUO - UUO handler for MS

	SEARCH GLXMAC,MSUNV
	PROLOG (MSUUO)

	CPYRYT
	MSINIT

;Global routines defined herein

	INTERNAL UUOH

;Global routines defined elsewhere

;MS.MAC
	EXTERNAL CKEXIT, MSGIDX, PRTSEQ, PRTSQS, RDELAY

;MSUTL.MAC
	EXTERNAL CLRCTO, CMDRES, CMDER1, CRIF, CRLF, KBFTOR, R, RSKP, TNOUT

;Global data items defined elsewhere

;MS.MAC
	EXTERNAL LASTM

;MSSEQ.MAC
	EXTERNAL LSTMSG

;Local storage

	IMPUR0

UUOACS:	BLOCK 20		;Saved ACs during UUO
LASTN:	BLOCK 1

	PURE

 SUBTTL Uuo handler

UUOH:	MOVEM 16,UUOACS+16	; Save all AC's
	MOVEI 16,UUOACS
	BLT 16,UUOACS+15
	LDB A,[POINT 9,40,8]	; Get opcode field
	CALL @UUOS(A)		; Do the right routine
	MOVSI 16,UUOACS		; Restore ac's
	BLT 16,16
	RET

UUOS:	0
	%PRINT
	%TYPE
	%ETYPE
	%ERROR

%PRINT:	HRRZ A,40		; Get byte
	$CALL KBFTOR
	RET

%TYPE:	CALL TYCRIF		; Check if we should do a crlf
	HRRZ A,40		; Get string
	HRLI A,(POINT 7,)
	$CALL KBFTOR
	RET

TYCRIF:	MOVE A,40		; Get instruction
	TLNE A,(<10,0>)		; Wants cr all the time?
	 CALLRET CRLF		; Yes
	TLNE A,(<1,0>)		; Wants fresh line?
	 CALLRET CRIF		; Yes
	RET

%ERROR:	CALL CLRCTO		; Clear ctrl-O
	CALL CRIF		; Get a fresh line
	MOVE B,40		; Get instruction
	TLNE B,(<10,0>)		; Wants %?
	 SKIPA A,["?"]		; No
	 MOVEI A,"%"
	$CALL KBFTOR
	TRNN B,-1		; Any message to print?
	 JRST %ERR2		; No
	CALL %ETYE0		; Yes,print it out
	MOVEI A," "
	$CALL KBFTOR
	MOVE B,40		; And recover instruction
%ERR2:	TLNN B,(<4,0>)		; Wants JSYS error message?
	 JRST %ERR3
	HRROI A,[ASCIZ /because: /]
	$CALL KBFTOR
   TOPS20<
	$CALL K%FLSH
	MOVEI A,.PRIOU
	HRLOI B,.FHSLF		; This fork
	SETZ C,
	ERSTR
	 JFCL
	 JFCL
   >;End TOPS20
   TOPS10<
	$TEXT (KBFTOR,<^E/[-1]/>)
   >;End TOPS10

%ERR3:	MOVEI A,^D10		; Ten seconds for error msgs
	CALL RDELAY		; Insure user gets time to read message
	LDB A,[POINT 2,40,12]	; Get low order bits of ac field
	JRST %ERRS(A)

%ERRS:	JRST CMDER1		; 0 - cause command error reparse
	FATAL (Unimplemented error macro invoked)
	CALL CKEXIT		; 2 - return to exec
	RET			; 3 - return to user

%ETYPE:	CALL TYCRIF		; Type a cr maybe
%ETYE0:	HRRZ U,40
%ETYS0:	HRLI U,(<POINT 7,0>)	; Get byte pointer to string
%ETYP1:	ILDB A,U		; Get char
	JUMPE A,R		; Done
	CAIE A,"%"		; Escape code?
	 JRST %ETYP0		; No, just print it out
	SETZ V,			; Reset ac
%ETYP2:	ILDB A,U
	CAIL A,"0"		; Is it part of addr spec?
	 CAILE A,"7"
	 JRST %ETYP3		; No
	IMULI V,10		; Yes, increment address
	ADDI V,-"0"(A)
	JRST %ETYP2
%ETYP3:	CAIGE A,"A"
	 JRST %ETYP0
	CALL @%ETYTB-"A"(A)	; Do dep't thing
	JRST %ETYP1

%ETYP0:	$CALL KBFTOR
	JRST %ETYP1

%ETYTB:	%ETYPA			; A - Print time
	%ETYPB			; B - Print date
	CRLF			; C - CRLF
	%ETYPD			; D - print decimal
	%ETYP0			; E
	%ETYP0			; F - floating  *** WHY??? ***
	%ETYP0			; G
	%ETYPH			; H - rh as octal
	%ETYP0			; I
	%ETYPJ			; J - filename
	%ETYP0			; K
	%ETYPL			; L - list
	%ETYPM			; M - current msg number
	%ETYPN			; N - host name
	%ETYPO			; O - octal
	%ETYPP			; P - plural (decimal)
	REPEAT 2,<%ETYP0>	; Q, R
	%ETYPS			; S - string
	%ETYPT			; T - date and time
	%ETYPU			; U - user name
	REPEAT 5,<%ETYP0>	; V, W, X, Y, Z

%ETYPA:	JUMPE V,.+2		; If AC field specified
	 SKIPA B,UUOACS(V)	; Use it
	 SETO B,		; Otherwise use now
	$TEXT (KBFTOR,<^C/B/^A>)
	RET

%ETYPT:	JUMPE V,.+2		; If ac field spec'd
	 SKIPA B,UUOACS(V)	; Use it
	 SETO B,		; Else use now
   TOPS20<
	PUSH P,B		; Save date/time
	$CALL K%FLSH		; Insure synchrony
	POP P,B			; Restore
	MOVX A,.PRIOU		; Output to terminal
	MOVX C,OT%DAY!OT%FDY!OT%FMN!OT%4YR!OT%DAM!OT%SPA!OT%NSC!OT%TMZ!OT%SCL
	ODTIM			; Fancy date/time output
	 JFCL
   >;End TOPS20
   TOPS10<
	$TEXT (KBFTOR,<^H15/B/^A>)
   >;End TOPS10
	RET

%ETYPB:	JUMPE V,.+2		; If AC field specified
	 SKIPA B,UUOACS(V)	; Use it
	 SETO B,		; else use now
	$TEXT (KBFTOR,<^H9/B/^A>)
	RET

%ETYPD:	SKIPA C,[^D10]		; Decimal
%ETYPO:	 MOVEI C,10		; Octal
	MOVE B,UUOACS(V)	; Get data
%ETYO0:	MOVEI A,.PRIOU
	MOVEM B,LASTN		; Save for %P
	CALL TNOUT
	RET

%ETYPM:	MOVEI C,^D10		; Decimal
	HRRZ B,UUOACS+M		; Current message
	AOJA B,%ETYO0		; Zero is msg 1

   REPEAT 0,<

%ETYPF:	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	SETZ C,
	FLOUT
	 JFCL
	RET

   >;End REPEAT 0

%ETYPP:	MOVE B,LASTN		; Get last number printed
	CAIN B,1		; C(b) := number printed
	 RET			; If 1 , then no plural
	MOVEI A,"s"		;  else - put out "s"
	$CALL KBFTOR
	RET			; and return

%ETYPL:	SETOB M,LSTMSG		; Init loop and sequence printer
%ETYL1:	MOVE B,UUOACS(V)	; Get bit to test
	MOVEI A,1(M)		; Starting message #
%ETYL2:	CAMLE A,LASTM		; Done?
	 JRST PRTSQS		; Yes - wrapup message sequence
	GTMBL (A,C)
	TDNN B,MSGBTS(C)	; Want this one?
	 AOJA A,%ETYL2		; No - try more
	MOVEI M,(A)		; Yes - use it
	CALL PRTSEQ		; Print sequence
	JRST %ETYL1		;  Then try next message till done

%ETYPH:	MOVEI C,10
	HRRZ B,UUOACS(V)
	JRST %ETYO0

%ETYPJ:				; Type a filespec
   TOPS20<
	$CALL K%FLSH
	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	SETZ C,
	JFNS
	RET
   >;End TOPS20
   TOPS10<
	MOVE A,UUOACS(V)	; Get IFN
	SETO B,			; Obtain exact filespec
	$CALL F%FD		;  ..
	$TEXT (KBFTOR,<^F/A/^A>)
	RET
   >;End TOPS10

%ETYPN:
   TOPS20<
	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	MOVEI C,10		; Just in case
	CVHST
	 NOUT
	 JFCL
   >;End TOPS20
   TOPS10<
	FATAL (ARPANET doesn't exist on TOPS10 systems)
   >;End TOPS10
	RET

%ETYPS:	PUSH P,U
	SKIPE U,UUOACS(V)
	 CALL %ETYS0		; Recursive call
	POP P,U
	RET

%ETYPU:	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)

   TOPS20<
	DIRST
	 JFCL
   >;End TOPS20

   TOPS10<
	$TEXT (KBFTOR,<^U/B/^A>)
   >;End TOPS10

	RET

	END

; *** Edit 2486 to MSUUO.MAC by PRATT on 22-Nov-85
; Copyright statements