.title PSRDN4 .ident /V05-001/ ; © 2000 P. Beaudoin ; This software is supplied as is and the usual warranty ; is implied - none. You may use, abuse, modify or ; or ignore this software as you see fit but are ; encouraged to give credit, as is good practice ; when stealing with permission ; ;++ ;1 PSRDN4 ; Program to receive DECnet IV frames from Listen, process them and ; build the internal PSRDN4 DB. ; ;2 Database ; Only the DECnet address and routing type are stored. All other DECnet IV ; data is gathered by the poller(s) and stored in EMUDB. ;-- .library /sys$library:lib.mlb/ .library /emu5_LIB:emu5.mlb/ $LCKDEF EMUIPCDEF ; IPC buffers EMUSYSDEF EMUCTRLDEF EMUPSRDEF EMUCNTDEF EMURLTDEF EMUMSGDEF .psect rw_data, noexe, rd, wrt, quad, pic, noshr THIS_PROCESS = SYS_PID_C_PSRDN4 THIS_PROCESS_FLAG = SYS_FLG_C_PSRDN4 HIORD: .BYTE ^XAA,^X00,^X04,^X00 ; Global Section areas ; ; returned addresses .ALIGN QUAD INADDR: .QUAD 0 EBUFFS_A: .QUAD 0 CONTROL_A: .QUAD 0 DN4DB_A: .QUAD 0 PSRTBL_A: .QUAD 0 COUNTERS_A: .QUAD 0 GBLSIZ: .LONG 0 DEFRECCNT: .LONG 1000 RLTCXT: .LONG RELDIS: .LONG 0 ; temp - move to section ENTRYCNT: .LONG 0 ; Count of db entries PSRTBLCNT: .LONG 0 PASS_COUNT: .LONG 0 ; COunt of buffs rec'ed 1 cycle BOXID: .LONG 0 ; Locking ; Lock value block DN4DBLVB: DN4LVBSTA: .WORD 0 ; Status DN4LVBRES: .WORD 0 ; Reserved DN4LVBID: .LONG 0 ; Lock id DN4LVBSIZ: .LONG 0 ; Begining of LVB (Size of DB in pages) DN4LVBSPR: .BLKL 3 ; Unused 12 bytes ; $ENQ call frame DN4DBLOCK: .LONG 12 ; Arguments .LONG 0 ; EFN LKMODE: .LONG LCK$K_EXMODE ; Lock mode .ADDRESS DN4DBLVB ; Lock value block LKFLGS: .LONG ; Use value block LKNAM: .ADDRESS DN4DBLKNAM ; Resourse name .LONG 0 ; Parent id .LONG 0 ; AST .LONG 0 ; AST Param .LONG 0 ; BLAST .LONG 0 ; ACC Mode .LONG 0 ; RSDM_ID .LONG 0 ; Null ; Error Log ; The error system works as follows: ; Fill in MSGDCE, PARCNT and required params and call EMU_LOGGER with ; the addr of this message as the param. ; MSGCDE is the EMU message code. Symbols are defined in _EMUMSGDEF ; PARCNT is the count of params in the MSGPARAMS area. There may be up to ; 7 params in any message. The params are FAO directives as required ; by the message. See EMUMSG.MSG ; Error System Params ERRORMSG: .LONG ;Arg, opts MSGCDE: .LONG ; Error code PARCNT: .WORD ; Paramater count .WORD ; Opts .LONG ; Time .ADDRESS RTNNAM ; Our name MSGPARAMS: .BLKL 7 ; Up to 7 params RTNNAM: .ASCID /PSRDN4/ .ALIGN LONG DN4SECFAB: $FAB FAC = ,- ; Access FNM = DN4SECRAB: $RAB FAB = DN4SECFAB,- ; Record RAC = SEQ,- RBF = DN4SECREC,- ; UBF = DN4SECREC,- ; USZ = DN4SECREC_SIZE,- ; RSZ = DN4SECREC_SIZE ; DN4SECREC: .BLKB PSR_DN4_C_RECSIZ DN4SECREC_SIZE = .-DN4SECREC .ALIGN LONG EXIT_STATUS: .LONG 0 EXIT_BLOCK: .LONG 0 .ADDRESS PSRDN4_EXIT .LONG 1 .ADDRESS EXIT_STATUS EFLAGS1: .ASCID /EFLAGS1/ ; Event Flag Cluster (64-95) EFLAGS2: .ASCID /EFLAGS2/ ; Event Flag Cluster (96-127) DN4SECNAM: .ASCID /EMU_PSRDN4/ ; Section name DN4DBLKNAM: .ASCID /EMU_DN4DB/ FLAGS: .LONG 0 .psect prog_code, rd, nowrt, exe, pic, shr, quad .CALL_ENTRY MAX_ARGS=2, - HOME_ARGS=TRUE, - INPUT =, - PRESERVE=, - LABEL=PSRDN4 ; Ensure death if control process dies calls #0, g^get_control_lock ; bsbw error_chk ; ; ; Define LNM$TEMPORARY_MAILBOX = LNM$SYSTEM ; make all temporary things in the system logical name table calls #0, g^asn_tempmbx_system bsbw error_chk ; ; ; Create and Map to sections ; PUSHAL COUNTERS_A ; Counters CALLS #1,G^MAP_COUNTERS BSBW ERROR_CHK pushal ebuffs_a ; Ebuffs section return addresses calls #1, g^map_ebuffs ; Create and map ebuffs bsbw error_chk ; check errors pushal control_a ; Control section return addresses calls #1, g^map_control ; Create and map control section bsbw error_chk ; check errors PUSHAL PSRTBLCNT ; Count of entries found PUSHAL PSRTBL_A ; PSR table start addr CALLS #2,G^MAP_PSRTBL BSBW ERROR_CHK ; Lock and map our database CALLS #0,G^MAP_DN4DB BLBS R0,10$ BSBW ERROR_CHK ; Record error RET ; ; Declare exit handler 10$: $DCLEXH_S DESBLK=EXIT_BLOCK ; BSBW ERROR_CHK ; ; ; Register constants ; R6 = Current buffer ; R8 = current datarec ; R9 = addr of que header ; R11 = counters MOVL EBUFFS_A,R9 ; que heads ; Common Event flag Cluster: ; $ASCEFC_S EFN = #64,- NAME = EFLAGS1 BSBW ERROR_CHK ; Fatal $ASCEFC_S EFN = #96,- NAME = EFLAGS2 BSBW ERROR_CHK ; Fatal ; Locate our place in the PSR table to ensure we should run. MOVL PSRTBL_A,R6 ; MOVL PSRTBLCNT,R3 ; Count of entries 100$: CMPL #THIS_PROCESS_FLAG,PSR_TBL_L_PSRID(R6) BEQLU 110$ ADDL #PSR_TBL_C_SIZE,R6 ; Next entry SOBGTR R3,100$ ; Loop for all MOVL #SS$_ITEMNOTFOUND,R0 ; We could not find ourselves RET 110$: ; Find our area in counters section and init MOVL COUNTERS_A,R11 ; Start of counters ADDL #CNT_PSR_C_START,R11 ; Start of PSRs MULL3 #THIS_PROCESS,#CNT_PSR_C_ASIZE,R1 ; Offset ADDL R1,R11 ; Our space MOVC5 #0,#0,#0,#CNT_PSR_C_ASIZE,(R11) ; Clear MOVQ PSR_TBL_Q_DNAM(R6),CNT_PSR_Q_NAME(R11) ; Our name MOVL PSR_TBL_L_RELDIS(R6),RELDIS ; Relater disable ; Send message to relater to enable us MOVL #100,R2 ; Try this many times 120$: CLRL RLTCXT PUSHL #THIS_PROCESS ; Identify sender PUSHL #RLT_FRM_C_MSGSTART ; Start us PUSHAL BOXID ; Dummy Boxid PUSHAL RLTCXT ; Context CALLS #4,G^CREATE_RELATER_FRAME BLBS R0,130$ SOBGTR R2,120$ ; Fatal error - log it and exit MOVL #MSG_GENPSR_SNDRLT,MSGCDE ; General PSR error MOVL #1,PARCNT ; 2 params MOVAL MSGPARAMS,R1 ; Plist MOVL R0,(R1) ; VMS error PUSHAL ERRORMSG ; Log it CALLS #1,G^EMU_LOGGER RET 130$: PUSHL RLTCXT ; Context CALLS #1,G^SEND_RELATER_FRAME 140$: WAIT: $wflor_s EFN=#96,- ; Wait for our flag set MASK=#THIS_PROCESS_FLAG $READEF_S EFN=#96,- ; Get EBUFF Flags STATE=FLAGS ; Current state READ: ; When our flag is set: ; 1. Clear our CEF ; 2. Scan all ebuffs for any with our flag set. ; If any found, process the buffer and clear our flag. ; repeat until no buffs are found for us ; Wait for our CEF ADDL3 #96,#THIS_PROCESS,R1 PUSHL R1 CALLS #1,G^SYS$CLREF ; Here call process command buffer CLRL PASS_COUNT ; Clear cycle count MOVL EBUFFS_A,R6 ; que heads ADDL #IPC_EBUF_C_BUFSTART,R6 ; Buffers MOVL #IPC_ETH_C_BUFNO,R7 ; Number of buffers MAIN: BBS #THIS_PROCESS,IPC_HDR_L_RFLAGS(R6),PROCESS ; Br if buffer is ours ADDL #IPC_ETH_C_BUFSIZE,R6 SOBGTR R7,MAIN TSTL PASS_COUNT ; Did we process any? BNEQU READ ; Cycle again BRW WAIT PROCESS: INCL CNT_PSR_L_PRCV(R11) ; Count 1 buff in ADDL3 #IPC_ETH_EA_SA,R6,R3 ; DN4 add is low 2 bytes of ea ADDL #4,R3 ; Addr ; PUSHL #1 ; Create if not found PUSHL #THIS_PROCESS ; This process is creator PUSHAL BOXID ; BOXID - always = 0 PUSHAL DN4DB_A ; Section PUSHL R3 ; Addr of ETH addr PUSHL #PSR_DN4_W_ADDR ; Offset to addr PUSHL #2 ; Push len CALLS #7,G^LOCATE_PSRREC BSBW ERROR_CHK ; Restart on error CMPL R0,#SS$_CREATED BNEQ 100$ ;; SEND ALERT - New addr 100$: MOVL R1,R8 ; Addr this rec MOVQ EXE$GQ_SYSTIME,COM_HDR_Q_LSTHRD(R8) ; Heard this addr now INCL COM_HDR_L_ACNT(R8) ; Count this access ; Check entry ADDL3 R8,#IPC_ETH_1500_DATA,R9 ; DN4 frame EXTZV #0,#2,12(R9),R4 ; Extract Routing type CMPW R4,PSR_DN4_W_ROUTYP(R8) ; Same? BEQLU DONE ;; SEND ALERT - routing type changed MOVW R4,PSR_DN4_W_ROUTYP(R8) ; reSet DONE: ; Make sure we are in the Relater DB CLRL RLTCXT ; Start with new frame BBS #THIS_PROCESS,RELDIS,10$ BBS #THIS_PROCESS,COM_HDR_L_PTYBITS(R8),10$ ADDL3 #PSR_DN4_W_ADDR,R8,-(SP) ; Our addr PUSHL #2 ; Len of our addr PUSHL #THIS_PROCESS ; Add our address PUSHL #THIS_PROCESS ; Identify sender PUSHL #RLT_FRM_C_MSGADD ; Add targets ADDL3 #COM_HDR_L_BOXID,R8,-(SP) ; Boxid PUSHAL RLTCXT ; Context CALLS #7,G^CREATE_RELATER_FRAME BLBS R0,10$ ; Br no err INCL CNT_PSR_L_NOIPC(R11) ; count err BRW 20$ 10$: ; As this frame came from Ethernet ... BBS #SYS_PID_C_PSRETH,RELDIS,20$ BBS #SYS_PID_C_PSRETH,COM_HDR_L_PTYBITS(R8),20$ ADDL3 #IPC_ETH_EA_SA,R6,-(SP) ; Ethernet addr PUSHL #6 ; Len of Ethernet addr PUSHL #SYS_PID_C_PSRETH ; Add Ethernet address PUSHL #THIS_PROCESS ; Identify sender PUSHL #RLT_FRM_C_MSGADD ; Add targets ADDL3 #COM_HDR_L_BOXID,R8,-(SP) ; Boxid PUSHAL RLTCXT ; Context CALLS #7,G^CREATE_RELATER_FRAME BLBS R0,20$ ; Br no err INCL CNT_PSR_L_NOIPC(R11) ; count err BRW 20$ ; skip to end 20$: TSTL RLTCXT ; Any frame to send? BEQL 100$ ; Br if not PUSHL RLTCXT ; Context (Addr of buffer) CALLS #1,G^SEND_RELATER_FRAME CLRL RLTCXT ; Saftey - don't reuse BLBS R0,30$ ; br no err INCL CNT_PSR_L_ERROR(R11) ; count err MOVL #MSG_GENPSR_SNDRLT,MSGCDE ; General PSR error MOVL #1,PARCNT ; 2 params MOVAL MSGPARAMS,R1 ; Plist MOVL R0,(R1) ; VMS error PUSHAL ERRORMSG ; Log it CALLS #1,G^EMU_LOGGER BRW 100$ ; skip 30$: INCL CNT_PSR_L_PREL(R11) ; Count relater frame sent BRW 100$ ; clear our bit in return ; reque this buff back to listen 100$: BICL #THIS_PROCESS_FLAG,IPC_HDR_L_RFLAGS(R6) MOVL COUNTERS_A,R11 INCL CNT_PSR_L_RET(R11) BRW MAIN ; Subroutines ERROR_CHK: .JSB_ENTRY INPUT=, - OUTPUT= BLBC R0,10$ RSB 10$: MOVL R0,R6 MOVL #MSG_GENPSR_SNDNAM,MSGCDE ; General PSR error MOVL #1,PARCNT ; 2 params MOVAL MSGPARAMS,R1 ; Plist MOVL R0,(R1) ; VMS error PUSHAL ERRORMSG ; Log it CALLS #1,G^EMU_LOGGER MOVL R6,R0 $EXIT_S RET .CALL_ENTRY MAX_ARGS=1, - HOME_ARGS=TRUE, - INPUT =, - PRESERVE=, - LABEL=MAP_DN4DB ;++ ;2 MAP_DN4DB ; Routine to create and initialise the DN4 db. This is a standard routine ; that any DB creator execxutes on it's own DB: ; Acquire exclusive lock on this database. ; Fatal error if not granted. ; Open file - if file not opened used hardcoded defaults. ; Create section. Fatal error ir we did not CREATE. ; Initalise with either file contents or defaults ; Write section size (in pages) to LVB ; Convert lock to CW ; That's it! ;-- MOVL #LCK$K_EXMODE,LKMODE ; EXCLUSIVE $ENQW_G DN4DBLOCK ; Get DB lock in exclusive mode BLBS DN4LVBSTA,10$ ; Br if got it CMPW #SS$_VALNOTVALID,DN4LVBSTA ; Ignore LVB not valid error BEQLU 10$ RET 10$: $OPEN FAB= DN4SECFAB ; Attempt to open BLBS R0,20$ ; Br if OK BRW 1000$ ; Use defaults 20$: $CONNECT RAB=DN4SECRAB BLBS R0,30$ RET 30$: $GET RAB=DN4SECRAB ; Get 1st rec BLBS R0,40$ RET 40$: ; Calc memory/file size, Get memory & Map section MOVAL DN4SECREC,R7 MULL3 COM_DBHDR_L_MAXENTRIES(R7),COM_DBHDR_L_RECSIZE(R7),GBLSIZ DIVL #512,GBLSIZ ; Pages INCL GBLSIZ ; Round up ; Get Memory 100$: CLRQ -(SP) ; p0 space, access mode PUSHAL INADDR ; returned address PUSHL GBLSIZ ; no. of pages CALLS #4, G^SYS$EXPREG ; Expand process space BSBW ERROR_CHK ; check ok ; MAP SECTION CLRQ -(SP) ; pfc, protection CLRL -(SP) ; virtual block number PUSHL GBLSIZ ; no. of pages CLRQ -(SP) ; channel, rel page no. CLRL -(SP) ; version id PUSHAL DN4SECNAM ; section name PUSHL # CLRL -(SP) ; access mode PUSHAL DN4DB_A ; returned address PUSHAL INADDR ; in address CALLS #12, G^SYS$CRMPSC ; create section BSBW ERROR_CHK CMPL #SS$_CREATED,R0 BEQL 200$ $CLOSE FAB=DN4SECFAB MOVL #SS$_INVEVENT,R0 ; We MUST create the section RET 200$: ; We created the section. Load it with file contents ; Move the 1st rec to rec header ; 1st rec cannot exceed common header size... MOVAL DN4DB_A,R11 ; Start of section MOVL (R11),R7 ; MOVC3 #COM_HDR_C_SIZE,DN4SECREC,(R7) ; Init header ADDL3 COM_DBHDR_L_RECSIZE(R7),R7,R8 ; Location of 1st rec CLRL COM_DBHDR_L_ENTRIES(R7) ; No entries yet MOVL COM_DBHDR_L_RECSIZE(R7),R9 ; rec size 210$: MOVL R8,DN4SECRAB+RAB$L_UBF ; Write rec here MOVW R9,DN4SECRAB+RAB$W_RSZ ; Record size MOVW R9,DN4SECRAB+RAB$W_USZ ; Record size $GET RAB = DN4SECRAB ; Get a record BLBC R0,260$ ; BR IF error INCL COM_DBHDR_L_ENTRIES(R7) ; Count ADDL R9,R8 ; Next slot ADDL3 R9,R8,R10 ; Check if enough room CMPL R10,4(R11) ; OK? BLEQU 210$ ; OK BRW 280$ ; Undo 260$: CMPL R0,#RMS$_EOF ; Was error end of file BEQLU 270$ ; Yes - OK RET ; No - Die 270$: $CLOSE FAB=DN4SECFAB BRW 2000$ 280$: ; Undo and set to default $CLOSE FAB=DN4SECFAB CLRQ -(SP) PUSHL 4(AP) CALLS #3,G^SYS$DELTVA 1000$: ; File was not found, or otherwise unloadable ; Use defaults MULL3 #PSR_DN4_C_RECSIZ,DEFRECCNT,GBLSIZ DIVL #512,GBLSIZ ; Pages INCL GBLSIZ ; Round up ; Get Memory CLRQ -(SP) ; p0 space, access mode PUSHAL INADDR ; returned address PUSHL GBLSIZ ; no. of pages CALLS #4, G^SYS$EXPREG ; Expand process space BSBW ERROR_CHK ; check ok ; map section CLRQ -(SP) ; pfc, protection CLRL -(SP) ; virtual block number PUSHL GBLSIZ ; no. of pages CLRQ -(SP) ; channel, rel page no. CLRL -(SP) ; version id PUSHAL DN4SECNAM ; section name PUSHL # CLRL -(SP) ; access mode PUSHAL DN4DB_A ; returned address PUSHAL INADDR ; in address CALLS #12, G^SYS$CRMPSC ; create section CMPL #SS$_CREATED,R0 BEQL 1100$ $CLOSE FAB=DN4SECFAB MOVL #SS$_INVEVENT,R0 ; We MUST create the section RET ; init header rec 1100$: MOVL DN4DB_a,R6 MOVL #PSR_DN4_C_RECSIZ,COM_DBHDR_L_RECSIZE(R6) ; write recsize MOVL #THIS_PROCESS,COM_DBHDR_L_FLAG(R6) ; Write flag MOVL DEFRECCNT,COM_DBHDR_L_MAXENTRIES(R6) 2000$: $ERASE FAB= DN4SECFAB ; Delete all versions BLBS R0,2000$ ; Br until no more SUBL3 DN4DB_A,DN4DB_A+4,R10 ; Size if section (bytes) DIVL3 #512,R10,DN4LVBSIZ ; Size (Pages) in LVB INCL DN4LVBSIZ ; Real number BISL #LCK$M_CONVERT,LKFLGS ; Set lock to convert MOVL #LCK$K_CWMODE,LKMODE ; COnvert to CW $ENQW_G DN4DBLOCK ; Convert DB lock MOVW DN4LVBSTA,R0 RET ; Return with any errors .CALL_ENTRY MAX_ARGS=0, - HOME_ARGS=TRUE, - INPUT =, - PRESERVE=, - LABEL=PSRDN4_EXIT ; Here at exit ; Disable ourselves MOVL PSRTBL_A,R6 ; MOVL PSRTBLCNT,R3 ; Count of entries 10$: CMPL #THIS_PROCESS_FLAG,PSR_TBL_L_PSRID(R6) BNEQU 15$ BICL #PSR_CFLG_M_DISAB,PSR_TBL_L_CFLGS(R6) ; Disable 15$: ADDL #PSR_TBL_C_SIZE,R6 ; Next entry SOBGTR R3,10$ ; Loop for all ; Get lock MOVL #LCK$K_EXMODE,LKMODE ; EXCLUSIVE BISL #LCK$M_CONVERT,LKFLGS ; Set lock to convert $ENQW_G DN4DBLOCK ; Get DB lock in exclusive mode BLBS DN4LVBSTA,20$ CMPW #SS$_VALNOTVALID,DN4LVBSTA ; Ignore LVB not valid error BEQLU 20$ MOVL #MSG_EMUSYS_LOCKDB,MSGCDE ; General PSR error MOVL #2,PARCNT ; 2 params MOVAL MSGPARAMS,R1 ; Plist MOVL LKNAM,(R1)+ ; Lock name MOVL R0,(R1) ; VMS error PUSHAL ERRORMSG ; Log it CALLS #1,G^EMU_LOGGER RET 20$: ; create new file $CREATE FAB=DN4SECFAB BLBS R0,30$ RET 30$: $CONNECT RAB=DN4SECRAB BLBS R0,40$ 40$: ; analyse section, dec entry count for any deleted recs MOVL DN4DB_A,R10 ; Top of section MOVL COM_DBHDR_L_ENTRIES(R10),R6 ; Number of entries BEQL 65$ ; Br if none MOVL COM_DBHDR_L_RECSIZE(R10),R7 ; Size of entries ADDL3 R7,R10,R8 ; 1st rec 50$: BBC #SYS_COM_V_DELETE,COM_HDR_L_SYSCTL(R8),60$ ; Br if not deleted DECL COM_DBHDR_L_ENTRIES(R10) ; uncount 60$: ADDL R7,R8 SOBGTR R6,50$ ; The count is now the count of valid recs ; Calc a new MAXENTRY 65$: MULL3 #100,COM_DBHDR_L_ENTRIES(R10),R1 DIVL #15,R1 ; increase by 15 % CMPL #100,R1 ; must be > 10 BLSS 70$ MOVL #100,R1 ; Set min BRB 100$ 70$: CMPL #1000,R1 ; must be < 100 BGTR 100$ MOVL #1000,R1 ; Set min 100$: ; Set header and write it ; MOVW COM_DBHDR_L_RECSIZE(R10),DN4SECRAB+RAB$W_RSZ ; rec size ADDL3 R1,COM_DBHDR_L_ENTRIES(R10),COM_DBHDR_L_MAXENTRIES(R10) ; Set new max size MOVL #-1,COM_HDR_L_ACNT(R10) ; Set this field Max count (FOR SORT) MOVL R10,DN4SECRAB+RAB$L_RBF ; Write this rec $PUT RAB = DN4SECRAB ; Write a record BLBS R0,110$ ; BR IF no error BRW 210$ ; 110$: ; Write out all recs (skip deletes) MOVL COM_DBHDR_L_ENTRIES(R10),R6 ; Number of entries BEQL 200$ ; Br if none MOVL COM_DBHDR_L_RECSIZE(R10),R7 ; Size of entries MOVW COM_DBHDR_L_RECSIZE(R10),DN4SECRAB+RAB$W_RSZ ; Size of record ADDL3 R7,R10,R8 ; 1st rec 120$: MOVL R8,DN4SECRAB+RAB$L_RBF ; Write this rec $PUT RAB = DN4SECRAB ; Write a record BLBC R0,210$ ; BR IF error ADDL R7,R8 SOBGTR R6,120$ 200$: $CLOSE FAB= DN4SECFAB ; RET 210$: $CLOSE FAB= DN4SECFAB ; $ERASE FAB= DN4SECFAB ; Delete Partial RET .end PSRDN4