ASMB,R,Q,C HED TYPE 5 ID MANAGER FOR RTE II,III & IV * NAM T5IDM,3,40 PRE REL 780224 (MOS) * NAM T5IDM,3,40 09570-16539 REV. A 761013 * NAM T5IDM,3,40 PRE RELEASE REV. C 780720 (RTE IV) NAM T5IDM,131,40 92067-16469 REV.1903 790222 * * *-------------------------------------------------------- * * RELOC. 09570-16539 * SOURCE 09570-18539 * * M. SPANN 24 MAR 77 REV. B * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY,1976. * ALL RIGHTS RESERVED.THE INFORMATION CONTAINED ON * THIS MEDIUM MAY BE USED WITH ONLY ONE COMPUTER * AT A TIME.IT SHALL NOT OTHERWISE BE RECORDED, * TRANSMITTED,OR STORED IN A RETRIEVAL SYSTEM. * COPYING OR OTHER REPRODUCTION WITHOUT PRIOR WRITTEN * CONSENT OF HEWLETT-PACKARD COMPANY IS PROHIBITED, * EXCEPT THAT ONE COPY MAY BE MADE AND RETAINED FOR ARCHIVE * PURPOSES ONLY. * * --------------- * * THE INFORMATION CONTAINED ON THIS MEDIUM IS PROPRIETARY * TO HEWLETT-PACKARD COMPANY. IT MAY BE USED WITH ONE * COMPUTER ONLY AND IS NOT TO BE DISCLOSED TO ANY THIRD * PARTIES OR REPRODUCED IN ANY FORM EXCEPT THAT IT MAY BE * TRANSFERRED TO ONE BACKUP COMPUTER DURING A COMPUTER * MALFUNCTION OR DURING PREVENTIVE MAINTENANCE. * *--------------------------------------------------------- ENT T5IDM EXT EXEC,PRTN,NAM..,$OPSY EXT RMPAR,OPEN,CLOSE,FSTAT EXT IDSGA,IDRPD,$LIBR,$LIBX EXT DTACH,$CL1,$CL2 * FOR SESSION MONITOR * A EQU 0 B EQU 1 KEYWD EQU 1657B XEQT EQU 1717B BPA3 EQU 1744B TATSD EQU 1756B SECT2 EQU 1757B SECT3 EQU 1760B SUP SKP TSIZE EQU 1270 ROOM FOR 254 ENTRIES PNTR NOP TABLE - 5 HPNTR NOP MPNTR NOP BPNTR NOP TPNTR NOP TABLE EQU * START OF TABLE UNL REP TSIZE DEC -1 LST TEND DEF * END OF TABLE + 1 TBLA DEF PNTR TABLE - 5 TBLAD DEF TABLE RROBN DEF TEND-5 ROUND ROBIN POINTER CRN# NOP NUMBER OF DISC LU'S CRN NOP TOP OF STACK OF DISC LU'S * DCB BSS 144 DCB SYSID EQU DCB ORG DCB LDA $CL2 CALCULATE THE LAST SECTOR NUMBER OF ADA D2 :CL ON SYSTEM DISC STA TEMP SAVE FOR LATER JSB EXEC GO READ THE :CL OF THE DISC DEF *+7 DEF D1 DEF PRC2 SYSTEM DISC DEF SYSIA DEF D128 DEF $CL1 :CL TRACK DEF TEMP & 2ND. SECTOR LDA SYSIA+125 GET SYSTEM SETUP CODE STA SYSUP AND SAVE FOR LATER USE CLA EXIT TO NEVER RETURN STA SYSI1 JMP SYSI1 SYSIA BSS 128 ORR DUMY EQU DCB+16-SYSIA ERROR HERE MEANS YOUR IN TROUBLE ORR NAME BSS 4 NAME OF ROOT SEGMT NUM NOP # OF SEGMTS TEMP NOP TEMPORARY STORAGE EFLAG NOP ERROR FLAG IERR NOP FOR FMGR CALLS NAME2 NOP FATHER'S NAME NOP NOP NOP ENTR# NOP NUMBER OF SEGMENTS REMAINING+1 BUFF EQU DCB BUFFER FOR CATRIDGE LIST SEARCH TAIL NOP TEMPORARY IDBUF BSS 35 BUFFER FOR HEADER RECORD ID EQU IDBUF-1 DID12 DEF ID+12 DID23 DEF ID+23 * D0 DEC 0 D1 DEC 1 D2 DEC 2 D3 DEC 3 D4 DEC 4 D5 DEC 5 SEGT EQU D5 D6 DEC 6 D11 DEC 11 D12 DEC 12 D14 DEC 14 D15 DEC 15 B17 EQU D15 B20 OCT 20 D20 DEC 20 D23 DEC 23 D28 DEC 28 D35 DEC 35 B40 OCT 40 B77 OCT 77 B177 OCT 177 HBIT OCT 100 B200 OCT 200 D128 EQU B200 B220 OCT 220 B377 OCT 377 DBLNK OCT 20040 OM20 OCT -20 OM360 OCT -360 OM200 OCT -200 MASK OCT 177400 DM1 DEC -1 DM3 DEC -3 * ***************************************************** UNL PRC OCT 74000 PRC2 OCT 74002 SKP LST * * ! T5IDM INTERNAL CIRCULAR LINKED LIST STRUCTURE ! * * LIST POINTER BACK/FWD * NAME1 N/A * NAME2 M/E * NAME/TYPE A/T * DISC WORD 27TH WRD OF ID * * CALLING SEQUENCE * * :RU,T5IDM,FN,AM,E,#IDS,CRN * ***************************************************** * * TEST PROGRAM SHOWS PARAMETER PASSING TO SEGMENT *FTN,L * PROGRAM TEST1 * DIMENSION IP(5),ITESTA(3) * DATA ITESTA/2HTE,2HST,2HA / * CALL RMPAR(IP) * CALL CLOVL(ITESTA,IP) * STOP 0 * END * PROGRAM TESTA(5) * DIMENSION IP(5) * CALL RMPAR(IP) * WRITE (1,100) IP * 100 FORMAT ("THE INPUT PARAMETERS WERE "5I7) * STOP 77 * END * END$ * * TEST PROGRAM SHOWS RETURN TO MAIN FROM SEGMENTS *FTN,L * PROGRAM TEST2 * DIMENSION ITESTB(3) * DATA ITESTB/2HTE,2HST,2HB / * CALL RPIDS(ITESTB,5) * CALL CLOVL(ITESTB) * ITESTB(3) = 2HC * CALL CLOVL(ITESTB) * ITESTB(3) = 2HD * CALL CLOVL(ITESTB) * ITESTB(3) = 2HE * CALL CLOVL(ITESTB) * ITESTB(3) = 2HF * CALL CLOVL(ITESTB) * STOP 77 * END * PROGRAM TESTB(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTB OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTC(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTC OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTD(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTD OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTE(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTE OVERLAY SEGMENT") * GO TO IRTN * END * PROGRAM TESTF(5) * DIMENSION IDMY(5) * EQUIVALENCE (IDMY,IRTN) * CALL RMPAR(IDMY) * WRITE (1,100) * 100 FORMAT ("I AM NOW IN THE TESTF OVERLAY SEGMENT") * GO TO IRTN * END * END$ SKP * EXAMPLE CALLING INTERFACE *ASMB,R,L,C * HED "CLOVL" ROUTINE TO CALL IN AN OVERLAY 2-77 (DLB) * NAM CLOVL,7 EXAMPLE ROUTINE TO USE TYPE 5 ID MANAGER * ENT CLOVL,RPIDS * EXT IDMG#,IDGT#,EXEC,.ENTR,PAU.E,.DFER * SPC 1 *A EQU 0 *B EQU 1 *XEQT EQU 1717B * SPC 1 ** PURPOSE (1): TO PRODUCE AND CALL AN RTE OVERLAY PROGRAM ** ** CALLING: ** ** CALL CLOVL(NAME) ** -OR- ** CALL CLOVL(NAME,IPBUF) ** ** ** WHERE: ** ** NAME = 3 WORD BUFFER CONTAINNING SEGMENT PROGRAM NAME. ** IPBUF = OPTIONAL 5 WORD BUFFER TO PASS TO SEGMENT PROGRAM. ** ** PURPOSE (2): TO PRODUCE MULTIPLE SHORT IDSEGMENTS SO THAT THEIR SIZE ** CAN BE EXAMINED. ** ** CALLING: ** ** CALL RPIDS(NAME,NUMBR) ** ** WHERE: ** ** NAME = 3 WORD BUFFER CONTAINNING SEGMENT PROGRAM NAME. ** NUMBR = NUMBER OF SEGMENTS THAT NEED TO BE PRODUCED, WHERE ** THE LAST NON-BLANK CHARACTER WILL BE INCREMENTED TO ** DETERMINE THE NEXT NAME TO BE USED. ** ** * SPC 1 *NAME NOP *PRAMS DEF *+1 DEFAULT CALLED ADDRESS (IF FROM ROOT CODE) *CLOVL NOP * JSB .ENTR *DFNAM DEF NAME * LDA PRAMS GET PARAMETER BUFFER ADDRESS * STA PRMBF+0 * INA * STA PRMBF+1 * INA * STA PRMBF+2 * INA * STA PRMBF+3 * INA * STA PRMBF+4 * LDA DFNAM RESET THE OPTIONAL PARAMETER ADDRESS WORD * ADA O2 * STA PRAMS *AGAIN JSB EXEC CALL THE OVERLAY * DEF *+8 * DEF NA8 NO ABORT CALL EXEC (8 * DEF NAME,I *PRMBF REP 5 * DEF * * LDA NAME GET NAMES DIRECT ADDRESS * JSB IDMG# USE T5IDM TO PRODUCE THE OVERLAY * JSB EXEC NOW TRY AGAIN * DEF *+8 * DEF NA8 * DEF NAME,I * DEF PRMBF+0,I * DEF PRMBF+1,I * DEF PRMBF+2,I * DEF PRMBF+3,I * DEF PRMBF+4,I * JSB .DFER MOVE THE SEGMENT NAME INTO THE MESSAGE BUFFER * DEF MESS * DEF NAME,I * LDA XEQT GET ADDRESS OF MY OWN NAME * ADA D12 INDEX INTO THE IDSEGMENT * LDB A,I GET 1ST TWO CHARS * STB PNAME * INA * DLD A,I GET LAST FOUR CHARS * STA PNAME+1 SAVE CHARS 3 & 4 * LSR 8 STRIP OFF LAST CHAR * BLF,BLF REPOSITION * ADB O40 * STB PNAME+2 SET THE LAST CHAR + SPACE * JSB EXEC NOW WRITE OUT THE NOT FOUND MESSAGE * DEF *+5 * DEF O2 WRITE * DEF PAU.E USE SAME LU AS THE "STOP" ROUTINE * DEF MESS * DEF D15 * JSB EXEC NOW PAUSE * DEF *+2 * DEF O7 NOW PAUSE FOR ID TO BE PRODUCED * JMP AGAIN NOW TRY SAME ALL OVER AGAIN * SPC 1 *O2 OCT 2 *O7 OCT 7 *D12 DEC 12 *D15 DEC 15 *O40 OCT 40 *NA8 OCT 100010 *MESS ASC 7,PROGA MISSING-PROGM SUSPENDED! *PNAME ASC 3,PROGM SUSPENDED! * ASC 5,SUSPENDED! *NAME1 NOP *NUMBR NOP *RPIDS NOP * JSB .ENTR GET CALLERS PARAMETERS * DEF NAME1 * LDA NAME1 GET ADDRESS OF SEGMENT NAME * LDB NUMBR,I GET THE NUMBER OF SEGMENTS NECESSARY * JSB IDGT# CALL TYPE 5 ID MANAGER INTERFACE ROUTINE * JMP RPIDS,I RETURN DONE * END SKP *ASMB,R,L,C * HED TYPE 5 MANAGER INTERFACE ** NAM IDGT#,7 PRE-REL 7-22-76 (MOS) ** NAM IDGT#,7 09570-16499 REV. A 761013 ** NAM IDGT#,7 PRE-REL 770213 (DLB) * NAM IDGT#,7 PRE-REL 780402 (DLB) (RTE-IV) ** **-------------------------------------------------------- ** ** RELOC. 09570-16499 ** SOURCE 09570-18499 ** ** M. SPANN 13 OCT 76 REV. ** **--------------------------------------------------------- ** * ENT IDGT#,IDMG# * EXT EXEC,.XLB ** *A EQU 0 *B EQU 1 *XEQT EQU 1717B *TAT EQU 1656B *TATSD EQU 1756B ** *IDMG# NOP * LDB IDMG# * STB IDGT# * CLB,INB,RSS *IDGT# NOP * STB IDMG# SAVE NUMBER OF MODULES TO :RP, * STA TEMP * INA * STA TEMP+1 * INA * STA TEMP+2 * LDA XEQT GET IDSEGMENT ADDRESS OF THIS PROGRAM * ADA D26 BUMP TO THE DISC ADDRESS WORD * JSB .XLB GET THE DISC ADDRESS WORD * DEF A,I * LDB A,I * CLE,ELB GET THE DISC LU IN E-REG * LSR 8 POSITION DISC TRACK TO LO 8 BITS * CLA,SEZ CHECK IF ON LU = 3 * ADB TATSD YES, LU = 3, ADD IN TRACKS IN LU = 2 * ADB TAT INDEX INTO THE TAT TABLE * JSB .XLB GET THE VALUE IN THE TAT TABLE * DEF B,I * LDB B,I * CPB FMPTK CHECK IF IS ON A FMGR TRACK? * CLA,INA,RSS YES, CONTINUE * JMP EXIT NO, SKIP CALL TO T5IDM * ELA NOW CALCULATE IF ON LU = 2 OR 3 * CMA,INA MAKE NEGATIVE * STA CRN AND SET TO CRN = -2 OR -3 * JSB EXEC * DEF RTN *DEFER DEF SCHD * DEF T5IDM *TEMP NOP PARAMETERS TO PASS * NOP * NOP * DEF IDMG# NUMBER OF SEGMENTS * DEF CRN THE CARTRAGE OF THIS PROGRAM *RTN NOP T5IDM NOT FOUND *EXIT JMP IDGT#,I ** *SCHD OCT 100027 *D26 DEC 26 *FMPTK OCT 77776 *T5IDM ASC 3,T5IDM *CRN NOP * END SKP T5IDM JSB RMPAR GET SCHED PARMS DEF *+2 DEF NAME SYSI1 JMP SYSID ONE TIME CODE LDA NUM GET USER SPECIFIED DISC LU SSA,RSS MAKE SURE IT'S NEGATIVE CMA,INA STA CRN AND SAVE LDA NAME+3 GET NUMBER OF SEG FROM USER SZA IF HE SPECIFIED 0 SSA OR NEGATIVE CLA,INA DEFAULT TO 1 STA NUM SAVE STA ENTR# * DO THE DOUG BASKINS' TABLE FLUSH LDB BPA3 GET START OF BCKGND BP CPB D2 IF RTE III OR IV CPA D1 AND LONG REQUEST JMP T50 SKIP IF SHORT OR RTE II LDB TBLA GET START OF TABLE STB IDBUF SAVE TEMP T5 LDB IDBUF LAST ENTRY PROCESSED ADB D5 BUMP TO NEXT CPB TEND END OF TABLE ? JMP T50 YES - DONE STB IDBUF SAVE POINTER ADB D3 TYPE STATUS WORD LDA B,I GET IT CPA DM1 VALID DATA ? JMP T50 NO AND B17 EXTRACT TYPE CPA D3 TYPE 3 ? JMP T5 YES - SKIP LDB IDBUF CURRENT ENTRY JSB FLUSH TRY TO DO AN RP,, JMP T5 TRY NEXT * T50 LDA NAME+1 SECOND WORD OF NAME SZA,RSS IF NULL LDA DBLNK DEFAULT TO BLANK STA NAME+1 RESTORE AND B377 LOOK AT LOW BYTE SZA IF NULL JMP T51 NOT NULL LDA B40 IOR NAME+1 ADD BLANK STA NAME+1 RESTORE T51 LDA NAME+2 GET 3RD WORD OF NAME SZA,RSS IF NULL LDA DBLNK DEFAULT TO BLANK AND MASK SAVE 5TH CHARACTER IOR B40 PUT BLANK IN 6TH POSITION STA NAME+2 SO MATCH WILL WORK CLA,CLE STA HPNTR INITIALIZE HEAD POINTER STA EFLAG ZERO ERROR COUNT SKP SRCH CLA INITIALIZE STA BPNTR BLANK POINTER STA MPNTR MATCH POINTER LDB TBLAD TABLE ADDRESS LOOP STB PNTR POINTER FOR SEARCH LOOP LDA B,I GET LINK WORD SZA,RSS IS IT A BLANK ? JMP BLANK -YES- CPA DM1 END OF ENTRIES ? JMP ENTR YES JSB MATCH IS IT ONE WE WANT ? DEF NAME STB MPNTR YES-SAVE ADDRESS AND HBIT [A] IS TYPE/STATUS SZA,RSS IS ENTRY A HEAD ? JMP NEXT NO CPB MPNTR IS HEAD A MATCH ? STB HPNTR YES SAVE ADDRESS JSB GOBCK LOOK AT TAIL OF LIST CPA D3 IS IT A TYPE 3 (FATHER) ? RSS YES JMP NEXT NO CHECK NEXT ENTRY CHCK JSB DRMNT REMOVE DORMANT TYPE 3 FROM LIST CPA D3 IS BACK TYPE 3? JMP CHCK YES- CHECK IT JSB GOFWD SEE IF ANY TYPE 3'S REMAIN CPA D3 JMP NEXT YES - LIST STILL MUST REMAIN CHC2 JSB FLUSH DO RP,, THING JSB GOFWD UNTILL CPA SEGT SKIP WHEN BACK TO HEAD JMP CHC2 NEXT LDB PNTR BUMP POINTER ADB D5 TO NEXT ENTRY CPB TEND END OF TABLE ? JMP ENTR YES JMP LOOP CONTINUE CHECKING * BLANK LDA BPNTR PREVIOUS BLANK ? SZA,RSS YES-SKIP STB BPNTR SAVE ADDRESS OF BLANK ENTRY JMP NEXT SKP * *TABLE HAS BEEN UPDATED ,CHECK ON CALLER ENTR LDB XEQT OUR ID ADDRESS ADB D20 21'ST WORD LDA B,I AND B377 EXTRACT FATHER'S ID # SZA,RSS DO WE HAVE A FATHER ? JMP EXIT NO! ADA DM1 WHY ??? ADA KEYWD CALCULATE HIS ID ADDRESS LDA A,I GET ID ADDRESS ADA D12 POINT TO HIS NAME LDB A,I GET 1ST WORD OF HIS NAME INA STB NAME2 SAVE LDB A,I GET 2ND WORD SZB,RSS IF NULL LDB DBLNK DEFAULT TO BLANK STB NAME2+1 SAVE INA LDB D12 ADD 12 TO POINT TO ADB A DISC ADD LDA A,I GET 3RD WORD SZA,RSS IF NULL LDA DBLNK DEFAULT TO BLANK AND MASK SAVE 5TH CHARACTER IOR B40 PUT IN BLANK FOR MATCH STA NAME2+2 SAVE LDA B,I GET DISC ADD STA NAME2+3 SAVE LDB DM3 LU=3 SSA,RSS OR INB LU=2 LDA CRN LU SPECIFIED? SZA,RSS WELL?? STB CRN NO USE POP'S JSB NAM.. CHECK IF NAME IS LEGAL ? DEF *+2 DEF NAME SZA JMP ERMOR NOT LEGAL SO RECORD ERROR LDB MPNTR DID WE FIND A MATCH ? SZB,RSS JMP NMTCH MATCH NOT FOUND * MATCH FOUND IN TABLE STB BPNTR SET POINTER FOR OPEN ADB D4 ADDRESS OF DISC WORD LDA B,I CHECK THE DISC WORD SZA DO WE HAVE A DISC ADDRESS ? CPA DM1 JMP NMTCH NO - OPEN FILE CLE,ELA PUT LU IN E REG. LDA CRN USER SPECIFIED LU RAR,ELA PUT E REG. IN LSB CPA CRN STILL SAME ? JMP ENT0 YES-THEY AGREE * ENL0 LDB MPNTR WE GOT THE WRONG DUDE !!! JSB GOBCK SEE IF WE CAN CHANGE HORSES CPA D3 TYPE THREE ? ENL1 JSB DRMNT IF DORMANT REMOVE FROM LIST CPA D3 IS BACK TYPE 3 ? JMP ENL1 YES - KEEP TRYING JSB GOFWD SEE IF ANY TYPE THREES CPA D3 REMAIN JSB ENL4 CHECK IF SAME FATHER ON DIFF LU. ENL3 JSB GOBCK BACK AROUND LIST CLA CLEAR OUT OLD DATA ADB D4 BUMP TO DISC WORD STA B,I CLEAR IT ADB DM4 RESTORE B REG. JSB FLUSH TRY RP,, IN CASE SZA IF SUCCESS CPA D14 OR NOT FOUND CPB MPNTR CHECK FULL CIRCLE JMP NMTCH YES -GO OPEN CORRECT FILE JMP ENL3 KEEP ON TRUCKING * ENL4 NOP JSB MATCH SEE IF SAME FATHER DEF NAME2 RSS YES SKIP JSB ERR GET OUT GRACEFULLY ADB D4 BUMP TO DISC WORD LDA B,I GET IT CLE,ELA LU TO E REG. LDA CRN USER SPECIFIED LU RAR,ELA REPLACE LSB CPA CRN STILL SAME ? JSB ERR YES - GET OUT LDA NAME2+3 GET NEW DISC WORD STA B,I PUT IN ENTRY ADB DM4 RESTORE B REG. JMP ENL4,I RETURN * ENT0 JSB IDSGA SEE IF NOW IN CORE DEF *+2 DEF NAME SZA IN CORE ? JMP ENTR1 YES LDB BPNTR ENTRY ADDRESS ADB D4 LDA B,I GET DISC WORD RAL,CLE,ERA PUT LU IN E REG STA B AND B177 EXTRACT SECTOR STA DCB+4 PUT IN DCB WORD XOR B REMOVE SECTOR FROM B ALF,ALF POSITION RAL STA DCB+3 PUT IN DCB LDA SECT2 IF LU=2 SEZ LDA SECT3 LU=3 STA DCB+8 PUT IN DCB CLA,INA FORM DISC LU ELA IF E SET IT'S LU=3 STA DCB PUT IN DCB LDB XEQT GET OUR ID ADDRESS STB DCB+9 SHOW FILE OPEN TO US JSB LOOK READ FILE HEADER JMP RPACK CHECKSUM ERROR LDB DID12 NAME IN FILE HEADER JSB MATCH SEE IF SAME AS DNAME DEF NAME REQUESTED NAME RSS YES - SKIP JMP ENL0 TRY FOR DESIRED ONE ENT00 JSB FID DO RP THING SZA ANY ERROR ? CPA D23 DUPLICATE ID ? JMP ENTR1 DUP OR NO ERROR CPA D14 NO ID AVAILABLE ? JSB ROBIN MAKE AN ID AVAILABLE JMP ERMOR NONE AVAILABLE JMP ENT00 TRY AGAIN * RPACK LDB TBLAD TABLE ADDRESS CLA RPK CPB TEND END OF TABLE ? JMP NMTCH YES - GO OPEN FILE ADB D4 WORD 5 STA B,I CLEAR DISC WORD INB JMP RPK LOOP FULL TABLE SKP * *NOW MAKE ENTRY IN OUR TABLE ENTR1 LDB HPNTR HEAD POINTER SZB FOUND ? JMP ENTR3 YES LDB BPNTR NOT FOUND SEARCH NTRL JSB GOBCK LOOK BACK AND HBIT SZA,RSS IS THIS THE HEAD OF THIS LIST ? CPB BPNTR LIST EXHUSTED ? RSS SKIP JMP NTRL NO KEEP LOOKING STB HPNTR SAVE HEAD ADDRESS ADB D3 LDA B,I GET WORD 4 IOR HBIT MARK AS HEAD STA B,I IN ENTRY ENTR2 LDB HPNTR JMP EN1 LOOK FOR FATHER * ENTR3 CPB BPNTR IF ENTRY IS HEAD JMP EN1 LOOK FOR FATHER LDB BPNTR OTHERWISE JSB GOFWD CHECK CPB BPNTR IF ONLY ENTRY RSS YES - SKIP JMP ENTR2 NO LDB HPNTR HEAD OF NEW LIST JSB GOFWD LDA B LINK IN FRONT OF NEW HEAD LDB BPNTR JSB INSRT LDA DNAME GET NAME ADDRESS INB BUMP TO WHERE NAME GOES JSB MOVE DEC -4 JMP ENTR2 SKP EN0 JSB MATCH IS THIS FATHER DNAM2 DEF NAME2 FATHER'S NAME JMP MORE? YES-ALREADY IN LIST EN1 JSB GOBCK LOOK BACK CPA D3 IS THIS A FATHER ? JMP EN0 YES-SEE IF IT'S OURS * FATHER NOT IN LIST MAKE ENTRY JSB QBLNK LOOK FOR BLANK SZB,RSS FOUND ONE ? JMP MORE? NO-CHECK FOR MORE LDA NAME2+2 GET WORD 4 AND MASK SAVE 5TH CHAR OF NAME IOR D3 PUT IN TYPE STA NAME2+2 PUT IN ENTRY LDA HPNTR HEAD ADDRESS JSB INSRT INSERT BEHIND HEAD LDA DNAM2 FATHERS' NAME ADDRESS INB WHERE IT GOES JSB MOVE DEC -4 SKP * *MORE THAN 1 SEGMENT ? MORE? LDA ENTR# GET ENTRY NUMBER ADA DM1 SUBTRACT 1 STA ENTR# CCE,SZA,RSS MORE? JMP EXIT NO- LDA NAME+2 GET 3RD. WORD OF NAME AND MASK STRIP TYPE/STATUS IOR B40 PUT IN BLANK STA NAME+2 AND RESTORE LDB DNAM ADDRESS OF SEG NAME ADB D2 START WITH 3RD. WORD NOT LDA B,I GET WORD SEZ E=0,LOW BYTE ALF,ALF POSITION HIGH TO LOW AND B377 MASK CPA B40 IF BLANK CPB DNAM OR ONE CHAR NAME JMP NOT1 DONE CMB,SEZ,CME,INB IF NOW HIGH BYTE CMB,RSS DECREMENT B WITHOUT SETTING E-REG CMB,INB BACK UP ONE WORD JMP NOT NOT1 LDA B,I GET THE WORD SEZ IF HIGH BYTE ALF,ALF SHIFT TO LOW SEZ,INA INCREMENT NAME ALF,ALF REPOSITION STA B,I RESTORE JMP SRCH SEE IF IT IS IN LIST * ERMOR ISZ EFLAG COUNT ERRORS JMP MORE? MORE SEGMENTS ? SKP * *HERE IF ENTRY NOT FOUND IN TABLE NMTCH JSB IDSGA SEE IF ALREADY IN CORE DEF *+2 DNAM DEF NAME SZA IN CORE ? JMP MORE? YES CCB DETERMINE DISK LU STB CRN# DEFAULT TO ONE DISC LDA CRN USER SPECIFIED DISC SZA IF IT IS ZERO CLB,RSS NOT ZERO USE IT LDA DM2 ZERO - SO DEFAULT IS LU 2 STA CRN SAVE FOR OPEN SZB USER SPECIFIED LU ? LDB SECT3 NO - DO WE HAVE AN LU 3 ? SZB,RSS USER SPECIFIED OR NO LU 3 JMP NMCH1 GO DO OPEN '(A)_DISC LU' JSB FSTAT REQUEST CATRIDGE LIST DEF *+2 ADBUF DEF BUFF BUFFER LDB ADBUF ADDRESS OF BUFFER CLOP LDA B,I ENTRY SZA,RSS END OF LIST ? JMP NMCA YES AND B77 MASK OF LU CPA D2 LU=2 ? JMP FOUND YES CPA D3 LU=3 ? JMP FOUND YES ADB D4 BUMP ADDRESS JMP CLOP KEEP LOOKING FOUND CMA,INA MAKE LU NEGATIVE STA CRN SAVE LDB DM2 NOW HAVE TWO STB CRN# DISC LU'S NMCA LDA CRN NMCH1 STA TEMP FOR OPEN JSB OPEN OPEN THE FILE DEF ORTN RETURN DEF DCB DEF IERR DEF NAME DEF D1 NON-EXCLUSIVE OPEN DEF D0 SECURITY DEF TEMP LU ORTN CPA D6 DID WE OPEN TYPE 6 ? JMP NMCH2 YES - GOOD OPEN LDB CRN# GET NUMBER OF DISC LU'S TO SEARCH LDA TEMP WHERE WE LOOKED CPA CRN TOP OF STACK ? CPB DM1 AND MORE THAN 1 DISC LU ? JMP NMC14 NO - NOT FOUND ,CLOSE THE DCB SLA,INA,RSS TRY OTHER DISC LDA DM3 JMP NMCH1 * NMCH2 LDA TEMP RETREIVE DISC LU STA CRN ALL SEGMT'S MUST BE ON SAME LU JMP NMCH3 SKIP NMC12 LDB NUM REQUESTED NO. OF SEGMENTS CPB D1 SHORT REQUEST JSB ROBIN MAKE AN ID AVAILABLE JMP NMC14 NONE AVAILABLE NMCH3 LDA CRN RETREIVE DISC LU CMA,INA MAKE POSITIVE JSB LOOK READ FILE HEADER JMP NMC14 CHECKSUM ERROR LDB DID12 CHECK NAME IN FILE HEADER JSB MATCH MUST MATCH DNAMN DEF NAME NAME REQUESTED RSS OK JMP NMC14 NO GO - CLOSE FILE JSB FID DO THE RP SZA,RSS ANY ERRORS ? JMP NMCH5 SUCCESS CPA D14 NO ID AVAILABLE ? JMP NMC12 YES - TRY TO FREE AN ID * NMC14 JSB CLOSE CLOSE DCB DEF *+2 DEF DCB JMP ERMOR TAKE ERROR EXIT * NMCH5 JSB CLOSE CLOSE DCB DEF *+2 DEF DCB * LDA NAME+2 MAKE UP ENTRY FOR SEGMENT AND MASK SAVE 5TH CHARACTER IOR SEGT INSERT TYPE LDB NUM REQUESTED NO OF ENTRIES CPB ENTR# IF FIRST ENTRY IOR HBIT IT'S A HEAD STA NAME+2 LDB HPNTR ADDRESS OF HEAD JSB GOFWD ADVANCE FORWARD STB TEMP SAVE LINK ADDRESS LDB BPNTR ENTRY ADDRESS TO B SZB,RSS DO WE HAVE A BLANK ? JSB QBLNK FIND ONE STB BPNTR SAVE ADDRESS SZB,RSS FOUND ? JSB ERR NO - TABLE FULL CPB MPNTR DID WE FIND IN TABLE ? JMP NMCH6 YES LDA TEMP LINK ADDRESS TO A JSB INSRT INSERT IN FRONT OF HEAD NMCH6 LDA DNAMN ADDRESS OF NAME INB WHERE IT GOES JSB MOVE DM4 DEC -4 LDA HPNTR DID WE HAVE A HEAD ? SZA,RSS LDA BPNTR N0 - NEW ENTRY IS HEAD STA HPNTR JMP ENTR1 GO PUT FATHER IN LIST SKP HED TERMINATE SAVING RESOURCES AND REPORT STATUS ERR NOP LDA *-1 GET ERROR ADDRESS STA NAME2 REPORT CLA,CCE,RSS EXIT CLA,CLE LDB EFLAG GET ERROR COUNT SZB ANY ERRORS ? CLA,CCE YES REPORT ! ERA STA EFLAG JSB DTACH RELEASE SELF FROM SESSION DEF *+1 JSB PRTN RETURN ANY ERROR DEF *+2 TO CALLER DEF EFLAG JSB EXEC DEF *+9 DEF D6 TERMINATE DEF D0 ME DEF D1 SAVING RESOURSES DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP DEF D0 CLEAR OUT XTEMP JMP T5IDM SKP HED SUBROUTINES * [B] ADDRESS OF ENTRY * JSB MATCH * DEF NAME NAME TO MATCH * IF MATCH * IF NO MATCH * [A] TYPE/STATUS OF ENTRY * MATCH NOP STB TPNTR SAVE ENTRY ADDRESS LDA MATCH,I GET NAME ADDRESS ISZ MATCH STA TEMP SAVE NAME ADDRESS INB DLD B,I 1ST TWO WORDS OF ENTRY NAME CPA TEMP,I SAME ? RSS YES-POSSIBLE MATCH JMP NXIT TAKE NO MATCH EXIT ISZ TEMP BUMP NAME POINTER CPB TEMP,I COMPARE ? RSS SAME JMP NXIT NO MATCH LDB TPNTR FIND ADDR OF LAST WORD ADB D3 IE WORD 4 ISZ TEMP LDA B,I GET LAST CHAR AND MASK IOR B40 BLANK CPA TEMP,I SAME ? JMP MXIT MATCH ! NXIT ISZ MATCH LDB TPNTR ENTRY ADDRESS ADB D3 POINT TO MXIT LDA B,I TYPE STATUS AND B377 EXTRACT LDB TPNTR RESTORE ADDRESS JMP MATCH,I RETURN * * FIND A BLANK ENTRY IF IT EXISTS IN TABLE * QBLNK NOP LDB TBLAD TABLE ADDRESS RSS QLP ADB D5 BUMP TO NEXT ENTRY CPB TEND END OF TABLE ? CLB,RSS YES LDA B,I GET ENTRY'S LINK WORD CPA DM1 UNUSED ENTRY ? CLA YES - USE AS BLANK SZB END OF TABLE ? SZA,RSS OR BLANK FOUND ? JMP QBLNK,I RETURN JMP QLP ELSE SKP * * [A] LINK POINTER - INSERT BEFORE * [B] ENTRY POINTER * JSB INSRT * INSRT NOP STA TEMP STB TPNTR LDA TBLA TABLE ADDRESS CMA,INA ADA TPNTR CALCULATE NEW ENTRY LINK CLB DIV D5 STA B SAVE IN B BLF,BLF POSITION TO HIGH BYTE IOR B MERGE TOGETHER LDB TEMP GET LINK POINTER SZB,RSS START OF NEW LIST ? JMP INSR1 YES STA IERR TEMPORARY LDA B,I BACK UP ALF,ALF AND B377 EXTRACT BACK LINK MPY D5 ADA TBLA ADDR OF PREVIOUS STA TAIL SAVE TAIL ADDRESS LDA TAIL,I GET TAIL POINTERS LDB TEMP,I AND HEAD POINTERS RRL 8 ALF,ALF REVERSE LINKS STA TPNTR,I PUT IT IN ENTRY LDA IERR RETREIVE TEMPORARY CPB TAIL,I SPECIAL CASE ? JMP *+3 YES TWO ENTRY LIST RRR 8 STB TEMP,I NEW HEAD POINTERS STA TAIL,I NEW TAIL POINTERS LDA TPNTR,I NEW ENTRY POINTERS INSR1 STA TPNTR,I PUT IN NEW LINKS LDB TPNTR JMP INSRT,I RETURN SKP * * [B] ENTRY ADDRESS * JSB GOFWD OR GOBCK * [A] TYPE STATUS * [B] NEXT ENTRY IN LIST ADDRESS * GOFWD NOP LDA B,I SZB IF NO ADDRESS SZA,RSS OR NO LINK JMP GOFWD,I RETURN AND B377 GET FWD LINK MPY D5 ADA TBLA CALCULATE STA B SAVE ADDRESS IN B REG. ADA D3 LDA A,I GET WORD 4 AND B377 EXTRACT TYPE/STATUS JMP GOFWD,I * GOBCK NOP LDA B,I SZB IF NO ADDRESS SZA,RSS OR NO LINK JMP GOBCK,I RETURN ALF,ALF AND B377 GET BACK LINK MPY D5 ADA TBLA STA B ADDRESS OF PREVIOUS ENTRY ADA D3 LDA A,I WORD 4 AND B377 EXTRACT TYPE/STATUS JMP GOBCK,I SKP * [B] ADDRESS OF ENTRY * JSB DRMNT CHECK IF PRGM DORMANT * [A] TYPE STATUS * [B] ADDRESS OF NEXT ENTRY * DRMNT NOP STB TPNTR SAVE CURRENT POINTER INB ADDRESS OF NAME IN ENTRY STB DDEF FOR CALL JSB IDSGA GET ID ADDRESS DEF *+2 DDEF NOP NAME ADDRESS LDB TPNTR RESTORE POINTER SZA,RSS DOES IT EXIST ? JMP RMOVE N0-DORMANT ADA D15 STATUS WORD FROM ID LDA A,I AND B17 EXTRACT STATUS SZA,RSS 0=DORMANT JMP RMOVE DORMANT SO REMOVE FROM LIST JSB GOBCK LOOK AT BACK JMP DRMNT,I * RMOVE STB TAIL IF ONLY ENTRY JSB GOBCK GET ADDRESS OF BACK CPB TPNTR IF ONLY ENTRY JMP RXIT JUST MARK AS BLANK STB TAIL SAVE TAIL ADDRESS LDA B,I GET LINK WORD AND MASK GET BACK STA TEMP SAVE LDA TPNTR,I AND B377 GET ENTRY'S FWD LINK IOR TEMP FORM NEW LINK STA B,I NEW LINK FOR BACK LDB TPNTR JSB GOFWD ADDRESS OF FORWARD LDA B,I CPB TAIL ONLY TWO ENTRIES ? LDA TPNTR,I YES - SPECIAL CASE AND B377 EXTRACT ITS FWD STA TEMP AND SAVE LDA TPNTR,I GET ENTRIES FROM BACK AND MASK IOR TEMP FORM NEW LINK STA B,I PUT IN FORWARD'S LINK WORD RXIT LDB TPNTR RESTORE B CLA STA B,I MARK ENTRY AS BLANK LDB TAIL RETURN WITH BACK ADDR LDA B ADA D3 LDA A,I AND B377 AND TYPE/STATUS JMP DRMNT,I RETURN SKP * * [B] ENTRY ADDRESS * JSB FLUSH - DO RP ,, ON ENTRY'S ID * [A] ERROR CODE * [B] UNCHANGED FLUSH NOP STB TPNTR SAVE ADDRESS INB ADDRESS OF NAME STB FNAM SAVE FOR CALL ADB D2 LDA B,I GET WORD 4 STA TEMP SAVE AND MASK EXTRACT TYPE/STATUS IOR B40 PUT IN BLANK STA B,I JSB IDRPD DO RP,, THING DEF *+2 FNAM NOP ID ADDRESS STA IERR SAVE ERROR CODE LDA TEMP RETREIVE SAVED TYPE STATUS LDB TPNTR ADB D3 STA B,I RESTORE WORD 4 LDB TPNTR AND B LDA IERR RETREIVE ERROR JMP FLUSH,I * * DO ROUND ROBIN TO MAKE ID AVAILABLE * JSB ROBIN * ROBIN NOP LDB RROBN GET ROUND ROBIN POINTER STB QBLNK SAVE TEMP JMP RR1 SKIP FIRST TIME RLP1 LDB RROBN GET ROUND ROBIN POINTER CPB QBLNK FULL CIRCLE ? JMP ROBIN,I YES - EXIT RR1 CPB TBLAD BEGINING OF TABLE ? LDB TEND YES - START AT BOTTOM ADB DM5 ADJUST TO PREVIOUS ENTRY STB RROBN SAVE ADB D3 TYPE STATUS WORD LDA B,I GET TYPE/STATUS CPA DM1 VALID ENTRY ? JMP RLP1 NO - KEEP LOOKING AND B17 EXTRACT TYPE CPA D3 IS IT TYPE 3 ? JMP RLP1 YES - LOOK AGAIN LDB RROBN JSB FLUSH DO RP,, SZA SUCCESS ? JMP RLP1 THIS ID NOT AVAIL TRY NEXT ISZ ROBIN BUMP RETURN (P+2) JMP ROBIN,I GOOD EXIT * SKP * * READ HEADER RECORD OF TYPE 6 FILE * FILE MUST BE OPEN AND DISC LU IN A REG. * * SYSUP NOP SYSTEM SETUP CODE WORD LOOK NOP IOR PRC MERGE IN PRIVILEDGE CODE STA TEMP SAVE DISC LU FOR EXEC CALL JSB EXEC DEF *+7 DEF D1 READ DEF TEMP DISC LU DFIDB DEF IDBUF DEST BUFFER ADDRESS DEF D35 LENGTH DEF DCB+3 DISC TRACK DEF DCB+4 DISC SECTOR LDA $OPSY CHECK IF RTE-IV SYSTEM LDB D28 CPA RT4FL IF RTE-IV, USE MORE WORDS FOR CHECKSUB ADB D5 MAKE IT 33 FOR RTE-IV STB LOOK1 SAVE FOR CHECKSUM CLA,CLE NOW CHECK FOR BELONGS THIS SYSTEM JSB SUM DEF IDBUF LOOK1 DEC 28 LDB LOOK1 GET INDEX INTO SKELITON DCB ADB DFIDB CPA B,I SAME ? INB,RSS YES - SKIP JMP ERR19 CHECKSUM ERROR LDA SYSUP GET THE SYSTEM SETUP CODE WORD CPA B,I SAME AS THIS SYSTEM? RSS YES - SKIP JMP ERR19 CHECKSUM ERROR LDA ID+15 GET TYPE WORD AND B17 MASK TO TYPE CPA SEGT SEGMENT ? RSS YES - SKIP JMP ERR19 NO - CLOSE FILE LDA DCB GET DISC LU ERA LSB 'LU' TO E REG. LDA DCB+3 GET TRACK ALF,ALF FOR DISC WORD ERA ADD LU IN BIT 15 LDB DCB+4 GET SECTOR ADA B PUT TOGETHER DISC WORD STA NAME+3 PUT IN OUR TABLE AND OM200 STRIP OUT SECTOR ADB D2 BUMP TO WHERE CODE STARTS CPB DCB+8 CHECK FOR TRACK CROSSING LDB B200 BUMP TRACK AND ZERO SECTOR ADA B FORM DISC WORD FOR ID STA ID+27 PUT IN SKELETON ID ISZ LOOK GOOD RETURN ERR19 JMP LOOK,I SPC 1 DM9 DEC -9 RT4FL EQU DM9 SKP * * FIND A BLANK SHORT ID AND SET IT UP * FID NOP JSB $LIBR GO PRIVILEDGE NOP TO PREVENT CONFLICTS JSB IDSGA SEE IF ID NOW IN CORE DEF *+2 DNAMF DEF NAME SEZ,CME NOT FOUND CLEAR E REG. JMP SERCH LDA D23 FOUND IN CORE JMP FXIT ERROR 23 ! LOOP1 LDA D14 SEZ,RSS IF DOWN TO DONT CARE ? JMP FXIT NO ID AVAILABLE * E=1 SEARCH FOR ID W/O TRACKS, E=0 DONT CARE ABOUT TRACKS SERCH CME TOGGLR E REG. LDA KEYWD ADDRESS OF ID TABLE STA TEMP RSS SKIP FIRST ISZ FIDL ISZ TEMP LDB TEMP,I GET ENTRY SZB,RSS END OF TABLE ? JMP LOOP1 TRY WITH TRACKS ADB D14 BUMP TO WORD 15 LDA B,I GET NAME/TYPE AND OM360 MASK TO CHAR 5 AND SHORT BIT CPA B20 NULL AND SHORT ? RSS YES - SKIP JMP FIDL LOOK SOME MORE ADB D5 CHECK FOR TRACKS LDB B,I WORD 20 SEZ,SZB IF HAS TRACKS AND CARE JMP FIDL SKIP THIS ONE * NOW SET UP THE ID LDB TEMP,I GET AVAILABLE ID ADDRESS ADB D11 CORRECT FOR SHORT ID LDA ID+8 ENTRY POINT ADDRESS STA B,I TO THE ID INB LDA DNAMF SEGMENT NAME JSB MOVE MOVE FIRST DM2 DEC -2 TWO WORDS LDA NAME+2 GET THIRD WORD AND MASK SAVE CHAR 5 XOR ID+15 MERGE IN PROG TYPE AND OM20 MASK OF BITS 4-14 XOR ID+15 IOR B220 PUT IN TEMP & SHORT BITS STA B,I MOVE TO ID INB LDA DID23 ADDRESS OF LOW MAIN ADDRESS JSB MOVE MOVE WORDS 23-27 DM5 DEC -5 CLA GOOD EXIT FXIT JSB $LIBX DEF FID * * MOVE ROUTINE A=SOURCE , B=DESTINATION ADDRESSES * MOVE NOP STA ID+18 SAVE SOURCE ADDRESS LDA MOVE,I GET COUNTER STA ID+19 SAVE ISZ MOVE SET RETURN MORE LDA ID+18,I GET NEXT WORD STA B,I PUT IT INB ISZ ID+18 ISZ ID+19 JMP MORE JMP MOVE,I RETURN - B=NEXT ADDRESS * * SUM ! P+1=ADDR. ,P+2=# OF WORDS * SUM NOP LDB SUM,I ISZ SUM STB MOVE TEMP LDB SUM,I GET # OF WORDS CMB,INB NEGATE ISZ SUM ADA MOVE,I ACCUMULATE SUM ISZ MOVE INB,SZB JMP *-3 JMP SUM,I * END T5IDM