Retro1.org codex

*DECK XCLOST
          IDENT  XCLOST 
          EXT    XTRACE 
          EXT    OMSG 
*IF DEF,IMS 
*#
*1DC  XCLOST
* 
*     1. PROC NAME           AUTHOR              DATE 
*        XCLOST              P.C.TAM             78/09/12 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        FLUSH ZZZZZDN CIO BUFFER, AND CLOSE THE FILE 
* 
*     3. METHOD USED. 
*        IF NO I/O ERROR ON FILE, 
*          EXECUTE WRITER MACRO TO FLUSH CIO BUFFER AND WRITE EOR.
*          IF I/O ERROR ON FILE,
*            CALL OMSG TO ISSUE DAYFILE MESSAGE.
* 
* 
*     4. ENTRY PARAMETERS.
*        (A1)                ADDRESS OF THE ADDRESS OF FET
* 
*     5. EXIT PARAMETERS. 
*        NONE.
* 
*     6. COMMON DECKS CALLED. 
*        CYBERDEFS INPARU MACDEF BPIPBUF
* 
*     7. ROUTINES CALLED. 
*        OMSG                ISSUE DAYFILE MESSAGE
*        XTRACE              TRACE CALLER 
* 
*     8. DAYFILE MESSAGES.
*        " CIO ERROR NNB, LFN = ZZZZZDN." 
* 
*        W A R N I N G - THIS ROUTINE IS LOADED WITH XENDNAM, XTERMST,
*                        OR WITH XENDRPV, XTERMST.  THE SUM OF XENDNAM
*                        XTERMST, XCLOST, OR OF XENDRPV, XTERMST, XCLOST
*                        CANNOT EXCEED THE SIZE OF PRIMARY OVERLAY
*CALL OPSIZE
*#
*ENDIF
*CALL MACDEF
*CALL CYBERDEFS 
*CALL INPARU
 
 XCL1     IFEQ   ZZDN,1 
 
          ENTRY  XCLOST 
 
 XCLOST   SUBR   =           ENTRY/EXIT 
 
          SX6    A1          ADDRESS OF PARAMETER BLOCK 
          SA6    TEMP        SAVE ADDRESS OF PARAMETER BLOCK IN TEMP
 
          IFEQ   DEBUG,1,4
          SX1     XXCLOST 
          RJ     XTRACE 
          SA1    TEMP 
          SA1    X1 
 
          MX4    5           MASK FOR ABNORMAL TERMINATION FIELD IN FET 
          SA2    X1          X2 = FIRST WORD OF FET 
          LX4    9+5         SHIFT MASK TO POSITION OF ABNORMAL TERM FLD
          BX5    X4*X2       EXTRACT ABNORMAL TERMINATION FIELD FROM FET
          NZ     X5,XCLOSTX  IF I/O ERROR HAS OCCURRED ON FILE
 
          WRITER X1,R 
          SA1    TEMP        X1 = ADDRESS OF PARAMETER BLOCK
          SA1    X1          X1 = ADDRESS OF FET
          MX4    5           MASK FOR ABNORMAL TERMINATION FIELD IN FET 
          SA2    X1          X2 = FIRST WORD OF FET 
          LX4    9+5         SHIFT MASK TO POSITION OF ABNORMAL TERM FLD
          BX5    X4*X2       EXTRACT ABNORMAL TERMINATION FIELD FROM FET
          ZR     X5,XCLOSTX  IF NO I/O ERROR OCCURRED ON FILE 
 
          MX0    3           MASK FOR ONE OCTAL DIGIT 
          AX5    9           RIGHT JUSTIFY ABNORMAL TERM CODE 
          LX0    3           RIGHT JUSTIFY OCTAL DIGIT MASK 
          SA2    ERRMSGC     X2 = WORD OF DAYFILE MSG TO CONTAIN CODE 
          BX4    X0*X5       EXTRACT LEAST SIGNIFICANT DIGIT
          AX5    3           EXTRACT MOST SIGNIFICANT DIGIT 
          SX4    X4+33B      CONVERT OCTAL DIGIT TO OCTAL DISPLAY 
          SX5    X5+33B      CONVERT OCTAL DIGIT TO OCTAL DISPLAY 
          LX5    6           SHIFT MOST SIG DIGIT TO 2ND DIGIT POS
          MX0    12D         MASK FOR ABNORMAL TERM FIELD IN DAY MSG
          BX5    X5+X4       ABNORMAL TERM CODE IN OCTAL DISPLAY CODE 
          LX0    42D+12D     SHIFT MASK TO ABNORMAL TERM FIELD POSITION 
          LX5    42D         SHIFT DISPLAY CODE NO TO DAY MSG POSITION
          BX0    -X0*X2      CLEAR ABNORMAL TERM CODE FIELD IN DAY MSG
          BX6    X0+X5       ADD ABNORMAL TERM CODE TO DAY MSG
          SA6    A2 
          SA1    LOCMSG      A1 = ADDRESS OF PARAMETER BLOCK
          RJ     OMSG        ISSUE DAYFILE MESSAGE
 
          EQ     XCLOSTX     RETURN 
 SAVEA1   BSS    1
 
 ERRMSG   DIS    ,* CIO ERROR NNB, LFN = ZZZZZDN.*
 ERRMSGC  EQU    ERRMSG+2    WORD TO CONTAIN ABNORMAL TERM CODE 
 
 LOCMSG   VFD    60D/ERRMSG  LOCATION OF DAYFILE MESSAGE
 
 XCL1     ENDIF 
 
 XXCLOST  DATA    L*XCLOS*
 TEMP     BSS    1
          END