Retro1.org codex

*DECK MACNIP
          IDENT  FSTATUS
          ENTRY  FSTATUS
          B1=1
          COMMENT DETERMINE IF FILE IS A LOCAL FILE.
          SPACE  4
***       FSTATUS - DETERMINE IF FILE IS A LOCAL FILE.
* 
*         CALL FSTATUS(FILE)
* 
*         ENTRY (FILE) = FIRST WORD OF THE FET
* 
*         FSTATUS(FILE);   ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 FSTATUS  SUBR   =
          SB1    1
          STATUS X1 
          JP     FSTATUSX 
 
          END 
          IDENT  GETFIL 
          B1=1
          TITLE  GETFIL - GET A PERMANENT FILE. 
          COMMENT   GET A PERMANENT FILE. 
          SPACE  4
***       NOS PERMANENT FILE MANAGER SYMPL INTERFACE ROUTINES 
* 
*         GETFIL(LFN,PFN) 
* 
*                LFN - LOGICAL FILE NAME, LEFT JUSTIFIED, ZERO FILLED,
*                      SEVEN CHARACTER MAXIMUM
*                PFN - PERMANENT FILE NAME, SAME CHARACTERISTICS AS LFN 
* 
*         THIS IS A SYMPL FUNCTION AND RETURNS THE STATUS FROM WORD 0,
*         BITS 17-10. SEE NOS REFERENCE MANUAL FOR PFM ERROR CODES. 
* 
 PFMFET   FILEB  DUMMY,DUMMYL,EPR,(FET=16D)    DUMMY PFM FET
 DUMMYL   EQU    0
 DUMMY    BSS    0
          SPACE  4
***       GETFIL - GETS A NOS PERMANENT FILE
* 
*         SYMPL CALL - STATUS = GETFIL(LFN,PFN);
* 
          ENTRY GETFIL
 GETFIL   SUBR   =           ENTRY/EXIT 
          SB1    1
          SA4    X1          GET LFN
          SA3    A1+B1       ADDRESS OF PFN IN X3 
          SA5    PFMFET      GET CONTENTS OF FET+0
          MX0    -18
          BX7    -X0*X5      MASK OLD LFN, LEAVE LOWER 18 BITS
          BX6    X0*X4       MASK OUT UNWANTED BITS 
          SA1    X3          GET PFM
          BX6    X6+X7       PUT FET+0 TOGETHER 
          BX1    X0*X1       X1 = PFM 
          SA6    A5          PUT LFN IN FET+0 
          GET    PFMFET,X1   GET FILE 
          SPACE  2
          BSS    0           RETURN ERROR CODE
          SA1    PFMFET      GET FET+0
          MX0    -8 
          AX1    10          RIGHT JISTIFY BITS 17-10 
          BX6    -X0*X1      ISOLATE ERROR CODE IN X6 
          JP   GETFILX         RETURN 
 
          END 
          IDENT  READ 
          ENTRY  READ 
          B1=1
          TITLE  READ - READ FILE TO CIO BUFFER.
          COMMENT   READ FILE TO CIO BUFFER.
 READ     SPACE  4,10 
