Google
 

Trailing-Edge - PDP-10 Archives - tops10_tools_bb-fp64b-sb - 10,7/galtol/demo.mac
There are 7 other files named demo.mac in the archive. Click here to see a list.
TITLE	DEMO - APPLICATION DEMO PROGRAM

	SEARCH	DMOPRM			;DEMO DEFINITIONS
	DMODEF	(DEMO)			;DEFINE COMMON PARAMETERS

	LOC	<.JBVER==:137>
	EXP	%%DEMO			;VERSION NUMBER

	RELOC	0
SUBTTL	GALAXY initialization blocks


; GLXLIB INITIALIZATION BLOCK
IB:	$BUILD	(IB.SZ)			;SIZE OF BLOCK
	  $SET	(IB.PRG,FWMASK,%%.MOD)	;PROGRAM NAME
	  $SET	(IB.FLG,IP.STP,1)	;SEND STOPCODES TO ORION
	  $SET	(IB.PIB,FWMASK,PIB)	;ADDRESS OF PIB
	  $SET	(IB.INT,FWMASK,VECTOR)	;ADDRESS OF PSI VECTORS
	$EOB				;END OF BLOCK

; PID INITIALIZATION BLOCK
PIB:	$BUILD	(PB.MNS)		;SIZE OF BLOCK
	  $SET	(PB.HDR,PB.LEN,PB.MNS)	;LENGTH OF THIS BLOCK
	  $SET	(PB.FLG,IP.PSI,1)	;USE PSI FOR IPCF
	  $SET	(PB.FLG,IP.RSE,1)	;RETURN ON SEND FAILURES
;	  $SET	(PB.FLG,IP.JWP,1)	;USE A JOB-WIDE PID
;	  $SET	(PB.FLG,IP.SPF,1)	;CREATE A SYSTEM PID
	  $SET	(PB.INT,IP.CHN,IPCOFS)	;OFFSET TO IPCF INTRUPT BLOCK
;	  $SET	(PB.INT,IP.SPI,SP.CAT)	;PID IS FOR [SYSTEM]CATALOG
	  $SET	(PB.SYS,IP.SQT,^D511)	;INFINITE SEND QUOTA
	  $SET	(PB.SYS,IP.RQT,^D511)	;INFINITE RECEIVE QUOTA
	$EOB
SUBTTL	Impure data storage


PDL:	BLOCK	PDLSIZ			;PUSH DOWN LIST
SAB:	BLOCK	SAB.SZ			;SEND ARGUMENT BLOCK
MSG:	BLOCK	PAGSIZ+1		;IPCF MESSAGE STORAGE
MSGLEN:	BLOCK	1			;REQUESTED MESSAGE LENGTH
MSGBLK:	BLOCK	1			;ADDRESS OF CURRENT BLOCK IN MESSAGE
MSGCNT:	BLOCK	1			;COUNT OF MESSAGE BLOCKS TO PROCESS
APLCOD:	BLOCK	1			;APPLICATION CODE
VECTOR:!				;PSI VECTORS
VECIPC:	BLOCK	4			;IPCF VECTOR
   IPCOFS==<VECIPC-VECTOR>		;IPCF VECTOR OFFSET
SUBTTL	Program initialization and idle loop


DEMO:	JFCL				;NO CCL ENTRY
	MOVE	P,[IOWD	PDLSIZ,PDL]	;SET UP STACK
	MOVEI	S1,IPCINT		;IPCF INTERRUPT ROUTINE ADDRESS
	MOVEM	S1,VECIPC+.PSVNP	;SAVE IN VECTOR
	MOVEI	S1,IB.SZ		;IB LENGTH
	MOVEI	S2,IB			;IB ADDRESS
	PUSHJ	P,I%INIT##		;FIRE UP GLXLIB
	$CALL	I%ION			;TURN ON THE PSI SYSTEM
	PUSHJ	P,INITIA		;INITIALIZE

MAIN:	PUSHJ	P,IPCF			;TRY TO PROCESS IPCF MESSAGES
	MOVEI	S1,ZZTIME		;TIME TO SNOOZE
	$CALL	I%SLP			;ZZZZZZ
	JRST	MAIN			;BACK TO TOP LEVEL
INITIA:	SETZM	APLCOD			;CLEAR OUR APPLICATION CODE

