projects / pdp8.git / blame
| Commit | Line | Data |
|---|---|---|
| 81e70d48 PH |
1 | C -+-+-+-+-+ \ e H A E S A M . F T \ e -+-+-+-+-+\r |
| 2 | C\r | |
| 3 | C FETCH THE INDEX'ED DATA-WORD FROM "CHANEL" OUT OF THE SAMPLE ON "UNIT"\r | |
| 4 | C THE FIRST ELEMENT OF THE SAMPLE BUFFER IS REFERENCED WITH INDEX=0\r | |
| 5 | C\r | |
| 6 | C * UP 7-OCT-82\r | |
| 7 | C * UP 18-OCT-83 TWO INPUT BUFFERS\r | |
| 8 | C\r | |
| 9 | REAL FUNCTION ESAM(INDEX)\r | |
| 10 | INTEGER INDEX\r | |
| 11 | C\r | |
| 12 | INCLUDE HAEBUF.FI\r | |
| 13 | INCLUDE HAESCR.FI\r | |
| 14 | INCLUDE HAEHAS.FI\r | |
| 15 | INCLUDE HAETTY.FI\r | |
| 16 | C\r | |
| 17 | REAL WGET\r | |
| 18 | EXTERNAL WGET\r | |
| 19 | C\r | |
| 20 | INTEGER RECNUM,WORD,R,J\r | |
| 21 | * , BUFCNT @ HOLDS NUMBER OF INPUT BUFFERS FOR UNIT 7\r | |
| 22 | DATA BUFCNT /2/\r | |
| 23 | \fC\r | |
| 24 | IF (.NOT.HSHDON) CALL MKHASH\r | |
| 25 | R=MOD(INDEX+1,PCKMAX)\r | |
| 26 | IF (R.EQ.0) R=PCKMAX\r | |
| 27 | WORD=INT(INDEX/PCKMAX)*HSHSIG+HASH(CHANEL+1,R)\r | |
| 28 | RECNUM=(WORD-1)/255+OFFSET @ GET THE RECORD NUMBER \r | |
| 29 | DO 15 J=1,BUFCNT\r | |
| 30 | IF (RECNUM.EQ.INPREC(J)) GOTO 10 @ JUMP IF RECORD ALREADY IN BUFFER\r | |
| 31 | 15 CONTINUE\r | |
| 32 | IF (RECNUM.GT.LASREC) GOTO 20 @ END OF FILE REACHED\r | |
| 33 | C\r | |
| 34 | C\r | |
| 35 | J=BUFCNT-RECACT+1 @ COMPUTE NEXT INPUT BUFFER\r | |
| 36 | GOTO (111,112),J\r | |
| 37 | 111 IF (WFLAG(J).AND.INPREC(J).GE.1) WRITE (UNIT'INPREC(J)) BUFFER\r | |
| 38 | READ (UNIT'RECNUM) BUFFER\r | |
| 39 | GOTO 16\r | |
| 40 | 112 IF (WFLAG(J).AND.INPREC(J).GE.1) WRITE (UNIT'INPREC(J)) BUFER2\r | |
| 41 | READ (UNIT'RECNUM) BUFER2\r | |
| 42 | 16 CONTINUE\r | |
| 43 | WFLAG(J)=.FALSE.\r | |
| 44 | INPREC(J)=RECNUM\r | |
| 45 | 10 CONTINUE\r | |
| 46 | WORD=MOD(WORD,255)\r | |
| 47 | IF (WORD.EQ.0) WORD=255\r | |
| 48 | RECACT=J @ BUFFER SWICTH\r | |
| 49 | GOTO (121,122),J\r | |
| 50 | 121 ESAM=WGET(BUFFER,WORD) @ EXTRACT THE WORD WANTED AND CONVERT TO REAL\r | |
| 51 | RETURN\r | |
| 52 | 122 ESAM=WGET(BUFER2,WORD)\r | |
| 53 | RETURN\r | |
| 54 | 20 CONTINUE @ END OF FILE ERROR MESSAGE\r | |
| 55 | WRITE (TTO,1) UNIT,INDEX,RECNUM,LASREC\r | |
| 56 | ESAM=4711 @ MOTHERFUCKER --- GO HOME\r | |
| 57 | RETURN\r | |
| 58 | 1 FORMAT (' EINHEIT',I2,' INDEX',I7,' SATZ',I7,\r | |
| 59 | * ' SATZENDE',I7,' UEBERLESEN.')\r | |
| 60 | END\r | |
| 61 | \1a\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0 |