C PROGRAM BNODE.FT C ----------------- C C C C SUBROUTINE BNODE(IX,IY,IPTR,IOPR) C PETER LEMKIN C NIH C BETHESDA, MD 20014 C C C FEB 8, 1978 C OCT 26, 1977 C MAY 14, 1977 C MAY 9, 1977 C MARCH 31, 1977 C MARCH 28, 1977 C MARCH 26, 1977 C MARCH 24, 1977 C MARCH 23, 1977 C MARCH 16, 1977 C MARCH 15,1977 C MARCH 13, 1977 C MARCH 10, 1977 C MARCH 12, 1977 C MARCH 9, 1977 C MARCH 8, 1977 C MARCH 4, 1977 C MARCH 3, 1977 C C C PURPOSE C ------- C PROVIDE HIGHER LEVEL FREESTORE NODE MANIPULATION. C C CMD FUNCTION C --- -------- C 1 KAPPENDXY - APPEND NEW NODE TO LIST POINTED TO BY IPTR C WITH (IX,IY) IN INFO[1:2] FIELD. IF THERE ARE NO C MORE NODES IN THE FREESTORE THEN IPTR[1:2] IS SET TO C -1 OTHERWISE IT IS UNCHANGED. C C 2 KDELETEXY - DELETE LAST NODE IN LIST POINTED TO BY IPTR C AND RETURN IT TO AVAIL. RETURN IPTR<==-1 IF LIST IS NULL. C C 3 KPRINTLIST - PRINT NODES OF LIST POINTED TO BY IPTR C IT DOES NOTHING IS THE LIST IS NULL. C THE LIST IS PRINTED ON: C IX DEVICE C -- ------ C 0 TTY&LPT C NEQ 0 IX DEVICE C C THE PRINT FORMAT IS: C IY FORMAT C -- ------ C 0 NODE ADDR: [BK,FD,RT,X,Y] C 1 NODE ADDRESS C 2 [BK,FD,RT] C 4 [X] C 8 [Y] C 16 [FP # RT&X&Y] C C 4 KINITAVAIL - INIT THE FREESTORE. THIS CREATES 65K/5 NODES. C C 5 KGETLIST - GET LIST HEADER FROM AVAIL AND RETURN THE C POINTER IN IPTR. THE POINTERS POINT TO THE LIST HEADER NODE. C IF THERE ARE NO MORE NODES, THEN IPTR[1:2]=-1. C IX,IY ARE STORED IN THE INFO[1:2] (DATA) FIELD OF THE NODE. C C 6 KFREELIST - RETURN A LIST TO AVAIL POINTED TO BY IPTR. C IF THE LIST IS NULL, THEN DO NOTHING. C THE LIST POINTER IPTR<==-1; C C 7 KLASTXY - RETURN THE BACKPTR(IPTR)==>IPTR; AND RETURN C THE IX,IY DATA OF THE INFO[1:2] FIELD OF THE NEW C NODE. C C 8 KNEXTXY - RETURN THE FRONTPTR(IPTR)==>IPTR; AND RETURN C THE IX,IY DATA OF THE INFO[1:2] FIELD OF THE NEW C NODE. C C 9 KCARXY - RETURN THE IX,IY DATA OF THE INFO[1:2] C FIELD OF THE NODE POINTED TO BY IPTR. C C 10 KFINDXY - FIND THE NODE CORRESPONDING TO XY DATA IX[1:2] C IN THE LIST POINTED TO BY IPTR[1:2] AND RETURN THE NODE C POINTER IN IY[1:2]. RETURN -1 IF IT IS NOT FOUND. C C 11 KCOPYLIST - CREATE A COPY OF A LIST (DATA) POINTED TO C BY IX[1:2] AND RETURN THE NEW LIST POINTER IN IPTR[1:2]. C C 12 KCONSLIST - CONCATINATE THE LISTS POINTED TO BY IX[1:2] C AND IY[1:2]. RETURN THE NEW LIST POINTER IF IT IS NOT C NULL IN IPTR[1:2] C ELSE RETURN -1. C C 13 KCDRLIST - GIVEN A LIST OF 2 OR MORE NODES POINTED C TO BY IPTR, RETURN THE FIRST NODE OF THE LIST TO IAVAIL C AND THEN IPTR TO POINT TO THE 2ND ELEMENT (IF IT EXISTS) C OF THE INITIAL LIST. IF THE INITIAL LIST CONTAINS C NULL OR 1 ELEMENT, THEN RETURN -1 TO IPTR. C C 14 KSETXY - SET IX[0:7]&IY[0:7]==> INFO[1:2] (DATA) C FIELD OF THE NODE POINTED TO BY IPTR. C C 15 KCVXYTOI - CONVERT THE TWO 8-BIT VALUES (IX,IY)==>16-BIT C D.P. VALUE IPTR BY IPTR[0:15]=IX[0:7]&IY[0:7]. C C 16 KCVITOXY - CONVERT THE 16-BIT D.P. VALUE IPTR TO C THE TWO 8-BIT VALUES (IX,IY) BY C IX=IPTR/256, C IY=IPTR LAND'377; C C 17 KWRITEINFO - COPY THE INFO[1:2,1:3] ARRAY POINTED TO C BY IX ==>NODE(IPTR)[1:2,3:5]. C C 18 KREADINFO - COPY THE INFO[1:2,1:3] ARRAY POINTED TO C BY IX <==NODE(IPTR)[1:2,3:5]. C C 19 KSETFREESTORE - SET THE IAVAIL PTR TO IPTR. C C DIMENSION IAVAIL(2),JPTR(2),KSIZE(2),MSIZE(2) DIMENSION LIST(2),NN(2),MM(2),IFRONT(2),IREAR(2),IVAL(2) DIMENSION FNODE(5),NODE(2,5),IWK(2),II(2),JJ(2) EQUIVALENCE (NODE(1,2),IWK) DIMENSION JKND(2),JKPT(2) C C C [0] INIT C DEFINE DPCVRT CALLS LDTOF=-1 LFTOD=+1 C C DEFINE FREESTORE CALLS NINIT=1 NGETNODE=2 NFREENODE=3 NREADINFO=4 NWRITEINFO=5 NSETBACKPTR=6 NGETBACKPTR=7 NSETLEFTPTR=8 NGETLEFTPTR=9 NSETRIGHTPTR=10 NGETRIGHTPTR=11 NSETALLPTRS=12 NGETALLPTRS=13 NLISTFREE=14 C C C C C [1] INIT VARIOUS VARIABLES. MEM=3 SPACE=' ' IDEV=1 KSIZE=5 S DCA \KSIZE# C C VERIFY OPR RANGE MAXOPRS=19 IF(IOPR-1)999,100,100 100 IF(IOPR-MAXOPRS)101,101,999 999 WRITE(1,998)IOPR 998 FORMAT('ILLEGAL BNODE IOPR=',I5) CALL EXIT C C DISPATCH 101 GOTO(210,220,230,240,250,260,270,280,290 1,300,310,320,330,340,350,360,370,380,390),IOPR C C C RETURN S \2047, CLA RETURN C [2.1] KAPPENDXY - APPEND A NEW NODE TO LIST POINTED TO BY IPTR C AND PACK (IX&IY)==>RIGHT PTR DATA FIELD. C 210 CONTINUE C C C GET LIST HEADER POINTER IPTR LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C C [2.1.1] GET NODE CALL FREESTORE(MEM,JKND,IAVAIL,JPTR,JKPT,NGETNODE) C C C [2.1.2] IF FREESTORE = NULL OR LIST=NULL C THEN RETURN IPTR=-1; S CLA IAC S TAD \JPTR# S SZA CLA S JMP \212 /NOT NULL C S CLA IAC / TEST IF =-1 S TAD \LIST# S SZA CLA S JMP \212 /NOT NULL C C C [2.1.2.1] RETURN NIL. -1 S CLA CMA S TAD \IPTR# S DCA \IPTR# C S CLA CMA /-1 S DCA I \IPTR S INC \IPTR# S CLA CMA S DCA I \IPTR GOTO 2047 C C C [2.1.3] LINK JPTR NODE TO LIST. C FRONT[JPTR]_LIST; 212 CALL FREESTORE(MEM,JKND,JPTR,LIST,JKPT,NSETLEFTPTR) C C REAR[JPTR]_REAR[LIST]; CALL FREESTORE(MEM,JKND,LIST,NN,JKPT,NGETBACKPTR) CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NSETBACKPTR) C C FRONT[REAR[LIST]]_JPTR; CALL FREESTORE(MEM,JKND,NN,JPTR,JKPT,NSETLEFTPTR) C C REAR[LIST]_JPTR CALL FREESTORE(MEM,JKND,LIST,JPTR,JKPT,NSETBACKPTR) C C C [2.1.4] INSERT IX, IY INTO INFO[1:2]FIELD CALL FREESTORE(MEM,NODE,JPTR,JKPT,KSIZE,NREADNODE) C COMPUTE: NODE(1,4)=IX IVAL=IX S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD \IVAL S DCA I 25 C COMPUTE: NODE(1,5)=IY IVAL=IY S TAD PNODE S TAD (D8 /(1,5) S DCA 25 S TAD \IVAL S DCA I 25 CALL FREESTORE(MEM,NODE,JPTR,JKPT,KSIZE,NWRITENODE) C GOTO 2047 C [2.2] KDELETEXY - DELETE A NODE FROM THE REAR OF THE LIST POINTED C TO BY IPTR AND RETURN THE NODE TO IAVAIL. 220 CONTINUE C COPY THE LIST HEADER PTR LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C RESET PTR S CLA CMA /-1 S TAD \IPTR# S DCA \IPTR# C C C [2.2.1] IF LIST[1:2]=-1 THEN NOP C S CLA IAC S TAD \LIST S SZA CLA S JMP \221 /NO C S CLA IAC S TAD \LIST# S SZA CLA S JMP \221 /NO C C YES, WRITE(IDEV,222) 222 FORMAT(' NULL LIST - NO DELETE!') GOTO 2047 C C [2.2.2] GET LAST NODE PTR 221 CALL FREESTORE(MEM,JKND,LIST,JPTR,JKPT,NGETBACKPTR) C C C [2.2.3] IF LIST=JPTR C THEN THIS IS THE LAST NODE, SO ZERO THE LIST PTR; S \223, TAD \JPTR S CIA S TAD \LIST S SZA CLA S JMP \224 /NO C S TAD \JPTR# S CIA S TAD \LIST# S SZA CLA S JMP \224 /NO C C [2.2.3.1] RETURN NULL (-1) PTR C S CLA CMA S DCA I \IPTR S INC \IPTR# S CLA CMA S DCA I \IPTR C C C C [2.2.4] RETURN JPTR NODE TO AVAIL - SHORTEN THE LIST-- C NN_REAR[JPTR] 224 CALL FREESTORE(MEM,JKND,JPTR,NN,JKPT,NGETBACKPTR) C C FRONT[NN]_LIST; CALL FREESTORE(MEM,JKND,NN,LIST,JKPT,NSETLEFTPTR) C C REAR[LIST]_NN CALL FREESTORE(MEM,JKND,LIST,NN,JKPT,NSETBACKPTR) C C C [2.2.5] RETURN NODE TO AVAIL LIST CALL FREESTORE(MEM,JKND,IAVAIL,JPTR,KSIZE,NFREENODE) C GOTO 2047 C [2.3] KPRINTLIST - PRINT NODES OF LIST POINTED TO BY IPTR C IT DOES NOTHING IS THE LIST IS NULL. C THE LIST IS PRINTED ON: C IX DEVICE C -- ------ C 0 TTY&LPT C NEQ 0 IX DEVICE C C THE PRINT FORMAT IS: C IY FORMAT C -- ------ C 0 NODE ADDR: [BK,FD,RT,X,Y] C 1 NODE ADDRESS C 2 [BK,FD,RT] C 4 [X] C 8 [Y] C 16 [FP # RT&X&Y] C 230 CONTINUE C TRAVERSE THROUGH THE LST. INIT PTR C COPY THE LIST PTR NUM=0 LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C INIT JPTR JPTR=LIST S TAD \LIST# S DCA \JPTR# C C DEFINE PRINT DEVICE C IF IX=0 C THEN TTY&LPT ELSE DEVICE IX; II=1 MM=3 JJ=2 S TAD I \IX S SNA CLA S JMP \235 /TTY&LPT C C ELSE DEVICE IX II=IX MM=II JJ=1 C C DEFINE PRINT PATTERN C IPATTERN=(IF IY=0) THEN '17 ELSE IY) 235 IPATTERN=IY S TAD \IPATTERN S SNA S TAD (0017 S DCA \IPATTERN C C C [2.3.1] IF NULL LIST THEN DO NOT PRINT. S CLA IAC S TAD \LIST# S SZA CLA S JMP \232 /NOT NULL, PRINT THE LIST! C C NULL, RETURN GOTO 2047 C C C [2.3.2] LOOP THROUGH LIST 231 IF(JPTR-LIST)232,237,232 S\237, TAD \JPTR# S CIA S TAD \LIST# S SNA CLA S JMP \2047 /!!! DONE!!! C C C [2.3.3] GET AND PRINT THE NODE CONTINUE 232 CALL FREESTORE(MEM,NODE,JPTR,JKPT,KSIZE,NGETALLPTRS) CALL DPCVRT(JPTR,FJPTR,LDTOF) C C C PRINT IT AFTER CVT TO D.P. C GET THE INFO AS WELL CALL FREESTORE(MEM,NODE,JPTR,JKPT,KSIZE,NREADINFO) C DO 233 I=1,KSIZE C CVT TO FP CALL DPCVRT(NODE(1,I),FNODE(I),LDTOF) 233 CONTINUE C NUM=NUM+1 C C PRINT IT ON DEVICES SPECIFIED DO 236 NN=II,MM,JJ WRITE(NN,1201)NUM, 1201 FORMAT(' #',I4) C C C IF IPATTERN='0001 C THEN PRINT NODE ADDRESS S TAD \IPATTERN S AND (0001 S SNA CLA S JMP \1202 /NO WRITE(NN,1203)FJPTR, 1203 FORMAT(' NODE=',F6.0) C C IF IPATTERN='0002 C THEN PRINT PTRS S\1202, TAD \IPATTERN S AND (0002 S SNA CLA S JMP \1205 /NO WRITE(NN,1204)(FNODE(I),I=1,3), 1204 FORMAT(' BK=',F6.0,', FD=',F6.0,', RT=',F6.0) C C IF IPATTERN='0004 C THEN PRINT INFO[1]=X S\1205, TAD \IPATTERN S AND (0004 S SNA CLA S JMP \1207 /NO WRITE(NN,1206)FNODE(4), 1206 FORMAT(' ,X=',F6.0) C C IF IPATTERN='0010 C THEN PRINT INFO[2]=Y S\1207, TAD \IPATTERN S AND (0010 S SNA CLA S JMP \1209 /NO WRITE(NN,1208)FNODE(5) 1208 FORMAT(' ,Y=',F6.0) C C IF IPATTERN='0020 C THEN PRINT FLOATING PT # CONSISTING OF LSW [RT,X,Y]; S\1209, TAD \IPATTERN S AND (0020 S SNA CLA S JMP \236 /NO C CONSTRUCT A FP NUMBER OUT OF NODE[1,3:5]==>FPNUM S TAD (5 S TAD PNODE S DCA 25 S CLA CMA S TAD PFPNUM S DCA 11 C S TAD I 25 S DCA I 11 C S TAD (2 S TAD 25 S DCA 25 S TAD I 25 S DCA I 11 C C S TAD (2 S TAD 25 S DCA 25 S TAD I 25 S DCA I 11 C WRITE(NN,1210)FPNUM 1210 FORMAT(' ,FP NUM=',F6.0) 236 CONTINUE C ADJUST PTR TO NEXT NODE. JPTR=NODE(1,2) JPTR(2)=NODE(2,2) GOTO 231 C [2.4] KINITAVAIL - INIT THE FREESTORE [1:65530] 240 CONTINUE C YES, C AVAIL=1.0 ENDAVAIL=65530.0 KSIZE=5 S DCA \KSIZE# C C C CVT TO INTEGER CALL DPCVRT(IAVAIL,AVAIL,LFTOD) CALL DPCVRT(JPTR,ENDAVAIL,LFTOD) C MSIZE=KSIZE S DCA \MSIZE# CALL FREESTORE(MEM,NODE,IAVAIL,JPTR,MSIZE,NINIT) C C CALL DPCVRT(MSIZE,SIZE,LDTOF) WRITE(IDEV,242)SIZE 242 FORMAT(' FREESTORE INITIALIZED WITH ',F9.0,' NODES.') GOTO 2047 C C [2.5] KGETLIST - CREATE A LIST FROM AVAIL AND RETURN THE C POINTER IN IPTR. IX&IY ARE STORED IN THE RIGHT PTR. 250 CONTINUE C GET A NODE CALL FREESTORE(MEM,JKND,IAVAIL,LIST,JKPT,NGETNODE) C C COPY PTR TO IPTR IPTR=LIST S INC \IPTR# S TAD \LIST# S DCA I \IPTR C C C SET POINTEST OF NODE TO ITSELF C R[LIST]_LIST, F[LIST]_LIST; CALL FREESTORE(MEM,JKND,LIST,LIST,JKPT,NSETBACKPTR) CALL FREESTORE(MEM,JKND,LIST,LIST,JKPT,NSETLEFTPTR) C C C [2.5.1] INSERT IX, IY INTO INFO[1:2]FIELD CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADNODE) C COMPUTE: NODE(1,4)=IX IVAL=IX S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD \IVAL S DCA I 25 C C COMPUTE: NODE(1,5)=IY IVAL=IY S TAD PNODE S TAD (D8 /(1,5) S DCA 25 S TAD \IVAL S DCA I 25 CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NWRITENODE) GOTO 2047 C C [2.6] KFREELST - RETURN A LIST TO AVAIL POINTED TO BY IPTR 260 CONTINUE LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C UPDATE THE PTR S CLA CMA S TAD \IPTR# S DCA \IPTR# C C IF LIST=-1 THEN ABORT LISTFREE S CLA IAC S TAD \LIST# S SNA CLA S JMP \2047 /NULL LIST! C C CALL FREESTORE(MEM,JKND,IAVAIL,LIST,MSIZE,NLISTFREE) C C CLEAR THE LIST POINTER IPTR=-1 S INC \IPTR# IPTR=-1 GOTO 2047 C C [2.7] KLASTXY - IPTR<==BACKPTR(IPTR), AND THEN RETURN C THE NEXT NODE INFO[1:2] (DATA)==>IX,IY. 270 CONTINUE C C GET THE NEXT NODE C GET THE POINTER LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C CALL FREESTORE(MEM,JKND,LIST,LIST,JKPT,NGETBACKPTR) C C [2.7.1] RETURN THE INFO[1:2] (DATA) IN IX,IY CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADINFO) C C COMPUTE: IX=NODE(1,4) S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD I 25 S DCA I \IX C C COMPUTE: IY=NODE(1,5) S TAD PNODE S TAD (D8 /(1,5) S DCA 25 S TAD I 25 S DCA I \IY C C C RETURN THE NEW PTR S CLA CMA S TAD \IPTR# S DCA \IPTR# C IPTR=LIST S INC \IPTR# S TAD \LIST# S DCA I \IPTR GOTO 2047 C [2.8] KNEXTXY - IPTR<==FRONT[IPTR], AND THEN RETURN C THE NEXT NODE INFO[1:2] (DATA)==>IX,IY. 280 CONTINUE C C GET THE NEXT NODE C GET THE POINTER LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C CALL FREESTORE(MEM,JKND,LIST,LIST,JKPT,NGETLEFTPTR) C C [2.8.1] RETURN THE INFO[1:2] (DATA) IN IX,IY CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADINFO) C C COMPUTE: IX=NODE(1,4) S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD I 25 S DCA I \IX C C COMPUTE: IY=NODE(1,5) S TAD PNODE S TAD (D8 /(1,5) S DCA 25 S TAD I 25 S DCA I \IY C C C RETURN THE NEW PTR S CLA CMA S TAD \IPTR# S DCA \IPTR# C IPTR=LIST S INC \IPTR# S TAD \LIST# S DCA I \IPTR GOTO 2047 C C C [2.9] KCARXY - THE NODE INFO[1:2] (DATA)==>IX,IY. 290 CONTINUE C C GET THE NEXT NODE C GET THE POINTER LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C C [2.9.1] RETURN THE INFO[1:2] (DATA) IN IX,IY CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADINFO) C C COMPUTE: IX=NODE(1,4) S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD I 25 S DCA I \IX C C COMPUTE: IY=NODE(1,5) S TAD PNODE S TAD (D8 /(1,5) S DCA 25 S TAD I 25 S DCA I \IY C C GOTO 2047 C C C [2.10] KFINDXY - FIND THE NODE CORRESPONDING TO XY DATA IX[1:2] C IN THE LIST POINTED TO BY IPTR[1:2] AND RETURN THE NODE C POINTER IN IY[1:2]. RETURN -1 IF IT IS NOT FOUND. C 300 CONTINUE C C [2.10.1] COPY ARGS BY VALUE C COPY LIST HEADER PTR LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C GET THE DATA TO LOOK FOR S TAD I \IX S AND (377 S DCA \IVAL# /Y C S TAD I \IX S RTL;RTL;RAL S AND (0017 S DCA \IVAL S INC \IX# S TAD I \IX S RTL; RTL S AND (0360 S TAD \IVAL S DCA \IVAL /X C C SET SWITCH TO FALSE L1=-1 L2=-1 C C C COPY LIST==>JPTR JPTR=LIST S TAD \LIST# S DCA \JPTR# C C C [2.10.2] TEST IF LIST IS NULL C IF LIST[1:2]=-1 C THEN RETURN -1; S TAD \LIST# S SMA CLA S JMP \301 /NOT NULL C C THEN RETURN (-1) C C C [2.10.3] RETURN (L1,L2) 302 IY=L1 S INC \IY# IY=L2 GOTO 2047 C C C [2.10.4] LOOP TO GET NODE AND TEST IF MATCH. 301 CALL FREESTORE(MEM,NODE,JPTR,JKPT,KSIZE,NREADINFO) C C C C II[1]_(NODE[1,4] LAND '377); C II[2]_(NODE[1,5] LAND '377); C C COMPUTE: NODE(1,4)= X S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD I 25 S AND (377 S DCA \II C C COMPUTE: NODE(1,5) S TAD PNODE S TAD (D8 /(1,5) = Y S DCA 25 S TAD I 25 S AND (377 S DCA \II# C C [2.10.4.1] IF II[1:2]=IVAL[1:2] C THEN C BEGIN "FOUND IT" C L1<==JPTR,L2<==JPTR[2]; C RETURN(L1,L2)==>IY[1:2] C END "FOUND IT"; S TAD \II S CIA S TAD \IVAL S SZA CLA S JMP \303 /NOT YET C S TAD \II# S CIA S TAD \IVAL# S SZA CLA S JMP \303 /NO, TEST IF DONE C C YES, FOUND IT RETURN PTR L1=JPTR S TAD \JPTR# S DCA \L2 GOTO 302 C C C [2.10.4.2], ADJUST PTR TO NEXT NODE AND TEST IF DONE! C COMPUTE: JPTR<==FRONT[JPTR]=IWK[1:2]. 303 JPTR=IWK S TAD \IWK# S DCA \JPTR# C C [2.10.4.3] IF LIST[1:2]=JPTR[1:2] C THEN FAILED (RETURN -1)==>IY[1:2]. C ELSE CONTINUE SEARCH; S TAD \LIST S CIA S TAD \JPTR S SZA CLA S JMP \301 /NOT DONE C S TAD \LIST# S CIA S TAD \JPTR# S SZA CLA S JMP \301 /NO CONTINUE SEARCH C C C [2.10.4.4] DONE!, FAILED SEARCH RETURN -1 GOTO 302 C C C C C [2.11] KCOPYLIST - CREATE A COPY OF A LIST (DATA) POINTED TO C BY IX[1:2] AND RETURN THE NEW LIST POINTER IN IPTR[1:2]. C 310 CONTINUE C COPY LIST HEADER PTR LIST=IX S INC \IX# S TAD I \IX S DCA \LIST# C C SETUP WORKING POINTER MM=LIST S TAD \LIST# S DCA \MM# C C COPY PTR TO NULL IFIRST=1 L1=-1 L2=-1 C C IF LIST[1:2]=-1 THEN RETURN -1 S CLA IAC S TAD \LIST S SZA CLA S JMP \311 /NO C S CLA IAC S TAD \LIST# S SZA CLA S JMP \311 /NO C YES, RETURN -1 312 IPTR=L1 S INC \IPTR# IPTR=L2 GOTO 2047 C C C GET A LIST HEADER NODE AND SET JPTR AND (L1,L2) TO IT. 311 CALL FREEST(MEM,JKND,IAVAIL,JPTR,KSIZE,NGETNODE) IF(IFIRST)313,314,313 C C SET UP PTR 313 L1=JPTR S TAD \JPTR# S DCA \L2 JJ=JPTR S TAD \JPTR# S DCA \JJ# C C C READ INFO ON SOURCE NODE 314 CALL FREESTORE(MEM,NODE,MM,JKPT,KSIZE,NGETALLPTRS) C C SAVE FWD PTR MM=IWK S TAD \IWK# S DCA \MM# C C C IF IFIRST=1 C THEN SET HEADER PTRS<==JPTR, IFIRST<==0 C ELSE APPEND JPTR TO JJ LIST. IF(IFIRST)315,316,315 C THEN SETUP HEADER NODE C REAR[JJ]<==JJ 315 NODE=JJ S TAD \JJ S DCA \NODE# C C FRONT[JJ]<==JJ IWK=JJ S TAD \JJ# S DCA \IWK# C 317 CALL FREESTORE(MEM,NODE,JJ,JKPT,KSIZE,NSETALLPTRS) IFIRST=0 C GO TEST IF DONE GOTO 318 C C C ELSE APPEND NODE C II<==REAR[JJ] 316 CALL FREESTORE(MEM,JKND,JJ,II,0,NGETBACKPTR) C C FRONT[REAR[JJ]]<==JPTR CALL FREESTORE(MEM,JKND,II,JPTR,0,NSETLEFTPTR) C C REAR[JJ]<<==JPTR CALL FREESTORE(MEM,JKND,JJ,JPTR,0,NSETBACKPTR) C C REAR[JPTR]<==II NODE=II S TAD \II# S DCA \NODE# C C FRON[JPTR]<==JJ IWK=JJ S TAD \II# S DCA \IWK# C WRITE OUT THE NODE AND CONTINUE GOTO 317 C C C TEST IF DONE C IF MM[1:2]=LIST[1:2] C THEN DONE S \318, TAD \MM S CIA S TAD \LIST S SZA CLA S JMP \311 /NO, CONTINUE C S TAD \MM# S CIA S TAD \LIST# S SZA CLA S JMP \311 /NO, CONTINUE C C DONE, RETURN (L1,L2)==>IPTR GOTO 312 C C [2.12] KCONSLIST - CONCATINATE HE LISTS POINTED TO BY IX[1:2] C AND IY[1:2]. RETURN THE C NEW LIST POINTER IF IT IS NOT NULL IN IPTR[1:2] C ELSE RETURN -1. C 320 CONTINUE C COPY IX, IY PTRS II=IX S INC \IX# S TAD I \IX S DCA \II# C JJ=IY S INC \IY# S TAD I \IY S DCA \JJ# C C SET RETURN PTR TO NULL L1=-1 L2=-1 C C C [2.12.1] IF (IX = NULL) AND (IY = NULL) C THEN RETURN (IPTR<==-1); S CLA IAC S TAD \II S SZA CLA S JMP \321 /NOT NULL C S CLA IAC S TAD \II# S SZA CLA S JMP \321 /NOT NULL C S CLA IAC S TAD \JJ S SZA CLA S JMP \322 /NOT NULL C S CLA IAC S TAD \JJ# S SZA CLA S JMP \322 /NOT NULL C C RETURN (IPTR<==-1) C C C RETURN PTR 329 IPTR=L1 S INC \IPTR# IPTR=L2 GOTO 2047 C C C [2.12.2] IF (IX NEQ NULL) AND (IY = NULL) C THEN RETURN (IPTR<==IX); S\321, CLA IAC S TAD \JJ S SZA CLA S JMP \323 /NOT NULL, CONTINUE C S CLA IAC S TAD \JJ# S SZA CLA S JMP \323 /NOT NULL, CONTINUE C C NULL L1=II S TAD \II# S DCA \L2 GOTO 329 C C C [2.12.3] IF (IX = NULL) AND (IY NEQ NULL) C THEN RETURN (IPTR<==IY); S\322, CLA IAC S TAD \II S SZA CLA S JMP \323 /NO C S CLA IAC S TAD \II# S SZA CLA S JMP \323 /NO C L1=JJ S TAD \JJ# S DCA \L2 GOTO 329 C C C [2.12.4] CONNECT THE TWO LISTS C MM<==REAR[II] 323 CALL FREESTORE(MEM,JKND,II,MM,JKPT,NGETBACKPTR) C C C NN<==REAR[JJ] CALL FREESTORE(MEM,JKND,JJ,NN,JKPT,NGETBACKPTR) C C C REAR[II]<==NN CALL FREESTORE(MEM,JKND,II,NN,JKPT,NSETBACKPTR) C C C REAR[JJ]<==MM CALL FREESTORE(MEM,JKND,JJ,MM,JKPT,NSETBACKPTR) C C C FRONT[MM]<==JJ CALL FREESTORE(MEM,JKND,MM,JJ,JKPT,NSETLEFTPTR) C C C FRONT[NN]<==II CALL FREESTORE(MEM,JKND,NN,II,JKPT,NSETLEFTPTR) C C C [2.12.5] RETURN (IPTR<==II) L1=II S TAD \II# S DCA \L2 GOTO 329 C C [2.13] KCDRLIST - GIVEN A LIST OF 2 OR MORE NODES POINTED TO BY C IPTR, RETURN THE FIRST NODE OF THE LIST TO IAVAIL AND C THEN IPTR TO POINT TO THE 2ND ELEMENT (IF IT EXISTS) C OF THE INITIAL LIST. IF THE INITIAL LIST CONTAINS C NULL OR 1 ELEMENT, THEN RETURN -1 TO IPTR. 330 CONTINUE C C COPY THE LIST POINTER LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C RESET THE IPTR DUMMY VARIABLE S CLA CMA S TAD \IPTR# S DCA \IPTR# C C C [2.13.1] IF LIST=-1 THEN RETURN. S CLA IAC S TAD \LIST S SZA CLA S JMP \331 /NOT NULL C S CLA IAC S TAD \LIST# S SZA CLA S JMP \331 /NOT NULL C C YES, NULL RETURN. GOTO 2047 C C C [2.13.2] GET FRONT[LIST]. 331 CALL FREESTORE(MEM,JKND,LIST,JPTR,JKPT,NGETLEFTPTR) C C C [2.13.3] LIST<==SWAP==>JPTR C WE WILL DELETE CURRENT LIST AND RETURN JPTR AT C [2.2.3] WHICH DELETES JPTR AND RETURNS LIST==>IPTR! IFRONT=JPTR S TAD \JPTR# S DCA \IFRONT# C JPTR=LIST S TAD \LIST# S DCA \JPTR# C C GOTO [2.2.3] TO DO THE ACTUAL CDR. GOTO 223 LIST=IFRONT S TAD \IFRONT# S DCA \LIST# C C [2.14] KSETXY - SET IX[0:7]&IY[0:7]==> RIGHT PTR (DATA) C FIELD OF THE NODE POINTED TO BY IPTR. 340 CONTINUE C C GET LIST HEADER PTR IPTR LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C IF LIST=NULL C THEN NOP S CLA IAC S TAD \LIST# S SNA CLA S JMP \2047 /ABORT C C [2.14.1] INSERT IX&IY INTO INFO[1:2] CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADNODE) C COMPUTE: NODE(1,4)=IX IVAL=IX S TAD PNODE S TAD (6 /(1,4) S DCA 25 S TAD \IVAL S DCA I 25 C COMPUTE: NODE(1,5)=IY IVAL=IY S TAD PNODE S TAD (D8 /(1,5) S DCA 25 S TAD \IVAL S DCA I 25 CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NWRITENODE) GOTO 2047 C [2.15] KCVXYTOI - CONVERT THE TWO 8-BIT VALUES (IX,IY)==>16-BIT C D.P. VALUE IPTR BY IPTR[0:15]=IX[0:7]&IY[0:7]. 350 CONTINUE S CLA S TAD I \IY S AND (377 S DCA \MM I=IX S TAD \I S RTR; RTR; RAR S AND (7400 S TAD \MM S DCA \MM C S TAD \I S RTR; RTR S AND (17 S DCA \MM# C IPTR=MM S INC \IPTR# S TAD \MM# S DCA I \IPTR GOTO 2047 C [2.16] KCVITOXY - CONVERT THE 16-BIT D.P. VALUE IPTR TO C THE TWO 8-BIT VALUES (IX,IY) BY C IX=IPTR/256, C IY=IPTR LAND'377; 360 CONTINUE S TAD I \IPTR S AND (377 S DCA I \IY S TAD I \IPTR S RTL;RTL;RAL S AND (0017 S DCA \MM# S INC \IPTR# S TAD I \IPTR S RTL;RTL S AND (360 S TAD \MM# S DCA I \IX GOTO 2047 C [2.17] KWRITEINFO - COPY THE INFO[1:2,1:3] ARRAY POINTED TO C BY IX ==>NODE(IPTR)[1:2,3:5]. C 370 CONTINUE C READ THE INFO INFROM THE NODE AND THEN COPY FROM IX[1:6]. C C GET LIST HEADER PTR IPTR LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C IF LIST=NULL C THEN NOP S CLA IAC S TAD \LIST# S SNA CLA S JMP \2047 /ABORT C CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADNODE) C C COPY NODE[1:2,3:5]==>IX[1:6] DO 371 I=1,6 S TAD PNODE S TAD \I S TAD (3 /POINTS TO NODE(1,3) S DCA 25 S TAD I \IX S DCA \IVAL S TAD \IVAL S DCA I 25 S INC \IX# 371 CONTINUE C C WRITE OUT THE MODIFIED NODE! CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NWRITENODE) GOTO 2047 C [2.18] KREADINFO - COPY THE INFO[1:2,1:3] ARRAY POINTED TO C BY IX <==NODE(IPTR)[1:2,3:5]. C 380 CONTINUE C READ THE INFO INTO THE NODE AND THEN COPY TO IX[1:6]. C C GET LIST HEADER PTR IPTR LIST=IPTR S INC \IPTR# S TAD I \IPTR S DCA \LIST# C C IF LIST=NULL C THEN NOP S CLA IAC S TAD \LIST# S SNA CLA S JMP \2047 /ABORT C CALL FREESTORE(MEM,NODE,LIST,JKPT,KSIZE,NREADNODE) C C COPY NODE[1:2,3:5]==>IX[1:6] DO 381 I=1,6 S TAD PNODE S TAD \I S TAD (3 /POINTS TO NODE(1,3) S DCA 25 S TAD I 25 S DCA I \IX S INC \IX# 381 CONTINUE GOTO 2047 C C [2.19] KSETFREESTORE - SET IAVAIL TO IPTR 390 IAVAIL=IPTR S INC \IPTR# S TAD I \IPTR S DCA \IAVAIL# GOTO 2047 C ****************PARAMETERS**** S PFPNUM, \FPNUM /PTR S PNODE, \NODE END