ASMB,C,Q,N IFN * START RTE CODE HED DLIST 91750-16072 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 XIF * END RTE CODE * IFZ * START RTE-M/L CODE HED DLIST 91750-16073 REV 2013 * (C) HEWLETT-PACKARD CO. 1980 XIF * END RTE-M/L CODE * IFN * START RTE CODE NAM DLIST,19,30 91750-16072 REV 2013 800205 MEF XIF * END RTE CODE * IFZ * START RTE-M/L CODE NAM DLIST,19,30 91750-16073 REV 2013 800205 L/M2/M3 XIF * END RTE-M/L CODE 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 DS-1000 * IFN = RTE SYSTEMS * IFZ = RTE-M/L FLOPPY-BASED SYSTEMS * * NAME: DLIST * SOURCE: 91750-18072 ('IFN' VERSION) * SOURCE: 91750-18072 ('IFZ' VERSION) * RELOC: 91750-16072 ('IFN' VERSION) * RELOC: 91750-16073 ('IFZ' VERSION) * PGMR: DAN GIBBONS * * * MODIFIED BY: GAB [790206] EIG REPLACEMENT WITH JSB'S * JDH [790220] DS REQUEST EQUATED OFFSETS * ******************************************************** SPC 2 * * PROGRAM TO DO DIRECTORY LISTING ON AS * MANY REMOTE TERMINALS AS REQUIRED * * ENT DLIST * EXT EXEC,#SLAV,#GET,#NODE EXT .MVW,.MBT,.LBT,.SBT EXT .DRCT EXT #RPB RQB EQU #RPB * IFN * START RTE CODE EXT $CL1,$CL2,FSTAT,$BMON EXT #ATCH,DTACH XIF * END RTE CODE IFZ * START RTE-M/L CODE EXT $CDIR,$XECM,#IDAD,$OPSY XIF * END RTE-M/L CODE * * A EQU 0 B EQU 1 SUP SPC 2 * 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 FLTR EQU #REQ+3 NAME FILTER...0..NO FILTER MCODF EQU #REQ+6 MASTER SECURITY CODE CRLU EQU #REQ+7 LU OF CART. TO DO FTYP EQU #REQ+8 FILE TYPE FILTER BROUT EQU #REQ+2 ADR OF NEXT PROCESS ROUTINE. 0=START WCLU EQU #REP+9 CURRENT LU FOR DISK READ WTRCK EQU #REP+10 CURRENT TRACK TO READ WSEC EQU #REP+11 CURRENT SECTOR TO READ DISP EQU #REP+12 DISPLACEMENT IN BUFFER SCTRK EQU #REP+13 # OF SECTORS/TRACK LUDSP EQU #REP+14 DISPLACEMENT IN DIRECTORY LU NTRKS EQU #REP+15 # OF DIRECTORY TRACKS * * 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 STA CLSSN SAVE CLASS NUMBER * IFN * START RTE CODE INIT LDA $BMON CHECK TYPE OF SYSTEM SZA PRE-RTE4B SYSTEM? JMP NEWSY NO, SETUP FOR NEW DRCTRY FRMT LDA TATSD YES, GET # TRKS IN SYS DISC ADA M1 GET TO LAST TRACK CLB SET FOR SECTOR ZERO JMP SETCD GO SET CARTRIDGE DRCTRY DISC ADR * CDTRK NOP CARTRIDGE DRCTRY TRACK # CDSEC NOP CARTRIDGE DRCTRY SECTR # * NEWSY JSB DTACH (IN CASE 'DINIT' SCHEDULED FROM SESSION) DEF *+1 * LDA MSCA ADJUST MSTR SEC CODE ADR ADA D128 FOR NEW CARTRIDGE DRCTRY STA MSCA FORMAT. LDA DBFA1 ADJUST BUFR PTR TO ADA D128 2ND BLOCK OF CARTRIDGE STA DBFAD DIRECTORY BUFR. LDA $CL1 GET CARTRIDGE DRCTRY TRK ADR LDB $CL2 GET SECTR ADR OF 2ND BLOCK ADB D2 OF CARTRIDGE DRCTRY. * SETCD STA CDTRK SET DRCTRY TRK # STB CDSEC AND SECTOR #. XIF * END RTE CODE 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 SUB3A DEF SUB3 SUB4A DEF SUB4 SUB5A DEF SUB5 SUB7A DEF SUB7 SUB9A DEF SUB9 SB10A DEF SUB10 SB11A DEF SUB11 DON1A DEF DONE1 SPC 5 * * HERE ON NEW REQUEST * SUB1 EQU * IFN * START RTE CODE LDA DBFA1 GET DIRECTORY DATA BUFR ADR STA RQB+LUDSP SAVE FOR LU LOOPING SUB2 LDA D2 GET LU OF SYSTEM DISC STA RQB+WCLU SAVE AS WANTED LU LDA CDTRK GET CARTRIDGE DRCTRY TRACK # STA RQB+WTRCK SAVE IN WANTED TRACK LDB CDSEC GET CARTRIDGE DRCTRY SECTOR # STB RQB+WSEC SAVE IN WANTED SECTOR LDA DBFAD READ 128 WORDS CONTAINING MSTR JSB GETSC SECURITY CODE. * LDA $BMON CHECK SYSTEM TYPE SZA,RSS PRE-RTE4B SYSTEM? JMP SUB2B YES, DRCTRY & MSC ARE IN DBUF LDA RQB+#SID GET SESSION ID WORD FROM REQ. AND RTBYT ISOLATE DEST. SESSION ID (BITS 0-7) STA TEMP SAVE SESSION ID FOR '#ATCH' CALL * JSB #ATCH ATTACH TO SESSION CONTROL BLOCK DEF *+2 DEF TEMP * INA,SZA,RSS CHECK FOR ERROR JMP RSERR "RS01" ERROR: SCB NOT FOUND * JSB FSTAT READ IN 253 WORD DEF *+3 CARTRIDGE DIRECTORY DEF DBUF (IN OLD FORMAT). DEF D253 * JSB DTACH DETACH FROM SCB DEF *+1 * SUB2B LDA RQB+LUDSP,I GET LU OF CARTRIDGE SZA,RSS DONE? XIF * END RTE CODE * IFZ * START RTE-M/L CODE * LDA M1 INITIALIZE VARIABLES TO ENSURE STA CTRCK FRESH FILE DIRECTORY COPY STA CSEC IS READ AT LEAST ONCE. STA CCLU * JSB .DRCT GET FLOPPY CARTRIDGE DIRECTORY ADR DEF $CDIR STA RQB+LUDSP SAVE FOR LU LOOPING SUB2B EQU * SUB2 JSB .DRCT GET ADR OF DIRECTORY DEF $CDIR ADA M1 GET TO END-OF-DIRECTORY ADR LDA A,I GET THE ADDRESS CPA RQB+LUDSP DONE? JMP DONE YES LDA RQB+LUDSP,I GET LU OF CARTRIDGE SZA DONE OR $CDIR CPA M2 NOT INITIALIZED? XIF * END RTE-M/L CODE * JMP DONE YES LDA RQB+FLTR IF FILTER-WORD #1 CPA M1 IS EQUAL TO A -1, THEN JMP *+2 THIS IS A CARTRIDGE LIST REQUEST; JMP SUB20 ELSE, PROCESS THE DIRECTORY LIST. LDA RQB+FLTR+1 IF FILTER-WORD #2 SZA,RSS IS EQUAL TO A 0, THEN JMP SUB8 BEGIN THE CARTRIDGE LIST JMP SUB10 ELSE, CONTINUE LISTING. SUB20 LDB RQB+BROUT SEE IF FIRST TIME SZB JMP SUB22 NOT FIRST TIME IFZ * START RTE-M/L CODE LDA $XECM GET RTE-M/L SECURITY CODE STA MSCA,I SAVE IT XIF * END RTE-M/L CODE CPB RQB+MCODF MSTR SECU SUPPLIED? (NOTE: =0) JMP SUB22 NONE--NO SPECIAL ACCESS. LDA MSCA,I GET MASTER SECURITY CODE. SZA,RSS IF NONE, ALLOW ACCESS. JMP SUB22 NO SYS SECU CODE, SO ALLOW ACCESS * IFN * START RTE CODE LDB $BMON CHECK TYPE OF SYSTEM SZB,RSS PRE-RTE4B SYSTEM? JMP NOMSK YES, NO MASK ON MSTR SECU CODE XOR MASK NO, SECU CODE IS ENCRYPTED INA CONTINUE THE DECRYPTION NOMSK EQU * XIF * END RTE CODE * CPA RQB+MCODF USER'S AND MASTER MATCH? JMP SUB22 MATCH! ALLOW ACCESS. CLB NO SPECIAL ACCESS ALLOWED, SO STB RQB+MCODF CLEAR MCODF. SUB22 LDA RQB+CRLU DO THEY WANT A SPECIFIED LU? SZA,RSS LU SUPPLIED? JMP MCR NO LDB RQB+LUDSP GET DISPLACEMENT CMA,INA ASSUME LU SSA,RSS IS IT LABEL? JMP SUB23 NO...LU CMA,INA YES...LABEL...MAKE POS AGAIN ADB D2 AND GET TO LABEL WORD SUB23 CPA B,I IS LABEL OR LU MATCH? JMP MCR MATCH...PROCESS LU LDA RQB+LUDSP NO MATCH GO TO NEXT ONE ADA D4 STA RQB+LUDSP JMP SUB2B UNL IFN * START RTE CODE MASK DEC 31178 XIF * END RTE CODE LST 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 SECT2 GET # OF SECTORS IN TRACK STA RQB+SCTRK SAVE IN SECTORS/TRACK LDA RQB+LUDSP,I GET LU OF DISK STA RQB+WCLU SAVE AS WANTED CURRENT LU ISZ RQB+LUDSP GET TO FIRST DIRECTORY TRACK LDB RQB+LUDSP,I GET DIRECTORY TRACK ADDRESS STB RQB+WTRCK SAVE TRACK ADDRESS ISZ RQB+LUDSP GET TO LOCK WORD ISZ RQB+LUDSP LDB RQB+LUDSP,I GET LOCK WORD ISZ RQB+LUDSP GET TO NEXT ENTRY SZB IS LU LOCKED JMP SUB2 YES * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB PRE-RTE4B SYSTEM? JMP MCR01 NO CPA D2 YES, IS IT SYSTEM DISC? LDB D14 YES RSS MCR01 CLB XIF * END RTE CODE * STB RQB+WSEC SAVE STARTING SECTOR ADDRESS LDA DBFA1 SET FOR ZERO DISPLACEMENT WITHIN BUFFER JSB SCFX GO GET SECTOR JMP SUB2 NO FILE DIRECTORY LDA RQB+DISP GET NAME OF CART. LDB CRNAA GET DESTINATION ADDRESS JSB .MVW MOVE 3 WORDS DEF D3 NOP LDA CRNA GET FIRST WORD OF CR NAME RAL,CLE,ERA GET RID OF SIGN BIT STA CRNA RESTORE LDA RQB+DISP GET TO LABEL WORD ADA D3 LDA A,I CONVERT LABEL WORD TO ASC JSB BNDEC DEF LWA LABEL WORD ADDRESS LDB RQB+DISP GET TO # SEC/TRACK ADB D6 LDA B,I GET # OF SECTORS/TRACK STA RQB+SCTRK SAVE AS # OF SECTORS/TRACK ADB D2 GET TO # OF DIRECTORY TRACKS LDA B,I ADA RQB+WTRCK GET ENDING DIRECTORY TRACK STA RQB+NTRKS LDA B,I GET # OF DIRECTORY TRACKS CMA,INA MAKE # POS. JSB BNDEC CONVERT TO ASC DEF DTRKA LDA DTRKA+2 MOVE UP THE LEAST SIGNIFICANT DIGITS STA DTRKA THEY ARE THE ONLY ONES TO BE PRINTED LDA #NODE IDENTIFY THE JSB BNDEC NODE WHICH IS DEF NODE BEING LISTED. JSB WTLIN SEND LINE TO TERMINAL DEF HEAD1 FIRST HEADING LINE SPC 5 * * HERE AFTER FIRST HEADING LINE WRITTEN * SUB3 LDA SUB4A GET ADDRESS WHERE TO GO NEXT TIME STA RQB+BROUT LDB D17 NON-SECURITY HEADER LENGTH. LDA RQB+MCODF SZA SECURITY CODES BEING LISTED? LDB D20 YES, ADD "SCODE" TO HEADER STB HEAD2 JSB WTLIN SEND OUT SEND HEADING LINE DEF HEAD2 SPC 5 * * HERE AFTER HEADING LINE WRITTEN * JUST OUTPUT A BLANK LINE * SUB5 LDA SUB3A GET 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 ADA D16 JSB SCFX SEE IF WE NEED NEW SECTOR JMP SUB2 DONE...NO MORE DIRECTORY LDA RQB+DISP,I IS THIS FILE PURGED? SSA JMP SUB4 YES...GO TO NEXT ONE SZA,RSS DONE? JMP SUB6 YES...2 SPACES & GET NEXT LU JSB MDLIN MOVE LINE IF IT PASSES THRU FILTER JMP SUB4 LINE FILTERED OUT. GET NEXT ENTRY JSB WTLIN GO WRITE THE LINE DEF DLINA ADDRESS OF DETAIL LINE 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 * * HERE TO DO A CARTRIDGE LIST * SUB8 LDA SUB9A GET ADDRESS FOR NEXT TIME. STA RQB+BROUT LDA #NODE IDENTIFY THE NODE JSB BNDEC WHOSE CARTRIDGE LIST DEF CLNOD IS BEING PROCESSED. JSB WTLIN OUTPUT THE DEF CLHED CARTRIDGE-LIST HEADER. SPC 2 * * HERE TO OUTPUT A SEPARATING BLANK LINE. * SUB9 LDA SB10A GET ADDRESS FOR FIRST LINE STA RQB+BROUT SET COROUTINE POINTER. JSB WTLIN OUTPUT A DEF BLNKL BLANK LINE. SPC 2 * * PROCESS THE CARTRIDGE-LIST ENTRY. * SUB10 LDA RQB+LUDSP,I GET THE CARTRIDGE LOGICAL UNIT. ISZ RQB+LUDSP ADVANCE THE ENTRY-POINTER. JSB BNDEC CONVERT THE LU DEF DTYPA TO IT'S ASCII EQUIVALENT. LDA DTYPA+2 GET THE TWO USEFUL ASCII DIGITS. STA LU CONFIGURE THE LINE. LDA RQB+LUDSP,I GET LAST TRACK FOR THE CARTRIDGE. ISZ RQB+LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT LAST TRACK TO ASCII, DEF LTRK AND CONFIGURE THE LINE. LDA RQB+LUDSP,I GET THE CARTRIDGE NUMBER. ISZ RQB+LUDSP ADVANCE THE POINTER. JSB BNDEC CONVERT CARTRIDGE NO. TO ASCII, DEF CART AND CONFIGURE INTO MESSAGE. LDB CLEN1 PREPARE FOR UNLOCKED LINE LENGTH. LDA RQB+LUDSP,I GET LOCK FLAG (I.D. SEG. ADDR.) ISZ RQB+LUDSP BUMP POINTER. SZA,RSS IF IT'S NOT LOCKED, JMP SNDLN THEN COMPLETE THE LINE; ADA D12 ELSE, POINT TO PROGRAM NAME, CLE,ELA AND FORM ITS BYTE ADDRESS. LDB CLKBA GET CONFIGURED MESSAGE BYTE ADDRESS. JSB .MBT MOVE THE LOCKER'S NAME TO THE LINE. DEF D5 NOP LDB CLEN2 GET LOCKED-CARTRIDGE LINE LENGTH. SNDLN STB CLINE CONFIGURE THE LINE LENGTH. LDB SUB2A SET FOR RETURN VIA RELOAD SECTION. LDA RQB+LUDSP,I IF THE NEXT ENTRY SZA,RSS IS NULL, THE LIST IS COMPLETE, SO LDB SB11A SET RETURN TO WRAP-UP SECTION; STB RQB+BROUT ESTABLISH THE COROUTINE POINTER. STB RQB+FLTR+1 SET FLAG FOR CLIST CONTINUATION. JSB WTLIN SEND THE CONFIGURED LINE DEF CLINE TO THE REMOTE NODE. * SUB11 LDA DON1A SEND A STA RQB+BROUT BLANK LINE, JSB WTLIN AND RETURN DEF BLNKL TO THE END PROCESSOR. * CLEN1 DEC 11 CLEN2 DEC 15 CLKBA DBL LOCK * CLHED DEC 24 ASC 14, LU LAST TRACK CR LOCK ASC 7, REMOTE NODE= CLNOD ASC 3, * CLINE NOP ASC 1, LU ASC 1, ASC 2, LTRK ASC 3, ASC 1, CART ASC 3, ASC 1, LOCK ASC 3, * HED DLIST: ROUTINES * (C) HEWLETT-PACKARD CO. 1980 * * SUBROUTINE TO MOVE DETAIL LINE TO PRINT LINE * CALLING SEQUENCE * JSB MDLIN * NO MATCH RETURN...IE..FILTER MIS-MATCH,TYPE NO MATCH * NORMAL RETURN * SPC 1 MDLIN NOP LDA RQB+FLTR IS FILTER SPECIFIED SZA NO CPA SPACA OR IS IT ALL SPACE? JMP NDLN2 NOT SUPPLIED OR SPACE JSB .DRCT GET ADDRESS WHERE FILTER LOCATED DEF RQB+FLTR CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP SAVE FILTER BYTE ADDRESS LDA RQB+DISP GET ADDRESS OF NAME CLE,ELA CONVERT TO BYTE ADDRESS STA TEMP1 SAVE IN BYTE ADD COUNTER LDA M6 # OF CHAR IN FILTER STA TEMP2 SAVE IN DOWN COUNTER MDN11 LDB TEMP GET BYTE ADD OF FILTER JSB .LBT GET BYTE SZA,RSS IF ZERO, CHANGE TO SPACE LDA C40 C40=SPACE CPA FLTRC IS IT A "-"? JMP MDN12 YES...DON'T CHECK STA TEMP3 SAVE IN TEMP LOCATION LDB TEMP1 GET BYTE ADDRESS OF NAME JSB .LBT GET BYTE CPA TEMP3 IS THERE A MATCH? RSS YES JMP MDLIN,I NO...IGNORE ENTRY MDN12 ISZ TEMP GET TO NEXT ENTRY ISZ TEMP1 ISZ TEMP2 DONE? JMP MDN11 NO SPC 1 * * AFTER CHECKING NAME, CHECK TYPE * NDLN2 LDB RQB+DISP GET TO FILE TYPE ADB D3 LDB B,I LDA RQB+FTYP CHECK WITH FILE TYPE PASSED RAL,CLE,ERA IS THERE A FILE TYPE? SEZ FILE TYPE SPECIFIED CPA B YES...DOES IT MATCH RSS MATCH...OR NO FILE TYPE SPECIFIED JMP MDLIN,I FILE TYPE NOT MATCHED ISZ MDLIN SET FOR NORMAL (P+2) RETURN. LDA DLLS ESTABLISH LINE LENGTH STA DLINA FOR LINE SANS SECURITY CODE. STB FTYPT SAVE FILE TYPE, TEMPORARILY. LDA B GET FILE TYPE FOR CONVERSION. JSB BNDEC CONVERT FILE TYPE TO ASC DEF DTYPA LDA RQB+DISP MOVE NAME TO OUTPUT LINE LDB ADNAM GET DESTINATION ADDRESS JSB .MVW MOVE NAME DEF D3 NOP LDA RQB+DISP GET # OF SECTORS OR LU ADA D4 ASSUME LU LDB FTYPT SEE IF TYPE=0 SZB YES? ADA D2 NO...GET # OF SECTORS LDA A,I GET VALUE SZB,RSS LU? JMP CNVRT YES, DON'T DIVIDE BY 2 SSA NEG BLOCK COUNT? CMA,INA,RSS YES, MAKE POS & SKIP DIV BY 2 CLE,ERA CONVERT TO # OF BLOCKS CNVRT JSB BNDEC CONVERT TO ASC DEF DBSLU LDA BLNK4 BLANK OUT THE LDB OPNAD 'OPEN TO' / EXTENT NO. JSB .MVW INFORMATION FIELD. DEF D4 NOP LDA FTYPT GET THE FILE TYPE. SZA,RSS IF THE TYPE IS ZERO, JMP OPNFL DON'T WORRY ABOUT EXTENTS. LDB RQB+DISP GET THE ADB D5 EXTENT WORD CLE,ELB FROM THE UPPER BYTE JSB .LBT OF THE DIRECTORY ENTRY. SZA,RSS IF NOT AN EXTENT, THEN JMP OPNFL CHECK THE OPEN FLAGS; JSB BNDEC ELSE, CONVERT EXTENT NO., OPNAD DEF DXOPN AND ADD IT TO THE LINE. LDA EXTBA GET BYTE ADDR. OF EXTENT DELIMITER. LDB EXNBA GET BYTE ADDR. OF DELIMITER BUFFER. JSB .MBT MOVE ' +' TO CONFIGURED LINE. DEF D3 NOP JMP SCODP IGNORE OPEN FLAGS FOR EXTENTS. OPNFL LDA RQB+DISP GET THE ADA D9 OPEN FLAG LDA A,I FROM THE ENTRY. * IFZ * START RTE-M/L CODE LDB $OPSY CHECK OPSYS TYPE CPB M31 RTE-L? JSB #IDAD YES, CONVERT OPEN-FLAG FORMAT XIF * END RTE-M/L CODE * IFN * START RTE CODE LDB $BMON CHECK SYSTEM TYPE SZB,RSS PRE-RTE4B SYSTEM? JMP OPNF1 NO LDB A YES, SAVE OPEN FLAG AND BT15 ISOLATE OPEN FLAG STA DTEMP SAVE EXCLUSIVE BIT LDA B RETRIEVE FLAG AND RTBYT ISOLATE ID SEG # SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. LDB KEYWD CALCULATE POINTER ADB M1 TO ID SEGMENT ADB A ADDRESS. LDA B,I GET ID SEG ADR IOR DTEMP INCLUDE EXCLUSIVE BIT XIF * END RTE CODE * OPNF1 SZA,RSS IF FILE'S NOT OPENED, THEN JMP SCODP IGNORE THIS ENTRY. CLE,ELA SAVE EXCLUSIVE FLAG, ADA D24 AND FORM I.D. SEG WD#13 BYTE ADDRESS. LDB OPNBA GET BYTE ADDR. FOR CONFIGURED LINE. JSB .MBT MOVE PROGRAM NAME INTO LINE. DEF D5 NOP LDA C55 IF IT IS EXCLUSIVE, THEN SEZ USE ' -' AS A DELIMITER, AND JSB .SBT ADD THE DELIMITER TO THE LINE. SCODP LDB RQB+MCODF SUPPLY SECURITY CODE? SZB,RSS JMP MDLIN,I NO...RETURN. LDA DLLWS ESTABLISH LINE LENGTH STA DLINA FOR LINE WITH SECURITY CODE. LDA RQB+DISP GET THE ADA D8 SECURITY CODE LDA A,I FROM THE ENTRY. JSB BNDEC CONVERT TO ASCII, DEF DSECA AND CONFIGURE INTO LINE. JMP MDLIN,I RETURN. SPC 1 FTYPT NOP D5 DEC 5 D9 DEC 9 D12 DEC 12 D16 DEC 16 D20 DEC 20 DLLS EQU D16 DLLWS EQU D20 D24 DEC 24 BLNK4 DEF BLNKL+1 BLPLS ASC 2, + EXTBA DBL BLPLS EXNBA DBL DXOPN OPNBA DBL DXOPN+1 KEYWD EQU 1657B KEYWORD BLOCK ADR RTBYT OCT 377 BT15 OCT 100000 SPC 5 * * HERE FOR REMOTE SESSION '#ATCH' ERROR * * IFN * START RTE CODE RSERR DLD RS01 SET "RS01" INTO STA RQB+#EC1 #EC1 & #EC2 OF STB RQB+#EC2 REPLY. LDA #NODE GET LOCAL NODE # IOR BT15 SET ASCII-ERROR BIT STA RQB+#ENO SET INTO REPLY JMP DONE1 GO RETURN TO USER * * RS01 ASC 2,RS01 XIF * END RTE CODE * SPC 5 * * 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 "DISK 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#REP 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 KEEP DISPLACEMENT ON DISK OK * CALLING SEQUENCE * JSB SCFX * NO MORE DIRECTORY TRACK RETURN * NORMAL RETURN * A REG=DISPLACEMENT * UPON RETURN * WILL UPDATE WTRCK,WSEC,AND DISP AS REQUIRED * ASSUMES DISP STARTS WITH ADDRESS OF BUFFER * SCTRK MUST BE SET TO # OF SECTORS/TRACK * IF TRACK CHANGES, NTRCK=LAST DIRECTORY TRACK-1 * ALL SECTORS ARE ASSUMED TO BE 128 WORDS LONG * SPC 1 SCFX NOP CMA,INA NEGATE ADDRESS ADA DBFA1 GET DISPLACEMENT CMA,INA MAKE IT POSITIVE CLB CHECK IF OVERFLOW DIV D128 CROSS A SECTOR BOUNDRY ADB DBFA1 GET DISPLACEMENT AS AN ADDRESS STB RQB+DISP SAVE DISPLACEMENT ADDRESS SZA,RSS SECTOR CHANGE JMP SCFXA NO LDA D14 YES...GET TO NEXT SECTOR ADA RQB+WSEC GET TO NEXT SECTOR ADDRESS CLB DIV RQB+SCTRK SEE IF WE HAVE LOOPED AROUND STB RQB+WSEC SAVE NEW SECTOR ADDRESS SZA IF NO ROLLOVER OR SZB NO NEW TRACK NEEDED JMP SCFXA DON'T UPDATE TRACK ADDRESS CCB UPDATE TRACK ADDRESS ADB RQB+WTRCK GET TO NEXT TRACK CPB RQB+NTRKS DONE? JMP SCFX,I YES STB RQB+WTRCK NO...SET IN NEW TRACK ADDRESS SCFXA LDA DBFA1 DO A 128 WORD READ JSB GETSC ISZ SCFX GET TO RETURN JMP SCFX,I RETURN SPC 5 * * SUBROUTINE TO READ A PHYSICAL SECTOR (128 WORDS) * * CALLING SEQUENCE: * * LDA * JSB GETSC * * THE FOLLOWING MUST BE SET UP: * * WTRCK,WSEC,WCLU * GETSC NOP STA BUFAD SAVE BUFFER ADR LDA RQB+FLTR IF A CARTRIDGE LISTING CPA M1 IS CURRENTLY IN PROGRESS, JMP GTSC1 FORCE A RELOAD OF THE SECTOR. LDA RQB+WTRCK GET CURRENT TRACK ADDRESS CPA CTRCK SAME AS ONE WE GOT NOW? RSS YES JMP GTSC1 NO...GO READ IT LDA RQB+WSEC IS IT THE SAME SECTOR CPA CSEC ? RSS YES JMP GTSC1 NO...GO READ IT LDA RQB+WCLU SAME LU? CPA CCLU JMP GETSC,I YES...DON'T READ SECTOR GTSC1 LDA RQB+WCLU SET UP AS CURRENT STA CCLU * IFZ * START RTE-M/L CODE LDB $OPSY CHECK SYSTEM TYPE CPB M31 RTE-L? IOR C7700 YES, SET CONWD FOR DISC ACCESS XIF * END RTE-M/L CODE * STA TEMP SAVE CONWD FOR EXEC CALL LDA RQB+WTRCK STA CTRCK LDA RQB+WSEC STA CSEC * JSB EXEC GO READ A SECTOR DEF *+7 DEF D1 DEF TEMP CONWD BUFAD NOP DEF D128 DEF RQB+WTRCK DEF RQB+WSEC JMP GETSC,I GOT SECTOR, RETURN SPC 2 CTRCK OCT -1 CSEC OCT -1 CCLU OCT -1 BUFL NOP SPC 5 * * SUBROUTINE CONVERT BINARY TO ASCII DECIMAL * CALLING SEQUENCE * JSB BNDEC * DEF BUFFER WHERE TO ASC * 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 M5 GET LOOP COUNT STA DTMP3 SAVE IN DOWN COUNTER LDA C40 GET A SPACE CHARACTERR LDB DTEMP GET BINARY VALUE SSB,RSS IF NEGATIVE...CONVERT JMP BNDCB NOT NEGATIVE CMB,INB NEGATIVE, MAKE POSITIVE STB DTEMP LDA C55 SET IN NEG SIGN BNDCB LDB DTMP1 GET BYTE ADDRESS JSB .SBT SAVE SIGN ISZ DTMP1 GET NEXT BYTE ADDRESS 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 .SBT 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 C55 OCT 55 DTEMP NOP DTMP1 NOP DTMP2 NOP DTMP3 NOP DNMA DEF DNM DNM DEC 10000,1000,100,10,1 C40 OCT 40 C60 OCT 60 C7700 OCT 7700 D3 DEC 3 D8 DEC 8 D14 DEC 14 D17 DEC 17 D128 DEC 128 D4 DEC 4 D1 EQU DNM+4 DEC 1 D6 DEC 6 D0 DEC 0 D2 DEC 2 M1 DEC -1 M2 DEC -2 M5 DEC -5 M6 DEC -6 BIT14 OCT 40000 FLTRC EQU C55 "DON'T-CARE" FILTER CHAR (MINUS SIGN) TEMP NOP TEMP1 NOP TEMP2 NOP TEMP3 NOP * TATSD EQU 1756B SECT2 EQU 1757B DBFA1 DEF DBUF IFN * START RTE CODE DBFAD DEF DBUF MAY BE MODIFIED AT INIT D253 DEC 253 XIF * END RTE CODE MSCA DEF DBUF+126 @MSC. MAY BE MODIFIED AT INIT CLSSN NOP CRNAA DEF CRNA ADNAM DEF DNAMA SPC 1 * * DEFINE OUTPUT LINE INFO * HEAD1 DEC 34 SPACA ASC 1, ASC 3,ILAB= CRNA ASC 3, ASC 1, ASC 10,REMOTE DLIST: NODE= NODE ASC 3, ASC 1, ASC 2,CR#= LWA ASC 3, ASC 1, ASC 5,DIR TRKS= DTRKA ASC 3, SPC 1 HEAD2 NOP ASC 20, NAME TYPE #BLKS/LU OPEN TO SCODE SPC 1 NOCRM DEC 9 ASC 9, DISK NOT MOUNTED DLINA NOP ASC 1, DNAMA ASC 3, ASC 1, DTYPA ASC 3, ASC 1 DBSLU ASC 3, DXOPN ASC 4, ASC 1, DSECA ASC 3, SPC 2 BLNKL DEC 1 OCT 20040,20040,20040,20040 * DBUF EQU * IFN * START RTE CODE BSS 256 XIF * END RTE CODE IFZ * START RTE-M/L CODE BSS 128 M31 DEC -31 XIF * END RTE-M/L CODE SPC 3 END EQU * END DLIST