| 1 | SECT DROP\r |
| 2 | / SUBROUTINE DROP(OBJECT,WHERE)\r |
| 3 | / C\r |
| 4 | / C PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.\r |
| 5 | / C DECR HOLDNG IF THE OBJECT WAS BEING TOTED.\r |
| 6 | / C\r |
| 7 | / IMPLICIT INTEGER (A-Z)\r |
| 8 | / COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG\r |
| 9 | / DIMENSION ATLOC(150)\r |
| 10 | / DIMENSION LINK(200)\r |
| 11 | / DIMENSION PLACE(100)\r |
| 12 | / DIMENSION FIXED(100)\r |
| 13 | \r |
| 14 | JA #ST\r |
| 15 | #XR, ORG .+10\r |
| 16 | TEXT +DROP +\r |
| 17 | #RET, SETX #XR\r |
| 18 | SETB #BASE\r |
| 19 | JA .+3\r |
| 20 | #BASE, ORG .+6\r |
| 21 | OBJECT, ORG .+3\r |
| 22 | WHERE, ORG .+3\r |
| 23 | ONE, F 1.0\r |
| 24 | HUND, F 100.0\r |
| 25 | M1, F -1.0\r |
| 26 | ORG #BASE+30\r |
| 27 | FNOP\r |
| 28 | JA #RET\r |
| 29 | FNOP\r |
| 30 | #GOBAK, 0;0\r |
| 31 | #LBL=.\r |
| 32 | COMMON PLACOM\r |
| 33 | ATLOC, ORG .+702\r |
| 34 | LINK, ORG .+1130\r |
| 35 | PLACE, ORG .+454\r |
| 36 | FIXED, ORG .+454\r |
| 37 | HOLDNG, ORG .+3\r |
| 38 | ORG #LBL\r |
| 39 | #RTN, BASE #BASE\r |
| 40 | JA #GOBAK\r |
| 41 | #ST, STARTD\r |
| 42 | 0210\r |
| 43 | FSTA #GOBAK,0\r |
| 44 | 0200\r |
| 45 | SETX #XR\r |
| 46 | SETB #BASE\r |
| 47 | LDX 0,1\r |
| 48 | FSTA #BASE\r |
| 49 | FLDA% #BASE,1+\r |
| 50 | FSTA OBJECT\r |
| 51 | FLDA% #BASE,1+\r |
| 52 | FSTA WHERE\r |
| 53 | STARTF\r |
| 54 | FLDA% WHERE /Pre-load index regs\r |
| 55 | ATX 6\r |
| 56 | FLDA% OBJECT\r |
| 57 | ATX 7\r |
| 58 | / IF(OBJECT.GT.100)GOTO 1\r |
| 59 | FSUB HUND\r |
| 60 | ATX 5 /Save object-100\r |
| 61 | JGT #1\r |
| 62 | / IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1\r |
| 63 | FLDA ONE\r |
| 64 | FADD PLACE-3,7\r |
| 65 | JNE #G1\r |
| 66 | FLDA M1\r |
| 67 | FADDM HOLDNG\r |
| 68 | / PLACE(OBJECT)=WHERE\r |
| 69 | #G1, FLDA% WHERE\r |
| 70 | FSTA PLACE-3,7\r |
| 71 | / GOTO 2\r |
| 72 | JA #2\r |
| 73 | \r |
| 74 | / 1 FIXED(OBJECT-100)=WHERE\r |
| 75 | #1, FLDA% WHERE\r |
| 76 | FSTA FIXED-3,5\r |
| 77 | \r |
| 78 | / 2 IF(WHERE.LE.0)RETURN\r |
| 79 | #2, JLE #RTN\r |
| 80 | / LINK(OBJECT)=ATLOC(WHERE)\r |
| 81 | #G2, FLDA ATLOC-3,6\r |
| 82 | FSTA LINK-3,7\r |
| 83 | / ATLOC(WHERE)=OBJECT\r |
| 84 | XTA 7\r |
| 85 | FSTA ATLOC-3,6\r |
| 86 | / RETURN\r |
| 87 | / END\r |
| 88 | JA #RTN\r |
| 89 | END\r |