perm filename WINGS[CAR,BGB] blob
sn#016002 filedate 1972-12-20 generic text, type T, neo UTF8
00100 TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
00200 COMMENT / - 32 PRIMITIVES -
00300
00400 1. BFEV MAKE & KILL OPERATIONS........................4 & 5.
00500 BNEW ← MKB(B); KLB(BNEW);
00600 FNEW ← MKF(B); KLF(B,FNEW);
00700 ENEW ← MKE(B); KLE(B,ENEW);
00800 VNEW ← MKV(B); KLV(B,VNEW);
00900 BNEW ← MKBFV; KLBFEV(Q);
01000
01100 2. WING MAKE LINK OPERATIONS..............................6.
01200 WING(E1,E2);
01300 LINKED(Q1,Q2);
01400
01500 3. ORIENTED WING FETCH & STORE OPERATIONS.............7 & 8.
01550 E ← ELEFT(V,F); E ← ERIGHT(V,F);
01600 E ← ECW(E,Q); E ← ECCW(E,Q);
01800 Q ← OTHER(E,Q); OTHER.(A,E,Q);
01900
02000 4. BFV FETCH OPERATIONS..............................9 & 10.
02100 B ← BODY(Q);
02200 F ← FCW(E,V); F ← FCCW(E,V);
02300 V ← VCW(E,F); V ← VCCW(E,F);
02400
02500 5. PARTS TREE OPERATIONS
02600 B ← SUPART(B); LOC ← MKLOCOR;
02700 ATT(B1,B2); ATTACH(B1,B2);
02800 DET(B); DETACH(B);
02900
03000 /
03100
03200 INTERN WORLD↔WORLD: 0
00100 ; BFEV MAKES AND KILLS.
00200 EXTERN GETBLK,RELBLK
00300 BEGIN MAKILL
00400 INTERN BTOTAL,FTOTAL,ETOTAL,VTOTAL
00500 BTOTAL: 0↔FTOTAL: 0↔ETOTAL: 0↔VTOTAL: 0
00600
00700 INTERN BSIZE,FSIZE,ESIZE,VSIZE
00800 BSIZE: 4+6
00900 FSIZE: 4+6
01000 ESIZE: 4+6
01100 VSIZE: 4+6
01200
01300 ; BNEW ← MKB(B0)
01400 SUBR(MKB)
01500 BEGIN MKB
01600 B←1 ↔ B0←2
01700 CALL GETBLK,BSIZE
01800 ADDI B,3 ↔ MARK B,BBIT
01900 ;ATTACH B TO B0, THAT IS B IS A SUB-PART OF B0.
02000 LAC B0,ARG1↔PART 0,B0↔PART. B,B0↔AOS 5(B0);INCREM PCNT.
02100 COPAR. 0,B↔LACN 0,B↔PART. 0,B; BNEW HAVE NO PARTS.
02200 DIP B,B↔FOR I←1,3<DAC B,I(B)↔>CDR B,B
02300 EXCH 2 ↔ AOS 2,BTOTAL ↔ SERIA. 2,B ↔ EXCH 2
02400 POP1J
02500 BEND
02600
02700 ;BNEW ← MKBFV;
02800 SUBR(MKBFV)
02900 CALL MKB,WORLD
03000 DAC 1,BNEW#
03100 CALL MKF,BNEW
03200 CALL MKV,BNEW
03300 LAC 1,BNEW↔POP0J
00100 ;FACE, EDGE & VERTEX MAKE PRIMITIVES.
00200
00300 SUBR(MKF)
00400 BEGIN MKF
00500 Q←1 ↔ X←2 ↔ B←3
00600 SAVAC(6)
00700 CALL GETBLK,FSIZE↔ADDI 1,3
00800 MARK 1,FBIT↔AOS FTOTAL
00900 LAC B,ARG1
01000 FCNT 0,B↔AOS↔FCNT. 0,B
01100 NFACE X,B
01200 PFACE. Q,X↔NFACE. Q,B
01300 PFACE. B,Q↔NFACE. X,Q
01400 SETZ↔CAME X,B↔SERIAL 0,X↔AOS↔SERIA. 0,Q
01500 GETAC(6)↔POP1J
01600 BEND
01700
01800 SUBR(MKE)
01900 BEGIN MKE
02000 Q←1 ↔ X←2 ↔ B←3
02100 SAVAC(6)
02200 CALL GETBLK,ESIZE↔ADDI 1,3
02300 MARK 1,EBIT↔AOS ETOTAL
02400 LAC B,ARG1
02500 ECNT 0,B↔AOS↔ECNT. 0,B
02600 NED X,B
02700 PED. Q,X↔NED. Q,B
02800 PED. B,Q↔NED. X,Q
02900 PBODY. B,Q
03000 SETZ↔CAME X,B↔SERIAL 0,X↔AOS↔SERIA. 0,Q
03100 GETAC(6)↔POP1J
03200 BEND
03300
03400 SUBR(MKV)
03500 BEGIN MKV
03600 Q←1 ↔ X←2 ↔ B←3
03700 SAVAC(6)
03800 CALL GETBLK,VSIZE↔ADDI 1,3
03900 MARK 1,VBIT↔AOS VTOTAL
04000 LAC B,ARG1
04100 VCNT 0,B↔AOS↔VCNT. 0,B
04200 NVT X,B
04300 PVT. Q,X↔NVT. Q,B
04400 PVT. B,Q↔NVT. X,Q
04500 SETZ↔CAME X,B↔SERIAL 0,X↔AOS↔SERIA. 0,Q
04600 GETAC(6)↔POP1J
04700 BEND
00100 ;BFEV KILL OPERATIONS.
00200
00300 ;KLB(BNEW).
00400 SUBR(KLB)
00500 BEGIN KLB
00600 B←1 ↔ X←2 ↔ Y←3
00700 LAC B,ARG1
00800 NBODY X,B↔PBODY Y,B ;DELETE FROM ALBODY RING.
00900 NBODY. X,Y↔PBODY. Y,X
01000 SUBI B,3↔LAC BSIZE↔DIPZ (B) ;RELEASE BODY BLK.
01100 CALL RELBLK,B
01200 SOS BTOTAL↔POP1J
01300 BEND
01400
01500 ;KLBFEV(Q).
01600 SUBR KLBFEV
01700 BEGIN KLBFEV
01800 ACCUMULATORS{B,F,E,V}
01900 LAC B,ARG1
02000 SETQ(B,{BODY,B})
02100 L1: PFACE F,B↔TESTZ F,FBIT↔GO[CALL KLF,B,F↔GO L1]
02200 L2: PED E,B↔TESTZ E,EBIT↔GO[CALL KLE,B,E↔GO L2]
02300 L3: PVT V,B↔TESTZ V,VBIT↔GO[CALL KLV,B,V↔GO L3]
02400 CALL KLB,B
02500 POP1J
02600 BEND
00100 ;FACE, EDGE & VERTEX KILL PRIMITIVES.
00200
00300 ;KLF(B,FNEW).
00400 SUBR(KLF)
00500 BEGIN KLF
00600 X←2 ↔ Y←B←3
00700 SAVAC(6)↔LAC 1,ARG1
00800 NFACE X,1↔PFACE Y,1 ;DELETE FROM FACE RING.
00900 NFACE. X,Y↔PFACE. Y,X
01000 SUBI 1,3↔LAC FSIZE↔DIPZ (1) ;RELEASE FACE BLK.
01100 CALL RELBLK,1
01200 SOS FTOTAL ;DECREMENT THE COUNTERS.
01300 LAC B,ARG2↔FCNT 0,B↔SOS↔FCNT. 0,B
01400 GETAC(6)↔POP2J
01500 BEND
01600
01700 ;KLE(B,ENEW).
01800 SUBR(KLE)
01900 BEGIN KLE
02000 X←2 ↔ Y←B←3
02100 SAVAC(6)↔LAC 1,ARG1
02200 NED X,1↔PED Y,1 ;DELETE FROM EDGE RING.
02300 NED. X,Y↔PED. Y,X↔ALT 6,1
02400 SUBI 1,3↔LAC ESIZE↔DIPZ (1) ;RELEASE EDGE BLK.
02500 CALL RELBLK,1
02600 SOS ETOTAL ;DECREMENT THE COUNTERS.
02700 LAC B,ARG2↔ECNT 0,B↔SOS↔ECNT. 0,B
02800 JUMPE 6,L
02900 SUBI 6,3↔LAC ESIZE↔DIPZ(6) ;RELEASE EDGE EXTENSION.
03000 CALL RELBLK,6
03100 L: GETAC(6)
03200 POP2J
03300 BEND
03400
03500 ;KLV(B,VNEW).
03600 SUBR(KLV)
03700 BEGIN KLV
03800 X←2 ↔ Y←B←3
03900 SAVAC(6)↔LAC 1,ARG1
04000 NVT X,1↔PVT Y,1 ;DELETE FROM VERTEX RING.
04100 NVT. X,Y↔PVT. Y,X
04200 SUBI 1,3↔LAC VSIZE↔DIPZ (1) ;RELEASE VERTEX BLK.
04300 CALL RELBLK,1
04400 SOS VTOTAL ;DECREMENT THE COUNTERS.
04500 LAC B,ARG2↔VCNT 0,B↔SOS↔VCNT. 0,B
04600 GETAC(6)↔POP2J
04700 BEND
04800 BEND
00100 ;WING(E1,E2) place wing pointers between two edges.
00200 ; THE AC-0 CONTROL BITS:
00300 ; [0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1]
00400 SUBR(WING)
00500 BEGIN WING
00600 E1←3 ↔ E2←4
00700 SAVAC(4)↔SETZ↔CDR E1,ARG2↔CDR E2,ARG1
00800
00900 ;FIND THE COMMON VERTEX.
01000 ; AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP in common.
01100 ; AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP in common.
01200 LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
01300 TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
01400 TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
01500
01600 ;FIND THE COMMON FACE.
01700 LAC 1,1(E1)↔MOVS 2,1↔XOR 1,1(E2)↔XOR 2,1(E2)
01800 TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
01900 TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
02000
02100 ;STORE THE WINGS AS INDICATED.
02200 SETCA
02300 TRNN 2020↔NCW.. E1,E2↔TRNN 1010↔NCW.. E2,E1
02400 TRNN 2002↔PCCW.. E1,E2↔TRNN 1001↔PCCW.. E2,E1
02500 TRNN 0220↔NCCW.. E1,E2↔TRNN 0110↔NCCW.. E2,E1
02600 TRNN 0202↔PCW.. E1,E2↔TRNN 0101↔PCW.. E2,E1
02700 GETAC(4)↔POP2J
02800 BEND
00100 ;LINKED(Q1,Q2) - DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
00200 SUBR(LINKED)
00300 BEGIN LINKED
00400 ACCUMULATORS{Q1,Q2,E}
00500 CDR Q1,ARG2↔CDR Q2,ARG1
00600 ;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
00700 TESTZ Q2,FBIT↔EXCH Q1,Q2
00800 TEST Q1,FBIT↔GO L1 ;POTENTIAL FACE NOW IN Q1.
00900 TESTZ Q2,FBIT↔GO FF
01000 TESTZ Q2,EBIT↔GO FE
01100 TESTZ Q2,VBIT↔GO FV↔GO FALSE
01200 L1: TESTZ Q2,EBIT↔EXCH Q1,Q2
01300 TEST Q1,EBIT↔GO L2 ;POTENTIAL EDGE NOW IN Q1.
01400 TESTZ Q2,EBIT↔GO EE
01500 TESTZ Q2,VBIT↔GO EV↔GO FALSE
01600 L2: TEST Q1,VBIT↔GO FALSE
01700 TEST Q2,VBIT↔GO FALSE↔GO VV
01800
01900 ;FACES WITH COMMON EDGE.
02000 FF: PED E,Q1↔DAC E,E0#
02100 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
02200 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
02300
02400 ;EDGE IN FACE PERIMETER.
02500 FE: PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
02600 NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
02700
02800 ;VERTEX IN FACE PERIMETER.
02900 FV: PED E,Q2↔DAC E,E0
02950 JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
03100 PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
03200 SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
03300
03400 ;EDGES WITH A COMMON VERTEX.
03500 EE: PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03600 NVT 1,Q2↔CAMN 0,1↔GO TRUE
03700 NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03800 NVT 1,Q2↔CAMN 0,1↔GO TRUE↔GO FALSE
03900
04000 ;VERTEX IN EDGE.
04100 EV: PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
04200 NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
04300
04400 ;VERTICES WITH A COMMON EDGE.
04500 VV: PED E,Q1↔DAC E,E0
04600 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
04700 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
04800
04900 FALSE: SETZ 1,↔POP2J
05000 TRUE: SETO 1,↔POP2J
05100 LIT↔VAR
05200 BEND
00100 SUBR(ELEFT)
00150 SKIPA 1,[-1] ;E ← ELEFT(FROM-V,ABOUT-F).
00200 SUBR(ERIGHT)
00250 SETZ 1, ;E ← ERIGHT(FROM-V,ABOUT-F).
00300 ; ELEFT ←-------V-------→ ERIGHT
00400 ; | |
00500 ; | F |
00600 ; | |
00700 BEGIN EFETCH
00800 ACCUMULATORS{V,F,E1,E2}
00900 Q←1
01000 SAVAC(5)
01100 DAC Q,QFLAG#↔LAC V,ARG2↔LAC F,ARG1
01200 TEST V,VBIT↔GO[SETCMM QFLAG↔EXCH F,V↔GO .+1]
01300 PED E2,V↔DAC E2,E0#
01400 L1: LAC E1,E2
01500 ;E2←ECW(E1,V) AND Q←FCW(E1,V).
01600 PVT Q,E1↔CAME Q,V↔GO .+4↔NCCW E2,E1↔NFACE Q,E1↔GO .+6
01700 NVT Q,E1↔CAME Q,V↔GO DIE↔PCCW E2,E1↔PFACE Q,E1
01800 CAMN Q,F↔GO L2↔CAME E2,E0↔GO L1
01900 DIE: FATAL(EFETCH)
02000 L2: LAC 1,E1↔SKIPE QFLAG↔LAC 1,E2
02100 GETAC(5)↔POP2J
02200 BEND
00100 ;E←ECW(FROM-X,ABOUT-Y) - EDGE CLOCKWISE FROM X ABOUT Y.
00200 SUBR(ECW)
00300 BEGIN ECW
00400 Q←1 ↔ X←2 ↔ E←3
00500 CDR 1,ARG2↔TEST 1,EBIT↔GO ERIGHT
00600 DAC 2,AC2↔ DAC 3,AC3
00700 CDR X,ARG1↔LAC E,1
00800 TEST X,VBIT↔GO[
00900 PFACE Q,E↔CAME Q,X↔GO L1↔ PCW Q,E↔GO L
01000 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L]
01100 PVT Q,E↔CAME Q,X↔GO L2↔ NCCW Q,E↔GO L
01200 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PCCW Q,E↔GO L
01300 DIE: FATAL(ECW)
01400 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01500 LIT
01600 BEND
01700
01800 SUBR(ECCW)
01900 BEGIN ECCW
02000 Q←1 ↔ X←2 ↔ E←3
02100 CDR 1,ARG2↔TEST 1,EBIT↔GO ELEFT
02200 DAC 2,AC2↔ DAC 3,AC3
02300 CDR X,ARG1↔LAC E,1
02400 TEST X,VBIT↔GO[
02500 PFACE Q,E↔CAME Q,X↔GO L1↔ PCCW Q,E↔GO L
02600 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCCW Q,E↔GO L]
02700 PVT Q,E↔CAME Q,X↔GO L2↔ PCW Q,E↔GO L
02800 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L
02900 DIE: FATAL(ECCW)
03000 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
03100 LIT
03200 BEND
00100 SUBR(OTHER)
00200 BEGIN OTHER
00300 Q←1 ↔ X←2 ↔ E←3
00400 DAC 2,AC2↔ DAC 3,AC3
00500 CDR X,ARG1↔CDR E,ARG2
00600 TEST X,VBIT↔GO[
00700 PFACE Q,E↔CAME Q,X↔GO L1↔ NFACE Q,E↔GO L
00800 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ PFACE Q,E↔GO L]
00900 PVT Q,E↔CAME Q,X↔GO L2↔ NVT Q,E↔GO L
01000 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PVT Q,E↔GO L
01100 DIE: FATAL(OTHER)
01200 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01300 LIT
01400 BEND
01500
01600 ; OTHER.(Q,E,X)
01700 SUBR(OTHER.)
01800 BEGIN OTHER.
01900 Q←1↔ X←2↔ E←3
02000 DAC AC0↔DAC 1,AC1↔DAC 2,AC2↔DAC 3,AC3
02100 CDR X,ARG1↔ CDR E,ARG2↔ CDR Q,ARG3
02200 TEST X,VBIT↔GO[
02300 PFACE 0,E↔ CAME X↔ GO L1↔ NFACE. Q,E↔GO L
02400 L1: NFACE 0,E↔ CAME X↔ GO DIE↔PFACE. Q,E↔GO L]
02500 NVT 0,E↔ CAME X↔ GO L2↔ PVT. Q,E↔GO L
02600 L2: PVT 0,E↔ CAME X↔ GO DIE↔NVT. Q,E↔GO L
02700 DIE: FATAL(OTHER.)
02800 L: LAC AC0↔LAC 1,AC1↔LAC 2,AC2↔LAC 3,AC3
02900 POP3J↔LIT
03000 BEND
00100 ; BODY FETCHER - GET THE BODY OF Q.
00200 ; B ← BODY(Q).
00300 SUBR(BODY)
00400 BEGIN BODY
00500 Q←1
00600 CDR Q,ARG1
00700 TESTZ Q,BBIT
00800 POP1J ;Q'S ALREADY A BODY.
00900 TESTZ Q,EBIT
01000 L1: GO [PBODY Q,Q↔POP1J] ;Q WAS AN EDGE.
01100 TESTZ Q,FBIT
01200 GO [PFACE 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;FACE
01300 TESTZ Q,VBIT
01400 GO [PVT 0,Q↔PED Q,Q↔JUMPN Q,L1↔GO L2] ;VERTEX
01500 POP1J; Q AIN'T GOT NO BODY.
01600 L2: POP1J(0) ;VERTEX BODY CASE.
01700 LIT
01800 BEND
01900
00100 ;V ← VCW(E,F).
00200 SUBR(VCW)
00300 BEGIN VCW
00400 Q←1 ↔ E←2
00500 DAC 2,AC2
00600 CDR E,ARG2
00700 PFACE Q,E↔CAME Q,ARG1↔GO L1 ↔PVT Q,E↔GO L
00800 L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE↔NVT Q,E↔GO L
00900 DIE: FATAL(VCW)
01000 L: LAC 2,AC2↔POP2J↔LIT
01100 BEND
01200
01300 ;V ← VCCW(E,F).
01400 SUBR(VCCW)
01500 BEGIN VCCW
01600 Q←1 ↔ E←2
01700 DAC 2,AC2
01800 CDR E,ARG2
01900 PFACE Q,E↔CAME Q,ARG1↔GO L1 ↔NVT Q,E↔GO L
02000 L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE↔PVT Q,E↔GO L
02100 DIE: FATAL(VCCW)
02200 L: LAC 2,AC2↔POP2J↔LIT
02300 BEND
02400
02500 ;F ← FCW(E,V).
02600 SUBR(FCW)
02700 BEGIN FCW
02800 Q←1 ↔ E←2
02900 DAC 2,AC2
03000 CDR E,ARG2
03100 PVT Q,E↔CAME Q,ARG1↔GO L1 ↔NFACE Q,E↔GO L
03200 L1: NVT Q,E↔CAME Q,ARG1↔GO DIE↔PFACE Q,E↔GO L
03300 DIE: FATAL(FCW)
03400 L: LAC 2,AC2↔POP2J↔LIT
03500 BEND
03600
03700 ;F ← FCCW(E,V).
03800 SUBR(FCCW)
03900 BEGIN FCCW
04000 Q←1 ↔ E←2
04100 DAC 2,AC2
04200 CDR E,ARG2
04300 PVT Q,E↔CAME Q,ARG1↔GO L1 ↔PFACE Q,E↔GO L
04400 L1: NVT Q,E↔CAME Q,ARG1↔GO DIE↔NFACE Q,E↔GO L
04500 DIE: FATAL(FCCW)
04600 L: LAC 2,AC2↔POP2J↔LIT
04700 BEND
00100 SUBR(MKLOCOR)
00200 BEGIN MKLOCOR
00300 PUSH P,[4+9];LOCOR SIZE.
00400 PUSHJ P,GETBLK
00500 ADDI 1,3
00600 SLACI(<1.0>)
00700 DAC IX(1)
00800 DAC JY(1)
00900 DAC KZ(1)
01000 POP0J
01100 BEND
01200
01300 ;FETCH THE SUPRA-PART OF A BODY.
01400 SUBR(SUPART)
01500 BEGIN SUPART
01600 B←1
01700 CDR B,ARG1
01800 COPART B,B
01900 JUMPGE B,.-1
02000 MOVMS B
02100 POP1J
02200 BEND
00100 ;ATTACH(B1,B2) PRIMITIVE
00200 ;ATTACH B1 TO B2, B1 BECOMES A SUBPART OF B2.
00300 SUBR(ATT)
00400 BEGIN ATT
00500 B←1
00600 ACCUMULATORS{B1,B2}
00700 CDR B1,ARG2
00800 CDR B2,ARG1
00900 PART B,B2
01000 COPAR. B,B1
01100 PART. B1,B2
01200 PCNT 0,B2↔AOS↔PCNT. 0,B2
01300 POP2J
01400 BEND
01500
01600 ;DETACH(B) PRIMITIVE
01700 ; DETACH B FROM ITS SUPART, B IS THEN FREE.
01800 SUBR(DET)
01900 BEGIN DET
02000 B1←1 ↔ B←2
02100 PUSH P,ARG1
02200 PUSHJ P,SUPART
02300 PCNT 0,1↔SOS↔PCNT. 0,1
02400 CDR B,ARG1 ;ME.
02500 PART 0,B1
02600 CAMN 0,B↔GO[COPART 0,B↔PART. 0,B1↔POP1J]
02700 LAC B1,0
02800 COPART 0,B1
02900 CAME 0,B↔GO[LAC B1,0↔GO .-2]
03000 COPART 0,B
03100 COPAR. 0,B1 ;HE POINTS WHERE I USE TO POINT.
03200 POP1J
03300 BEND
03400
00100 ;ATTACH(B1,B2) COMMAND.
00200 SUBR(ATTACH)
00300 BEGIN ATTACH
00400 LAC 2,ARG1↔TEST 2,BBIT↔POP2J
00500 LAC 2,ARG2↔TEST 2,BBIT↔POP2J
00600 PUSH P,ARG2
00700 PUSHJ P,DET
00800 GO ATT
00900 BEND
01000
01100 ;DETACH(B) COMMAND.
01200 SUBR(DETACH)
01300 BEGIN DETACH
01400 LAC 2,ARG1↔TEST 2,BBIT↔POP1J
01500 PUSH P,ARG1
01600 PUSHJ P,DET
01700 POP P,0 ;MY RETURN ADDRESS.
01800 PUSH P,WORLD
01900 PUSH P,0 ;KIND OF A PUSHJ.
02000 GO ATT
02100 BEND
02200 END
02300 WING.FAI - EOF.