ASMB,N,C,L IFN NAM DSINF,19,65 1000-1000-3000 780106 24999-16215 REV 1902 EXT DEXEC XIF IFZ NAM DSINF,19,65 1000-3000 VRSN 780106 XIF SPC 1 SUP A EQU 0 B EQU 1 EXT $LIBR,$LIBX,$PARS,$CVT1,CNUMO,CNUMD EXT EXEC,RMPAR,$CLAS,$RNTB SPC 1 * **************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * **************************************************************** SPC 1 ******************************************** * * * NAME: DSINF (DS INFORMATION) * * * * SOURCE: 24999-18215 (N-OPTION) * * * * RELOCATABLE: 24999-16215 (N-OPTION) * * * * PROGRAMMER: DT * * * * DATE: APRIL 1977 * * * ******************************************** SPC 3 * THE ORIGINAL CODE FOR THIS PROGRAM WAS WRITTEN IN HP ALGOL. * MODIFICATIONS HAVE BEEN INTRODUCED SINCE TRANSLATION TO * ASSEMBLY LANGUAGE! SPC 3 * ASSEMBLY OPTIONS: * N 1000-1000 AND 1000-3000 VERSION * Z 1000-3000 ONLY (NO DEXEC OR NRV) SKP *COMMENT DS/1000 UTILTIY PROGRAM. [DT] * *RUN FROM RTE WITH * RU,DSINF,,,,, * *THE RUN-TIME PARAMETERS HAVE THESE MEANINGS: * * THE LOGICAL UNIT NUMBER OF THE INPUT DEVICE. THE DEFAULT * IS THE NUMBER OF THE SCHEDULING TERMINAL PASSED BY M-T-M * OR 1. IF THE INPUT DEVICE IS INTERACTIVE (USES DVR00 OR * SUBCHANNEL 0 AND DVR05), A PROMPT IS PRINTED ON THE DEVICE * BEFORE EACH READ. * * THE LOGICAL UNIT NUMBER OF THE DEVICE WHERE INFORMATION IS * PRINTED. THE DEFAULT IS THE INPUT LU (IF INTERACTIVE) OR 6. * * A CONTROL WORD WHICH SPECIFIES DSINF WILL BE RUN NON- * INTERACTIVELY. THE FUNCTIONS WHICH TAKE PLACE ARE * DETERMINED BY THE BITS SET: * * DECIMAL * VALUE PRINT THIS INFORMATION * ------- ------------------------------ * 1 AVAILABLE MEMORY SUSPEND LIST * 2 I/O CLASSES * 4 DS/1000 VALUES * 8 DUMP OF SAM BLOCK * 16 DS/1000 LISTS * 32 NODAL ROUTING VECTOR * 64 DS/1000 EQT ENTRIES * * FOR EXAMPLE, TO PRINT THE I/O CLASS AND DS/1000 VALUES * ON YOUR TERMINAL, TYPE RU,DSINF,,,6. * * THE NODE NUMBER WHERE I/O IS TO OCCUR. DEFAULT IS LOCAL * NODE (-1). * * SET TO A NON-ZERO VALUE WHEN THE NODE NUMBER IS 0 (TO * DISTINGUISH IT FROM THE DEFAULT). * * *DSINF RECOGNIZES THE FOLLOWING COMMANDS: * AV AVAILABLE MEMORY SUSPEND LIST * CL I/O CLASSES * VA DS/1000 VALUES * DU DUMP OF SAM BLOCK * LI DS/1000 LISTS * NR NODAL ROUTING VECTOR * EQ DS/1000 EQT ENTRIES * EQ,N PRINT INFORMATION ON EQT N * /E OR EX TERMINATE DSINF * *ALL OTHER CHARACTERS CAUSE THE FUNCTIONS TO BE LISTED ON THE *OUTPUT DEVICE.; SKP * RUN-TIME PARAMETERS *INTEGER INLU,OUTLU,CONWD,P4,P5; INLU BSS 01 OUTLU BSS 01 CONWD BSS 01 NODE BSS 01 FLAG BSS 01 SPC 2 *INTEGER I,J, & COUNTERS I BSS 01 J BSS 01 * KYWRD, & BASE OF KEYWORD TABLE KYWRD BSS 01 * BLANK:=" ", & ASCII BLANK BLANK OCT 020040 * MAXID, & # OF ENTRIES IN KEYWORD TABLE MAXID BSS 01 * SSIZE; & SIZE OF SAM BLOCK SSIZE BSS 01 SPC 2 * DS/1000 VALUES EXT #CNOD,#FWAM,#TBRN,#QRN,#MSTO,#SVTO,#WAIT EXT #BREJ,#LU3K,#QZRN,#GRPM,#NRV,#TST EXT #RFSZ,#LDEF,#NCNT,#NODE,#LNOD,D$LID,D$RID SPC 2 *INTEGER ARRAY BUFR[1:1]; & OUTPUT BUFFER BUFR EQU * * OUTPUT FIELDS (WORDS 1 THROUGH 39) W1 BSS 01 W2 BSS 01 W3 BSS 2 W5 BSS 01 W6 BSS 01 W7 BSS 01 W8 BSS 01 W9 BSS 01 W10 BSS 01 W11 BSS 2 W13 BSS 01 W14 BSS 01 W15 BSS 01 W16 BSS 01 W17 BSS 1 W18 BSS 1 W19 BSS 01 W20 BSS 01 W21 BSS 19 * * HOLDING AREA FOR NUMBER CONVERSION *INTEGER HOLD1,HOLD2,HOLD3; HOLD1 BSS 01 HOLD2 BSS 01 HOLD3 BSS 01 * * BASE PAGE LOCATIONS SAMIN BSS 1 SAM ARRAY INITIALIZED? *INTEGER EQTA := @1650, & FIRST WORD OF EQUIPMENT TABLE EQTA EQU 1650B * DRT := @1652, & FIRST WORD OF DEVICE REFERENCE TABLE DRT EQU 1652B * LUMAX := @1653, & NUMBER OF LOGICAL UNITS IN DRT LUMAX EQU 1653B * KEYWD := @1657, & FWA OF KEYWORD BLOCK KEYWD EQU 1657B * SUSP2 := @1713, & "WAIT SUSPEND" LIST SUSP2 EQU 1713B * SUSP3 := @1714; & "AVAILABLE MEMORY" WAIT LIST SUSP3 EQU 1714B XEQT EQU 1717B MY ID SEGMENT ADDRESS * *EQUATE LSTRM := 10; & LAST STREAM NUMBER LSTRM EQU 10 NOSTR ABS LSTRM * *INTEGER ARRAY SAM[0:640], & DS/1000 SYSTEM-AVAILABLE-MEMORY SAM EQU * BSS 640 * PNTR[-3:LSTRM]; & POINTERS INTO SAM PNTR EQU *+3 BSS LSTRM+4 SKP * +--------------+ * ! PROCEDURES ! * +--------------+ SPC 3 * * CONVERT DECIMAL NUMBER TO ASCII * CNVTD NOP STA T1 SAVE THE RAW DATA, TEMPORARILY. LDA CNVTD,I GET THE DESTINATION ADDRESS. STA STUFM CONFIGURE THE CALL TO 'CNUMD'. JSB CNUMD GO TO DEF *+3 CONVERT DEF T1 THE VALUE STUFM NOP TO ASCII. ISZ CNVTD ADJUST THE RETURN POINTER, JMP CNVTD,I AND RETURN TO THE CALLER. SPC 3 * * CONVERT DECIMAL NUMBER TO ASCII, TWO DIGITS * (VALUE GOES IN A-REGISTER) * KCVT NOP CCE SET DECIMAL OPTION. JSB $LIBR GO TO NOP THE SYSTEM JSB $CVT1 FOR CONVERSION. JSB $LIBX RETURN TO DEF KCVT THE CALLER. SPC 3 * * CHASE DOWN INDIRECTS * INDR NOP RSS N LDA A,I RAL,CLE,SLA,ERA JMP N JMP INDR,I SKP * * FILL BUFR ARRAY WITH A-REGISTER CONTENTS * FILL NOP ENTRY POINT LDX D39 INITIALIZE COUNTER LOOP SAX BUFR-1 STORE A-REG DSX DECREMENT X-REG AND CONTINUE JMP LOOP IN LOOP UNTIL X=0. * JMP FILL,I RETURN SPC 3 * * PRINT A STRING * MSG BSS 1 STRING ADDRESS LEN BSS 1 LENGTH * PRINT NOP ENTRY POINT LDA PRINT,I GET PARAMETERS STA MSG ISZ PRINT LDA PRINT,I STA LEN ISZ PRINT * UNL IFN LST JSB DEXEC CALL DEXEC FOR WRITE DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC CALL EXEC FOR WRITE DEF *+5 UNL XIF LST DEF D2 DEF OUTLU DEF MSG,I DEF LEN * JMP PRINT,I RETURN SKP * * MOVE THE DS/1000 BLOCK OF SAM * DEST DEF SAM DESTINATION ADDRESS PONTR NOP ADDRESS WHERE POINTER IS STORED DEF PNTR-3 POINTERS' ARRAY * GTSAM NOP ENTRY POINT JSB $LIBR INSURE NOBODY CHANGES SAM NOP BY GOING PRIVILEGED * LDA #FWAM A-REG := SOURCE ADDR IN SAM LDB DEST B-REG := DESTINATION LDX SSIZE X-REG := # OF WORDS TO MOVE MWF MOVE WORDS FROM ALTERNATE MAP * LDA PONTR+1 STA PONTR CCA \ GET ADDRESS ADA #LDEF / OF FIRST POINTER LDX D14 INITIALIZE COUNTER LOOP2 LDB A,I PICK UP POINTER LDB B,I STB PONTR,I STORE POINTER INA INCREMENT SOURCE ADDR ISZ PONTR INCREMENT DEST ADDR DSX DONE? JMP LOOP2 NO--MOVE NEXT POINTER * JSB $LIBX RESTORE SYSTEM DEF GTSAM AND RETURN SPC 3 * * PLACE THE CONTENTS OF A LOCATION IN ALTERNATE MAP * INTO THE A-REGISTER * IXGET NOP ENTRY POINT XLA A,I JMP IXGET,I RETURN SKP * (LYLE WEIMAN'S 11-2-76 VERSION MODIFIED BY DT) * * RETRIEVE DS/1000 EQT CONTENTS * * CALL FROM ALGOL WITH * GTEQT(IBUF[1],EQTN,LU) * * IBUF - BUFFER TO ACCOMODATE 15 WORDS OF EQT + 8 WORD EXTENT * EQTN - I'LL FIND THE FIRST EQT *AFTER* EQTN WHICH IS * DIRECTED TO DVA65 (TYPE 65) AND RETURN THAT * EQT NUMBER IN EQTN - IF NO EQT IS FOUND, I'LL RETURN * ZERO IN 'EQTN' * LU - AN LU POINTING TO THE EQT * EQTBF DEF EBUFR+1 UNL IFN LST EQTN DEF EQNUM EQLU DEF LUNUM * GTEQT NOP LDA 1651B IF REQUEST IS FOR N> NUMBER CMA,INA OF EQT'S IN SYSTEM, ERROR! ADA EQTN,I SSA,RSS JMP DONE1 * LOOP1 LDA EQTN,I GET ADDRESS OF EQT ISZ EQTN,I (POINT TO NEXT ONE...) MPY D15 ADA EQTA STA EQADR SAVE ADA D4 CHECK TYPE CODE LDA A,I AND EQTYP CPA D65TP FOR DVA65? JMP MOVE YES, GO MOVE IT TO USER AREA LDA EQTN,I NO, WAS IT THE LAST ONE IN CPA 1651B THE SYSTEM? JMP DONE1 YES, ALL DONE! JMP LOOP1 NO, LOOK AGAIN! * * MOVE EQT TO USER BUFFER MOVE LDA EQADR A := SOURCE ADDRESS LDB EQTBF B := DESTINATION JSB $LIBR MAKE SURE EQT ISN'T CHANGED NOP BY HOLDING OFF INTERRUPTS MVW D15 MOVE 15 WORDS FROM EQT * MOVE EQT EXTENSION LDA EQADR GET ADDRESS OF EQT EXTENSION ADA D12 (IT'S IN EQT WORD 13) LDA A,I MVW D8 MOVE 8 WORD EXTENSION JSB $LIBX RESTORE INTERRUPTS DEF *+1 DEF *+1 * * CLA,INA PRESET TO LU=1 STA EQLU,I LDA LUMAX GET DRT TABLE SIZE CMA,INA NEGATE AS COUNTER STA C0UNT LDB DRT GET DRT ADDRESS LOOP4 LDA B,I GET DRT ENTRY AND B77 GET EQT NUMBER CPA EQTN,I = OURS? JMP GTEQT,I YES, WE'RE ALL DONE!, RETURN ISZ EQLU,I NO,INDEX TO NEXT INB ISZ C0UNT JMP LOOP4 KEEP GOING 'TILL RUN OUT... * CLA CAN'T FIND AN LU, SET IT = 0 STA EQLU,I JMP GTEQT,I RETURN TO CALLER * * GET HERE IF RUN OUT OF EQT'S... DONE1 CLA RETURN WITH EQTN=0 STA EQTN,I JMP GTEQT,I RETURN... * C0UNT BSS 1 EQADR BSS 1 EQTYP OCT 37400 D65TP OCT 32400 UNL XIF LST SPC 3 *PROCEDURE BLINE; BLINE NOP * PRINT A BLANK LINE JSB PRINT DEF BLANK D1 DEC 1 JMP BLINE,I SKP *PROCEDURE LFUNS; * BEGIN * * COMMENT * +------------------------------------+ * ! LIST FUNCTIONS PROVIDED BY DSINF ! * +------------------------------------+; * @FUN1 DBL FUN1+1 FUN1 ASC 13, /DSINF: VALID FUNCTIONS-- FUN2 ASC 18, AV AVAILABLE MEMORY SUSPEND LIST FUN3 ASC 9, CL I/O CLASSES FUN5 ASC 11, VA DS/1000 VALUES FUN6 ASC 12, DU DUMP OF SAM BLOCK FUN7 ASC 10, LI DS/1000 LISTS UNL IFN LST FUN9 ASC 14, NR NODAL ROUTING VECTOR UNL XIF LST FUN8 ASC 13, EQ DS/1000 EQT ENTRIES UNL IFN LST FUN8A ASC 15, EQ,N DS/1000 EQT ENTRY # N UNL XIF LST FUN10 ASC 14, /E OR EX TERMINATE DSINF @FN10 DBR FUN10+11 * LFUNS NOP * JSB BLINE * JSB PRINT DEF FUN1 DEC 13 * JSB PRINT DEF FUN2 DEC 18 * JSB PRINT DEF FUN3 DEC 9 * JSB PRINT DEF FUN5 DEC 11 * JSB PRINT DEF FUN6 DEC 12 * JSB PRINT DEF FUN7 DEC 10 * UNL IFN LST JSB PRINT DEF FUN9 DEC 14 * UNL XIF LST JSB PRINT DEF FUN8 DEC 13 * UNL IFN LST JSB PRINT DEF FUN8A DEC 15 * UNL XIF LST JSB PRINT DEF FUN10 DEC 14 * JSB BLINE * END OF LFUNS; JMP LFUNS,I SKP *PROCEDURE AVMEM; * BEGIN * COMMENT * +---------------------------------------+ * ! PRINT AVAILABLE MEMORY SUSPEND LIST ! * +---------------------------------------+; * * HEADINGS: MHED1 ASC 20, AVAILABLE MEMORY SUSPEND LIST IS EMPTY MHED2 ASC 23, PT SZ PRGRM T PRIOR AMT.MEM RN FATHER * B40K OCT 40000 B76K OCT 76000 B77 OCT 77 D3 DEC 3 D6 DEC 6 HYPHN ASC 1,-- "B" ASC 1,B "RN" ASC 1,RN WRD21 BSS 1 ID SEGMENT WORD 21 WRD22 BSS 1 ID SEGMENT WORD 22 FATHR BSS 1 FATHER'S ID SEGMENT WORD 1 MORE BSS 1 MORE FATHERS WAITING? AW1 DEF W1 BAW7 DBL W7 * AVMEM NOP JSB BLINE * IF (LINK := IGET(SUSP3))#0 THEN LDA SUSP3 STA LINK SZA,RSS JMP L383 * BEGIN * & PRINT HEADING JSB PRINT DEF MHED1 D15 DEC 15 * JSB BLINE * JSB PRINT DEF MHED2 DEC 23 * & PRINT A LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * & PRINT ID INFORMATION FOR EACH PROGRAM IN LIST * DO * BEGIN * & POINT TO NEXT LINK IN "AVAILABLE MEMORY" LIST * FILL(BUFR,BLANK); & CLEAR OUTPUT BUFR L338 LDA BLANK JSB FILL * & MOVE PROGRAM NAME LDA LINK ADA D12 CLE,ELA LDB BAW7 MBT D5 * W10 := KCVT(IGET(LINK+14) AND @17); & TYPE LDA LINK ADA D14 LDA A,I AND B17 JSB KCVT STA W10 * W3 := KCVT(((WRD22:=IGET(LINK+21)) AND @77)+1); & PARTN LDA LINK ADA D21 LDA A,I STA WRD22 AND B77 INA JSB KCVT STA W3 * W5 := KCVT((WRD22 AND @76000)\@2000 + 1); & SIZE LDA WRD22 AND B76K CLB LSR 10 INA JSB KCVT STA W5 * CNUMD(IGET(LINK+6),W11); & PRIORITY LDA LINK ADA D6 LDA A,I JSB CNVTD DEF W11 * IF (WRD21 := IGET(LINK+20))<0 THEN W14:="B "; & BATCH? LDB "B" LDA LINK ADA D20 LDA A,I STA WRD21 SSA STB W14 * CNUMD(IGET(LINK+1),W15); & AMOUNT OF MEMORY REQUESTED LDA LINK INA LDA A,I JSB CNVTD DEF W15 * IF (WRD21 AND @400)#0 THEN W19:="RN"; & RN? LDB "RN" LDA WRD21 AND B400 SZA STB W19 * & PUT LINE LENGTH IN "I" * I := 20; LDA D20 STA I * & CHECK "FATHER WAITING" BIT * IF (MORE := ((WRD21 AND @40000)#0)) THEN LDA WRD21 AND B40K SZA,RSS JMP L373 CCA STA MORE * BEGIN * & MOVE FATHER NAME(S) * FATHR := IGET(KYWRD + (WRD21 AND @377)); LDA WRD21 AND B377 ADA KYWRD LDA A,I STA FATHR * WHILE MORE DO * BEGIN * & MOVE THE NAME L354 LDA FATHR ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB MBT D5 * & CHECK FOR GRANDFATHER WAITING * IF (MORE := (IGET(FATHR+20) AND @40000)#0) THEN LDA FATHR ADA D20 LDA A,I AND B40K SZA,RSS JMP L373 CCA STA MORE * BEGIN * I := I + 3; LDA I ADA D3 STA I * FATHR:=IGET(KYWRD+(IGET(FATHR+20) AND @377)); LDA FATHR ADA D20 LDA A,I AND B377 ADA KYWRD LDA A,I STA FATHR * & CHECK FOR FULL OUTPUT BUFFER * IF I > 35 THEN LDA I ADA DM34 SSA JMP L354 * BEGIN & WRITE LINE, THEN CLEAR BUFFER * JSB PRINT DEF BUFR DEC 38 * FILL(BUFR,BLANK); LDA BLANK JSB FILL * I := 20; LDA D20 STA I * END; * END; * END; JMP L354 * END; * & PRINT OUTPUT BUFFER * PRINT1(I+3); L373 LDA I ADA D3 STA T1 JSB PRINT DEF BUFR T1 DEC 0 * LINK := IGET(LINK); & NEXT ID SEGMENT IN LIST OR 0 LDA LINK,I STA LINK * END * UNTIL LINK=0; SZA JMP L338 * & PRINT LINE OF HYPHENS * FILL(BUFR,"--"); LDA HYPHN JSB FILL * JSB PRINT DEF BUFR DEC 35 * END * ELSE JMP L384 * & NO PROGRAMS IN "AVAILABLE MEMORY" LIST * L383 JSB PRINT DEF MHED1 D20 DEC 20 * BLINE; L384 JSB BLINE * END OF AVMEM; JMP AVMEM,I SKP *PROCEDURE CLASS; * BEGIN * * COMMENT * +-------------------------------+ * ! PRINT I/O CLASS INFORMATION ! * +-------------------------------+; * *INTEGER NBLCK, & NUMBER OF BLOCKS WAITING IN SAM NBLCK BSS 01 * TBLCK; & TOTAL SIZE OF SAM BLOCKS FOR A CLASS TBLCK BSS 01 * * HEADINGS: CHED1 ASC 11, I/O CLASS INFORMATION CHED2 ASC 12, CLASSES IN SYSTEM CHED3 ASC 10, CLASSES IN USE: CHED4 ASC 22, CLASS STATE GET POSSIBLE OWNER CHED5 ASC 12, CLASSES AVAILABLE CHED6 ASC 13,[ BLOCK(S) WORDS] * ACHD6 DEF CHED6 "BU" ASC 1,BU "AL" ASC 1,AL "GT" ASC 1,GT B174C OCT 17400 D4 DEC 4 B17 EQU D15 D32 DEC 32 DM34 DEC -34 DCLAS DEF $CLAS AVLBL BSS 1 NUMBER OF CLASSES AVAILABLE TADDR BSS 1 I/O CLASS OR RN TABLE ADDRESS TSIZE BSS 1 TABLE SIZE ENTRY BSS 1 TABLE ENTRY NUMBER TWORD BSS 1 CONTENTS OF TABLE ENTRY LINK BSS 1 ID SEGMENT WORD 1 AW9 DEF W9 AW11 DEF W11 * * & GET CLASS I/O TABLE START ADDRESS & NUMBER OF ENTRIES * GETCL(TADDR,TSIZE); CLASS NOP LDA DCLAS GET CLASS TABLE ADDRESS JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF CHED1 DEC 11 * & PRINT NUMBER OF CLASSES * CNUMD(TSIZE,CHED2); LDA TSIZE JSB CNVTD DEF CHED2 * JSB PRINT DEF CHED2 D12 DEC 12 * BLINE; JSB BLINE * & PRINT HEAD FOR CLASSES IN USE * JSB PRINT DEF CHED3 D10 DEC 10 * JSB PRINT DEF CHED4 DEC 22 * & LOOK AT EACH CLASS TO DETERMINE STATE AND POSSIBLE OWNER * AVLBL := 0; CLA STA AVLBL * FOR ENTRY := TADDR+1 TO TADDR+TSIZE DO LDA TADDR INA STA ENTRY LDB TADDR ADB TSIZE STB LASTI L424 CMA,INA ADA LASTI SSA JMP L498 * BEGIN * INTOF; JSB $LIBR NOP * IF (TWORD := IGET(ENTRY))=0 THEN LDA ENTRY,I STA TWORD SZA JMP L434 * BEGIN * INTON; JSB $LIBX DEF *+1 DEF *+1 * AVLBL := AVLBL + 1; & CLASS IS AVAILABLE ISZ AVLBL * END * ELSE JMP L497 * BEGIN * FILL(BUFR,BLANK); L434 LDA BLANK JSB FILL * CNUMD(ENTRY-TADDR,W3); LDA TADDR CMA,INA ADA ENTRY JSB CNVTD DEF W3 * IF TWORD>0 THEN LDA TWORD SZA SSA JMP L456 * BEGIN & STATE 2--BUFFERED REQUESTS * W8 := "BU"; LDA "BU" STA W8 * & FOLLOW LINKS TO BLOCKS OF SAM * NBLCK := TBLCK := 0; CLA STA TBLCK STA NBLCK * WHILE TWORD>0 DO L441 LDA TWORD SZA SSA * BEGIN JMP L447 * NBLCK := NBLCK + 1; ISZ NBLCK * TBLCK := TBLCK + IXGET(TWORD+3); LDA TWORD ADA D3 JSB IXGET ADA TBLCK STA TBLCK * TWORD := IXGET(TWORD); LDA TWORD JSB IXGET STA TWORD * END; JMP L441 * INTON; L447 JSB $LIBX DEF *+1 DEF *+1 * & PRINT INFORMATION * & MOVE # OF BLOCKS AND WORDS HEAD TO OUTPUT BUFFER LDA ACHD6 LDB AW9 MVW D13 * W10 := KCVT(NBLCK); LDA NBLCK JSB KCVT STA W10 * CNUMD(TBLCK,HOLD1); LDA TBLCK JSB CNVTD DEF HOLD1 * MOVE(HOLD2,W16,4); LDA HOLD2 STA W16 LDA HOLD3 STA W17 * JSB PRINT DEF BUFR DEC 22 * FILL(BUFR,BLANK); LDA BLANK JSB FILL * END * ELSE INTON; JMP L457 L456 JSB $LIBX DEF *+1 DEF *+1 * IF (TWORD AND @40000)=0 THEN L457 LDA TWORD AND B40K SZA JMP L461 * W8 := "AL" & ALLOCATED * ELSE LDA "AL" STA W8 JMP L476 * BEGIN * W8 := "GT"; & GET L461 LDA "GT" STA W8 * & SOMEONE MUST BE WAITING ON THIS CLASS'S GET * INTOF; JSB $LIBR NOP * LINK := IGET(SUSP2); & HEAD OF GENERAL WAIT QUEUE LDA SUSP2 STA LINK * WHILE LINK#0 AND IGET(LINK+1)#ENTRY DO L465 LDA LINK SZA,RSS JMP L467 LDA LINK INA LDA A,I CMA,INA ADA ENTRY SZA,RSS * LINK := IGET(LINK); JMP L467 LDA LINK,I STA LINK JMP L465 * INTON; L467 JSB $LIBX DEF *+1 DEF *+1 * IF LINK#0 THEN LDA LINK SZA,RSS JMP L473 * BEGIN & FOUND "GET" PROGRAM * & MOVE NAME TO OUTPUT BUFFER LDA LINK ADA D12 CLE,ELA LDB AW11 CLE,ELB MBT D5 * END * ELSE JMP L476 * & MOVE "" TO BUFFER L473 LDA ANONE LDB AW11 MVW D3 * END; * & PICK UP INDEX INTO KEYWORD TABLE, MODULO 32 * IDNUM := ROTATE(TWORD AND @17400); L476 LDA TWORD AND B174C ALF,ALF * IF IDNUM=0 THEN IDNUM:=32; SZA,RSS LDA D32 STA IDNUM * & FIND POSSIBLE OWNERS * I := 15; & OUTPUT BUFFER POINTER LDA D15 STA I * DONE := FALSE; CLA STA DONE * DO * BEGIN * LINK := IGET(KYWRD+IDNUM); L483 LDA KYWRD ADA IDNUM LDA A,I STA LINK * IF (IGET(LINK+14) AND @20)=0 AND IGET(LINK+12)#0 THEN ADA D14 LDA A,I AND B20 SZA JMP L490 LDA LINK ADA D12 LDA A,I SZA,RSS JMP L490 * BEGIN & GOOD ID SEGMENT * MOVII(LINK+12,AW1+I,5); LDA LINK ADA D12 CLE,ELA LDB AW1 ADB I CLE,ELB MBT D5 * IF (I := I + 4)>34 THEN LDA I ADA D4 STA I ADA DM34 SZA SSA JMP L490 * DONE := TRUE; & OUTPUT BUFFER IS FULL CCA STA DONE * END; * IF (IDNUM:=IDNUM+32)>MAXID THEN L490 LDA IDNUM ADA D32 STA IDNUM CMA,INA ADA MAXID SSA,RSS JMP L493 * DONE := TRUE; & ALL ID SEGMENTS CHECKED CCA STA DONE * END * UNTIL DONE; L493 LDA DONE SSA,RSS JMP L483 * & PRINT LINE OF INFORMATION FOR THIS CLASS LDA I STA T4 JSB PRINT DEF BUFR T4 DEC 0 * END; * END; L497 LDA ENTRY INA STA ENTRY JMP L424 * IF AVLBL=TSIZE THEN L498 LDA TSIZE CMA,INA ADA AVLBL SZA JMP L502 * JSB PRINT DEF NONE DEC 7 * ELSE JMP L507 * BEGIN & PRINT NUMBER OF AVAILABLE CLASSES * BLINE; L502 JSB BLINE * CNUMD(AVLBL,CHED5); LDA AVLBL JSB CNVTD DEF CHED5 * JSB PRINT DEF CHED5 DEC 12 * END; * BLINE; L507 JSB BLINE * END OF CLASS; JMP CLASS,I SPC 3 DONE BSS 1 ALL POSSIBLE CLASS OWNERS FOUND? IDNUM BSS 1 INDEX INTO KEYWORD TABLE NONE ASC 7, SKP *PROCEDURE VALUS; * BEGIN * * COMMENT * +------------------------+ * ! PRINT DS/1000 VALUES ! * +------------------------+; * * HEADINGS: VHED1 ASC 8, DS/1000 VALUES: VHED2 ASC 20, RESOURCE NUMBERS: OWNER LOCKER VHED3 ASC 7,TABLE ACCESS VHED4 ASC 7,QUIESCENT VHED5 ASC 7,QUEZ "LISTEN" VHD12 ASC 12, TIMEOUT VALUES (SEC): VHD13 ASC 13, MASTER T/O VHD14 ASC 13, SLAVE T/O VHD15 ASC 13, REMOTE BUSY WAIT VHD16 ASC 13, REMOTE QUIET WAIT VHED7 ASC 16, RFA FILES MAY BE OPEN VHED9 ASC 11, HP3000 IS ON LU VHD10 ASC 21, LOCAL ID SEQUENCE: VHD11 ASC 21, REMOTE ID SEQUENCE: * B377 OCT 377 UPMSK OCT 177400 MASK2 OCT 177760 D5 DEC 5 D26 DEC 26 AVH10 DBL VHD10+13 AVH11 DBL VHD11+13 DRNTB DEF $RNTB RN BSS 1 FMTAD BSS 1 GLBAL ASC 5, AGLBL DEF GLBAL ANONE DEF NONE+4 AW3 DEF W3 AW13 DEF W13 AW16 DEF W16 AW18 DEF W18 * * PROCEDURE RNOUT(RN,FMTAD); RNOUT BSS 01 * VALUE RN,FMTAD; INTEGER RN,FMTAD; * BEGIN & PRINT RN INFORMATION AND B377 ISOLATE RESOURCE STA RN NUMBER. LDA RNOUT,I STA FMTAD ISZ RNOUT * FILL(BUFR,BLANK); LDA BLANK JSB FILL * & MOVE TITLE LDA FMTAD LDB AW3 MVW D7 * & CONVERT RN NUMBER * W10 := KCVT(RN); LDA RN JSB KCVT STA W10 * & FIND LOCKER * TWORD := IGET(TADDR+RN); LDA TADDR ADA RN LDA A,I STA TWORD * IF (IDNUM := TWORD AND @377)=@377 THEN AND B377 STA IDNUM CPA B377 RSS JMP L548 * & MOVE "" LDA AGLBL LDB AW16 INB MVW D5 * ELSE IF IDNUM=0 THEN JMP L553 L548 LDA IDNUM SZA JMP L551 * & MOVE "" LDA ANONE LDB AW18 MVW D3 * ELSE JMP L553 * & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 L551 LDA KYWRD ADA IDNUM LDA A,I ADA D12 CLE,ELA LDB AW18 CLE,ELB MBT D5 * & FIND OWNER * IF (IDNUM := ROTATE(TWORD) AND @377)=@377 THEN L553 LDA TWORD ALF,ALF AND B377 STA IDNUM CPA B377 RSS JMP L555 * & MOVE "" LDA AGLBL LDB AW11 INB MVW D5 * ELSE IF IDNUM=0 THEN JMP L560 L555 LDA IDNUM SZA JMP L558 * & MOVE "" LDA ANONE LDB AW13 MVW D3 * ELSE JMP L560 * & MOVE THE PROGRAM NAME FROM IGET(KYWRD+IDNUM)+12 L558 LDA KYWRD ADA IDNUM LDA A,I ADA D12 CLE,ELA LDB AW13 CLE,ELB MBT D5 * & PRINT INFORMATION L560 JSB PRINT DEF BUFR D21 DEC 21 * END OF RNOUT; JMP RNOUT,I * * & PRINT HEADINGS VALUS NOP * BLINE; JSB BLINE * JSB PRINT DEF VHED1 D8 DEC 8 * BLINE; JSB BLINE * & RESOURCE NUMBERS JSB PRINT DEF VHED2 DEC 20 * GETRN(TADDR,TSIZE); LDA DRNTB GET RN TABLE ADDRESS JSB INDR CHASE INDIRECT ADDRESS STA TADDR LDA A,I GET NUMBER OF ENTRIES STA TSIZE * RNOUT(TBRN,FADDRESS(VHED3)); LDA #TBRN JSB RNOUT DEF VHED3 * RNOUT(QRN,FADDRESS(VHED4)); LDA #QRN JSB RNOUT DEF VHED4 * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L574 * RNOUT(QZRN,FADDRESS(VHED5)); LDA #QZRN JSB RNOUT DEF VHED5 * BLINE; L574 JSB BLINE * & TIMEOUT VALUES JSB PRINT DEF VHD12 DEC 12 * CNUMD(-(MSTO OR @177400)*5,VHD13[10]); LDA #MSTO IOR UPMSK CMA,INA CLB MPY D5 JSB CNVTD DEF VHD13+10 * JSB PRINT DEF VHD13 D13 DEC 13 * CNUMD(-(SVTO OR @177400)*5,VHD14[10]); LDA #SVTO IOR UPMSK CLB MPY D5 CMA,INA JSB CNVTD DEF VHD14+10 * JSB PRINT DEF VHD14 DEC 13 * HOLD1 := KCVT(NOT(ROTATE(BREJ) OR @177760)); LDA #BREJ ALF,ALF IOR MASK2 CMA JSB KCVT STA VHD15+12 * MOVII(AHLD1,FADDRESS(VHD15)+13,2); * JSB PRINT DEF VHD15 DEC 13 * CNUMD(-WAIT,HOLD1); LDA #WAIT CMA,INA JSB CNVTD DEF HOLD1 * MOVIIAHLD2,FADDRESS(VHD16)+12,4); LDA HOLD2 STA VHD16+11 LDA HOLD3 STA VHD16+12 * JSB PRINT DEF VHD16 DEC 13 * BLINE; JSB BLINE * & NUMBER OF FILES WHICH MAY BE OPEN AT ONCE * CNUMD(RFSZ,VHED7[2]); LDA #RFSZ JSB CNVTD DEF VHED7+2 * JSB PRINT DEF VHED7 B20 DEC 16 * & CHECK FOR HP3000 AGAIN * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L611 * BEGIN * BLINE; JSB BLINE * & HP3000 LU * VHED9[10] := KCVT(LU3K); LDA #LU3K JSB KCVT STA VHED9+10 * JSB PRINT DEF VHED9 DEC 11 * & LOCAL ID SEQUENCE LDA D$LID LOCAL ID POINTER IN "RES" LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0 JMP L603 INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH10 B := DEST ADDRESS MBT I MOVE CHARACTERS L603 LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L607 * PRINT(VHD10,26+I); ADA D26 CMA,INA STA T3 JSB PRINT DEF VHD10 T3 DEC 0 * & REMOTE ID SEQUENCE L607 LDA D$RID GET REMOTE POINTER IN "RES" INA LDB A,I B := NUMBER OF CHARACTERS STB I STORE IN I SZB,RSS IF # 0, JMP L603A INA A := ADDR OF CHARACTERS CLE,ELA CHANGE TO BYTE ADDR LDB AVH11 B := DESTINATION ADDR MBT I MOVE CHARACTERS L603A LDA I A := NUMBER OF CHARACTERS * IF I>0 THEN SZA SSA JMP L611 * PRINT(VHD11,26+I); ADA D26 CMA,INA STA T7 JSB PRINT DEF VHD11 T7 DEC 0 * END; * BLINE; L611 JSB BLINE *END OF VALUS; JMP VALUS,I SKP *PROCEDURE DUMP; * BEGIN * * COMMENT * +--------------------------------------+ * ! DUMP CONTENTS OF DS/1000 SAM BLOCK ! * +--------------------------------------+; * * INTEGER BADDR, & DUMP BEGINNING ADDRESS BADDR BSS 01 * EADDR, & DUMP ENDING ADDRESS EADDR BSS 01 * INCR; & ADDRESS INCREMENT INCR BSS 01 * * HEADINGS: DHED1 ASC 9, DUMP OF TCB BLOCK DHED2 ASC 25, LOC OCTAL CONTENTS OF LOC THROUGH LOC+4 DHED3 ASC 20, DUMP OF HP3000 TRANSACTION STATUS TABLE DHED4 ASC 25, LOC OCTAL CONTENTS OF LOC THROUGH LOC+7 * D33 DEC 33 DM1 DEC -1 * PROCEDURE DODMP; DODMP BSS 01 * BEGIN * FILL(BUFR,BLANK); LDA BLANK JSB FILL * FOR I := BADDR STEP INCR UNTIL EADDR DO LDA BADDR STA I L637 CMA,INA ADA EADDR LDB INCR SSB CMA,INA SSA JMP L647 * BEGIN * & CONVERT ADDRESS * CNUMO(I,W2); JSB CNUMO DEF *+3 DEF I DEF W2 * FOR J := 0 TO INCR-1 DO CLA STA J CCB ADB INCR STB T1 L641 CMA,INA ADA T1 SSA JMP L645 * & CONVERT CONTENTS * CNUMO(SAM[I+J-FWAM],BUFR[7+4*J]); LDA I ADA J CMA ADA #FWAM CMA CAX LAX SAM STA T2 LDA J RAL,RAL ADA D6 ADA AW1 STA T4 JSB CNUMO DEF *+3 DEF T2 DEF T4,I LDA J INA STA J JMP L641 * & PRINT L645 JSB PRINT DEF BUFR LEN1 NOP * END; LDA I ADA INCR STA I JMP L637 * BLINE; L647 JSB BLINE * END OF DODMP; JMP DODMP,I * * & GET DS/1000 SAM BLOCK DUMP NOP * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * SAMIN := TRUE; CCA STA SAMIN * BLINE; JSB BLINE * & DUMP TCB AREA IN SAM JSB PRINT DEF DHED1 D9 DEC 9 * JSB PRINT DEF DHED2 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := FWAM; LDA #FWAM STA BADDR * EADDR := (IF TST#0 THEN TST ELSE NRV) - 1; LDA #TST SZA,RSS LDA #NRV ADA DM1 STA EADDR * INCR := 5; LDA D5 STA INCR LDA D25 SET LEN1 STA LEN1 TO 25. * DODMP; JSB DODMP * & HP3000 CONNECTED? * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L674 * BEGIN * & DUMP TST AREA IN SAM * JSB PRINT DEF DHED3 DEC 20 * JSB PRINT DEF DHED4 DEC 25 * & SET UP START, STOP, AND INCREMENT OF ADDRESS * BADDR := TST; LDA #TST STA BADDR * EADDR := FWAM + SSIZE - 1; CCA ADA #FWAM ADA SSIZE STA EADDR * INCR := 7; LDA D7 STA INCR LDA D33 SET LEN1 STA LEN1 TO 33. * DODMP; JSB DODMP * END; * END OF DUMP; L674 JMP DUMP,I SKP *PROCEDURE LISTS; * BEGIN * * COMMENT * +----------------------------------+ * ! PRINT DS/1000 LIST INFORMATION ! * +----------------------------------+; * * INTEGER COUNT, & # OF ENTRIES IN A LIST COUNT BSS 01 * STCB, & # OF SLAVE TCB ENTRIES STCB BSS 01 * HEAD, & LIST HEAD HEAD BSS 01 * NEXT; & NEXT LIST ELEMENT NEXT BSS 01 * * HEADINGS: LHED1 ASC 7, DS/1000 LISTS LHED2 ASC 20, ENTRIES IN MASTER REQUEST LIST, ASC 9, STARTING AT LHED3 ASC 24, ACTIVE SLAVE MONITORS: 1ST TCB LHED4 ASC 24, STREAM CLASS MONITOR ENTRIES LOCATION LHED5 ASC 24, ENTRIES IN NULL LIST, STARTING AT LHED7 ASC 20, ENTRIES IN HP3000 PROCESS LIST, ASC 9, STARTING AT LHED8 ASC 16, ENTRIES IN SLAVE LISTS NOT15 OCT 77777 D2 DEC 2 D19 DEC 19 D39 DEC 39 * * PROCEDURE CHASE; CHASE BSS 01 * BEGIN * COMMENT CHASE A LIST TO ITS END; * COUNT := 0; CLA STA COUNT * WHILE NEXT#0 DO L705 LDA NEXT SZA,RSS * BEGIN JMP L710 * NEXT := SAM[NEXT-FWAM]; LDA #FWAM CMA,INA ADA NEXT CAX LAX SAM STA NEXT * COUNT := COUNT + 1; ISZ COUNT * END; JMP L705 * END; L710 LDA COUNT PUT COUNT IN A-REG. JMP CHASE,I RETURN. * * LISTS NOP * & PRINT HEADINGS * BLINE; JSB BLINE * JSB PRINT DEF LHED1 D7 DEC 7 * BLINE; JSB BLINE * & DO WE NEED TO GET SAM AND POINTERS? * IF NOT SAMIN THEN LDA SAMIN SSA JMP L721 * GTSAM(SAM[0],SSIZE,PNTR[-3]); JSB GTSAM * & CHECK OUT MASTER REQUEST LIST * HEAD := NEXT := PNTR[-1]; L721 LDA PNTR-1 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED2[1]); JSB CNVTD DEF LHED2+1 * CNUMO(HEAD,LHED2[26]); JSB CNUMO DEF *+3 DEF HEAD DEF LHED2+26 * PRINT(LHED2,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T2 JSB PRINT DEF LHED2 T2 DEC 0 * BLINE; JSB BLINE * & CHECK SLAVE STREAMS JSB PRINT DEF LHED3 DEC 24 JSB PRINT DEF LHED4 DEC 24 * STCB := 0; CLA STA STCB * FOR I := 0 TO LSTRM DO CLA STA I L733 CMA,INA ADA NOSTR SSA JMP L753 * BEGIN * HEAD := IGET(LDEF+2+I); LDA #LDEF ADA D2 ADA I LDA A,I STA HEAD * NEXT := PNTR[I]; LDX I LAX PNTR STA NEXT * FILL(BUFR,BLANK); LDA BLANK JSB FILL * & GET MONITOR NAME FROM ID SEGMENT LDA HEAD ADA D2 LDA A,I * (CHECK FOR INACTIVE MONITOR:) SZA,RSS JMP L751A AND NOT15 ADA D12 CLE,ELA LDB AW11 INB CLE,ELB MBT D5 * W5 := KCVT(I); & STREAM NUMBER LDA I JSB KCVT STA W5 * W9 := KCVT(IGET(HEAD+1) AND @377); & CLASS NUMBER LDA HEAD INA LDA A,I AND B377 JSB KCVT STA W9 * IF NEXT>0 THEN LDA NEXT SZA SSA JMP L751 * BEGIN * & WE HAVE AN ACTIVE STREAM * CNUMO(NEXT,W21); & STARTING LOCATION JSB CNUMO DEF *+3 DEF NEXT DEF W21 * CHASE; JSB CHASE * CNUMD(COUNT,W16); & NUMBER OF ENTRIES JSB CNVTD DEF W16 * JSB PRINT DEF BUFR DEC 23 * STCB := STCB + COUNT; LDA STCB ADA COUNT STA STCB JMP L751A * END; * EMPTY SLAVE LIST-- W18:="0" L751 LDA "0" STA W18 JSB PRINT DEF BUFR DEC 18 *** * END; L751A LDA I INA STA I JMP L733 * & TOTAL NUMBER OF SLAVE TCB'S * CNUMD(STCB,LHED8[1]); L753 LDA STCB JSB CNVTD DEF LHED8+1 * JSB PRINT DEF LHED8 DEC 16 * BLINE; JSB BLINE * & NULL LIST * HEAD := NEXT := PNTR[-2]; LDA PNTR-2 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED5[1]); JSB CNVTD DEF LHED5+1 * CNUMO(HEAD,LHED5[21]); JSB CNUMO DEF *+3 DEF HEAD DEF LHED5+21 * PRINT(LHED5,29+19*SIGN(HEAD)); LDB D29 LDA HEAD SZA ADB D19 CMB,INB STB T5 JSB PRINT DEF LHED5 T5 DEC 0 * & CHECK FOR HP3000 * IF LU3K#0 THEN LDA #LU3K SZA,RSS JMP L787 * BEGIN * & PROCESS NUMBER LIST * HEAD := NEXT := PNTR[-3]; LDA PNTR-3 STA NEXT STA HEAD * CHASE; JSB CHASE * CNUMD(COUNT,LHED7[1]); JSB CNVTD DEF LHED7+1 * CNUMO(HEAD,LHED7[26]); JSB CNUMO DEF *+3 DEF HEAD DEF LHED7+26 * PRINT(LHED7,39+19*SIGN(HEAD)); LDB D39 LDA HEAD SZA ADB D19 CMB,INB STB T6 JSB PRINT DEF LHED7 T6 DEC 0 * END; * BLINE; L787 JSB BLINE * END OF LISTS; JMP LISTS,I SKP *PROCEDURE EQTS; EQTS NOP * * COMMENT * +--------------------------------------+ * ! PRINT CONTENTS OF ALL DS/1000 EQTS ! * +--------------------------------------+; * JSB BLINE UNL IFN LST *IF GRPM#0 THEN LDA #GRPM SZA JMP L857 UNL XIF LST * BEGIN JMP L903 * BEGIN * * INTEGER EQNUM, & EQT NUMBER EQNUM BSS 01 * LUNUM, & LU CONECTED TO EQT LUNUM BSS 01 * FPNTR, & FORMAT ADDRESS POINTER FPNTR BSS 01 * * INTEGER ARRAY EBUFR[1:22]; & HOLDS EQT WORDS EBUFR EQU *-1 BSS 23 * AEQ1 DEF EQ1 AEHD4 DEF EHED4+1 DM22 DEC -22 DM6 DEC -6 "0" ASC 1, 0 "1" ASC 1, 1 EHED2 ASC 11, DVA65 EQT INFORMATION EHED3 ASC 12, EQT # , LU # : EHED4 ASC 18, WORD VALUE MEANING ASC 11, WORD VALUE MEANING EHED5 ASC 25, *BIT BREAKDOWN 15 12 9 6 3 0 EHED6 ASC 11, DVG67 EQT INFORMATION * * & EQT WORDS DESCRIPTIONS--20 CHARACTERS EACH EQ1 ASC 10,I/O LIST ADDRESS ASC 10,INITIATION ADDRESS ASC 10,CONTINUATION ADDR ASC 10,STATUS/UNIT/SUBCHNL* ASC 10,AV/TYPE/STATUS* ASC 10,CONWD UNL IFN LST ASC 10,DATA BUFFER ADDRESS ASC 10,DATA BUFFER LENGTH ASC 10,REQUEST BUFFER ADDR ASC 10,REQUEST BUFFER LEN ASC 10,COROUTINE ADDRESS ASC 10,CURRENT STATUS* ASC 10,EQT EXTENSION ADDR ASC 10,NOMINAL TIMEOUT ASC 10,MICROCODE TIMEOUT ASC 10,DATA TRANSFER COUNT ASC 10,LAST WORD RECEIVED ASC 10,VPW/REPLY REQ LENGTH ASC 10,DPW/REPLY DATA LEN ASC 10,TOTAL BLOCK TRANSFERS ASC 10,TOTAL # RETRIES ASC 10,NEW REQ ID SEQ ADDR UNL XIF LST * AW20 DEF W20 COL1 BSS 1 COL3 BSS 1 LASTI BSS 1 LASTJ BSS 1 * * PROCEDURE EQMOV(COL1,COL2,COL3); * INTEGER COL1,COL2,COL3; * BEGIN & MOVE EQT INFO TO OUTPUT BUFFER EQMOV NOP STA COL1 ADA D2 STA COL2 ADA D4 STA COL3 * COL1 := KCVT(I); & EQT WORD NUMBER LDA I JSB KCVT STA COL1,I * CNUMO(EBUFR[I],COL2); & CONTENTS LDX I LAX EBUFR STA T5 JSB CNUMO DEF *+3 DEF T5 COL2 DEF *-* * & MOVE MEANING LDA FPNTR LDB COL3 MVW D10 * I := I + 1; ISZ I * POINT TO NEXT MEANING LDA FPNTR ADA D10 STA FPNTR * END OF EQMOV; JMP EQMOV,I SPC 1 * THIS ALGOL BLOCK WAS MODIFIED INTO A SUBROUTINE TO PRINT * EQT INFORMATION. EQOUT NOP * BEGIN * & PRINT HEADER FOR EQT INFORMATION * BLINE; JSB BLINE * CNUMD(EQNUM,HOLD1); LDA EQNUM JSB CNVTD DEF HOLD1 * MOVII(AHLD2,FADDRESS(EHED3)+5,4); LDA HOLD2 STA EHED3+4 LDA HOLD3 STA EHED3+5 * EHED3[10] := KCVT(LUNUM); LDA LUNUM JSB KCVT STA EHED3+10 * JSB PRINT DEF EHED3 DEC 12 * JSB PRINT DEF EHED4 D29 DEC 29 * & PRINT CONTENTS OF EQT AND EXTENT * FILL(BUFR,BLANK); LDA BLANK JSB FILL * FPNTR := FADDRESS(EQ1)+1; LDA AEQ1 STA FPNTR * I := 1; CLA,INA STA I * WHILE I NODE NUMBER (OR "NONE"), DEF APMSG WITHOUT A HEADER. DEC 16 JSB BLINE JMP DSNRV,I PROCESS COMPLETE--CHECK FOR NEW REQUEST. SPC 2 NODM1 ASC 10, NRV SPECIFICATIONS: NODM2 ASC 7, LOCAL NODE#: LOCLN ASC 3, ASC 8,, NO. OF NODES= NNODS ASC 3, * NRVMS EQU * SEQN ASC 3, ASC 4,: NODE= NODEN ASC 3, ASC 3,, LU= VECTR ASC 3, ASC 3,, TO= NRVTO ASC 3, ASC 3,(SEC.) * APMSG ASC 13, LAST LOAD-NODE= APNOD ASC 3,NONE * BT137 OCT 37700 DM256 DEC -256 * NCNT NOP NUMBER OF NODES NONDT NOP NODE COUNTER NPNT NOP SKP UNL XIF LST *PROCEDURE XEQFN; * "AV" ASC 1,AV "CL" ASC 1,CL "VA" ASC 1,VA "DU" ASC 1,DU "LI" ASC 1,LI "NR" ASC 1,NR "EQ" ASC 1,EQ "/E" ASC 1,/E "EX" ASC 1,EX FNCTN ASC 3, FUNCTION TO BE PERFORMED * XEQFN BSS 01 * BEGIN * * COMMENT * +----------------------+ * ! EXECUTE A FUNCTION ! * +----------------------+; * * IF PRMPT THEN LDA PRMPT SSA,RSS JMP L928 * BEGIN & PROMPT FOR COMMAND UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF BLANK DEF D1 * & PRINT THE PROMPT UNL IFN LST JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST JSB EXEC DEF *+5 UNL XIF LST DEF D2 DEF INLU DEF PROMP DEF D9 * END; * * CLEAR WORDS 2 & 3 OF FNCTN LDA BLANK STA FNCTN+1 STA FNCTN+2 * READ COMMAND FROM INPUT LU UNL IFN LST L928 JSB DEXEC DEF *+6 DEF NODE UNL XIF LST UNL IFZ LST L928 JSB EXEC DEF *+5 UNL XIF LST DEF SD1 SET NO-ABORT BIT. DEF INLU DEF FNCTN DEF D3 JMP EX ERROR: TREAT AS "/E". * * EXECUTE COMMAND * IF FNCTN="AV" THEN AVMEM LDA FNCTN CPA "AV" RSS JMP *+3 JSB AVMEM JMP L939 * ELSE IF FNCTN="CL" THEN CLASS CPA "CL" RSS JMP *+3 JSB CLASS JMP L939 * ELSE IF FNCTN="VA" THEN VALUS CPA "VA" RSS JMP *+3 JSB VALUS JMP L939 * ELSE IF FNCTN="DU" THEN DUMP CPA "DU" RSS JMP *+3 JSB DUMP JMP L939 * ELSE IF FNCTN="LI" THEN LISTS CPA "LI" RSS JMP *+3 JSB LISTS JMP L939 UNL IFN LST * CHECK FOR "NR": CPA "NR" RSS JMP *+3 JSB DSNRV JMP L939 UNL XIF LST * ELSE IF FNCTN="EQ" THEN EQTS CPA "EQ" RSS JMP *+3 JSB EQTS JMP L939 * ELSE IF FNCTN="/E" OR FNCTN="EX" THEN MOREC:=FALSE CPA "/E" JMP EX CPA "EX" RSS JMP BADF EX CLA STA MOREC JMP L939 * ELSE LFUNS; BADF JSB LFUNS * END OF XEQFN; L939 JMP XEQFN,I SPC 6 B206 OCT 206 B400 OCT 400 B401 OCT 401 DM640 DEC -640 DM11 DEC -11 D16 DEC 16 D64 DEC 64 D640 DEC 640 SD1 DEF 1,I @EXCW DBL EXECW EXECW ASC 3,EXECW @NAME NOP PROMP ASC 9,/DSINF: FUNCTION?_ RUNL ASC 13, /DSINF: RUN LSTEN FIRST! FINIS ASC 11, *** END OF DSINF *** @RUNL DBL RUNL+1 @PRMP DBR PROMP @FINS DBL FINIS+6 SUB BSS 1 INPUT LU'S SUBCHANNEL DVR BSS 1 INPUT LU'S DRIVER TYPE MOREC BSS 1 MORE COMMANDS TO READ? PRMPT BSS 1 PROMPT FOR COMMANDS? SKP *+-----------------------------+ *! BEGINNING OF MAIN PROGRAM ! *+-----------------------------+; SPC 1 * PICK UP RUN-TIME PARAMETERS *RMPAR(INLU); DSINF JSB RMPAR DEF *+2 DEF INLU *& SET FLAGS *PRMPT := SAMIN := FALSE; CLA STA SAMIN STA PRMPT * UNL IFN LST * DETERMINE THE NODE NUMBER: LDA NODE IF NODE SZA NOT 0, JMP OK USE IT. LDB FLAG CHECK SZB NODE 0 JMP OK FLAG. * WE HAVE BEEN SCHEDULED WITH BOTH FLAG AND NODE SET TO 0. * IF OUR FATHER IS "EXECW", USE #CNOD AS THE NODE NUMBER. LDB XEQT GET ADB D20 FATHER'S LDA B,I ID SEGMENT AND B377 NUMBER. SZA,RSS IF ZERO, JMP LOCAL WE ARE LOCAL. ADA DM1 ADA KEYWD GET ADDR OF FATHER'S LDB A,I ID SEGMENT. ADB D12 WHAT'S CLE,ELB HIS NAME? LDA @EXCW EXECW? CBT D5 JMP NTLOC YES--NOT LOCAL NOP LOCAL CCA NODE:=-1 RSS NTLOC LDA #CNOD NODE:=#CNOD STA NODE OK EQU * UNL XIF LST SPC 1 * GET TRUE PROGRAM NAME (USUALLY WILL BE DSINF). LDA XEQT GET ID SEG ADDR. ADA D12 CLE,ELA STA @NAME MOVE FOR LDB @RUNL "RUN LSTEN" MESSAGE. MBT D5 LDA @NAME MOVE FOR LDB @FINS FINAL MESSAGE. MBT D5 LDA @NAME MOVE FOR LDB @PRMP PROMPT. MBT D5 * *IF INLU<1 OR INLU>IGET(LUMAX) THEN CCA ADA INLU SSA JMP L963 LDA LUMAX CMA ADA INLU SSA JMP L968 * BEGIN * INLU := @401; & DEFAULT INPUT LU IS SYS CONSOLE L963 LDA B401 STA INLU * PRMPT := TRUE; & INTERACTIVE DEVICE CCA STA PRMPT * END * ELSE JMP L977 * BEGIN & GET LU INFORMATION UNL IFN LST * DEXEC(NODE,13,INLU,DVR,T7,SUB); L968 JSB DEXEC DEF *+7 DEF NODE UNL XIF LST UNL IFZ LST * EXEC(13,INLU,DVR,T7,SUB); L968 JSB EXEC DEF *+6 UNL XIF LST DEF D13 DEF INLU DEF DVR DEF T7 DEF SUB * SUB := SUB AND @17; LDA SUB AND B17 STA SUB * DVR := ROTATE DVR AND @77; LDA DVR ALF,ALF AND B77 STA DVR * PRMPT := (DVR=00) OR (DVR=07 OR DVR=05 AND SUB=0); CCB SZA,RSS JMP TRU CPA D7 JMP SUBCK CPA D5 JMP SUBCK JMP FLS SUBCK LDA SUB SZA FLS CMB TRU STB PRMPT * IF PRMPT THEN SSB,RSS JMP L977 * INLU:=INLU OR @400; & SET "K" BIT FOR INTERACTIVE INPUT LDA INLU IOR B400 STA INLU * END; * CHECK OUTPUT LU DEVICE *IF OUTLU<1 OR OUTLU>IGET(LUMAX) THEN L977 CCA ADA OUTLU SSA JMP L978 LDA LUMAX CMA ADA OUTLU SSA JMP L984 * OUTLU := IF PRMPT THEN INLU ELSE @206; L978 LDB INLU LDA PRMPT SSA,RSS LDB B206 STB OUTLU * * FIND # OF PROGRAM ID SEGMENTS IN SYSTEM *KYWRD := IGET(KEYWD) - 1; L984 CCA ADA KEYWD STA KYWRD *I := 1; CLA,INA STA I *WHILE IGET(KYWRD+I)#0 DO L986 LDA KYWRD ADA I LDA A,I SZA,RSS * I := I + 1; JMP L988 LDA I INA STA I JMP L986 *MAXID := I - 1; L988 CCA ADA I STA MAXID * *SSIZE := (IF TST#0 THEN (TST+14*TSTSZ) ELSE NRV) - FWAM; LDA #TST SZA,RSS JMP L995 LDA D14 CLB MPY #TST+1 ADA #TST RSS L995 LDA #NRV CMA ADA #FWAM CMA STA SSIZE *IF SSIZE>640 THEN ADA DM640 SZA SSA JMP L1001 * & DON'T OVERRUN SAM ARRAY * SSIZE := 640; LDA D640 STA SSIZE * * CHECK TO SEE IF LSTEN HAS BEEN RUN *IF FWAM=0 THEN L1001 LDA #FWAM SZA JMP L1007 * JSB PRINT DEF RUNL DEC 13 * ELSE JMP L1037 * * * CHECK FOR NON-INTERACTIVE RUN *IF CONWD # 0 THEN L1007 LDA CONWD SZA,RSS JMP L1033 * BEGIN * INTEGER TMSC,SEC,MIN,HOUR; JMP L1014 TMSC BSS 01 SEC BSS 01 MIN BSS 01 HOUR BSS 01 BSS 1 TIME ASC 9, TIME--- : : * PRMPT := FALSE; L1014 CLA STA PRMPT * EXEC(11,TMSC); JSB EXEC DEF *+3 DEF D11 DEF TMSC * TIME[8] := KCVT(SEC); LDA SEC JSB KCVT STA TIME+8 * TIME[6] := KCVT(MIN); LDA MIN JSB KCVT STA TIME+6 * TIME[4] := KCVT(HOUR); LDA HOUR JSB KCVT STA TIME+4 JSB BLINE * JSB PRINT DEF TIME DEC 9 UNL IFN LST * PRINT LOCAL NODE NUMBER LDA #NODE JSB CNVTD DEF LOCLN JSB PRINT DEF NODM2 DEC 10 UNL XIF LST * BLINE; JSB BLINE * IF (CONWD AND 1)#0 THEN AVMEM; LDA CONWD AND D1 SZA JSB AVMEM * IF (CONWD AND 2)#0 THEN CLASS; LDA CONWD AND D2 SZA JSB CLASS * IF (CONWD AND 4)#0 THEN VALUS; LDA CONWD AND D4 SZA JSB VALUS * IF (CONWD AND 8)#0 THEN DUMP; LDA CONWD AND D8 SZA JSB DUMP * IF (CONWD AND 16)#0 THEN LISTS; LDA CONWD AND D16 SZA JSB LISTS UNL IFN LST * IF (CONWD AND 32)#0 THEN DSNRV; LDA CONWD AND D32 SZA JSB DSNRV UNL XIF LST * IF (CONWD AND 64)#0 THEN EQTS; LDA CONWD AND D64 SZA JSB EQTS * END * *ELSE JMP L1037 * SET PROGRAM NAME IN FUN1 AND FUN10 L1033 LDA @NAME LDB @FUN1 MBT D5 * MOREC := TRUE; CCA STA MOREC LDA @NAME LDB @FN10 MBT D5 * WHILE MOREC DO L1034 LDA MOREC SSA,RSS * XEQFN; JMP L1037 JSB XEQFN JMP L1034 * L1037 JSB PRINT DEF FINIS DEC 11 * * DSINF REUSES PARAMETERS IF IN TIME LIST * EXEC(6,0,0,INLU,OUTLU,CONWD); JSB EXEC DEF *+9 DEF D6 DEF D0 DEF D0 DEF INLU DEF OUTLU DEF CONWD DEF NODE DEF FLAG D0 DEC 0 *END$ END DSINF