ASMB,R,L,C HED TYPE 5 ID MANAGER FOR RTE II/III * NAM T5IDM,3,40 PRE REL 10-14-76 (MOS) * NAM T5IDM,3,40 09570-16539 REV. A 761013 * NAM T5IDM,3,40 PRE RELEASE REV. B 770324 NAM T5IDM,3,40 PRE-REL REV. D 780604 (DLB) RTE-IV * * *-------------------------------------------------------- * * 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.. EXT RMPAR,LOPEN,LCLOS,FSTAT EXT IDSGA,IDRPD,$LIBR,$LIBX *780604 EXT .OPSY * A EQU 0 B EQU 1 EQTA EQU 1650B KEYWD EQU 1657B XEQT EQU 1717B BPA1 EQU 1742B BPA3 EQU 1744B SECT2 EQU 1757B SECT3 EQU 1760B TATSD EQU 1756B 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 CCA CALCULATE THE LAST TRACK NUMBER ON ADA TATSD SYSTEM DISC STA TEMP SAVE FOR LATER JSB EXEC GO READ THE :CL OF THE DISC DEF *+7 DEF O1 DEF PRC2 SYSTEM DISC DEF SYSIA DEF D128 DEF TEMP DEF D0 SECTOR ZERO 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 EQU EFLAG 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 O1 EQU D1 D2 DEC 2 O2 EQU D2 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 DM9 DEC -9 RT4FL EQU DM9 * ***************************************************** 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) ** **-------------------------------------------------------- ** ** RELOC. 09570-16499 ** SOURCE 09570-18499 ** ** M. SPANN 13 OCT 76 REV. ** **--------------------------------------------------------- ** * ENT IDGT#,IDMG# * EXT EXEC ** *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 * LDB A,I GET THE DISC ADDRESS WORD * 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 * LDB B,I GET THE VALUE IN THE TAT TABLE * 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 LDB DEFER T5IDM NOT FOUND * DLD B,I ERROR FLAG TO A *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 GO GET THE SYSTEM ID WORD * PREVIOUS WORD IS PATCHED OUT AFTER 1ST EXECUTION 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 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 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 JSB NAM.. CHECK IF NAME IS LEGAL ? DEF *+2 DEF NAME SZA JMP MORE? NOT LEGAL SO FORGET IT 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 ? RSS YES DO ROUND ROBIN JMP MORE? NO - IGNORE JSB ROBIN MAKE AN ID 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 * 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