Trailing-Edge
-
PDP-10 Archives
-
cuspjul86upd_bb-jf24a-bb
-
10,7/galaxy/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