Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-06 - 43,50417/dispat.mac
There are no other files named dispat.mac in the archive.
TITLE DISPAT, A GENERAL PROGRAM DISPATCHER
SUBTTL	M.LEVIN - 19-JUL-76

NAMAC==0	;.SGNAM - FILENAME
RUNAC==1	;USED TO PERFORM THE RUN
T1==2		;TEMP REGISTER
PTR==3		;POINTER
OPT==4		;OPTION
N==5		;NUMBERS, WORDS, ETC.......
CH==N+1		;FOLLOWED BY CHARACTER
PPNAC==7	;.SGPPN - DIRECTORY NAME
F==10		;FLAG REGISTER
	RENFLG==1
DEVAC==11	;.SGDEV - DEVICE NAME
MX==12		;MESSAGE INDEX
P==17

GO:	JRST	SETUP		;GETS REPLACED BY [TDZA RUNAC,RUNAC]
	 MOVSI	RUNAC, 1	;RUN OFFSET

	SKIPN	RUNDEV		;HAS A DEVICE BEEN PRE-SET?
	 MOVEM	DEVAC, RUNDEV	;NO, USE CURRENT VALUE
	SKIPN	RUNNAM		;DITTO FILENAME
	 MOVEM	NAMAC, RUNNAM
	SKIPN	RUNPPN		;AND PPN
	 MOVEM	PPNAC, RUNPPN

	MOVE	T1, .JBREL##	;HIGHEST ADDRESS
	CAILE	T1, 5K		;MORE THAN 5K?
	 MOVEM	T1, RUNCOR	;YES, PASS IT ON

	MOVE	P, [IOWD LIFLNG, LIFO]
	SKIPE	MSGPTR		;ANY MESSAGE?
	 PUSHJ	P, TYPMSG	;YES, TYPE IT
	SKIPE	STOP		;TRY TO RUN?
	 EXIT	1,		;NO (THO CONT WILL WORK)

	HRRI	RUNAC, RUNBLK
	RUN	RUNAC,
	 HALT
SETUP:	MOVE	T1, [TDZA RUNAC,RUNAC]
	MOVEM	T1, GO		;SET UP FOR "REAL" START
	MOVEI	T1, REE		;GET REENTER ADDRESS
	MOVEM	T1, .JBREN##	;SET IT
	OUTSTR	[ASCIZ /
DISPATCH GENERATOR
IN THE FOLLOWING DIALOGUE, TYPE <CR> TO LEAVE A VALUE BLANK/]
	TRZ	F, RENFLG
	JRST	SETUP2

REE:	OUTSTR	[ASCIZ /
DISPATCHER BUILT BY THE DISPATCH GENERATOR
IN THE FOLLOWING DIALOGUE, TYPE <CR> TO USE PRESET VALUE (IF ANY),
TYPE <ESC> TO CLEAR OUT AN EXISTING VALUE/]
	TRO	F, RENFLG
SETUP2:	OUTSTR	[ASCIZ /
(BLANK VALUES WILL DEFAULT TO THE VALUE OF THE RUNNING PROGRAM):
/]
	RESET
	MOVE	P, [IOWD LIFLNG,LIFO]

	SKIPN	N, RUNDEV	;PRE-SET DEVICE?
	 JRST	SETDEV		;NO, ASK FOR VALUE
	OUTSTR	[ASCIZ /PRESET TO RUN FROM /]
	PUSHJ	P, TYPDEV	;TYPE IT
	OUTSTR	[ASCIZ / -- /]
SETDEV:	OUTSTR	[ASCIZ /WHAT DEVICE OR ERSATZ AREA? /]
	PUSHJ	P, GETSIX
	MOVEI	T1, RUNDEV	;SPECIFY TARGET LOCATION
	PUSHJ	P, SETIT	;AND SET VALUE FROM N

	SKIPN	N, RUNNAM	;ANY PRESET PROGRAM NAME?
	 JRST	SETNAM		;NO, JUST ASK
	OUTSTR	[ASCIZ /PRESET TO RUN /]
	PUSHJ	P, TYPSIX
	OUTSTR	[ASCIZ / -- /]