INIT.1:	MOVEI	S1,SP.OPR		;GET [SYSTEM]OPERATOR PID INDEX
	$CALL	C%RPRM			;ASK FOR THE PID
	JUMPT	INIT.2			;JUMP IF WE HAVE IT
	MOVEI	S1,1			;TIME TO WASTE
	$CALL	I%SLP			;ZZZZZZ
	JRST	INIT.1			;TRY AGAIN

INIT.2:	MOVEI	M,AHLMSG		;POINT TO APPLICATION HELLO MSG
	PUSHJ	P,SNDOPR		;SEND TO ORION
	POPJ	P,			;RETURN


; APPLICATION HELLO MESSAGE
AHLMSG:	$BUILD	(.OHDRS)		;SIZE OF BLOCK
	  $SET	(.MSTYP,MS.TYP,.OMAHL)	;APPLICATION HELLO CODE
	  $SET	(.MSTYP,MS.CNT,AHLLEN)	;LENGTH
	  $SET	(.OARGC,,1)		;1 ARGUMENT BLOCK
	$EOB				;END OF BLOCK

	$BUILD	(ARG.DA)		;SIZE OF BLOCK
	  $SET	(ARG.HD,AR.TYP,.AHNAM)	;BLOCK TYPE
	  $SET	(ARG.HD,AR.LEN,AHNLEN)	;LENGTH OF NAME
	$EOB
	ASCIZ	|DEMO|			;APPLICATION NAME
AHNLEN==.-AHLMSG-.OHDRS			;APPLICATION NAME LENGTH
AHLLEN==.-AHLMSG			;MESSAGE LENGTH
SUBTTL	IPCF interface -- Send a message


SNDOPR:	MOVEI	S1,0			;DON'T USE A REAL PID
	MOVX	S2,SI.FLG+SP.OPR	;SEND TO [SYSTEM]OPERATOR
	TXO	S2,SI.FLG		;USING SPECIAL PID INDEX

SEND:	MOVEM	S1,SAB+SAB.PD		;SAVE PID
	MOVEM	S2,SAB+SAB.SI		;SAVE SPECIAL PID INDEX WORD
	LOAD	S1,.MSTYP(M),MS.CNT	;GET LENGTH
	MOVEM	S1,SAB+SAB.LN		;SAVE
	MOVEM	M,SAB+SAB.MS		;SAVE MESSAGE ADDRESS
	MOVEI	S1,SAB.SZ		;SAB LENGTH
	MOVEI	S2,SAB			;SAB ADDRESS
	$CALL	C%SEND			;SEND MESSAGE
	JUMPT	.POPJ			;RETURN IF NO ERRORS
	$STOP	(ISF,<IPCF send failed>)
SUBTTL	IPCF interface -- IPCF interrupt processing


IPCINT:	$BGINT	(1)			;SWITCH TO INTERRUPT CONTEXT
	$CALL	C%INTR			;TELL LIBRARY WE HAVE A MESSAGE
	$DEBRK				;DISMISS INTERRUPT
SUBTTL	IPCF interface -- IPCF message processing


IPCF:	$CALL	C%RECV			;TRY TO RECEIVE A MESSAGE
	JUMPF	.POPJ			;NONE THERE--RETURN
	LOAD	M,MDB.MS(S1),MD.ADR	;POINT M AT INCOMMING PACKET
	MOVEI	S1,.OHDRS+ARG.HD(M)	;POINT TO FIRST BLOCK IN MESSAGE
	MOVEM	S1,MSGBLK		;SAVE
	MOVE	S1,.OARGC(M)		;GET ARGUMENT BLOCK COUNT
	MOVEM	S1,MSGCNT		;SAVE
	LOAD	S1,.MSTYP(M),MS.TYP	;GET MESSAGE TYPE
	PUSH	P,S1			;SAVE IT
	MOVE	S1,MSGPTR		;POINT TO MESSAGE TABLE

IPCF.1:	HLRZ	S2,(S1)			;GET TYPE FROM TABLE
	CAME	S2,(P)			;A MATCH?
	AOBJN	S1,IPCF.1		;KEEP SEARCHING
	SKIPL	S1			;POINTER POSITIVE IF NO MATCH
	MOVEI	S1,0			;UNKNOWN MESSAGE TYPE
	POP	P,(P)			;TRIM STACK
	HRRZ	S1,(S1)			;GET PROCESSOR ADDRESS
	PUSHJ	P,(S1)			;DISPATCH

IPCF.X:	$CALL	C%REL			;RELEASE MESSAGE
	JRST	IPCF			;TRY FOR ANOTHER PACKET


