projects / pdp8.git / blame
| Commit | Line | Data |
|---|---|---|
| 84b5715c PH |
1 | C WAS SUBROUTINE GETIN(WORD1,WORD1A,WORD1X,WORD2,WORD2A,WORD2X)\r |
| 2 | C OS/8 version returns 4 chars in the first word of each command entity\r | |
| 3 | C\r | |
| 4 | C GET A COMMAND FROM THE ADVENTURER. SNARF OUT THE FIRST WORD, PAD IT WITH\r | |
| 5 | C BLANKS, AND RETURN IT IN WORD1 AND WORD1A. (for OS/8, WORD1)\r | |
| 6 | C CHARS 5 AND 6 ARE RETURNED IN WORD1X, IN\r | |
| 7 | C CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE. ANY NUMBER OF\r | |
| 8 | C BLANKS MAY FOLLOW THE WORD. IF A SECOND WORD APPEARS, IT IS RETURNED IN\r | |
| 9 | C WORD2 AND WORD2A (CHARS 5 AND 68 IN WORD2X), ELSE WORD2 IS SET TO ZERO.\r | |
| 10 | C (for OS/8, WORD2 and WORD2X).\r | |
| 11 | C\r | |
| 12 | C IMPLICIT INTEGER (A-Z)\r | |
| 13 | C LOGICAL*1 FRST(20),BLANK,LCA,LCZ,UCA\r | |
| 14 | C DATA BLANK/' '/,UCA/'A'/,LCA/'a'/,LCZ/'z'/\r | |
| 15 | \r | |
| 16 | SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X)\r | |
| 17 | INTEGER INPUT(20),WORD1,WORD1X\r | |
| 18 | INTEGER WORD2,WORD2X\r | |
| 19 | \r | |
| 20 | 10 WRITE(4,1)\r | |
| 21 | 1 FORMAT(' > ',$)\r | |
| 22 | C READ(4,2)INPUT\r | |
| 23 | C2 FORMAT(20A1)\r | |
| 24 | CALL RDLINE(INPUT, 20)\r | |
| 25 | WORD1 = ' '\r | |
| 26 | WORD1X = ' '\r | |
| 27 | WORD2 = ' '\r | |
| 28 | WORD2X = ' '\r | |
| 29 | \r | |
| 30 | DO 15 I=1,20\r | |
| 31 | C Using INT here to normalize the input values\r | |
| 32 | J = INT(INPUT(I))\r | |
| 33 | 15 INPUT(I) = J\r | |
| 34 | IX1=0\r | |
| 35 | IX2=0\r | |
| 36 | I=0\r | |
| 37 | C\r | |
| 38 | C Find first nonblank\r | |
| 39 | C\r | |
| 40 | 20 I=I+1\r | |
| 41 | IF(I.GT.20)GOTO 10\r | |
| 42 | IF(INPUT(I).EQ.32)GOTO 20\r | |
| 43 | C\r | |
| 44 | C Move four characters to WORD1\r | |
| 45 | C\r | |
| 46 | DO 30 IX1 = 1, 4\r | |
| 47 | CALL CPUT(WORD1, IX1, INPUT(I))\r | |
| 48 | I=I+1\r | |
| 49 | IF(I.GT.20)GOTO 100\r | |
| 50 | C\r | |
| 51 | C If blank, go to word 2\r | |
| 52 | C\r | |
| 53 | IF(INPUT(I) .EQ. 32) GOTO 50\r | |
| 54 | 30 CONTINUE\r | |
| 55 | C\r | |
| 56 | C Move two characters to WORD1X\r | |
| 57 | C\r | |
| 58 | DO 40 IX1 = 1, 20\r | |
| 59 | IF (IX1 .GT. 2) GOTO 35\r | |
| 60 | CALL CPUT(WORD1X, IX1, INPUT(I))\r | |
| 61 | 35 I=I+1\r | |
| 62 | IF(I.GT.20)GOTO 100\r | |
| 63 | IF(INPUT(I).EQ.32)GOTO 50\r | |
| 64 | 40 CONTINUE\r | |
| 65 | \r | |
| 66 | C\r | |
| 67 | C Find next nonblank\r | |
| 68 | C\r | |
| 69 | 50 I = I + 1\r | |
| 70 | IF(I.GT.20) GOTO 100\r | |
| 71 | IF (INPUT(I).EQ. 32)GOTO 50\r | |
| 72 | \r | |
| 73 | C\r | |
| 74 | C Move four to WORD2\r | |
| 75 | C\r | |
| 76 | DO 60 IX1 = 1,4\r | |
| 77 | CALL CPUT(WORD2, IX1, INPUT(I))\r | |
| 78 | I = I + 1\r | |
| 79 | IF (I.GT.20) GOTO 100\r | |
| 80 | IF (INPUT(I).EQ. 32) GOTO 100\r | |
| 81 | 60 CONTINUE\r | |
| 82 | C\r | |
| 83 | C Move to to WORD2X\r | |
| 84 | C\r | |
| 85 | DO 70 IX1 = 1,2\r | |
| 86 | CALL CPUT(WORD2X, IX1, INPUT(I))\r | |
| 87 | I = I + 1\r | |
| 88 | IF (I.GT.20) GOTO 100\r | |
| 89 | IF(INPUT(I).EQ.32) GOTO 100\r | |
| 90 | 70 CONTINUE\r | |
| 91 | 100 IF (WORD2 .NE. ' ') RETURN\r | |
| 92 | WORD2 = 0\r | |
| 93 | WORD2X = 0\r | |
| 94 | RETURN\r | |
| 95 | END\r |