Retro1.org codex

*DECK NDLWLCR 
USETEXT NDLDATT 
USETEXT NDLFETT 
USETEXT NDLNCFT 
USETEXT NDLTBLT 
      PROC NDLWLCR(NPU$NAME,LAST$ENTRY);
      BEGIN 
*IF,DEF,IMS 
# 
**    NDLWLCR - WRITE LINE CONFIGURE RECORD.
* 
*     D.K. ENDO    81/11/10 
* 
*     THIS PROCEDURE MAKES ENTRIES IN LINE CONFIGURE INDEX AND WRITES 
*     LINE CONFIGURE ENTRY TO FILE. 
* 
*     PROC NDLWLCR(NPU$NAME,LAST$ENTRY) 
* 
*     ENTRY        NPU$NAME = NAME OF NPU SUPPORT LINE. 
*                  LAST$ENTRY = LAST ENTRY FLAG.
* 
*     EXIT         NONE.
* 
*     METHOD
* 
*     IF NO FATAL ERRORS HAVE BEEN DETECTED,
*       IF NPU$NAME IS NOT EQUAL TO NAME IN CURRENT INDEX ENTRY,
*         IF NEED MORE TABLE SPACE FOR INDEX, 
*           ALLOCATE MORE SPACE.
*         MAKE NEW ENTRY IN INDEX.
*       IF LAST$ENTRY IS NOT SET, 
*       THEN, 
*         INCREMENT RECORD LENGTH.
*         INCREMENT ENTRY COUNT.
*         WRITE ENTRY TO FILE.
*       OTHERWISE,
*         FLUSH CIO BUFFER FOR LINE CONFIG FILE.
*         WRITE EOR MAKER FOR RECORD. 
* 
# 
*ENDIF
      ITEM NPU$NAME C(7);    # NAME OF NPU SUPPORTING LINE             #
      ITEM LAST$ENTRY B;     # LAST ENTRY INDICATOR                    #
# 
****  PROC NDLWLCR - XREF LIST BEGINS.
# 
      XREF
        BEGIN 
        PROC SSTATS;         # ALLOCATES MORE TABLE SPACE              #
        PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT CLEARED #
        PROC WRITER;         # WRITES -EOR-                            #
        PROC WRITEW;         # WRITES GIVEN NUMBER OF WORDS            #
        END 
# 
****
# 
      ITEM I;                # SCRATCH ITEM                            #
      ITEM ITEMP;            # INTEGER TEMPORARY                       #
      CONTROL EJECT;
#                                                                      #
#                            NDLWLNR CODE BEGINS HERE                  #
#                                                                      #
      IF ERRCNT EQ 0         # IF NO FATAL ERRORS HAVE BEEN DETECTED   #
      THEN
        BEGIN 
        IF NPU$NAME NQ LCRNAME[LCRWC[1] - 1]
        THEN                 # MUST BE A NEW ENTRY                     #
          BEGIN 
          IF (LCRWC[1] + 2) GQ LCR$LENG 
          THEN               # NEED MORE TABLE SPACE                   #
            BEGIN 
            SSTATS(P<LIN$CON$INDX>,30); 
            END 
          LCRWC[1] = LCRWC[1] + 1;     # INCREMENT WORD COUNT          #
          LCRWORD[LCRWC[1]] = 0;       # CLEAR FIRST WORD IN ENTRY     #
          LCRNAME[LCRWC[1]] = NPU$NAME;# PUT NPU NAME IN ENTRY         #
          LCRWC[1] = LCRWC[1] + 1;     # INCREMENT WORD COUNT          #
          LCRRL[LCRWC[1]] = 0;         # CLEAR RECORD LENGTH           #
          LCRRANINDX[LCRWC[1]] = LRCRI[0]; # SET POINTER TO SECTOR     #
          END 
        IF NOT LAST$ENTRY    # LAST ENTRY HAS NOT BEEN DETECTED YET    #
        THEN
          BEGIN 
                             # INCREMENT RECORD LENGTH                 #
          LCRRL[LCRWC[1]] = LCRRL[LCRWC[1]] + LCWC[0] + 1;
          IF LCNI[0] EQ 0    # IF THIS IS NOT A -GROUP- DEFINITION     #
          THEN
            BEGIN            # INCREMENT ENTRY COUNT BY ONE            #
            LCRENT[LCRWC[1] - 1] = LCRENT[LCRWC[1] - 1] + 1;
            END 
          ELSE               # THIS IS A -GROUP- DEFINITION            #
            BEGIN            # INCREMENT ENTRY COUNT BY -NI- VALUE     #
            LCRENT[LCRWC[1] - 1] = LCRENT[LCRWC[1] - 1] + LCNI[0];
            END 
          WRITEW(LRFET,LIN$CON$REC,LCWC[0]+1); # WRITE ENTRY TO RECORD #
          END 
        ELSE                 # LAST ENTRY WAS FOUND                    #
          BEGIN 
          WRITER(LRFET,0);   # FLUSH CIO BUFFER AND WRITE EOR TO FILE  #
          RECALL(LRFET);
          END 
        END 
      RETURN;                # **** RETURN ****                        #
      END # NDLWLCR # 
      TERM