; Message dispatch table
MSGTAB:	XWD	000000,UNKMSG		;?????? UNKNOWN MESSAGES
	XWD	.OMHAC,AACK		;ORION  APPLICATION ACK
	XWD	.OMCMD,OPRCMD		;ORION  OPERATOR COMMAND MESSAGE
	XWD	MT.TXT,ACK		;ACKS
NUMMSG==.-MSGTAB
MSGPTR:	-NUMMSG,,MSGTAB			;AOBJN POINTER TO MESSAGE TABLE
SUBTTL	IPCF interface -- Message block processing


; Get the next block of a message
; Call:	PUSHJ	P,GETBLK
;	<NON-SKIP>		;END OF MESSAGE
;	<SKIP>			;NEXT BLOCK FOUND
;
; On error return, T1, T2 and T3 left unchanged
; On sucessful return, T1= type, T2= length, T3= data address
;
; AC usage:	Destroys S1
;
GETBLK:	SOSGE	MSGCNT			;SUBTRACT 1 FROM THE BLOCK COUNT
	POPJ	P,			;ERROR RETURN IF NO MORE
	MOVE	S1,MSGBLK		;GET THE PREVIOUS BLOCK ADDRESS
	LOAD	T1,ARG.HD(S1),AR.TYP	;GET THE BLOCK TYPE
	LOAD	T2,ARG.HD(S1),AR.LEN	;GET THE BLOCK LENGTH
	MOVEI	T3,ARG.DA(S1)		;GET THE BLOCK DATA ADDRESS
	ADD	S1,T2			;POINT TO THE NEXT MESSAGE BLOCK
	MOVEM	S1,MSGBLK		;SAVE IT FOR THE NEXT CALL
	JRST	.POPJ1			;RETURN SUCESSFUL
SUBTTL	IPCF interface -- Send setup


; Setup a message
; Call:	PUSHJ	P,SETMSG
;
; On return, M= message address
;
SETMSG:	MOVEI	S1,PAGSIZ		;LENGTH
	MOVEM	S1,MSGLEN		;SAVE REQUESTED LENGTH
	MOVEI	M,MSG			;POINT TO MESSAGE STORAGE
	TRNN	M,PAGSIZ-1		;ON A PAGE BOUNDRY?
	ADDI	M,1			;YES--DON'T WANT TO IPCF IT AWAY
	MOVSI	S1,(M)			;START ADDRESS
	HRRI	S1,1(M)			;MAKE A BLT POINTER
	SETZM	(M)			;CLEAR FIRST WORD
	BLT	S1,PAGSIZ-1(M)		;CLEAR MESSAGE STORAGE
	POPJ	P,			;DONE
SUBTTL	IPCF interface -- Unknown message


UNKMSG:	$WTO	(<DEMO error>,<^I/UNKTXT/>,,<$WTFLG(WT.SJI)>)
	POPJ	P,			;RETURN

UNKTXT:	ITEXT	(<                  Unknown IPCF message
Message header: ^O12R0/.MSTYP(M)/, ^O12R0/.MSFLG(M)/, ^O12R0/.MSCOD(M)/>)
SUBTTL	IPCF interface -- ORION message #200020 (APL ACK)


AACK:	PUSHJ	P,GETBLK		;GET ARGUMENT BLOCK
	  JRST	BADAPA			;BAD APPLICATION MESSAGE
	CAIN	T1,.AHTYP		;APPLICATION CODE?
	CAIE	T2,2			;TWO WORDS?
	JRST	BADAPA			;BAD APPLICATION MESSAGE
	MOVE	S1,(T3)			;GET CODE
	MOVEM	S1,APLCOD		;SAVE FOR LATER
	$LOG	(<DEMO starting>,<^I/AACKT1/>,,<$WTFLG(WT.SJI)>)
	POPJ	P,			;RETURN

BADAPA:	SKIPA	S1,[AACKT2]		;BAD ACK
BADAPL:	MOVEI	T1,AACKT3		;BAD MESSAGE
	$WTO	(<DEMO error>,<^I/(S1)/>,,<$WTFLG(WT.SJI)>)
	POPJ	P,			;RETURN

AACKT1:	ITEXT	(<Application code = ^O/APLCOD/>)
AACKT2:	ITEXT	(<Bad application hello ack from ORION>)
AACKT3:	ITEXT	(<Bad application message from ORION>)
SUBTTL	IPCF interface -- ORION message #200050 (OPR CMD)


