mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-06 19:11:04 +00:00
295 lines
9.2 KiB
Plaintext
295 lines
9.2 KiB
Plaintext
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
|