ASMB,C,Q HED DLIST 91750-16070 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 NAM DLIST,19,30 91750-16070 REV 2013 800425 M CTU SPC 1 ****************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. 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 2 ******************************************************* * * DIRECTORY LIST MONITOR FOR RTE-M CTU-BASED SYSTEMS * * NAME: DLIST * SOURCE: 91750-18070 * RELOC: 91750-16070 * PGMR: DAN GIBBONS * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,#SLAV,#GET,#NODE EXT .MVW EXT .DRCT,$CDIR EXT #RPB RQB EQU #RPB * * SUP A EQU 0 B EQU 1 SKP * GLBLK-START * ****************************************************************** * * * G L O B A L B L O C K REV XXXX 790531 * * * * GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY: * * * * REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST * * GET, #SLAV, RQCNV, RPCNV, GRPM, LSTEN, PTOPM * * EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3 * * * ****************************************************************** * ***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!*** #STR EQU 0 STREAM WORD. #SEQ EQU #STR+1 SEQUENCE NUMBER. #SRC EQU #SEQ+1 SOURCE NODE #. #DST EQU #SRC+1 DEST. NODE #. #EC1 EQU #DST+1 REPLY ECOD1. #EC2 EQU #EC1+1 REPLY ECOD2. #ENO EQU #EC2+1 NUMBER OF NODE REPORTING ERROR. * #ECQ EQU #ENO+1 ERROR CODE QUALIFIER (BITS 4 TO 7) #LVL EQU #ECQ MESSAGE FORMAT LEVEL (BITS 0 TO 3) #MAS EQU #LVL+1 MA "SEND" SEQ. # #MAR EQU #MAS+1 MA "RECV" SEQ. # #MAC EQU #MAR+1 MA "CANCEL" FLAGS #HCT EQU #MAC+1 HOP COUNT #SID EQU #HCT+1 SESSION ID WORD * #EHD EQU #SID LAST ITEM OF HEADER #MHD EQU #EHD+1 MINIMUM HEADER SIZE #REQ EQU #MHD START OF REQUEST SPECIFIC AREA #REP EQU #MHD START OF REPLY SPECIFIC AREA * #MXR EQU #MHD+24 <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>> #LSZ EQU 2 <<< SIZE OF LOCAL APPENDAGE AREA >>> * ****************************************************************** * * GLBLK-END SPC 3 * * OFFSETS INTO DLIST REQUEST/REPLY BUFFER * STYP EQU #STR STREAM TYPE STAT EQU #REP STATUS LNGH EQU #REQ+1 LENGTH WORD BROUT EQU #REQ+2 ADR OF NEXT PROCESS ROUTINE. 0=START CTULU EQU #REQ+7 CARTRIDGE TAPE UNIT LU # ENDCD EQU #REP+9 END-OF-CARTRIDGE-DIRECTORY ADR ENDFD EQU #REP+10 END-OF-FILE-DIRECTORY ADR VAL EQU #REP+11 DIRECTORY-VALID FLAG. 0=VALID DISP EQU #REP+12 DISPLACEMENT IN BUFFER LUDSP EQU #REP+14 DISPLACEMENT IN DIRECTORY LU * * L#REQ ABS #REQ+16 REQUEST LENGTH L#REP EQU L#REQ REPLY LENGTH HED DLIST: MAIN * (C) HEWLETT-PACKARD CO. 1980 * * MAIN ROUTINE STARTS HERE * DLIST NOP LDA B,I SEE IF THEY WANT DEBUG STA CLSSN SAVE CLASS NUMBER SPC 1 DLST0 JSB #GET DO A GET CALL DEF *+6 DEF CLSSN DEF RQB DEF L#REQ DEF D0 NO DATA DEF D0 JMP DLST0 IGNORE ERROR CALL * LDA RQB+BROUT GET ADDRESS OF CURRENT COROUTINE SZA,RSS JMP SUB1 JMP A,I GO TO SPECIFIED SUBROUTINE SPC 2 SUB2A DEF SUB2 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 JSB .DRCT GET ADR OF CTU DIRECTORY DEF $CDIR STA RQB+LUDSP SAVE FOR LU LOOPING ADA M1 GET TO LAST TRACK LDA A,I GET LAST-ENTRY ADR STA RQB+ENDCD SAVE IT SUB2 LDA RQB+LUDSP GET DIRECTORY POINTER CPA RQB+ENDCD DONE? JMP DONE YES LDA A,I GET CARTRIDGE LU SZA,RSS DONE? JMP DONE YES SUB22 LDA RQB+CTULU DO THEY WANT A SPECIFIED LU? CPA DBLNK LU SUPPLIED? JMP MCR NO, DO ALL LU'S LDB RQB+LUDSP GET DISPLACEMENT SSA IF NEG, MAKE POS CMA,INA CPA B,I DOES LU MATCH? JMP MCR MATCH...PROCESS LU ADB D4 NO MATCH. GO TO NEXT ENTRY STB RQB+LUDSP JMP SUB2 SPC 5 * * ROUTINE TO PROCESS A MOUNTED CARTRIDGE * SPC 1 MCR LDA SUB5A SET UP FOR RETURN AFTER SENDING THE LINE STA RQB+BROUT * LDA LUDSP,I CONVERT LU TO TWO JSB BNDEC ASCII DIGITS & SET DEF LUXX INTO HEAD1 MSG. * ISZ RQB+LUDSP GET TO VALIDITY WORD ADR LDA LUDSP,I GET THE ADR LDA A,I GET THE VALIDITY WORD STA RQB+VAL SAVE IT LDB LHED1 GET HEAD1 MESSAGE LENGTH SZA IS DIRECTORY VALID? LDB LHED2 NO, ADJUST LENGTH OF MESSAGE STB HEAD1 SET MESSAGE LENGTH ISZ RQB+LUDSP GET TO FILE DIRECTORY ADR LDA LUDSP,I GET THE ADR STA RQB+DISP SAVE THE ADR ADA M1 GET TO LAST-ENTRY ADR LDA A,I GET THE ADR STA RQB+ENDFD SAVE IT ISZ RQB+LUDSP GET TO NEXT CTU ISZ RQB+LUDSP DIRECTORY ENTRY. JSB WTLIN SEND LINE BACK TO REMOTE DEF HEAD1 HEADING LINE ADR SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE IF DIRECTORY VALID. * SUB5 LDA RQB+VAL SZA DIRECTORY VALID? JMP SUB6 NO, GET NEXT ONE LDA SUB4A SET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN SEND OUT BLANK LINE DEF BLNKL SPC 5 * * HERE TO START OUTPUTTING DIRECTORY * SUB4 LDA RQB+DISP GET FILE ENTRY ADR CPA RQB+ENDFD END OF DIRECTORY? JMP SUB6 YES LDA A,I GET ENTRY SSA IS THE FILE PURGED? JMP NXT YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU LDA RQB+DISP MOVE THE LDB ADNAM DETAIL LINE JSB .MVW TO PRINT LINE. DEF D4 NOP LDA RQB+DISP GET TO NEXT ENTRY ADA D4 STA RQB+DISP JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE NXT LDA RQB+DISP GET TO NEXT ENTRY ADA D4 STA RQB+DISP JMP SUB4+1 SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB6 LDA SUB7A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL SPC 5 * * HERE TO OUTPUT A BLANK LINE * SUB7 LDA SUB2A GET ADDRESS FOR NEXT TIME STA RQB+BROUT JSB WTLIN OUTPUT A BLANK LINE DEF BLNKL HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * HERE WHEN WE ARE ALL DONE * DONE LDA RQB+BROUT SEE IF WE SENT THEM ANYTHING SZA JMP DONE1 YES...JUST TERMINATE LDA DON1A GET ADDRESS OF TERMINATION POINT STA RQB+BROUT JSB WTLIN SEND "CTU NOT MOUNTED" DEF NOCRM * DONE1 CLA STA RQB+LNGH SET FOR NO DATA LDA BIT14 TELL OTHER SIDE, ALL DONE JMP TERM SPC 5 * * SUBROUTINE TO SEND DATA TO REMOTE * CALLING SEQUENCE * JSB WTLIN * DEF BUFFER * BUFFER FORMAT * LENGTH WORD, DATA BUFFER * WTLIN NOP LDA WTLIN,I GET ADDRESS OF OUPUT LINE INA GET TO FIRST DATA WORD STA WTLNB LDB WTLIN,I GET LENGTH OF MESSAGE LDB B,I LDA RQB+LNGH GET AVAILABLE LENGTH CMA,INA ADA B SEE IF THERE WAS TO MUCH ROOM SSA CHANGE LENGTH? STB RQB+LNGH YES...SET IN CORRECT LENGTH * CLA SET FOR MORE TO COME TERM STA RQB+STAT SAVE STATUS LDA RQB+STYP GET STREAM TYPE IOR BIT14 SET FOR REPLY STA RQB+STYP LDA #NODE STA RQB+#ENO SET STATUS LOCATION * JSB #SLAV SEND REPLY DEF *+4 DEF L#REQ REPLY LENGTH WTLNB NOP DATA ADDRESS DEF RQB+LNGH DATA LENGTH * NOP IGNORE ERROR RETURN JMP DLST0 GO DO A GET CALL * SPC 5 * * SUBROUTINE TO CONVERT BINARY # TO 2 ASCII DECIMAL DIGITS * * CALLING SEQUENCE: * * JSB BNDEC * DEF BUFFER WHERE TO STORE ASCII DIGITS * A REG=BINARY # * BNDEC NOP STA DTEMP SAVE BINARY # LDB BNDEC,I GET ADDRESS WHERE TO ASC CLE,ELB CONVERT TO BYTE ADDRESS STB DTMP1 SAVE BYTE ADDRESS ISZ BNDEC GET TO RETURN ADDRESS LDA DNMA GET ADDRESS OF DIVISORS STA DTMP2 SAVE FOR DIVIDING LDA M2 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER BNDCA LDA DTEMP GET BINARY # CLB GET A ZERO DIV DTMP2,I STB DTEMP SAVE REMAINDER ADA C60 CONVERT TO ASC LDB DTMP1 GET CURRENT BYTE ADDRESS JSB SBYTE SAVE ASC BYTE ISZ DTMP2 GET NEXT DIVISOR ISZ DTMP1 GET NEXT BYTE ADDRESS ISZ DTMP3 DONE? JMP BNDCA NO JMP BNDEC,I RETURN SPC 1 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM M2 DEC -2 C60 OCT 60 DNM DEC 10,1 SPC 3 * * SUBROUTINE TO STORE A BYTE * CALLING SEQUENCE * JSB SYBTE * A REG CONTAINS THE BYTE * B REG CONTAINS THE BYTE ADDRESS * SBYTE NOP AND B377 MASK ALL BUT LOWER 8 BITS STA STEMP SAVE IN TEMP LOCATION CLE,ERB CONVERT TO WORD ADDRESS LDA B,I GET WORD SEZ,RSS RIGHT OR LEFT HALF? ALF,ALF LEFT AND UB377 ISOLATE UPPER 8 BITS IOR STEMP OR IN NEW HALF SEZ,RSS LEFT OR RIGHT? ALF,ALF LEFT STA B,I SAVE WORD ELB,CLE GET BYTE ADDRESS AGAIN JMP SBYTE,I RETURN SPC 1 STEMP NOP B377 OCT 377 UB377 OCT 177400 SPC 5 D4 DEC 4 D1 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 BIT14 OCT 40000 * CLSSN NOP ADNAM DEF DNAMA LHED1 ABS ENDM1-SPACA LHED2 ABS ENDM2-SPACA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 BSS 1 HOLDS MESSAGE LENGTH SPACA ASC 2, ASC 9,REMOTE DLIST LU LUXX BSS 1 ASC 5, DIRECTORY ENDM1 EQU * ASC 4, INVALID ENDM2 EQU * NOCRM DEC 8 ASC 8, CTU NOT MOUNTED DLINA DEC 7 ASC 3, DNAMA ASC 4, SPC 2 BLNKL DEC 1 DBLNK OCT 20040 SPC 3 END EQU * END DLIST