Retro1.org codex

*DECK LFGGNT
      PROC LFGGNT(TOKEN,COL,LENGTH,TYPE,LINE);
      BEGIN                  # GET NEXT TOKEN                          #
*IF,DEF,IMS 
# 
**    LFGGNT -- GET NEXT TOKEN. 
* 
*     D.K. ENDO    81/16/12 
* 
*     LFGGNT FORMS THE NEXT TOKEN ON THE SOURCE LINE AND CLASSIFIES IT. 
*     IF CHARACTER 72 IS REACHED, AN END OF CARD STATUS IS RETURNED.
* 
*     PROC LFGGNT(TOKEN,COL,LENGTH,TYPE,LINE) 
* 
*     ENTRY        COL = POINTER TO CURRENT CHARACTER.
*                  LINE = SOURCE LINE TO BE PARSED. 
* 
*     EXIT         TOKEN = TOKEN FORMED.
*                  COL = NEXT CHARACTER TO BEGIN SCAN.
*                  LENGTH = CHARACTER COUNT OF TOKEN. 
*                  TYPE = CLASSIFICATION OF TOKEN.
* 
*     METHOD
* 
*     CLEAR TOKEN,COL, AND LENGTH.
*     IF COL IS GREATER THAN MAX, 
*     THEN, 
*       SET TYPE TO EOC.
*     OTHERWISE,
*       FOR EACH CHARACTER UNTIL EOC OR TOKEN IS FORMED,
*         SELECT CASE THAT APPLIES, 
*           CASE 1(ALPHANUMERIC): 
*             IF LENGTH IS NOT GREATER THAN TEN,
*               STORE CHARACTER.
*               INCREMENT LENGTH. 
*             INCREMENT COL.
*           CASE 2(DELIMITER):  
*             IF NAME IS BEING FORMED,
*             THEN, 
*               SET TYPE TO NAME. 
*             OTHERWISE,
*               STORE CHARACTER.
*               INCREMENT LENGTH AND COL. 
*               SET TYPE TO DELIMITER 
*           CASE 3(SPECIAL):  
*             IF NAME IS BEING FORMED,
*             THEN, 
*               SET TYPE TO NAME. 
*             OTHERWISE,
*               STORE CHARACTER.
*               INCREMENT LENGTH AND COL. 
*               SET TYPE TO UNKNOWN.
*           CASE 4(BLANK):  
*             IF NAME IS BEING FORMED,
*             THEN
*               SET TYPE TO NAME. 
*             OTHERWISE,
*               INCREMENT COL.
*       IF NO TOKEN WAS FORMED
*         SET TYPE TO EOC.
* 
# 
*ENDIF
      ITEM TOKEN C(10);                # FORMED TOKEN                  #
      ITEM COL I;                      # CHARACTER POINTER             #
      ITEM LENGTH I;                   # LENGTH OF TOKEN               #
      ITEM TYPE I;                     # CLASSIFICATION OF TOKEN       #
      ARRAY LINE [0:0] S(8);           # SOURCE LINE TO BE PARSED      #
        BEGIN 
        ITEM LINE$TEXT  C(00,00,80);   # SOURCE LINE TEXT              #
        END 
      DEF MXCOL # 72 #;                # LAST CHARACTER TO BE SCANNED  #
      STATUS STAT  UNK,                # STATUS TYPE FOR TOKEN         #
                   NAME,
                   DELIM, 
                   EOC; 
      ITEM CTEMP C(1);                 # CHARACTER TEMPORARY           #
      ITEM EXIT B;                     # EXIT FLAG                     #
      ITEM I I;                        # SCRATCH ITEM                  #
      SWITCH GNTSWTCH        SPECIAL,  # COLON #
                             ALPHANUM, # A #
                             ALPHANUM, # B #
                             ALPHANUM, # C #
                             ALPHANUM, # D #
                             ALPHANUM, # E #
                             ALPHANUM, # F #
                             ALPHANUM, # G #
                             ALPHANUM, # H #
                             ALPHANUM, # I #
                             ALPHANUM, # J #
                             ALPHANUM, # K #
                             ALPHANUM, # L #
                             ALPHANUM, # M #
                             ALPHANUM, # N #
                             ALPHANUM, # O #
                             ALPHANUM, # P #
                             ALPHANUM, # Q #
                             ALPHANUM, # R #
                             ALPHANUM, # S #
                             ALPHANUM, # T #
                             ALPHANUM, # U #
                             ALPHANUM, # V #
                             ALPHANUM, # W #
                             ALPHANUM, # X #
                             ALPHANUM, # Y #
                             ALPHANUM, # Z #
                             ALPHANUM, # 0 #
                             ALPHANUM, # 1 #
                             ALPHANUM, # 2 #
                             ALPHANUM, # 3 #
                             ALPHANUM, # 4 #
                             ALPHANUM, # 5 #
                             ALPHANUM, # 6 #
                             ALPHANUM, # 7 #
                             ALPHANUM, # 8 #
                             ALPHANUM, # 9 #
                             SPECIAL,  # + #
                             SPECIAL,  # - #
                             DELIM,    # * #
                             SPECIAL,  # / #
                             SPECIAL,  # ( #
                             SPECIAL,  # ) #
                             SPECIAL,  # $ #
                             SPECIAL,  # = #
                             BLANK,    # BLANK #
                             DELIM,    # , #
                             SPECIAL,  # . #
                             SPECIAL,  # EQUIV #
                             SPECIAL,  # [ #
                             SPECIAL,  # ] #
                             SPECIAL,  # % (FOR 63 CODE SET -- COLON)  #
                             SPECIAL,  # " #
                             SPECIAL,  # _ #
                             SPECIAL,  # ! #
                             SPECIAL,  # & #
                             SPECIAL,  # ' #
                             SPECIAL,  # ? #
                             SPECIAL,  # < #
                             SPECIAL,  # > #
                             SPECIAL,  # @ #
                             SPECIAL,  # \ #
                             SPECIAL,  # ^ #
                             SPECIAL;  # SEMICOLON #
      CONTROL EJECT;