SETNAM:	OUTSTR	[ASCIZ /WHAT PROGRAM? /]
	PUSHJ	P, GETSIX
	MOVEI	T1, RUNNAM
	PUSHJ	P, SETIT	;SET NAME

	SKIPN	T1, RUNPPN	;ANY PRESET PPN?
	 JRST	SETPPN
	OUTSTR	[ASCIZ /PRESET TO RUN FROM /]
	PUSHJ	P, TYPPPN
	OUTSTR	[ASCIZ / -- /]
SETPPN:	OUTSTR	[ASCIZ /WHAT PPN? /]
	PUSHJ	P, GETOCT	;PROJ
	JUMPE	N, NULPPN	;IF NO PROJ, DONT TRY PROG
	HRRZI	T1, (N)
	
	PUSHJ	P, GETOCT	;PROG
	HRLI	N, (T1)		;PPN
NULPPN:	PUSHJ	P, SCNEOL
	MOVEI	T1, RUNPPN
	PUSHJ	P, SETIT	;SET PPN
	OUTSTR	[ASCIZ /
DISPATCH CONTROL -- DO YOU WISH TO
 D - DISPATCH WITHOUT A MESSAGE
 W - WARN USER, THEN DISPATCH
 F - TYPE A FATAL ERROR MESSAGE, BUT STILL DISPATCH
 X - TYPE A FATAL MESSAGE AND ABORT
/]
	LDB	CH, [POINT 6, .JBVER##, 17]
	JUMPE	CH, SETOPT
	OUTSTR	[ASCIZ /
CURRENTLY SET TO OPTION /]
	ADDI	CH, "A"-1
	OUTCHR	CH
	SKIPE	MSGPTR
	 OUTSTR	[ASCIZ / WITH THIS MESSAGE:
/]
	PUSHJ	P, TYPMSG
SETOPT:	OUTSTR	[ASCIZ /
WHICH OPTION DESIRED (D,W,F,X)? /]
	PUSHJ	P, GETOPT
	SETZ	OPT,
	CAIN	N, "D"		;DISPATCH
	 MOVEI	OPT, 2
	CAIN	N, "W"		;WARNING
	 MOVEI	OPT, 3
	CAIN	N, "F"		;FATAL
	 MOVEI	OPT, 4
	CAIN	N, "X"		;FATAL AND ABORT
	 MOVNI	OPT, 1
	JUMPE	OPT, SETOPT	;LOOP TIL GOOD OPTION SEEN
	SUBI	OPT, 2		;X=-1, D=0, W=1, F=2
	SETOM	.JBVER##	;SET VERSION NUMBER
	SUBI	N, "A"-1	;A=1, B=2, ETC.
	DPB	N, [POINT 6, .JBVER##, 17]	;INCL. TYPE
	
	SETZM	STOP
	SKIPGE	OPT		;OPT X?
	 SETOM	STOP		;YES, TURN ON STOP FLAG
	JUMPE	OPT, OPT.D	;NO MESSAGE FOR OPT D
	MOVE	PTR, [POINT 7, MESSAGE, 20]	;POINTER TO 3RD CHAR
	MOVEI	CH, "?"		;FATAL MESSAGE
	CAIN	OPT, 1		;WARNING?
	 MOVEI	CH, "%"		;YES, USE "%" INSTEAD
	DPB	CH, PTR		;DEPOSIT THE 3RD CHARACTER
	SKIPN	MSGPTR		;ANY MESSAGE PRESET?
	 JRST	SETMSG		;NO, JUST GET NEW ONE
ASKRTN:	OUTSTR	[ASCIZ /RETAIN OLD TEXT (Y,N)? /]
	PUSHJ	P, GETOPT
	CAIN	N, "Y"
	 JRST	ALLSET		;IF YES, ALL DONE
	CAIE	N, "N"
	 JRST	ASKRTN
SETMSG:	OUTSTR	[ASCIZ /
TYPE TEXT OF MESSAGE (^D,^N,^P AS FLAGS, TERMINATE WITH <ESC>):

/]
	LDB	CH, PTR		;GET THE CHARACTER BACK
	OUTCHR	CH		;DISPLAY 3RD CHAR
	SETZ	MX,		;CLEAR INDEX TO POINTERS
MSG.0:	HRRZM	PTR, MSGPTR(MX)
MLOOP:	INCHWL	CH		;GET A CHAR
MLOOP1:	CAMN	PTR, [POINT 7,MSGEND,27]	;END OF THE BUFFER?
	 JRST	TOOBIG		;YES, ABORT
	IDPB	CH, PTR		;SAVE THE CHARACTER

	CAIN	CH, 33
	 JRST	EOM
	CAIN	CH, 12
	 JRST	EOL
	CAIN	CH, "^"
	 JRST	FLAGCH		;SPECIAL HANDLING
	JRST	MLOOP

TOOBIG:	OUTSTR	[ASCIZ /
MESSAGE IS TOO LONG FOR THE BUFFER -- END OF MESSAGE FORCED NOW!
/]
EOM:	SETZ	CH,
	DPB	CH, PTR		;MAKE IT AN ASCIZ STRING
ALLSET:	OUTSTR	[ASCIZ /
PROGRAM MAY NOW BE SAVED (GET AND REENTER TO CHECK SETTINGS)
/]
	EXIT	1,
	EXIT

EOL:	INCHWL	CH		;GET 1ST CHAR OF NEXT LINE
	CAIN	CH, "?"		;IF NOT A "?"
	 CAIE	OPT, 1		;OR NOT OPT 1 - WARNING
	  JRST	MLOOP1		;GO ANALYZE IT
	OUTSTR	[ASCIZ /
WARNING MESSAGE MAY NOT HAVE LINES FLAGGED AS FATAL
INITIAL "?" WILL BE IGNORED
/]
	JRST	EOL
FLAGCH:	INCHWL	CH		;GET A CHARACTER
	SETZ	T1,
	CAIE	CH, "D"
	 CAIN	CH, "D"+40
	  MOVSI	T1, MSGDEV	;DEVICE
	CAIE	CH, "N"
	 CAIN	CH, "N"+40
	  MOVSI	T1, MSGNAM	;NAME
	CAIE	CH, "P"
	 CAIN	CH, "P"+40
	  MOVSI	T1, MSGPPN	;PPN
	JUMPE	T1, MLOOP1	;PROCESS NORMALLY IF NONE OF ABOVE
	HLLM	T1, MSGPTR(MX)	;STORE ROUTINE NAME
	SETZ	CH,		;ASCII NUL
	DPB	CH, PTR		;END MESSAGE PORTION
	ADDI	MX, 1		;UPDATE INDEX
	CAIL	MX, MPARTS	;STILL IN RANGE?
	 JRST	TOOMNY		;NOPE! ABORT
	ADDI	PTR, 1		;POINT TO START OF NEXT WORD
	HRLI	PTR, (<POINT 7,0>)	;UPDATE CHAR PTR
	JRST	MSG.0		;GO START NEXT PART

TOOMNY:	OUTSTR	[ASCIZ /
TOO MANY PARTS TO THE MESSAGE -- END OF MESSAGE FORCED NOW!
/]
	JRST	EOM

OPT.D:	SETZM	MSGPTR		;CLEAR MESSAGE
	JRST	ALLSET

MSGDEV:	SKIPN	N, RUNDEV
	 MOVE	N, DEVAC
TYPDEV:	PUSHJ	P, TYPSIX
	OUTCHR	[":"]
	POPJ	P,

MSGNAM:	SKIPN	N, RUNNAM
	 MOVE	N, NAMAC
	JRST	TYPSIX

MSGPPN:	SKIPN	T1, RUNPPN
	 MOVE	T1, PPNAC
TYPPPN:	OUTCHR	["["]
	HLRZ	N, T1
	PUSHJ	P, TYPOCT
	OUTCHR	[","]
	HRRZI	N, (T1)
	PUSHJ	P, TYPOCT
	OUTCHR	["]"]
	POPJ	P,
GETSIX:	SETZ	N,		;INITIALIZE
	MOVE	T1, [POINT 6, N]
G6LOOP:	INCHWL	CH		;GET A CHARACTER
	CAIG	CH, "9"		;DIGIT?
	 CAIGE	CH, "0"
	  SKIPA
	   JRST	GOTSX		;YES, GO PROCESS IT
	CAIG	CH, "Z"+40	;LOWER CASE LETTER?
	 CAIGE	CH, "A"+40
	  SKIPA
	    SUBI	CH, 40	;YES, MAKE IT UPPER CASE
	CAIG	CH, "Z"		;UPPER CASE LETTER?
	 CAIGE	CH, "A"
	  JRST	SCNEOL		;NONE OF THE ABOVE, EXIT
GOTSX:	SUBI	CH, " "-' '	;CONVERT TO SIXBIT
	TLNE	T1, 770000
	 IDPB	CH, T1		;STORE IT IF THERE'S ROOM
	JRST	G6LOOP

GETOCT:	SETZ	N,		;INITIALIZE
GOCTLP:	INCHWL	CH
	CAIGE	CH, "8"		;OCTAL DIGIT?
	 CAIGE	CH, "0"
	  POPJ	P,		;NOPE, ALL DONE
	IMULI	N, 10		;FOLD IN NEW DIGIT
	ADDI	N, -"0"(CH)
	JRST	GOCTLP

GETOPT:	INCHWL	N		;FIRST CHAR DETERMINES OPTION
	CAIL	CH, "A"+40	;CONVERT LC TO UC
	 SUBI	N, 40
	MOVEI	CH, (N)
SCNEOL:	CAIN	CH, 33
	OUTSTR	[ASCIZ /
/]
	CAIE	CH, 12		;LF
	 CAIN	CH, 33		;OR ESC
	  POPJ	P,
	INCHWL	CH
	JRST	SCNEOL		;SCAN TO END OF LINE


TYPOCT:	IDIVI	N, 10		;DIVIDE BY 10 (OCTAL)
	HRLM	CH, 0(P)	;STORE DIGIT (CH = N+1)
	SKIPE	N		;FINISHED YET?
	 PUSHJ	P, TYPOCT	;NO, PROCESS NEXT DIGIT
	HLRZ	CH, 0(P)	;NOW RETRIEVE DIGIT
	ADDI	CH, "0"		;MAKE IT ASCII
	OUTCHR	CH		;AND TYPE IT
CPOPJ:	POPJ	P,		;THEN EXIT FOR NEXT

TYPSIX:	JUMPE	N, CPOPJ	;EXIT WHEN NO MORE CHARACTERS
	SETZ	CH,
	ROTC	N, 6		;BRING CHAR IN TO CH (CH = N+1)
	ADDI	CH, " "-' '	;MAKE IT ASCII
	OUTCHR	CH		;TYPE IT
	JRST	TYPSIX		;LOOP FOR NEXT
TYPMSG:	SETZ	MX,
TMLOOP:	MOVE	T1, MSGPTR(MX)
	
	OUTSTR	0(T1)
	HLRZS	T1
	JUMPE	T1, CPOPJ
	PUSHJ	P, 0(T1)
	AOJA	MX, TMLOOP

SETIT:	;N HAS VALUE, CH HAS TERMINATOR, T1 HAS POINTER
	JUMPE	N, BLANK	;JUMP IF BLANK VALUE
	MOVEM	N, 0(T1)	;STORE SPECIFIED VALUE
	POPJ	P,		;AND EXIT

BLANK:	CAIN	CH, 33		;WAS ESC USED?
	 SETZM	0(T1)		;YES, BLANK OUT WHATEVER'S THERE
	POPJ	P,		;NO, USE OLD VALUE (IF ANY)


RUNBLK:	RUNDEV:	.-.
	RUNNAM:	.-.
	RUNEXT:	0
		0
	RUNPPN:	.-.
	RUNCOR:	.-.

STOP:	BLOCK	1
   LIFLNG==20
LIFO:	BLOCK	LIFLNG
MESSAGE:ASCII /
/		;ALL MESSAGES BEGIN WITH CRLF
	BLOCK	^D1000	;ROOM FOR 5000 CHARACTERS ...
MSGEND:	BLOCK	1	;... PLUS A FEW MORE
    MPARTS==20
MSGPTR:	BLOCK MPARTS

END GO