OPRCMD:	MOVE	S1,MSGBLK		;GET CURRENT BLOCK ADDRESS
	MOVE	T1,MSGCNT		;GET COUNT OF BLOCKS
	MOVE	T2,0(S1)		;GET APPLICATION CODE
	MOVE	T3,1(S1)		;GET NODE (INCASE OF ERROR)
	SKIPLE	T1			;CHECK BLOCK COUNT
	CAME	T2,APLCOD		;MATCHING APPLICATION CODE
	JRST	BADAPL			;APPLICATION MESSAGE SCREWUP
	ADDI	S1,(T1)			;OFFSET TO ARG BLOCK COUNT
	MOVE	S2,(S1)			;GET COUNT
	MOVEM	S2,MSGCNT		;SAVE
	ADDI	S1,1			;ADVANCE TO FIRST APPLICATION ARG
	MOVEM	S1,MSGBLK		;UPDATE
	PUSHJ	P,GETBLK		;GET INITIAL BLOCK
	  JRST	OPRERR			;OPR CMD ERROR
	CAIE	T1,.CMKEY		;MUST START WITHA KEYWORD
	JRST	OPRERR			;OPR CMD ERROR
	MOVSI	S1,-CMDMAX		;SET COUNTER

OPRC.1:	HLRZ	S2,CMDTAB(S1)		;GET OPERATOR COMMAND CODE
	CAME	S2,(T3)			;A MATCH?
	AOBJN	S1,OPRC.1		;KEEP SEARCHING
	JUMPGE	S1,OPRERR		;OPR CMD ERROR
	HRRZ	S2,CMDTAB(S1)		;GET PROCESSOR ADDRESS
	JRST	(S2)			;DISPATCH

OPRERR:	$WTO	(<DEMO error>,<OPR application table skew>,,<$WTFLG(WT.SJI)>)
	POPJ	P,			;RETURN

CMDTAB:	XWD	.DMHLP,OPRERR		;HELP (SHOULD NEVER GET HERE)
	XWD	.DMSHW,SHOW		;SHOW
	XWD	.DMTST,TEST		;TEST
CMDMAX==.-CMDTAB			;LENGTH OF TABLE
SUBTTL	IPCF interface -- ACK message #700000


ACK:	MOVX	S2,MF.NOM		;GET THE 'NO MESSAGE' BIT
	SKIPE	S1,.MSCOD(M)		;GET ACK CODE (IF ANY)
	TDNN	S2,.MSFLG(M)		;ALL GOOD ACKS HAVE THIS BIT SET
	SKIPA				;MUST BE SOME JUNK TEXT ACK
	JRST	ACK.1			;UNEXPECTED TEXT MESSAGE
	SKIPN	.OARGC(M)		;QUASAR SNIFFING AROUND?
	POPJ	P,			;YES--JUST RETURN
	LOAD	S1,.MSFLG(M),MF.SUF	;GET SUFFIX
	CAIE	S1,'ODE'		;OPR DOES NOT EXIST?

ACK.1:	$WTO	(<Unexpected text message to DEMO>,<^T/.OHDRS+ARG.DA(M)/>)
	POPJ	P,			;RETURN
SUBTTL	Command processing -- SHOW


SHOW:	PUSHJ	P,GETBLK		;GET NEXT BLOCK
	  JRST	OPRERR			;OPR CMD ERROR
	CAIE	T1,.CMCFM		;CONFIRMATION?
	JRST	OPRERR			;OPR CMD ERROR
	$WTO	(<DEMO version is ^V/.JBVER/>,,,<$WTFLG(WT.SJI)>)
	POPJ	P,			;RETURN
SUBTTL	Command processing -- TEST


TEST:	$SAVE	<P1>			;SAVE P1
	PUSHJ	P,GETBLK		;GET NEXT ARG BLOCK
	  JRST	OPRERR			;OPR CMD ERROR
	CAIE	T1,.CMQST		;QUOTED STRING?
	CAIN	T1,.CMFLD		;OR UNQUOTED TEXT?
	SKIPA	P1,T3			;YES--COPY STRING ADDRESS
	JRST	OPRERR			;OPR CMD ERROR
	PUSHJ	P,GETBLK		;GET NEXT ARG BLOCK
	  JRST	OPRERR			;OPR CMD ERROR
	CAIE	T1,.CMCFM		;MUST BE CONFIRMATION
	JRST	OPRERR			;OPR CMD ERROR
	$WTO	(<TEST command>,<^T/(P1)/>,,<$WTFLG(WT.SJI)>)
	POPJ	P,			;RETURN


	END	DEMO