#                                                                      #
#                            LFGGNT CODE BEGINS HERE                   #
#                                                                      #
      EXIT = FALSE;          # CLEAR EXIT FLAG                         #
      LENGTH = 0;            # CLEAR LENGTH                            #
      TOKEN = " ";           # CLEAR TOKEN                             #
      IF COL LS MXCOL        # IF NOT END OF CARD                      #
      THEN
        BEGIN 
        FOR I=0 WHILE NOT EXIT AND COL LS MXCOL 
        DO                   # FOR EACH CHARACTER UNTIL EOC OR         #
          BEGIN              #   FORMING OF TOKEN                      #
          CTEMP = C<COL,1>LINE$TEXT[0]; 
          GOTO GNTSWTCH[CTEMP];        # SWITCH BASED ON CHARACTER     #
ALPHANUM: 
          IF LENGTH LS 10              # IF TOKEN IS NOT FULL          #
          THEN
            BEGIN 
            C<LENGTH,1>TOKEN = CTEMP;  # PUT CHARACTER IN TOKEN        #
            END 
          LENGTH = LENGTH + 1;         # INCREMENT LENGTH              #
          COL = COL + 1;               # POINT TO NEXT COLUMN          #
          TEST I; 
DELIM:  
          IF LENGTH EQ 0               # IF NOT CURRENTLY FORMING NAME #
          THEN
            BEGIN 
            TOKEN = CTEMP;             # PUT DELIMITER IN TOKEN        #
            TYPE = STAT"DELIM";        # SET TYPE TO DELIMITER         #
            COL = COL + 1;             # POINT TO NEXT COLUMN          #
            LENGTH = 1;                # SET LENGTH                    #
            END 
          ELSE                         # MUST HAVE NAME IN TOKEN       #
            BEGIN 
            TYPE = STAT"NAME";         # SET TYPE TO NAME              #
            END 
          EXIT = TRUE;                 # SET EXIT FLAG                 #
          TEST I; 
SPECIAL:  
          IF LENGTH EQ 0               # IF NOT CURRENTLY FORMING NAME #
          THEN
            BEGIN 
            TOKEN = CTEMP;             # PUT CHARACTER IN TOKEN        #
            TYPE = STAT"UNK";          # SET TYPE TO UNKNOWN           #
            COL = COL + 1;             # POINT TO NEXT COLUMN          #
            LENGTH = 1;                # SET LENGTH                    #
            END 
          ELSE                         # MUST BE FORMING A NAME        #
            BEGIN 
            TYPE = STAT"NAME";         # SET TYPE TO NAME              #
            END 
          EXIT = TRUE;                 # SET EXIT FLAG                 #
          TEST I; 
BLANK:  
          IF LENGTH NQ 0               # IF CURRENTLY FORMING A NAME   #
          THEN
            BEGIN 
            TYPE = STAT"NAME";         # SET TYPE TO NAME              #
            EXIT = TRUE;               # SET EXIT FLAG                 #
            END 
          ELSE                         # NOTHING FORMED YET            #
            BEGIN 
            COL = COL + 1;             # INCREMENT CHARACTER POINTER   #
            END 
          END 
        IF LENGTH EQ 0                 # IF NO TOKEN WAS FORMED        #
        THEN
          BEGIN 
          TYPE = STAT"EOC";            # SET TYPE TO END OF CARD       #
          END 
        END 
      ELSE                             # HAVE REACHED END OF CARD      #
        BEGIN 
        TYPE = STAT"EOC";              # SET TYPE TO INDICATE SO       #
        END 
      RETURN;                # **** RETURN ****                        #
      END # LFGGNT #
      TERM