***       READ - READ FILE TO CIO BUFFER. 
* 
*         CALL READ (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         READ(FILE);        ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 READ     SUBR   =
          SB1    1
          READ   X1,R 
          JP     READX
 
          END 
          IDENT  REWIND 
          ENTRY  REWIND 
          B1=1
          TITLE  REWIND - REWIND FILE.
          COMMENT   REWIND FILE.
 REWIND   SPACE  4,10 
***       REWIND - REWIND FILE. 
* 
*         CALL REWIND (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         REWIND(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 REWIND   SUBR   =
          SB1    1
          REWIND X1,R 
          JP     REWINDX
 
          END 
          IDENT  ROUTE
          ENTRY  ROUTE
          COMMENT   ROUTES FILE TO INPUT
          TITLE ROUTE   - ROUTES A FILE 
*IF DEF,IMS 
*#
*     1. ROUTINE NAME        AUTHOR              DATE 
*        ROUTE               S. KRULEVITCH       78/11/13 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        ROUTES A FILE TO DESTINATION SPECIFIED BY PARAMETER BLOCK
* 
*     3. METHOD USED
*        SYMPL CALL:  
*        ROUTE  (PARAM,RECALL); 
* 
*     4. ENTRY CONDITIONS 
*        PARAM - PARAMETER BLOCK ADDRESS
*        RECALL - CIO CALL WITH RECALL IF SET 
* 
*     5. EXIT CONDITIONS
*        NONE 
* 
*     6. COMDECKS CALLED
* 
*     7. MACROS CALLED
*        ROUTE
* 
*     8. DAYFILE MESSAGES 
*#
*ENDIF
 ROUTE    SUBR   =
          SA3    A1+1        ADDRESS OF RECALL BIT
          SA3    X3 
          ROUTE  X1,X3
          EQ     ROUTEX      RETURN TO ENTRY POINT
          END 
          IDENT  WRITEO 
          ENTRY  WRITEO 
          TITLE  WRITEO  - WRITES ONE WORD TO FILE
          COMMENT  WRITES ONE WORD TO FILE
*IF DEF,IMS 
*#
*1DC WRITEO 
* 
*     1. SUBROUTINE NAME     AUTHOR              DATE 
*        WRITEO              C. BITTNER          83/05/23 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        THIS ROUTINE WRITES ONE WORD TO THE CIRCULAR IO BUFFER.
* 
*     3. METHOD USED
*        SYMPL CALL:  WRITEO(FILE,WORD);
* 
*     4. ENTRY PARAMETERS 
*        FILE - FIRST WORD OF THE FET 
*        WORD - WORD TO BE TRANSFERRED
* 
*     5. EXIT PARAMETERS
*        NONE 
* 
*     6. COMMON DECKS CALLED
*        NONE 
* 
*     7. DAYFILE MESSAGES 
*        NONE 
* 
*#
*ENDIF
 WRITEO   SUBR   =
          SA3    A1+B1       ADDRESS OF WORD
          SA3    X3          WORD 
          BX6    X3 
          WRITEO X1 
          EQ     WRITEO 
          END 
          IDENT  WRITER 
          ENTRY  WRITER 
          B1=1
          TITLE  WRITER - WRITE END OF RECORD.
          COMMENT   WRITE END OF RECORD.
 WRITER   SPACE  4,10 
***       WRITER - WRITE END OF RECORD. 
* 
*         CALL WRITER (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         WRITER(FILE); ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 WRITER   SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF LEVEL 
          SA3    X3          LEVEL
          WRITER X1,X3
          EQ     WRITERX
 
          END 
          IDENT  XCOD 
          ENTRY  XCOD 
          B1=1
          LIST   F
          TITLE  XCOD - CONVERT INTEGER TO OCTAL DISPLAY CODE.
          COMMENT   CONVERT INTEGER TO OCTAL DISPLAY CODE.
 XCOD     SPACE  4,10 
***       XCOD - CONVERT INTEGER TO OCTAL DISPLAY CODE. 
* 
*         HOLLERITH = XCOD (INTEGER)
* 
*         XX = XCOD(YY);     ( SYMPL CALL ) 
* 
*         ENTRY - YY, AN ITEM THAT CONTAINS THE INTEGER TO BE CONVERTED 
* 
*         EXIT - XX, A CHAR. ITEM TO CONTAIN DISPLAY CODE ON EXIT 
 
 
 XCOD     SUBR   =           ENTRY/EXIT 
          SB1    1
          SA1    X1+
          RJ     =XCOD= 
          JP     XCODX       RETURN, RESULT IN X6 
 
          END 
          IDENT  OPEN 
          ENTRY  OPEN 
          B1=1
          TITLE  OPEN A FILE (CREATE A FILE)
          COMMENT OPEN A FILE 
 OPEN     SPACE  4,10 
**        OPEN - OPEN A FILE
* 
*         OPEN(FILE);  (SYMPL CALL) 
* 
*         ENTRY - FILE     AN ARRAY THAT CONTAINS THE FET 
* 
 OPEN     SUBR   =
          SB1    1
          OPEN   X1,WRITE,R 
          EQ     OPENX
 
          END