Retro1.org codex

MACREL

[00007] MACREL - SYSTEM MACRO INTERFACE ROUTINES.
[00010] SYSTEM MACRO INTERFACE ROUTINES.
[00030] MACREL - SYSTEM MACRO INTERFACE ROUTINES.
[00074] MACREL. - UNDEFINED MACRO PROCESSOR.
[00097] MACREL= - ILLEGAL ARGUMENT PROCESSOR.
[00132] BKSP - BACKSPACE 1 LOGICAL RECORD.
[00155] BKSPRU - BACKSPACE PHYSICAL RECORDS.
[00182] CHECKF - CHECK FILE STATUS FOR OWNCODE EXECUTION.
[00208] CLOSE - CLOSE FILE.
[00276] CLOSER - CLOSE REEL.
[00335] EVICT - RELEASE FILE SPACE.
[00358] OPEN - OPEN FILE FOR PROCESSING.
[00468] POSMF - POSITION MULTI-FILE SET.
[00492] READ - READ FILE TO CIO BUFFER.
[00515] READCW - READ FILE NON-STOP WITH CONTROL WORDS.
[00547] READEI - READ FILE TO END OF INFORMATION.
[00571] READLS - READ FILE WITH LIST.
[00594] READN - READ FILE NON-STOP FOR TAPES.
[00618] READNS - READ FILE NON-STOP. (READ TO EOF)
[00642] READSKP - READ FILE AND SKIP.
[00673] RETURN - RETURN FILE TO SYSTEM.
[00703] REWIND - REWIND FILE.
[00726] REWRITE - REWRITE DATA FROM CIO BUFFER.
[00750] REWRITF - REWRITE END OF FILE.
[00776] REWRITR - REWRITE END OF RECORD.
[00806] RPHR - READ PHYSICAL RECORD TO CIO BUFFER.
[00831] RPHRLS - READ PRUS WITH LIST.
[00861] SKIPB - SKIP RECORDS BACKWARDS.
[00892] SKIPEI - SKIP TO END OF INFORMATION.
[00916] SKIPF - SKIP RECORDS FORWARD.
[00943] SKIPFB - SKIP FILES BACKWARD.
[00970] SKIPFF - SKIP FILES FORWARD.
[00997] UNLOAD - UNLOAD FILE.
[01020] WPHR - WRITE 1 PHYSICAL RECORD FROM CIO BUFFER.
[01044] WRITE - WRITE DATA FROM CIO BUFFER.
[01067] WRITECW - WRITE FILE NON-STOP WITH CONTROL WORDS.
[01090] WRITEF - WRITE END OF FILE.
[01113] WRITEN - WRITE FILE NON-STOP FOR TAPES.
[01137] WRITER - WRITE END OF RECORD.
[01162] READC - READ CODED LINE IN *C* FORMAT.
[01208] WRITEC - WRITE CODED LINE IN *C* FORMAT.
[01236] READH - READ CODED LINE IN *H* FORMAT.
[01283] WRITEH - WRITE CODED LINE IN *H* FORMAT.
[01315] READO - READ ONE WORD.
[01358] WRITEO - WRITE ONE WORD.
[01386] READS - READ CODED LINE TO CHARACTER BUFFER.
[01435] WRITES - WRITE CODED LINE FROM CHARACTER BUFFER.
[01468] READW - READ DATA TO WORKING BUFFER.
[01511] WRITEW - WRITE DATA FROM WORKING BUFFER.
[01543] ABORT - ABORT JOB / ENDRUN - END CENTRAL PROGRAM.
[01582] ATTACH - ATTACH A PERMANENT FILE.
[01671] CHECKPT - TAKE CHECKPOINT DUMP.
[01714] CLOCK - OBTAIN TIME OF DAY.
[01745] DATE - OBTAIN DATE.
[01774] DEFINE - DEFINE A NOS PERMANENT FILE.
[01940] IOTIME - OBTAIN ACCUMULATED IO TIME.
[01979] JDATE - OBTAIN JULIAN DATE.
[02028] LOADREQ - CALL SYSTEM LOADER VIA PPU.
[02053] MEMORY - REQUEST MEMORY.
[02131] MESSAGE - SEND MESSAGE.
[02179] MOVE - MOVE BLOCK OF CENTRAL MEMORY WORDS.
[02272] PURGE - PURGE A PERMANENT FILE.
[02342] RECALL - PLACE PROGRAM IN RECALL STATUS.
[02374] REQUEST - REQUEST ASSIGNMENT OF EQUIPMENT TO FILE.
[02399] RTIME - OBTAIN REAL TIME CLOCK READING.
[02437] SETUI - SET USER INDEX
[02521] SYSTEM - REQUEST SYSTEM FUNCTION.
[02550] TIME - OBTAIN ACCUMULATED CPU TIME.
[02585] TRANSF - TRANSFER TO DEPENDENT JOBS.
[02653] XREL - COMMON DECK INTERFACE ROUTINES.
[02657] COMMON DECK INTERFACE ROUTINES.
[02676] XREL. - UNDEFINED COMMON DECK PROCESSOR.
[02699] XREL= - ILLEGAL ARGUMENT PROCESSOR.
[02735] XCDD - CONVERT INTEGER TO DECIMAL DISPLAY CODE.
[02760] XCFD - CONVERT INTEGER TO F10.3 FORMAT.
[02785] XCHD - CONVERT HEXIDECIMAL INTEGER TO DISPLAY CODE.
[02837] XCOD - CONVERT INTEGER TO OCTAL DISPLAY CODE.
[02862] XSFN - SPACE FILL NAME.
[02888] XSFW - SPACE FILL WORD.
[02914] XWHD - CONVERT HEXIDECIMAL WORD TO DISPLAY CODE.
[02976] XWOD - CONVERT WORD TO OCTAL DISPLAY CODE.
[03010] DFC - DECREMENT FAMILY COUNT OF USERS.
[03045] APPLS - GET LOC AND SIZE OF NETWORK APPLICATION TABLE.
[03086] JROUTE - ROUTE JOB FILE TO INPUT QUEUE.
[03112] GETFIL - GET A PERMANENT FILE.
[03163] GLIDC - GET LID CONFIGURATION .
[03196] GPIDA - GET PID ATTRIBUTES .
[03250] SPIDA - SET PID ATTRIBUTES .
[03281] VALIDU - VALIDATE USER FOR NVF.
[03316] WRITEWC - WRITE DATA FROM WORKING BUFFER.
[03354] XSST - SHELL SORT TABLE.
Source Code

*DECK     MACREL
          IDENT  MACREL 
          ENTRY  MACREL.
          ENTRY  MACREL=
          B1=1
          LIST   F
          TITLE  MACREL - SYSTEM MACRO INTERFACE ROUTINES.
          COMMENT  SYSTEM MACRO INTERFACE ROUTINES. 
 MACREL   SPACE  4,10 
***       MACREL - SYSTEM MACRO INTERFACE ROUTINES. 
* 
*         T. R. RAMSEY.      76/08/08.
*         M. D. PICKARD      77/03/14 
*         M. E. VATCHER      80/01/15 
* 
*         COPYRIGHT CONTROL DATA SYSTEMS INC. 1994. 
 MACREL   SPACE  4,10 
***              MACREL IS A COLLECTION OF RELOCATABLE MODULES THAT 
*         PROVIDE THE INTERFACE BETWEEN HIGHER LEVEL LANGUAGE MODULES 
*         AND THE SYSTEM MACROS.
* 
*         FORTRAN CALLING SEQUENCES ARE SHOWN IN EACH MODULE ALONG WITH 
*         OTHER PERTINENT INFORMATION, E.G., ENTRY, EXIT
* 
*         ALSO SYMPL CALLING SEQUENCES ARE SHOWN IN EACH MODULE 
*         ALONG WITH THE APPROPRIATE SYMPL DATA TYPES NEEDED
*         FOR ENTRY/EXIT.  THE SYMPL INTERFACES TO CPU CONVERSION 
*         ROUTINES CDD,COD,WOD,CHD,SFN,SFW AND CFD ARE PROVIDED FOR 
*         NETWORKS. 
          TITLE  MACREL - SYSTEM MACRO INTERFACE ROUTINES.
 MACREL   SPACE  4,10 
**               MACREL MODULES TRANSLATE PARAMETERS IN HIGHER LEVEL
*         LANGUAGE CALLING SEQUENCES INTO MACRO CALLING SEQUENCES.
*         FORTRAN CALLING SEQUENCES MENTIONED ARE EQUIVALENT TO 
*         COBOL (ENTER USING), SYMPL, ETC.
* 
*         ENTRY  FORTRAN *CALL* AND FUNCTION REFERENCE CALLING
*                SEQUENCES USE THE ACTUAL PARAMETER LIST, CALL BY 
*                REFERENCE CALLING SEQUENCE WHERE - 
*                 (A1)      = FWA OF APLIST 
*                ((A1))     _ FIRST PARAMETER 
*                ((A1+1))   _ SECOND PARAMETER
*                  .          . 
*                  .          . 
*                  .          . 
*                ((A1+N))   _ N-TH PARAMETER
*                ((A1+N+1)) = 0 (ZERO)  (NOMINALLY)  (UN-NEEDED HEREIN) 
*                 (X1)      _ FIRST PARAMETER 
* 
*         EXIT   FOR *CALL*, TYPICALLY NONE, BUT SEE INDIVIDUAL MODULES.
*                FOR FUNCTION REFERENCES, 
*                (X6) = FUNCTION RESULT 
*                (X7) = SECOND WORD OF TWO WORD RESULT, E.G., COMPLEX 
* 
*         USES   PRESERVES A0 
* 
*         CALLS  MACREL. IF MACRO UNDEFINED OR NOT CODED YET
*                MACREL= IF ARGUMENT ERROR
* 
*         NEEDS  EACH MODULE CONTAINS A CALL TO A MACRO WHOSE NAME IS 
*                THE SAME AS THE MODULE (EXCEPT WHERE NOTED).  THESE
*                MACROS ARE DEFINED IN SYSTEXT (NOS) AND CPUTEXT
*                (NOSBE ) AND ALSO IN JETTEXT.  JETTEXT IS THE
*                PREFERRED SYSTEM TEXT. 
* 
*         NOTE   B1 IS SET TO ONE UPON ENTRY TO EACH MODULE 
* 
*         OTHER  MACREL IS A COLLECTION OF RELOCATABLE MODULES COMBINED 
*                INTO ONE *UPDATE* DECK ENTITY NAMED MACREL.  THE 
*                MODULES ARE ARRANGED IN THE SAME ORDER AS THE MACROS 
*                IN JETTEXT.
 MACREL   SPACE  4,10 
 MACREL.  SPACE  4,10 
**        MACREL. - UNDEFINED MACRO PROCESSOR.
* 
*         ENTRY  (X1) = MACRO NAME IN 0L FORMAT 
* 
*         EXIT   DOES NOT EXIT
* 
*         USES   A6  B1  X6 
* 
*         CALLS  NONE 
* 
*         NEEDS  MACROS ABORT, MESSAGE
 
 
 MACREL.  SUBR   =           ENTRY/EXIT 
          SB1    1
          BX6    X1 
          SA6    MACA+3 
          MESSAGE  MACA,LOCAL,RCL 
          ABORT 
          JP     MACREL.X 
 
 MACA     DATA   C* MACREL - UNDEFINED MACRO -   FILL-IN.*
 MACREL=  SPACE  4,10 
**        MACREL= - ILLEGAL ARGUMENT PROCESSOR. 
* 
*         ENTRY  (X1) = MACRO NAME IN 0L FORMAT 
*                (X2) = ILLEGAL ARGUMENT
* 
*         EXIT   DOES NOT EXIT
* 
*         USES   A6  B1  X0,X1,X2,X6
* 
*         CALLS  SFW
* 
*         NEEDS  MACROS ABORT, MESSAGE
 
 
 MACREL=  SUBR   =           ENTRY/EXIT 
          SB1    1
          BX0    X2          SAVE SECOND ARGUMENT 
          LX1    -6 
          SX2    1R-
          BX1    X1+X2
          RJ     =XZTB= 
          BX1    X0 
          SA6    MACB 
          RJ     =XZTB= 
          SA6    MACB+3 
          MESSAGE  MACB,LOCAL,RCL 
          ABORT 
          JP     MACREL=X 
 
 MACB     DATA   C* FILL-IN - ILLEGAL ARGUMENT  >FILL-IT-IN<.*
 
          END 
          IDENT  BKSP 
          ENTRY  BKSP 
          B1=1
          TITLE  BKSP - BACKSPACE 1 LOGICAL RECORD. 
          COMMENT   BACKSPACE 1 LOGICAL RECORD. 
 BKSP     SPACE  4,10 
***       BKSP - BACKSPACE 1 LOGICAL RECORD.
* 
*         CALL BKSP (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         BKSP(FILE);        ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 BKSP     SUBR   =
          SB1    1
          BKSP   X1 
          JP     BKSPX
 
          END 
          IDENT  BKSPRU 
          ENTRY  BKSPRU 
          B1=1
          TITLE  BKSPRU - BACKSPACE PHYSICAL RECORDS. 
          COMMENT   BACKSPACE PHYSICAL RECORDS. 
 BKSPRU   SPACE  4,10 
***       BKSPRU - BACKSPACE PHYSICAL RECORDS.
* 
*         CALL BKSPRU (FILE,N)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (N) = NUMBER OF RECORDS
* 
*         BKSPRU(FILE,N);    ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 N, AN ITEM CONTAINING THE NUMBER OF PRU"S TO BACKSPACE
 
 
 BKSPRU   SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF N 
          SA3    X3          N
          BKSPRU X1,X3
          JP     BKSPRUX
 
          END 
          IDENT  CHECKF 
          ENTRY  CHECKF 
          B1=1
          TITLE  CHECKF - CHECK FILE STATUS FOR OWNCODE EXECUTION.
          COMMENT   CHECK FILE STATUS FOR OWNCODE EXECUTION.
          IPARAMS 
 CHECKF   SPACE  4,10 
***       CHECKF - CHECK FILE STATUS FOR OWNCODE EXECUTION. 
* 
*         CALL CHECKF (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         CHECKF(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 CHECKF   SUBR   =
          SB1    1
SCPNOS    IFC    EQ,*"OS.NAME"*NOSBE *
          CHECKF X1 
SCPNOS    ENDIF 
          JP     CHECKFX
 
          END 
          IDENT  CLOSE
          ENTRY  CLOSE
          B1=1
          TITLE  CLOSE - CLOSE FILE.
          COMMENT   CLOSE FILE. 
 CLOSE    SPACE  4,10 
***       CLOSE - CLOSE FILE. 
* 
*         CALL CLOSE (FILE,OPTION)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (OPTION) = 0, CLOSE WITH REWIND
*                         = 2HNR, CLOSE WITHOUT REWIND
*                         = 6HRETURN, CLOSE WITH REWIND, RETURN 
*                         = 6HREWIND, CLOSE WITH REWIND 
*                         = 6HUNLOAD, CLOSE WITH REWIND, UNLOAD 
* 
* 
*         CLOSE(FILE,OPTION); ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 OPTION, AN ITEM CONTAINING ONE OF THE FOLLOWING 
*                         CHARACTER STRINGS, LEFT JUSTIFIED, BLANK
*                         FILL, OR A BINARY 0.
*                            NR  ( NO REWIND )
*                            RETURN 
*                            REWIND ( SAME AS 0 ) 
*                            UNLOAD 
* 
*         EXIT   TO ARGUMENT-ERROR PROCESSOR IF OPTION IS UNRECOGNIZED
*         ELSE   NONE 
 
 
 CLOSE    SUBR   =
          SB1    1
          SA2    A1+B1       ADDRESS OF OPTION
          SA2    X2          OPTION 
          ZR,X2  CLO1 
          SA3    =0HNR
          BX4    X2-X3
          ZR,X4  CLO2        IF NR
          SA3    =0HRETURN
          BX4    X2-X3
          ZR,X4  CLO6        IF RETURN
          SA3    =0HREWIND
          BX4    X2-X3
          ZR,X4  CLO1        IF REWIND
          SA3    =0HUNLOAD
          BX4    X2-X3
          ZR,X4  CLO8        IF UNLOAD
          SA1    =0LCLOSE 
          RJ     =XMACREL=   DIAGNOSE ILLEGAL ARGUMENT
          JP     CLOSEX 
 
 CLO1     CLOSE  X1 
          JP     CLOSEX 
 
 CLO2     CLOSE  X1,NR
          JP     CLOSEX 
 
 CLO6     CLOSE  X1,RETURN
          JP     CLOSEX 
 
 
 CLO8     CLOSE  X1,UNLOAD
          JP     CLOSEX 
 
          END 
          IDENT  CLOSER 
          ENTRY  CLOSER 
          B1=1
          TITLE  CLOSER - CLOSE REEL. 
          COMMENT   CLOSE REEL. 
 CLOSER   SPACE  4,10 
***       CLOSER - CLOSER REEL. 
*         FOR NOSBE, DEVICE SET FILES ALSO. 
* 
*         CALL CLOSER (FILE,OPTION) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (OPTION) = 0, CLOSE WITH REWIND
*                         = 2HNR, CLOSE WITHOUT REWIND
*                         = 6HREWIND, CLOSE WITH REWIND 
*                         = 6HUNLOAD, CLOSE WITH REWIND, UNLOAD 
* 
*         CLOSER(FILE,OPTION); ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 OPTION, AN ITEM THE CONTAINS ONE OF THE FOLLOWING 
*                         CHARACTER STRINGS, LEFT JUSTIFIED, BLANK
*                         FILL, OR A BINARY 0 
*                            NR  ( NO REWIND )
*                            REWIND ( SAME AS 0 ) 
*                            UNLOAD 
* 
*         EXIT   TO ARGUMENT-ERROR PROCESSOR IF OPTION IS UNRECOGNIZED
*         ELSE   NONE 
 
 
 CLOSER   SUBR   =
          SB1    1
          SA2    A1+B1       ADDRESS OF OPTION
          SA2    X2          OPTION 
          ZR,X2  CLO1 
          SA3    =0HNR
          BX4    X2-X3
          ZR,X4  CLO2        IF NR
          SA3    =0HREWIND
          BX4    X2-X3
          ZR,X4  CLO1        IF REWIND
          SA3    =0HUNLOAD
          BX4    X2-X3
          ZR,X4  CLO4        IF UNLOAD
          SA1    =0LCLOSER
          RJ     =XMACREL=   DIAGNOSE ILLEGAL ARGUMENT
          JP     CLOSERX
 
 CLO1     CLOSER X1 
          JP     CLOSERX
 
 CLO2     CLOSER X1,NR
          JP     CLOSERX
 
 CLO4     CLOSER X1,UNLOAD
          JP     CLOSERX
 
          END 
          IDENT  EVICT
          ENTRY  EVICT
          B1=1
          TITLE  EVICT - RELEASE FILE SPACE.
          COMMENT   RELEASE FILE SPACE. 
 EVICT    SPACE  4,10 
***       EVICT - RELEASE FILE SPACE. 
* 
*         CALL EVICT (FILE) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         EVICT(FILE);       (SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 EVICT    SUBR   =
          SB1    1
          EVICT  X1 
          JP     EVICTX 
 
          END 
          IDENT  OPEN 
          ENTRY  OPEN 
          B1=1
          TITLE  OPEN - OPEN FILE FOR PROCESSING. 
          COMMENT   OPEN FILE FOR PROCESSING. 
 OPEN     SPACE  4,10 
***       OPEN - OPEN FILE FOR PROCESSING.
* 
*         CALL OPEN (FILE,OPTION) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (OPTION) = 0, SAME AS ALTER
*                         = 5HALTER,
*                         = 7HALTERNR,
*                         = 2HNR, 
*                         = 4HREAD, 
*                         = 6HREADNR, 
*                         = 4HREEL, 
*                         = 6HREELNR, 
*                         = 5HWRITE,
*                         = 7HWRITENR,
* 
* 
*         OPEN(FILE,OPTION);
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 OPTION, AN ITEM CONTAINING ONE OF THE FOLLOWING 
*                         CHARACTER.STRINGS, LEFT JUSTIFIED, BLANK
*                         FILL, ON A BINARY 0 
*                            ALTER
*                            ALTERNR  ( ALTER, NO REWIND )
*                            NR  ( NO REWIND )
*                            READ 
*                            READNR  ( READ, NO REWIND )
*                            REEL 
*                            REELNR  ( REEL, NO REWIND )
*                            WRITE
*                            WRITENR  ( WRITE, NO REWIND )
* 
*         EXIT   TO ARGUMENT-ERROR PROCESSOR IF OPTION IS UNRECOGNIZED
*         ELSE   NONE 
 
 
 OPEN     SUBR   =
          SB1    1
          SA2    A1+B1       ADDRESS OF OPTION
          SA2    X2          OPTION 
          ZR,X2  OPE1 
          SA3    =0HALTER 
          SA4    =0HALTERNR 
          SA5    =0HNR
          BX3    X2-X3
          BX4    X2-X4
          ZR,X3  OPE2        IF ALTER 
          BX5    X2-X5
          ZR,X4  OPE3        IF ALTERNR 
          ZR,X5  OPE4        IF NR
          SA3    =0HREAD
          SA4    =0HREADNR
          SA5    =0HREEL
          BX3    X2-X3
          BX4    X2-X4
          ZR,X3  OPE5        IF READ
          BX5    X2-X5
          ZR,X4  OPE6        IF READNR
          ZR,X5  OPE7        IF REEL
          SA3    =0HREELNR
          SA4    =0HWRITE 
          SA5    =0HWRITENR 
          BX3    X2-X3
          BX4    X2-X4
          ZR,X3  OPE8        IF REELNR
          BX5    X2-X5
          ZR,X4  OPE9        IF WRITE 
          ZR,X5  OPE10       IF WRITENR 
          SA1    =0LOPEN
          RJ     =XMACREL=   DIAGNOSE ILLEGAL ARGUMENT
          JP     OPENX
 
 OPE1     OPEN   X1 
          JP     OPENX
 
 OPE2     OPEN   X1,ALTER 
          JP     OPENX
 
 OPE3     OPEN   X1,ALTERNR 
          JP     OPENX
 
 OPE4     OPEN   X1,NR
          JP     OPENX
 
 OPE5     OPEN   X1,READ
          JP     OPENX
 
 OPE6     OPEN   X1,READNR
          JP     OPENX
 
 OPE7     OPEN   X1,REEL
          JP     OPENX
 
 OPE8     OPEN   X1,REELNR
          JP     OPENX
 
 OPE9     OPEN   X1,WRITE 
          JP     OPENX
 
 OPE10    OPEN   X1,WRITENR 
          JP     OPENX
 
          END 
          IDENT  POSMF
          ENTRY  POSMF
          B1=1
          TITLE  POSMF - POSITION MULTI-FILE SET. 
          COMMENT   POSITION MULTI-FILE SET.
 POSMF    SPACE  4,10 
***       POSMF - POSITION MULTI-FILE SET.
*         LABELED MULTI-FILE MAGNETIC TAPE ONLY.
* 
*         CALL POSMF (MFILNAM)
* 
*         ENTRY  (MFILNAM) = FIRST WORD OF THE FET
* 
*         POSMF(MFILNAM);    ( SYMPL CALL ) 
* 
*         ENTRY - MFILNAM, AN ARRAY THAT CONTAINS THE FET 
 
 
 POSMF    SUBR   =
          SB1    1
          POSMF  X1 
          JP     POSMFX 
 
          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 
          JP     READX
 
          END 
          IDENT  READCW 
          ENTRY  READCW 
          B1=1
          TITLE  READCW - READ FILE NON-STOP WITH CONTROL WORDS.
          COMMENT   READ FILE NON-STOP WITH CONTROL WORDS.
 READCW   SPACE  4,10 
***       READCW - READ FILE NON-STOP WITH CONTROL WORDS. 
* 
*         CALL READCW (FILE,LEVEL)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (LEVEL) = RECORD LEVEL 
*                        = 0, STOP AT END OF INFORMATION
*                        = 17B, STOP AT END OF FILE 
* 
*         READCW(FILE,LEVEL); ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 LEVEL, AN ITEM CONTAINING ONE OF THE FOLLOWING
*                        VALUES 
*                            0, STOP AT EOI 
*                            17B, STOP AT EOF 
 
 
 READCW   SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF LEVEL 
          SA3    X3          LEVEL
          READCW X1,X3
          JP     READCWX
 
          END 
          IDENT  READEI 
          ENTRY  READEI 
          B1=1
          TITLE  READEI - READ FILE TO END OF INFORMATION.
          COMMENT   READ FILE TO END OF INFORMATION.
 READEI   SPACE  4,10 
***       READEI - READ FILE TO END OF INFORMATION. 
*         FOR NOSBE, MASS STORAGE FILES ONLY. 
* 
*         CALL READEI (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         READEI(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 READEI   SUBR   =
          SB1    1
          READEI X1 
          JP     READEIX
 
          END 
          IDENT  READLS 
          ENTRY  READLS 
          B1=1
          TITLE  READLS - READ FILE WITH LIST.
          COMMENT   READ FILE WITH LIST.
 READLS   SPACE  4,10 
***       READLS - READ FILE WITH LIST. 
*         MASS STORAGE FILES ONLY.
* 
*         CALL READLS (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         READS(FILE);       ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 READLS   SUBR   =
          SB1    1
          READLS X1 
          JP     READLSX
 
          END 
          IDENT  READN
          ENTRY  READN
          TITLE  READN - READ FILE NON-STOP FOR TAPES.
          COMMENT   READ FILE NON-STOP FOR TAPES. 
 READN    SPACE  4,10 
***       READN - READ FILE NON-STOP FOR TAPES. 
*         MAGNETIC TAPES IN S OR L FORMAT ONLY. 
* 
*         CALL READN (FILE) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         READN(FILE);       ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 READN    SUBR   =
          SB1    1
          READN  X1 
          JP     READNX 
 
          END 
          IDENT  READNS 
          ENTRY  READNS 
          B1=1
          TITLE  READNS - READ FILE NON-STOP. (READ TO EOF) 
          COMMENT   READ FILE NON-STOP. (READ TO EOF) 
 READNS   SPACE  4,10 
***       READNS - READ FILE NON-STOP. (READ TO EOF)
*         FOR NOSBE, MASS STORAGE FILES ONLY. 
* 
*         CALL READNS (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         READNS(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 READNS   SUBR   =
          SB1    1
          READNS X1 
          JP     READNSX
 
          END 
          IDENT  READSKP
          ENTRY  READSKP
          B1=1
          TITLE  READSKP - READ FILE AND SKIP.
          COMMENT   READ FILE AND SKIP. 
 READSKP  SPACE  4,10 
***       READSKP - READ FILE AND SKIP. 
* 
*         CALL READSKP (FILE,LEVEL) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (LEVEL) = RECORD LEVEL 
*                        = 0, SKIP TO END OF RECORD 
*                        = 17B, SKIP TO END OF FILE 
* 
*         READSKP(FILE,LEVEL); ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 LEVEL, AN ITEM THAT CONTAINS ONE OF THE FOLLOWING 
*                        VALUES 
*                            0, SKIP TO EOR 
*                            17B, SKIP TO EOF 
 
 
 READSKP  SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF LEVEL 
          SA3    X3          LEVEL
          READSKP X1,X3 
          JP     READSKPX 
 
          END 
          IDENT  RETURN 
          B1=1
          TITLE  RETURN - RETURN FILE TO SYSTEM.
          COMMENT   RETURN FILE TO SYSTEM.
 RETURN   SPACE  4,10 
***       RETURN - RETURN FILE TO SYSTEM. 
* 
*         CALL RETURN (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         RETERN(FILE);      ( SYMPL CALL ) 
* 
*         NOTE :  RETURN IS A RESERVED WORD IN SYMPL, A CALL TO 
*                 THE RETURN MACRO IN SYMPL MUST SPELL RETURN WITH
*                 AN "E" INSTEAD OF A "U".
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
          ENTRY  RETERN 
          ENTRY  RETURN 
 RETERN   BSS  0             ENTRY FOR SYMPL ROUTINES 
 RETURN   SUBR   =
          SB1    1
          RETURN X1 
          JP     RETURNX
 
          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 
          JP     REWINDX
 
          END 
          IDENT  REWRITE
          ENTRY  REWRITE
          B1=1
          TITLE  REWRITE - REWRITE DATA FROM CIO BUFFER.
          COMMENT   REWRITE DATA FROM CIO BUFFER. 
 REWRITE  SPACE  4,10 
***       REWRITE - REWITE DATA FROM CIO BUFFER.
*         MASS STORAGE FILES ONLY.
* 
*         CALL REWRITE (FILE) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         REWRITE(FILE);     ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 REWRITE  SUBR   =
          SB1    1
          REWRITE X1
          JP     REWRITEX 
 
          END 
          IDENT  REWRITF
          ENTRY  REWRITF
          B1=1
          TITLE  REWRITF - REWRITE END OF FILE. 
          COMMENT   REWRITE END OF FILE.
 REWRITF  SPACE  4,10 
***       REWRITF - REWRITE END OF FILE.
*         MASS STORAGE FILES ONLY.
* 
*         CALL REWRITF (FILE) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         REWRITE(FILE);     ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 REWRITF  SPACE  4,10 
**        NEEDS  MACRO REWRITEF 
 
 
 REWRITF  SUBR   =
          SB1    1
          REWRITEF X1 
          JP     REWRITFX 
 
          END 
          IDENT REWRITR 
          ENTRY REWRITR 
          B1=1
          TITLE  REWRITR - REWRITE END OF RECORD. 
          COMMENT   REWRITE END OF RECORD.
 REWRITR  SPACE  4,10 
***       REWRITR - REWRITE END OF RECORD.
*         MASS STORAGE FILES ONLY.
* 
*         CALL REWRITR (FILE,LEVEL) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (LEVEL) = RECORD LEVEL 
* 
*         REWRITR(FILE,LEVEL); ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 LEVEL, AN ITEM THAT CONTAINS ONE OF THE RECORD LEVEL
 REWRITR  SPACE  4,10 
**        NEEDS  MACRO REWRITER 
 
 
 REWRITR  SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF LEVEL 
          SA3    X3          LEVEL
          REWRITER X1,X3
          JP     REWRITRX 
 
          END 
          IDENT  RPHR 
          ENTRY  RPHR 
          B1=1
          TITLE  RPHR - READ PHYSICAL RECORD TO CIO BUFFER. 
          COMMENT   READ PHYSICAL RECORD TO CIO BUFFER. 
 RPHR     SPACE  4,10 
***       RPHR - READ PHYSICAL RECORD TO CIO BUFFER.
*         FOR NOSBE, MAGNETIC TAPES IN NOSBE FORMAT ONLY. 
* 
*         CALL RPHR (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         RPHR(FILE);        ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 RPHR     SUBR   =
          SB1    1
          RPHR   X1 
          JP     RPHRX
 
          END 
          IDENT  RPHRLS 
          ENTRY  RPHRLS 
          B1=1
          LIST   F
          TITLE  RPHRLS - READ PRUS WITH LIST.
          COMMENT   READ PRUS WITH LIST.
          IPARAMS 
 RPHRLS   SPACE  4,10 
***       RPHRLS - READ PRUS WITH LIST. 
*         NOS ONLY. MASS STORAGE FILES ONLY.
* 
*         CALL RPHRLS (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         RPHRLS(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 RPHRLS   SUBR   =
          SB1    1
 KRNNOS   IFC    EQ,*"OS.NAME"*KRONOS*
          RPHRLS X1 
 KRNNOS   ELSE
          SA1    =0LRPHRLS
          RJ     =XMACREL.   DIAGNOSE UNDEFINED MACRO 
 KRNNOS   ENDIF 
          JP     RPHRLSX
 
          END 
          IDENT  SKIPB
          ENTRY  SKIPB
          B1=1
          TITLE  SKIPB - SKIP RECORDS BACKWARDS.
          COMMENT   SKIP RECORDS BACKWARDS. 
 SKIPB    SPACE  4,10 
***       SKIPB - SKIP RECORDS BACKWARDS. 
* 
*         CALL SKIPB (FILE,N,LEVEL) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (N) = NUMBER OF RECORDS
*                (LEVEL) = RECORD LEVEL 
* 
*         SKIPB(FILE,N,MEVEL); ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 N, AN ITEM CONTAINING THE NUMBER OF RECORDS TO SKIP 
*                 LEVEL, AN ITEM CONTAINING THE RECORD LEVEL
 
 
 SKIPB    SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF N 
          SA4    A3+B1       ADDRESS OF LEVEL 
          SA3    X3          N
          SA4    X4          LEVEL
          SKIPB  X1,X3,X4 
          JP     SKIPBX 
 
          END 
          IDENT  SKIPEI 
          ENTRY  SKIPEI 
          B1=1
          TITLE  SKIPEI - SKIP TO END OF INFORMATION. 
          COMMENT   SKIP TO END OF INFORMATION. 
 SKIPEI   SPACE  4,10 
***       SKIPEI - SKIP TO END OF INFORMATION.
*         FOR NOSBE, MASS STORAGE FILES ONLY. 
* 
*         CALL SKIPEI (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         SKIPEI(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 SKIPEI   SUBR   =
          SB1    1
          SKIPEI X1 
          JP     SKIPEIX
 
          END 
          IDENT  SKIPF
          ENTRY  SKIPF
          B1=1
          TITLE  SKIPF - SKIP RECORDS FORWARD.
          COMMENT   SKIP RECORDS FORWARD. 
 SKIPF    SPACE  4,10 
***       SKIPF - SKIP RECORDS FORWARD. 
* 
*         CALL SKIPF (FILE,N) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (N) = NUMBER OF RECORDS
* 
*         SKIPF(FILE,N); ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 N, AN ITEM CONTAINING THE NUMBER OF RECORDS TO SKIP 
 
 
 SKIPF    SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF N 
          SA3    X3          N
          SKIPF  X1,X3
          JP     SKIPFX 
 
          END 
          IDENT  SKIPFB 
          ENTRY  SKIPFB 
          B1=1
          TITLE  SKIPFB - SKIP FILES BACKWARD.
          COMMENT   SKIP FILES BACKWARD.
 SKIPFB   SPACE  4,10 
***       SKIPFB - SKIP FILES BACKWARD. 
* 
*         CALL SKIPFB (FILE,N)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (N) = NUMBER OF FILES
* 
*         SKIPFB(FILE,N);    ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 N, AN ITEM CONTAING THE NUMBER OF FILES TO SKIP 
 
 
 SKIPFB   SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF N 
          SA3    X3          N
          SKIPFB X1,X3
          JP     SKIPFBX
 
          END 
          IDENT  SKIPFF 
          ENTRY  SKIPFF 
          B1=1
          TITLE  SKIPFF - SKIP FILES FORWARD. 
          COMMENT   SKIP FILES FORWARD. 
 SKIPFF   SPACE  4,10 
***       SKIPFF - SKIP FILES FORWARD.
* 
*         CALL SKIPFF (FILE,N)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (N) = NUMBER OF FILES
* 
*         SKIPFF(FILE,N);    ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF FILES TO SKIP
 
 
 SKIPFF   SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF N 
          SA3    X3          N
          SKIPFF X1,X3
          JP     SKIPFFX
 
          END 
          IDENT  UNLOAD 
          ENTRY  UNLOAD 
          B1=1
          TITLE  UNLOAD - UNLOAD FILE.
          COMMENT   UNLOAD FILE.
 UNLOAD   SPACE  4,10 
***       UNLOAD - UNLOAD FILE. 
* 
*         CALL UNLOAD (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         UMLOAD(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 UNLOAD   SUBR   =
          SB1    1
          UNLOAD X1 
          JP     UNLOADX
 
          END 
          IDENT  WPHR 
          ENTRY  WPHR 
          B1=1
          TITLE  WPHR - WRITE 1 PHYSICAL RECORD FROM CIO BUFFER.
          COMMENT   WRITE 1 PHYSICAL RECORD FROM CIO BUFFER.
 WPHR     SPACE  4,10 
***       WPHR - WRITE 1 PHYSICAL RECORD FROM CIO BUFFER. 
*         FOR NOSBE, MAGNETIC TAPES IN NOSBE FORMAT ONLY. 
* 
*         CALL WPHR (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         WPHR(FILE);        ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 WPHR     SUBR   =
          SB1    1
          WPHR   X1 
          JP     WPHRX
 
          END 
          IDENT  WRITE
          ENTRY  WRITE
          B1=1
          TITLE  WRITE - WRITE DATA FROM CIO BUFFER.
          COMMENT   WRITE DATA FROM CIO BUFFER. 
 WRITE    SPACE  4,10 
***       WRITE - WRITE DATA FROM CIO BUFFER. 
* 
*         CALL WRITE (FILE) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         WRITE(FILE);       ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 WRITE    SUBR   =
          SB1    1
          WRITE  X1 
          JP     WRITEX 
 
          END 
          IDENT  WRITECW
          ENTRY  WRITECW
          B1=1
          TITLE  WRITECW - WRITE FILE NON-STOP WITH CONTROL WORDS.
          COMMENT   WRITE FILE NON-STOP WITH CONTROL WORDS. 
 WRITECW  SPACE  4,10 
***       WRITECW - WRITE FILE NON-STOP WITH CONTROL WORDS. 
* 
*         CALL WRITECW (FILE) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         WRITECW(FILE);     ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 WRITECW  SUBR   =
          SB1    1
          WRITECW X1
          JP     WRITECWX 
 
          END 
          IDENT  WRITEF 
          ENTRY  WRITEF 
          B1=1
          TITLE  WRITEF - WRITE END OF FILE.
          COMMENT   WRITE END OF FILE.
 WRITEF   SPACE  4,10 
***       WRITEF - WRITE END OF FILE. 
* 
*         CALL WRITEF (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         WRITEF(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
 
 
 WRITEF   SUBR   =
          SB1    1
          WRITEF X1 
          JP     WRITEFX
 
          END 
          IDENT  WRITEN 
          ENTRY  WRITEN 
          B1=1
          TITLE  WRITEN - WRITE FILE NON-STOP FOR TAPES.
          COMMENT   WRITE FILE NON-STOP FOR TAPES.
 WRITEN   SPACE  4,10 
***       WRITEN - WRITE FILE NON-STOP FOR TAPES. 
*         MAGNETIC TAPES IN S OR L FORMAT ONLY. 
* 
*         CALL WRITEN (FILE)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
*         WRITEN(FILE);      ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ENTRY THAT CONTAINS THE FET
 
 
 WRITEN   SUBR   =
          SB1    1
          WRITEN X1 
          JP     WRITENX
 
          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  READC
          ENTRY  READC
          B1=1
          TITLE  READC - READ CODED LINE IN *C* FORMAT. 
          COMMENT   READ CODED LINE IN *C* FORMAT.
 READC    SPACE  4,10 
***       READC - READ CODED LINE IN *C* FORMAT.
* 
*         CALL READC (FILE,BUF,N,STATUS)
* 
*         TRANSFERS DATA UNTIL THE END OF LINE BYTE (0000) IS SENSED. 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         READC(FILE,BUF,N,STATUS);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
* 
*         EXIT   (STATUS) = 0, TRANSFER COMPLETE
*                         = -1, END-OF-FILE DETECTED ON FILE
*                         = -2, END-OF-INFORMATION DETECTED ON FILE 
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO 
*                           WORKING BUFFER
* 
*         EXIT -  STATUS, AN ITEM THAT WILL HAVE THE RESPONSE VALUE 
*                         PUT IN IT 
 
 
 READC    SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA5    A4+B1       (X5) = ADDRESS OF STATUS WORD
          SA4    X4          WORD COUNT 
          READC  X1,X3,X4 
          BX6    X1 
          SA6    X5 
          JP     READCX 
 
          END 
          IDENT  WRITEC 
          ENTRY  WRITEC 
          B1=1
          TITLE  WRITEC - WRITE CODED LINE IN *C* FORMAT. 
          COMMENT   WRITE CODED LINE IN *C* FORMAT. 
 WRITEC   SPACE  4,10 
***       WRITEC - WRITE CODED LINE IN *C* FORMAT.
* 
*         CALL WRITEC (FILE,BUF)
* 
*         TRANSFERS DATA UNTIL THE END OF LINE BYTE (0000) IS SENSED. 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
* 
*         WRITEC(FILE,BUF);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
 
 
 WRITEC   SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          WRITEC X1,X3
          JP     WRITECX
 
          END 
          IDENT  READH
          ENTRY  READH
          B1=1
          TITLE  READH - READ CODED LINE IN *H* FORMAT. 
          COMMENT   READ CODED LINE IN *H* FORMAT.
 READH    SPACE  4,10 
***       READH - READ CODED LINE IN *H* FORMAT.
* 
*         CALL READH (FILE,BUF,N,STATUS)
* 
*         TRANSFERS DATA UNTIL THE END OF LINE BYTE (0000) IS SENSED. 
*         FILLS TRAILING SPACES INTO THE WORKING BUFFER.
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         READH(FILE,BUF,N,STATUS); ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
* 
*         EXIT   (STATUS) = 0, TRANSFER COMPLETE
*                         = -1, END-OF-FILE DETECTED ON FILE
*                         = -2, END-OF-INFORMATION DETECTED ON FILE 
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO 
*                           WORKING BUFFER
 
* 
*         EXIT -  STATUS, AN ITEM THAT WILL HAVE THE RESPONSE VALUE 
*                         PUT IN IT 
 
 READH    SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA5    A4+B1       (X5) = ADDRESS OF STATUS WORD
          SA4    X4          WORD COUNT 
          READH  X1,X3,X4 
          BX6    X1 
          SA6    X5 
          JP     READHX 
 
          END 
          IDENT  WRITEH 
          ENTRY  WRITEH 
          B1=1
          TITLE  WRITEH - WRITE CODED LINE IN *H* FORMAT. 
          COMMENT   WRITE CODED LINE IN *H* FORMAT. 
 WRITEH   SPACE  4,10 
***       WRITEH - WRITE CODED LINE IN *H* FORMAT.
* 
*         CALL WRITEH (FILE,BUF,N)
* 
*         TRANSFERS ONE LINE OF DATA. DELETES TRAILING SPACES.
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         WRITEH(FILE,BUF,N);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
 
 
 WRITEH   SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA4    X4          WORD COUNT 
          WRITEH X1,X3,X4 
          JP     WRITEHX
 
          END 
          IDENT  READO
          ENTRY  READO
          B1=1
          TITLE  READO - READ ONE WORD. 
          COMMENT   READ ONE WORD.
 READO    SPACE  4,10 
***       READO - READ ONE WORD.
* 
*         CALL READO (FILE,WORD,STATUS) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
* 
* 
*         READO(FILE,WORD,STATUS);  ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
* 
*         EXIT   (WORD) = WORD READ IF (STATUS) = 0 
*                (STATUS) = 0, TRANSFER COMPLETE
*                         = -1, END-OF-FILE DETECTED ON FILE
*                         = -2, END-OF-INFORMATION DETECTED ON FILE 
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO 
*                           WORKING BUFFER
* 
*         EXIT -  WORD, WORD READ, IF STATUS EQUALS 0 
*                 STATUS, AN ITEM THAT WILL HAVE THE RESPONSE VALUE 
*                         PUT IN IT 
 
 
 READO    SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF WORD
          SA5    A3+B1       (X5) = ADDRESS OF STATUS WORD
          BX0    X3 
          READO  X1 
          SA6    X0          WORD READ
          BX7    X1          STATUS 
          SA7    X5 
          JP     READOX 
 
          END 
          IDENT  WRITEO 
          ENTRY  WRITEO 
          B1=1
          TITLE  WRITEO - WRITE ONE WORD. 
          COMMENT   WRITE ONE WORD. 
 WRITEO   SPACE  4,10 
***       WRITEO - WRITE ONE WORD.
* 
*         CALL WRITEO (FILE,WORD) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (WORD) = WORD TO BE TRANSFERRED
* 
*         WRITEO(FILE,WORD);  ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 WORD, ITEM TO BE TRANSFERED 
 
 
 WRITEO   SUBR   =
          SB1    1
          SA3    A1+B1       ADDRESS OF WORD
          SA3    X3          WORD 
          BX6    X3 
          WRITEO X1 
          JP     WRITEOX
 
          END 
          IDENT  READS
          ENTRY  READS
          B1=1
          TITLE  READS - READ CODED LINE TO CHARACTER BUFFER. 
          COMMENT   READ CODED LINE TO CHARACTER BUFFER.
 READS    SPACE  4,10 
***       READS - READ CODED LINE TO CHARACTER BUFFER.
* 
*         CALL READS (FILE,BUF,N,STATUS)
* 
*         UNPACKS WORDS AND STORES THEM IN THE WORKING BUFFER, ONE
*         CHARACTER/WORD, UNTIL THE END OF LINE BYTE (0000) IS SENSED.
*         FILLS THE WORKING BUFFER WITH SPACE CODES IF THE CODED LINE 
*         TERMINATES BEFORE *N* CHARACTERS ARE STORED.
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         READS(FILE,BUF,N,STATUS);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
* 
*         EXIT   (STATUS) = 0, TRANSFER COMPLETE
*                         = -1, END-OF-FILE DETECTED ON FILE
*                         = -2, END-OF-INFORMATION DETECTED ON FILE 
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO 
*                           WORKING BUFFER
* 
*         EXIT -  STATUS, AN ITEM THAT WILL HAVE THE RESPONSE VALUE 
*                         PUT IN IT 
 
 
 READS    SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA5    A4+B1       (X5) = ADDRESS OF STATUS WORD
          SA4    X4          WORD COUNT 
          READS  X1,X3,X4 
          BX6    X1 
          SA6    X5 
          JP     READSX 
 
          END 
          IDENT  WRITES 
          ENTRY  WRITES 
          B1=1
          TITLE  WRITES - WRITE CODED LINE FROM CHARACTER BUFFER. 
          COMMENT   WRITE CODED LINE FROM CHARACTER BUFFER. 
 WRITES   SPACE  4,10 
***       WRITES - WRITE CODED LINE FROM CHARACTER BUFFER.
* 
*         CALL WRITES (FILE,BUF,N)
* 
*         PACKS CHARACTERS FROM THE WORKING BUFFER TEN CHARACTERS/WORD. 
*         DELETES TRAILING SPACE CODES BEFORE PACKING CHARACTERS. 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         WRITES(FILE,BUF,N);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
 
 
 WRITES   SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA4    X4          WORD COUNT 
          WRITES X1,X3,X4 
          JP     WRITESX
 
          END 
          IDENT  READW
          ENTRY  READW
          B1=1
          TITLE  READW - READ DATA TO WORKING BUFFER. 
          COMMENT   READ DATA TO WORKING BUFFER.
 READW    SPACE  4,10 
***       READW - READ DATA TO WORKING BUFFER.
* 
*         CALL READW (FILE,BUF,N,STATUS)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         READW(FILE,BUF,N,STATUS);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
*         EXIT   (STATUS) = 0, TRANSFER COMPLETE
*                         = -1, END-OF-FILE DETECTED ON FILE
*                         = -2, END-OF-INFORMATION DETECTED ON FILE 
*                         = LWA, END-OF-RECORD DETECTED ON FILE BEFORE
*                                TRANSFER WAS COMPLETE
*                     LWA = ADDRESS + 1 OF LAST WORD TRANSFERRED TO 
*                           WORKING BUFFER
* 
*         EXIT -  STATUS, AN ITEM THAT WILL HAVE THE RESPONSE VALUE 
*                         PUT IN IT 
 
 
 READW    SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA5    A4+B1       (X5) = ADDRESS OF STATUS WORD
          SA4    X4          WORD COUNT 
          READW  X1,X3,X4 
          BX6    X1 
          SA6    X5 
          JP     READWX 
 
          END 
          IDENT  WRITEW 
          ENTRY  WRITEW 
          B1=1
          TITLE  WRITEW - WRITE DATA FROM WORKING BUFFER. 
          COMMENT   WRITE DATA FROM WORKING BUFFER. 
 WRITEW   SPACE  4,10 
***       WRITEW - WRITE DATA FROM WORKING BUFFER.
* 
*         CALL WRITEW (FILE,BUF,N)
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         WRITEW(FILE,BUF,N);  ( SYMPL CALL ) 
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
 
 
 WRITEW   SUBR   =
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA4    X4          WORD COUNT 
          WRITEW X1,X3,X4 
          EQ     WRITEWX
 
          END 
          IDENT  ABEND
          ENTRY  ABORT
          ENTRY  ENDRUN 
          B1=1
          LIST   F
          TITLE  ABORT - ABORT JOB  /  ENDRUN - END CENTRAL PROGRAM.
          COMMENT   ABORT/ENDRUN. 
 ABORT    SPACE  4,10 
***       ABORT - ABORT JOB.
* 
*         CALL ABORT
* 
*         ENTRY  NONE 
* 
*         ABORT;  ( SYMPL CALL )
* 
*         EXIT   DOES NOT EXIT
 
 
 ABORT    SUBR   =
          SB1    1
          ABORT 
 ENDRUN   SPACE  4,10 
***       ENDRUN - END CENTRAL PROGRAM. 
* 
*         CALL ENDRUN 
* 
*         ENTRY  NONE 
* 
*         ENDRUN;  ( SYMPL CALL ) 
* 
*         NOTE - A "STOP;" IN SYMPL DOES THE SAME THING 
* 
*         EXIT   DOES NOT EXIT
 
 
 ENDRUN   SUBR   =
          SB1    1
          ENDRUN
 
          END 
          IDENT  ATTACH 
          B1=1
          LIST   F
          TITLE  ATTACH - ATTACH A PERMANENT FILE.
          COMMENT   ATTACH A PERMANENT FILE.
          IPARAMS 
 ATTACH   SPACE  4,10 
 NOSPFM   IFC    EQ,*"OS.NAME"*KRONOS*
***       NOS PERMANENT FILE MANAGER SYMPL INTERFACE ROUTINES 
* 
*         ATTACH(LFN,PFN,UN,PW,M) 
* 
*         DEFINE(LFN,PFN,PW,CT) 
* 
*         PURGE(LFN,UN,PW)
* 
*                LFN - LOGICAL FILE NAME, LEFT JUSTIFIED, ZERO FILLED,
*                      SEVEN CHARACTER MAXIMUM
*                PFN - PERMANENT FILE NAME, SAME CHARACTERISTICS AS LFN 
*                UN  - USER NUMBER, SAME CHARACTERISTICS AS PFN,LFN 
*                PW  - PASSWORD, SAME CHARACTERISTICS AS UN,PFN,LFN 
*                CT  - FILE CATEGORY
*                    - = 0, PRIVATE FILE
*                    - = 1, SEMI-PRIVATE FILE 
*                    - = 2, PUBLIC FILE 
*                M   - FILE ACCESS MODE 
*                    - = 0, READ/WRITE
*                    - = 1, READ
* 
*         THESE ARE SYMPL FUNCTIONS AND WILL RETURN THE STATUS
*         FROM WORD 0, BITS 17-10.  SEE NOS REFERENCE MANUAL, VOL. 2
*         CHAPTER  5, FOR THE PFM ERROR CODE. ZERO IS SUCCESSFUL
*         COMPLETION. 
* 
 PFMFET   FILEB  DUMMY,DUMMYL,EPR,(FET=14D)    DUMMY PFM FET
 DUMMYL   EQU    0
 DUMMY    BSS    0
 PFMUN    EQU    PFMFET+9D   FET ALTERNATE USER NUMBER WORD 
 PFMERD   EQU    PFMFET+10D  ERROR ADDRESS WORD IN FET
 PFMERAD  BSSZ   3           PUT ERROR MESSAGE HERE/NOT DAYFILE 
          SPACE  4,15 
***       ATTACH - ATTACHES A NOS PERMANENT FILE
* 
*         SYMPL CALL - STATUS = ATTACH(LFN,PFN,UN,PW,M);
* 
* 
          ENTRY ATTACH
 ATTACH   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 
          SA4    A3+B1       ADDRESS OF UN IN X4
          MX6    42          SET MASK 
          SA5    A4+B1       ADDRESS OF PW IN X5
          SX7    PFMERAD     ADDRESS OF MSG BUFFER
          SA3    X4          GET UN 
          BX3    X0*X3       X3 = UN
          SA2    X5          GET PW 
          BX2    X0*X2       X2 = PW
          SA4    A5+B1       ADDRESS OF MODE IN X4
          SA5    X4          GET MODE 
          SA4    PFMERD      FETCH ERROR ADDRESS WORD FROM FET
          BX4    X6*X4       CLEAR OLD ADDRESS
          BX7    X7+X4       PUT NEW ONE IN 
          SA7    A4          STORE BACK IN FET
          ZR   X5,ATT1       JIF WRITE MODE WANTED
          ATTACH PFMFET,X1,X3,X2,R  READ MODE ATTACH
          EQ     ATT2        COMMON EXIT
          SPACE  2
 ATT1     BSS    0           WRITE MODE ATTACH
          ATTACH PFMFET,X1,X3,X2,W   WRITE MODE ATTACH
          SPACE  2
 ATT2     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   ATTACHX         RETURN 
 NOSPFM   ENDIF 
          END 
          IDENT  CHECKPT
          ENTRY  CHECKPT
          B1=1
          LIST   F
          TITLE  CHECKPT - TAKE CHECKPOINT DUMP.
          COMMENT   TAKE CHECKPOINT DUMP. 
          IPARAMS 
 CHECKPT  SPACE  4,10 
***       CHECKPT - TAKE CHECKPOINT DUMP. 
* 
*         CALL CHECKPT (LIST,OPTION)
* 
*         ENTRY  (LIST) = LIST OF FILE PROCESSING SPECIFICATIONS
*                (OPTION) = 0, PROCESS ALL FILES
*                         = OTHER, PROCESS ONLY THE SPECIFIED FILES 
* 
*         CHECKPT(LIST,OPTION); 
* 
*         ENTRY - LIST, AN ARRAY THAT CONTAINS A LIST OF FILE 
*                       PROCESSING SPECIFICATIONS 
*                 OPTION, AN ITEM THAT CONTAINS THE OPTION
 
 
 CHECKPT  SUBR   =
          SB1    1
 
 SCPNOS   IFC    EQ,*"OS.NAME"*NOSBE *
          SA2    A1+1        ADDRESS OF OPTION
          SA2    X2          OPTION 
          ZR,X2  CHE1        IF ALL FILES TO BE PROCESSED 
          CHECKPT X1,OPTION 
          JP     CHECKPTX 
 
 CHE1     CHECKPT X1
          JP     CHECKPTX 
 
 SCPNOS   ELSE
          SA1    =0LCHECKPT 
          RJ     =XMACREL.   DIAGNOSE UNDEFINED MACRO 
          JP     CHECKPTX 
 SCPNOS   ENDIF 
 
          END 
          IDENT  CLOCK
          ENTRY  CLOCK
          B1=1
          LIST   F
          TITLE  CLOCK - OBTAIN TIME OF DAY.
          COMMENT   OBTAIN TIME OF DAY. 
 CLOCK    SPACE  4,10 
***       CLOCK - OBTAIN TIME OF DAY. 
* 
*         CALL CLOCK (STATUS) 
* 
*         ENTRY  NONE 
* 
*         EXIT   (STATUS) = TIME OF DAY 
**T       60/ * HH.MM.SS.*
* 
*         CLOCK(STATUS);  ( SYMPL CALL )
* 
*         EXIT  - STATUS, A CHARACTER ITEM THAT WILL CONTAIN THE
*                         CLOCK READING 
 
 
 CLOCK    SUBR   =
          SB1    1
          BX5    X1 
          CLOCK  X1 
          SA1    X5 
          BX6    X1          RETURN TIME OF DAY AS FUNCTION RESULT
          EQ     CLOCKX 
 
          END 
          IDENT  DATE 
          ENTRY  DATE 
          B1=1
          LIST   F
          TITLE  DATE - OBTAIN DATE.
          COMMENT   OBTAIN DATE.
 DATE     SPACE  4,10 
***       DATE - OBTAIN DATE. 
* 
*         CALL DATE (STATUS)
* 
*         ENTRY  NONE 
* 
*         EXIT   (STATUS) = DATE
**T       60/ * YY/MM/DD.*
* 
*         DATE(STATUS);  ( SYMPL CALL ) 
* 
*         EXIT  - STATUS, A CHARACTER ITEM TO CONTAIN THE TIME
 
 
 DATE     SUBR   =
          SB1    1
          BX5    X1 
          DATE   X1 
          SA1    X5 
          BX6    X1          RETURN DATE AS FUNCTION RESULT 
          EQ     DATEX
 
          END 
          IDENT  DEFINE 
          B1=1
          LIST   F
          TITLE  DEFINE - DEFINE A NOS PERMANENT FILE.
          COMMENT   DEFINE A NOS PERMANENT FILE.
          IPARAMS 
 DEFINE   SPACE  4,10 
 NOSPFM   IFC    EQ,*"OS.NAME"*KRONOS*
*         NOS PERMANENT FILE MANAGER SYMPL INTERFACE ROUTINES 
* 
*         DEFINE(LFN,PFN,PW,CT,M,AC)
* 
*                LFN - LOGICAL FILE NAME, LEFT JUSTIFIED, ZERO FILLED,
*                      SEVEN CHARACTER MAXIMUM
*                PFN - PERMANENT FILE NAME, SAME CHARACTERISTICS AS LFN 
*                PW  - PASSWORD, SAME CHARACTERISTICS AS UN,PFN,LFN 
*                CT  - FILE ACCESS CATEGORY 
*                      = 0, PRIVATE 
*                      = 1, SEMIPRIVATE 
*                      = 2, PUBLIC
*                M   - FILE ACCESS MODE 
*                      = 0, READ/WRITE/MODIFY/APPEND/UPDATE/PURGE/EXECUTE 
*                      = 1, READ
*                      = 2, APPEND
*                      = 3, EXECUTE 
*                      = 4, NONE
*                      = 5, MODIFY/APPEND/UPDATE/READ/EXECUTE 
*                      = 6, READ-MODIFY 
*                      = 7, READ-APPEND 
*                      = 8, UPDATE
*                      = 9, READ-UPDATE 
*                AC  - ALTERNATE CATLIST
*                      = 1, DO NOT ALLOW ALTERNATE CATLIST
*                      = 2, ALLOW ALTERNATE CATLIST 
* 
*         THESE ARE SYMPL FUNCTIONS AND WILL RETURN THE STATUS
*         FROM WORD 0, BITS 17-10.  SEE NOS REFERENCE MANUAL, VOL. 2
*         CHAPTER  5, FOR THE PFM ERROR CODE. ZERO IS SUCCESSFUL
*         COMPLETION
* 
 PFMFET   FILEB  DUMMY,DUMMYL,EPR,(FET=16D)    DUMMY PFM FET
 DUMMYL   EQU    0
 DUMMY    BSS    0
 PFMUN    EQU    PFMFET+9D   FET ALTERNATE USER NUMBER WORD 
 PFMERD   EQU    PFMFET+10D  ERROR ADDRESS WORD IN FET
 PFMERAD  BSSZ   5           PUT ERROR MESSAGE HERE/NOT DAYFILE 
          SPACE  4,15 
***       DEFINE - DEFINES A NOS PERMANENT FILE 
* 
*         SYMPL CALL - STATUS = DEFINE(LFN,PFN,PW,CT,M,AC); 
* 
* 
          ENTRY DEFINE
 DEFINE   SUBR   =           ENTRY/EXIT 
          SB1    1
          SA4    X1          GET THE LFN
          MX0    -18         SET MASK 
          BX6    X0*X4       ISOLATE LFN
          SX4    B1 
          BX6    X6+X4       SET COMPLETION BIT IN FET+0
          SA6    PFMFET      WRITE WORD ZERO OF FET 
          SA3    A1+B1       ADDRESS OF PFN IN X3 
          SA1    X3          GET PFN
          BX1    X0*X1       X1 = PFN 
          SA4    A3+B1       ADDRESS OF PW IN X4
          SA2    X4          GET PW 
          BX2    X0*X2       X2 = PW
          SA3    A4+B1       ADDRESS OF CT
          SA4    X3          X4 = CT
          BX7    X4 
          SA7    CATEGOR     SET FILE CATEGORY
          SA4    A3+B1       ADDRESS OF MODE
          SA3    X4          X4 = MODE
          BX7    X3 
          SA7    MODE        SAVE 
          SA3    A4+B1       ADDRESS OF ALTERNATE CATLIST 
          SA4    X3          X4 = AC
          BX7    X4 
          SA7    ALTCAT      SAVE 
          SA5    PFMUN       GET ALT. USER NUMBER WORD FROM PFMFET
          BX6    -X0*X5      MASK OUT ANY POSSIBLE USER NUMBER LEFT 
          SA6    A5          WRITE BACK REST OF ALT. USER NUM. WORD 
          SA4    PFMERD      FETCH ERROR ADDRESS WORD FROM FET
          SX7    PFMERAD     ADDRESS OF MSG BUFFER
          BX4    X0*X4       CLEAR OLD ADDRESS
          BX7    X7+X4       PUT NEW ONE IN 
          SA7    A4          STORE BACK IN FET
          DEFINE PFMFET,X1,X2,,,CATEGOR,MODE,,,,,,,,,ALTCAT 
          SA1    PFMFET      GET FET+0
          MX0    -8 
          AX1    10          RIGHT JISTIFY BITS 17-10 
          BX6    -X0*X1      ISOLATE ERROR CODE IN X6 
          JP   DEFINEX         RETURN 
 CATEGOR  BSSZ   1           FILE CATEGORY
 MODE     BSSZ   1           FILE PERMISSION MODE 
 ALTCAT   BSSZ   1           ALTERNATE CATLIST
 NOSPFM   ENDIF 
          END 
          IDENT  EDATE
          ENTRY  EDATE
          B1=1
          LIST   F
          COMMENT  UNPACK DATE. 
 OPL      XTEXT  COMCEDT
 OPL      XTEXT  COMCCDD
          SPACE 4 
***       EDATE - UNPACK DATE.
* 
*         XX = EDATE(YY);   (SYMPL CALL)
* 
*         ENTRY YY  CONTAINS PACKED DATE
* 
*         EXIT XX  CONTAINS UNPACKED DATE 
* 
 
 EDATE    BSS    1
          SB1    1
          SA1    X1 
          EDATE  X1 
          EQ     EDATE
          END 
          IDENT  ETIME
          ENTRY  ETIME
          B1=1
          LIST   F
          COMMENT  UNPACK TIME. 
 OPL      XTEXT  COMCEDT
 OPL      XTEXT  COMCCDD
          SPACE  4
***       ETIME - UNPACK TIME.
* 
*         XX = ETIME(YY);    (SYMPL CALL) 
* 
*         ENTRY  YY  CONTAINS PACKED TIME 
* 
*         EXIT   XX  CONTAINS UNPACKED TIME 
* 
 ETIME    BSS    1
          SB1    1
          SA1    X1 
          ETIME  X1 
          EQ     ETIME
          END 
          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  IOTIME 
          ENTRY  IOTIME 
          B1=1
          LIST   F
          TITLE  IOTIME - OBTAIN ACCUMULATED IO TIME. 
          COMMENT   OBTAIN ACCUMULATED IO TIME. 
          IPARAMS 
 IOTIME   SPACE  4,10 
***       IOTIME - OBTAIN ACCUMULATED IO TIME.
*         NOSBE ONLY. 
* 
*         CALL IOTIME (STATUS)
* 
*         ENTRY  NONE 
* 
*         EXIT   (STATUS) = RESPONSE
*                RESPONSE FORMAT - 24/ IO TIME LIMIT (SECONDS), 
*                24/ IO TIME USED (SECONDS),  12/ IO TIME USED (MS) 
* 
*         IOTIME(STATUS);  ( SYMPL CALL ) 
* 
*         EXIT - STATUS, AN ITEM TO CONTAIN THE IO STATUS WORD ON EXIT
 
 
 IOTIME   SUBR   =
          SB1    1
 
 SCPNOS   IFC    EQ,*"OS.NAME"*NOSBE *
          BX5    X1 
          IOTIME X1 
          SA1    X5 
          BX6    X1          RETURN RESPONSE AS FUNCTION RESULT 
 SCPNOS   ELSE
          SA1    =0LIOTIME
          RJ     =XMACREL.   DIAGNOSE UNDEFINED MACRO 
 SCPNOS   ENDIF 
          JP     IOTIMEX
 
          END 
          IDENT  JDATE
          ENTRY  JDATE
          B1=1
          LIST   F
          TITLE  JDATE - OBTAIN JULIAN DATE.
          COMMENT   OBTAIN JULIAN DATE. 
 JDATE    SPACE  4,10 
***       JDATE - OBTAIN JULIAN DATE. 
* 
*         CALL JDATE (STATUS) 
* 
*         ENTRY  NONE 
* 
*         EXIT   (STATUS) = JULIAN DATE 
**T       30/ 0,  30/ *YYDDD* 
* 
*         JDATE(STATUS);  ( SYMPL CALL )
* 
*         EXIT - STATUS, A CHAR. ITEM TO CONTAIN JDATE ON EXIT
 
 
 JDATE    SUBR   =
          SB1    1
          BX5    X1 
          JDATE  X1 
          SA1    X5 
          BX6    X1          RETURN JULIAN DATE AS FUNCTION RESULT
          JP     JDATEX 
 
          END 
          IDENT  LOADOVL
          ENTRY  LOADOVL
 LOADOVL  SUBR   =
          SA2    A1 
          SA2    X2          OVERLAY NAME IN X2 
          SA3    A1+1 
          SA3    X3          LEVEL 1 IN X3
          LX3    12          SHIFT LEFT 12 BITS 
          BX2    X2+X3       STORE LEVEL 1 IN X2
          SX3    A1+2 
          SA3    X3          LEVEL 2 IN X3
          BX1    X2+X3       X1 IS OVERLAY NAME/LEVEL 1/LEVEL 2 
          SX0    A1          SAVE ADDRESS OF PARAMETER LIST 
          RJ     =XFOL.LOV   CALL FAST OVERLAY LOADER 
          SX7    B7          STORE FWA OF OVERLAY IN X7 
          SA2    X0+3        STORE ADDRESS OF RETURN VARIABLE 
          SA7    X2          RETURN FWA OF OVERLAY
          EQ     LOADOVL
          END 
          IDENT  LOADREQ
          ENTRY  LOADREQ
          B1=1
          LIST   F
          TITLE  LOADREQ - CALL SYSTEM LOADER VIA PPU.
          COMMENT   CALL SYSTEM LOADER VIA PPU. 
 LOADREQ  SPACE  4,8
***       LOADREQ - CALL SYSTEM LOADER VIA PPU. 
* 
*         CALL LOADREQ (LIST) 
* 
*         ENTRY  SEE LOADER REFERENCE MANUAL
* 
*         LOADREQ(LIST);  ( SYMPL CALL )
* 
* 
*         EXIT   SEE LOADER REFERENCE MANUAL
 
 
 LOADREQ  SUBR   =
          SB1    1
          SYSTEM LDR,RCL,X1 
          JP     LOADREQX 
 
          END 
          IDENT  MEMORY 
          ENTRY  MEMORY 
          B1=1
          LIST   F
          TITLE  MEMORY - REQUEST MEMORY. 
          COMMENT   REQUEST MEMORY. 
 MEMORY   SPACE  4,10 
***       MEMORY - REQUEST MEMORY.
* 
*         CALL MEMORY (TYPE,STATUS) 
* 
*         ENTRY  (TYPE) = 2HCM OR 3HSCM  OR  3HECS OR 3HLCM 
*                (STATUS) = 30/N,30/0   N=AMOUNT REQUESTED
* 
*         MEMORY(TYPE,STATUS);  ( SYMPL CALL )
* 
*         ENTRY - TYPE, AN ITEM CONTAINING A "CM" OR "SCM", LEFT
*                       JUSTIFIED, BLANK FILLED 
*                 STATUS, AN ITEM CONTAINING THE MEMORY REQ. STATUS 
*                         WORD
* 
*         EXIT   TO ARGUMENT-ERROR PROCESSOR IF OPTION IS UNRECOGNIZED
*         ELSE   IF N = 0, CURRENT AMOUNT ASSIGNED IS RETURNED IN 
*                          BITS 59-30 OF STATUS WORD
* 
*         DAYFILE MESSAGES
*                *MAX FIELD LENGTH EXCEEDED, JOB ABORTED.*
*                            IF THE FIELD LENGTH RETURNED IS SMALLER
*                            THAN THE REQUESTED FIELD LENGTH. 
 
 
 MEMORY   SUBR   =
          SB1    1
          SA2    X1          TYPE 
          SA1    A1+1        ADDRESS OF STATUS WORD 
          SA5    X1 
          MX0    30 
          BX6    X0*X5       STATUS WORD TO X6
          BX6    X6+X1       SAVE STATUS ADDRESS IN LOWER 30
          SA6    SCRT 
          SA3    =0HCM
          SA4    =0HSCM 
          BX3    X2-X3
          BX4    X2-X4
          BX5    X3*X4
          ZR,X5  MEM1        IF CM OR SCM 
          SA3    =0HECS 
          SA4    =0HLCM 
          BX3    X2-X3
          BX4    X2-X4
          BX5    X3*X4
          ZR,X5  MEM2        IF ECS OR LCM
          BX2    X1 
          SA1    =0LMEMORY
          RJ     =XMACREL=   DIAGNOSE ILLEGAL ARGUMENT
          JP     MEMORYX
 
MEM1      MEMORY CM,X1,RCL,,NA
          JP     ERRTST 
 
MEM2      MEMORY ECS,X1,RCL,,NA 
 
ERRTST    BSS    0
          SA5    SCRT        OLD FIELD LENGTH TO X5 
          SA3    X5          NEW FL TO X3 
          MX6    30 
          BX5    X5*X6       USE ONLY THE UPPER HALF-WORD 
          BX3    X3*X6
          IX5    X3-X5
          NG     X5,ERR1     IF NEW FL LT OLD THEN MESSAGE
          JP     MEMORYX
 
ERR1      MESSAGE TAG 
          ABORT 
 
TAG       DATA   C*MAX FIELD LENGTH EXCEEDED, JOB ABORTED.* 
SCRT      BSS    1
          END 
          IDENT  MESSAGE
          ENTRY  MESSAGE
          B1=1
          LIST   F
          TITLE  MESSAGE - SEND MESSAGE.
          COMMENT   SEND MESSAGE. 
 MESSAGE  SPACE  4,10 
***       MESSAGE - SEND MESSAGE. 
* 
*         CALL MESSAGE (TEXT,OPTION)
* 
*         ENTRY  (TEXT) = MESSAGE ARRAY, TERMINATED BY ZERO BYTE
*                (OPTION) = 0, SEND MESSAGE TO SYSTEM DAYFILE,
*                              LOCAL JOB DAYFILE, AND A AND B DISPLAYS
*                         = 1, SEND MESSAGE TO LINE 1 OF CONTROL POINT
*                         = 2, SEND MESSAGE TO LINE 2 OF CONTROL POINT
*                         = 3, SEND MESSAGE TO USER DAYFILE AND LINE
*                              1 OF CONTROL POINT 
*                         = 4, SEND MESSAGE TO ERROR LOG DAYFILE
*                         = 5, SEND MESSAGE TO ACCOUNT DAYFILE
*                         = 6, SAME AS 0
*                         = 7, SAME AS 3
*                         = 5HLOCAL, SEND MESSAGE TO LOCAL JOB DAYFILE
* 
*         MESSAGE(TEXT,OPTION);  ( SYMPL CALL ) 
* 
*         ENTRY - TEXT, AN ARRAY WITH THE TEXT IN IT, OR AN ITEM
*                       WITH TEXT IN IT 
*                 OPTION, AN ITEM CONTAINING ONE OF THE OPTIONS 
 
 
 
 
 MESSAGE  SUBR   =
          SB1    1
          SA2    A1+1        ADDRESS OF OPTION
          SA2    X2          OPTION 
          SA3    =0HLOCAL 
          BX4    X2-X3
          ZR,X4  MES2        IF LOCAL 
          MESSAGE X1,X2 
          JP     MESSAGEX 
 
 
 MES2     MESSAGE X1,LOCAL
          JP     MESSAGEX 
 
          END 
          IDENT  MOVE 
          ENTRY  MOVE 
          ENTRY  MOVEI
          B1=1
          TITLE  MOVE - MOVE BLOCK OF CENTRAL MEMORY WORDS. 
          COMMENT  MOVE BLOCK OF CENTRAL MEMORY WORDS.
 MOVE     SPACE  4,10 
***       MOVE - MOVE BLOCK OF CENTRAL MEMORY WORDS, DIRECT ADDRESSING. 
* 
*         CALL MOVE (COUNT,FROM,TO) 
* 
*         ENTRY  (COUNT) = COUNT OF WORDS TO MOVE 
*                (FROM) = FIRST WORD OF THE *FROM* BLOCK
*                (TO) = FIRST WORD OF THE *TO* BLOCK
* 
*         MOVE(COUNT,FROM,TO);  ( SYMPL CALL )
* 
*         ENTRY - COUNT, AN ITEM THAT CONTAINS THE NUMBER OF WORDS TO 
*                        MOVE 
*                 FROM, AN ARRAY TO MOVE FROM 
*                 TO, AN ARRAY TO MOVE TO 
 
 
 MOVE     SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SA2    A1+B1       (X2) = FROM FWA
          SA3    A2+B1       (X3) = TO FWA
          SA1    X1          (X1) = COUNT 
          SX2    X2 
          SX3    X3          CLEAR UPPER BITS 
          SX1    X1 
          MOVE   X1,X2,X3    MOVE DATA
          JP     MOVEX       RETURN 
 MOVEI    SPACE  4,10 
***       MOVEI - MOVE BLOCK OF CENTRAL MEMORY WORDS, INDIRECT ADDRESS. 
* 
*         CALL MOVEI (COUNT,LOC(FROM),LOC(TO))
* 
*         ENTRY  (COUNT) = COUNT OF WORDS TO MOVE 
*                (FROM) = FIRST WORD OF THE *FROM* BLOCK
*                (TO) = FIRST WORD OF THE *TO* BLOCK
*                LOC = LOCATION OF
* 
*         MOVEI(COUNT,FROM,TO);  ( SYMPL CALL ) 
* 
*         ENTRY - COUNT, AN ITEM THAT CONTAINS THE NUMBER OF WORDS TO 
*                        MOVE 
*                 FROM, AN ITEM THAT CONTAINS THE ADDRESS OF WHERE TO 
*                       MOVE FROM, OR A LOC OF AN ARRAY 
*                 TO, AN ITEM THAT CONTAINS THE ADDRESS OF WHERE TO 
*                     MOVE TO, OR A LOC OF AN ARRAY 
 
 
 MOVEI    SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SA2    A1+B1       (X2) = LOC (FROM FWA)
          SA3    A2+B1       (X3) = LOC (TO FWA)
          SA1    X1          (X1) = COUNT 
          SA2    X2          (X2) = FROM FWA
          SA3    X3          (X3) = TO FWA
          SX1    X1 
          SX2    X2          CLEAR UPPER BITS 
          SX3    X3 
          MOVE   X1,X2,X3    MOVE DATA
          JP     MOVEIX       RETURN
 
          END 
          EJECT 
          IDENT  PDATE
          ENTRY  PDATE
          B1=1
          LIST   F
          COMMENT   OBTAIN PACKED DATE. 
          SPACE 4 
***       PDATE - OBTAIN PACKED DATE. 
* 
*         CALL DATE (STATUS)
* 
*         ENTRY NONE
* 
*         EXIT   (STATUS) = PACKED DATE AND TIME
* 
*         PDATE(STATUS);  ( SYMPL CALL )
* 
 
 PDATE    SUBR   =
          SB1    1
          BX5    X1 
          PDATE  X1 
          SA1    X5 
          BX6    X1 
          EQ     PDATEX 
 
          END 
          IDENT  PURGE
          B1=1
          LIST   F
          TITLE  PURGE - PURGE A PERMANENT FILE.
          COMMENT   PURGE A PERMANENT FILE. 
          IPARAMS 
 PURGE    SPACE  4,10 
 NOSPFM   IFC    EQ,*"OS.NAME"*KRONOS*
*         NOS PERMANENT FILE MANAGER SYMPL INTERFACE ROUTINES 
* 
*         PURGE(LFN,UN,PW)
* 
*                LFN - LOGICAL FILE NAME, LEFT JUSTIFIED, ZERO FILLED,
*                      SEVEN CHARACTER MAXIMUM
*                PFN - PERMANENT FILE NAME, SAME CHARACTERISTICS AS LFN 
*                UN  - USER NUMBER, SAME CHARACTERISTICS AS PFN,LFN 
*                PW  - PASSWORD, SAME CHARACTERISTICS AS UN,PFN,LFN 
*                M   - FILE ACCESS MODE 
*                      = 0, READ/WRITE
*                      = 1, READ
* 
*         THESE ARE SYMPL FUNCTIONS AND WILL RETURN THE STATUS
*         FROM WORD 0, BITS 17-10.  SEE NOS REFERENCE MANUAL, VOL. 2
*         CHAPTER  5, FOR THE PFM ERROR CODE. ZERO IS SUCCESSFUL
*         COMPLETION
* 
 PFMFET   FILEB  DUMMY,DUMMYL,EPR,(FET=14D)    DUMMY PFM FET
 DUMMYL   EQU    0
 DUMMY    BSS    0
 PFMUN    EQU    PFMFET+9D   FET ALTERNATE USER NUMBER WORD 
 PFMERD   EQU    PFMFET+10D  ERROR ADDRESS WORD IN FET
 PFMERAD  BSSZ   3           PUT ERROR MESSAGE HERE/NOT DAYFILE 
          SPACE  4,15 
***       PURGE - PURGES A NOS PERMANENT FILE 
* 
*         SYMPL CALL - STATUS = PURGE(LFN,UN,PW)
* 
* 
          ENTRY  PURGE
 PURGE    SUBR   =           ENTRY/EXIT 
          SB1    1
          SA5    PFMFET      GET CONTENTS OF FET+0
          SA4    X1          GET LFN
          MX0    -18         SET MASK 
          BX6    X0*X4
          BX7    -X0*X5      MASK OLD LFN, LEAVE LOWER 18 BITS
          BX6    X6+X7       PUT FET+0 TOGETHER 
          SA6    A5          PUT LFN IN FET+0 
          SX7    PFMERAD     ADDRESS OF MSG BUFFER
          SA5    A1+B1       ADDRESS OF UN IN X5
          SA3    X5          GET UN 
          BX3    X0*X3       X3 = UN
          SA6    PFMFET      PUT LFN IN FET+0 
          SA4    A5+B1       ADDRESS OF PW IN X4
          MX6    42          SET MASK 
          SA2    X4          GET PW 
          SA4    PFMERD      FETCH ERROR ADDRESS WORD FROM FET
          BX2    X0*X2       X2 = PW
          BX4    X6*X4       CLEAR OLD ADDRESS
          BX7    X7+X4       PUT NEW ONE IN 
          SA7    A4          STORE BACK IN FET
          PURGE  PFMFET,X3,X2 
          SA1    PFMFET      GET FET+0
          MX0    -8 
          AX1    10          RIGHT JISTIFY BITS 17-10 
          BX6    -X0*X1      ISOLATE ERROR CODE IN X6 
          JP   PURGEX 
 NOSPFM   ENDIF 
          END 
          IDENT  RECALL 
          ENTRY  RECALL 
          B1=1
          LIST   F
          TITLE  RECALL - PLACE PROGRAM IN RECALL STATUS. 
          COMMENT   PLACE PROGRAM IN RECALL STATUS. 
 RECALL   SPACE  4,10 
***       RECALL - PLACE PROGRAM IN RECALL STATUS.
* 
*         CALL RECALL (STATUS)
* 
*         ENTRY  (STATUS) = 0, ONE SYSTEM PERIODIC RECALL IS ISSUED 
*                         = OTHER, PROGRAM IS RECALLED WHEN BIT 0 IS SET
* 
*         RECALL(STATUS);  ( SYMPL CALL ) 
* 
*         ENTRY -  STATUS, AN ITEM THAT IS 0 OR THE COMPLETE BIT WORD 
*         EXIT   NONE IF (STATUS) =0
*         ELSE   BIT 0 OF STATUS IS SET 
 
 
 RECALL   SUBR   =
          SB1    1
          SA2    X1          STATUS WORD
          ZR,X2  REC1        IF SINGLE RECALL 
          RECALL X1          ELSE, AUTO-RECALL
          JP     RECALLX
 
 REC1     RECALL
          JP     RECALLX
 
          END 
          IDENT  REQUEST
          ENTRY  REQUEST
          B1=1
          LIST   F
          TITLE  REQUEST - REQUEST ASSIGNMENT OF EQUIPMENT TO FILE. 
          COMMENT   REQUEST ASSIGNMENT OF EQUIPMENT TO FILE.
 REQUEST  SPACE  4,10 
***       REQUEST - REQUEST ASSIGNMENT OF EQUIPMENT TO FILE.
* 
*         CALL REQUEST (LIST) 
* 
*         ENTRY  SEE SYSTEM REFERENCE MANUAL
* 
*         REQUEST(LIST);  ( SYMPL CALL )
* 
*         ENTRY - AN ARRAY CONTAINING A REQUEST LIST, SEE OPERATING 
*                 SYSTEM REFERENCE MANUAL 
 
 
 REQUEST  SUBR   =
          SB1    1
          REQUEST X1
          JP     REQUESTX 
 
          END 
          IDENT  RTIME
          ENTRY  RTIME
          B1=1
          LIST   F
          TITLE  RTIME - OBTAIN REAL TIME CLOCK READING.
          COMMENT   OBTAIN REAL TIME CLOCK READING. 
 RTIME    SPACE  4,10 
***       RTIME - OBTAIN REAL TIME CLOCK READING. 
* 
*         CALL RTIME (STATUS) 
* 
*         ENTRY  NONE 
* 
*         EXIT   (STATUS) = RESPONSE
*         NOS RESPONSE -
**T       24/ SECONDS,36/ MILLISECONDS
* 
*         NOSBE RESPONSE -
**T       24/ JUNK,24/ SECONDS,12/ QM 
* 
*         TIME IS SYSTEM SOFTWARE CLOCK TIME SINCE DEADSTART
*         QM = 1/4096 OF A SECOND 
* 
*         RTIME(STATUS);  ( SYMPL CALL )
* 
*         EXIT - STATUS, AN ITEM THAT WILL CONTAIN THE RTIME STATUS 
*                        WORD ON EXIT 
 
 
 RTIME    SUBR   =
          SB1    1
          BX5    X1 
          RTIME  X1 
          SA1    X5 
          BX6    X1          RETURN RESPONSE AS FUNCTION RESULT 
          JP     RTIMEX 
 
          END 
          IDENT  SETUI
          ENTRY  SETUI
          B1=1
          COMMENT SETUI - SET USER INDEX
          TITLE  SETUI - SET USER INDEX 
          SPACE  4
***       SETUI - SET USER INDEX. 
* 
* 
*         SETUI  N
* 
*         ENTRY  *N* = USER INDEX.
* 
 SETUI    SUBR   =
          SB1    1
          SA1    X1 
          SETUI  X1 
          JP     SETUIX 
          END 
          IDENT  GETPFP 
          ENTRY  GETPFP 
          B1=1
          COMMENT GETPFP - GET PERMANENT FILE PARAMETERS. 
          SPACE  4,10 
***       GETPFP - GET PERMANENT FILE PARAMETERS. 
*                  CPM 57(8) CALL.
* 
*         GETPFP ADDR 
* 
*         ENTRY  *ADDR* = ADDRESS TO RECEIVE THE PARAMETER
*                         BLOCK.
* 
*         EXIT   PARAMETERS RETURNED IN PARAMETER BLOCK WHICH 
*                HAS THE FOLLOWING FORMAT - 
* 
*         42/ FAMILY NAME, 18/0 
*         42/ PACK NAME,   18/DEVICE TYPE 
*         42/ USER NAME,   18/USER INDEX
* 
 
 GETPFP   SUBR   =
          SB1    1
          SA1    A1 
          GETPFP X1 
          JP     GETPFPX
          END 
          IDENT  SETPFP 
          ENTRY  SETPFP 
          B1=1
          COMMENT SETPFP - SET PERMANENT FILE PARAMETERS. 
          SPACE  4,10 
***       SETPFP - SET PERMANENT FILE PARAMETERS. 
*                  CPM 60(8) CALL.
* 
*         SETPFP ADDR 
* 
*         ENTRY  *ADDR* = ADDRESS OF PARAMETER BLOCK WHICH HAS
*                         THE FOLLOWING FORMAT -
* 
*         42/ FAMILY NAME, 14/ , 4/FG 
*         42/ PACK NAME,   18/PACK TYPE 
*         42/ USER NAME,   18/USER INDEX
* 
*         FG = FLAG BITS DENOTING WHICH FIELDS TO SET.
*              BIT 3 - FAMILY NAME. 
*              BIT 2 - PACK NAME. 
*              BIT 1 - USER NAME. 
*              BIT 0 - USER INDEX.
* 
*         EXIT   PARAMETERS SET IN CONTROL POINT AREA IF FLAGGED. 
*                STATUS OF SPECIFIED FAMILY RETURNED AS FOLLOWS - 
* 
*         42/ FAMILY NAME, 6/ST, 8/0, 4/FG
*         ST = 0 IF FAMILY NAME SET IN CONTROL POINT AREA.
*            = 1 IF SPECIFIED FAMILY WAS NOT FOUND (CURRENT 
*              FAMILY REMAINS UNCHANGED). 
* 
 
 SETPFP   SUBR   =
          SB1    1
          SA1    A1 
          SETPFP X1 
          JP     SETPFPX
          END 
          IDENT  SYSTEM 
          ENTRY  SYSTEM 
          B1=1
          LIST   F
          TITLE  SYSTEM - REQUEST SYSTEM FUNCTION.
          COMMENT   REQUEST SYSTEM FUNCTION.
 SYSTEM   SPACE  4,10 
***       SYSTEM - REQUEST SYSTEM FUNCTION. 
* 
*         CALL SYSTEM (ARGUMENT)
* 
*         ENTRY  (ARGUMENT) = 3 CHARACTER SYSTEM REQUEST NAME,
*                             INCLUDING OPTIONAL PARAMETERS 
* 
*         SYSTEM(ARGUMENT);  ( SYMPL CALL ) 
* 
*         ENTRY - ARGUMENT, AN ITEM CONTAINING THE REQUEST ARGUMENT 
* 
*         EXIT   DEPENDS ON CALL, SEE SYSTEM REFERENCE MANUAL 
 
 
 SYSTEM   SUBR   =
          SB1    1
          SA1    X1          SYSTEM REQUEST 
          BX6    X1 
          SYSTEM
          JP     SYSTEMX
 
          END 
          IDENT  TIME 
          ENTRY  TIME 
          B1=1
          LIST   F
          TITLE  TIME - OBTAIN ACCUMULATED CPU TIME.
          COMMENT   OBTAIN ACCUMULATED CPU TIME.
 TIME     SPACE  4,10 
***       TIME - OBTAIN ACCUMULATED CPU TIME. 
* 
*         CALL TIME (STATUS)
* 
*         ENTRY  NONE 
* 
*         EXIT   (STATUS) = RESPONSE
*         NOS RESPONSE -
**T       12/ 2000B,12/0,24/ SECONDS,12/ MILLISECONDS 
* 
*         NOSBE RESPONSE -
**T       24/ TIME LIMIT (SECONDS),24/ SECONDS,12/ MILLISECONDS 
* 
*         TIME(STATUS);  ( SYMPL CALL ) 
* 
*         EXIT - STATUS, AN ITEM THAT WILL CONTAIN THE TIME STATUS WORD 
*                        ON EXIT
 
 
 TIME     SUBR   =
          SB1    1
          BX5    X1 
          TIME   X1 
          SA1    X5 
          BX6    X1          RETURN CPU TIME AS FUNCTION RESULT 
          JP     TIMEX
 
          END 
          IDENT  TRANSF 
          ENTRY  TRANSF 
          B1=1
          LIST   F
          TITLE  TRANSF - TRANSFER TO DEPENDENT JOBS. 
          COMMENT   TRANSFER TO DEPENDENT JOBS. 
          IPARAMS 
 TRANSF   SPACE  4,10 
***       TRANSF - TRANSFER TO DEPENDENT JOBS.
*         NOSBE ONLY. 
* 
*         CALL TRANSF (LIST)
* 
*         ENTRY  (LIST) = LIST OF JOBNAMES WHOSE DEPENDENCY COUNTS ARE
*                         TO BE DECREMENTED. TERMINATED BY A ZERO WORD. 
* 
*         TRANSF(LIST);  ( SYMPL CALL ) 
 
 
 TRANSF   SUBR   =
          SB1    1
 SCPNOS   IFC    EQ,*"OS.NAME"*NOSBE *
          SX6    A0 
          SA6    TRAA 
          TRANSF X1 
          SA1    TRAA 
          SA0    X1 
 SCPNOS   ELSE
          SA1    =0LTRANSF
          RJ     =XMACREL.   DIAGNOSE UNDEFINED MACRO 
 SCPNOS   ENDIF 
          JP     TRANSFX
 
 TRAA     CON    0
 
          END 
          IDENT  VERSION
          ENTRY  VERSION
          B1=1
          LIST   F
          COMMENT  GET OPERATING SYSTEM VERSION.
          SPACE  4
***       VERSION - GET OPERATING SYSTEM VERSION. 
* 
*         VERSION(ADDR);    (SYMPL CALL)
* 
*         ENTRY  ADDR  12/BC,12/SB,12/BP,6/0,18/WADDR 
* 
*         BC = NUMBER OF BYTES (1-10)TO RETURN FROM TWO-WORD
*              SOURCE FIELD (CM LOCATION CONTAINING VERSION 
*              NAME)
* 
*         SB = BYTE IN SOURCE FIELD TO BEGIN TRANSFER AT (0 TO 9);
*              THE SUM OF BC AND SB MUST BE LESS THAN 11. 
* 
*         BP = BYTE POSITION WITHIN RECEIVING FIELD (WADDR) 
*              TO BEGIN TRANSFER AT (0 TO 4)
* 
*         WADDR = BEGINNING ADDRESS OF THREE WORD BLOCK TO
*                 RECEIVE DATA
* 
 
 VERSION  BSS    1
          SB1    1
          VERSION X1
          EQ     VERSION
          END 
          IDENT  XREL 
          ENTRY  XREL.
          ENTRY  XREL=
          B1=1
          LIST   F
          TITLE  XREL - COMMON DECK INTERFACE ROUTINES. 
          COMMENT  COMMON DECK INTERFACE ROUTINES.
          IPARAMS 
 XREL     SPACE  4,10 
***       XREL - COMMON DECK INTERFACE ROUTINES.
* 
*         T. R. RAMSEY.      76/08/08.
*         M. D. PICKARD      77/03/11 
*                            ADDED XCHD TO CONVERT HEX TO DISPLAY 
*                            ADDED XWOD TO CONVERT ONE 60 BIT WORD
*                            TO TWO 10 CHAR DISPLAY CODE WORDS
*                            ADDED SYMPL CALLING SEQUENCE TO IMS
* 
*         COPYRIGHT CONTROL DATA SYSTEMS INC. 1994
 XREL     SPACE  4,10 
***              XREL IS A COLLECTION OF RELOCATABLE MODULES THAT 
*         PROVIDE THE INTERFACE BETWEEN HIGHER LEVEL LANGUAGE MODULES 
*         AND THE STANDARD COMMON DECK ROUTINES THAT ARE NOT CALLED 
*         BY SYSTEM MACROS. 
 XREL     SPACE  4,10 
 KRNNOS   IFC    EQ,*"OS.NAME"*KRONOS*,1
 LOCAL    EQU    3
 XREL.    SPACE  4,10 
**        XREL. - UNDEFINED COMMON DECK PROCESSOR.
* 
*         ENTRY  (X1) = LAST 3 CHARACTERS OF COMMON DECK NAME IN 0L FORM
* 
*         EXIT   DOES NOT EXIT
* 
*         USES   A6  B1  X6 
* 
*         CALLS  NONE 
* 
*         NEEDS  MACROS ABORT, MESSAGE
 
 
 XREL.    SUBR   =           ENTRY/EXIT 
          SB1    1
          BX6    X1 
          SA6    XREA+3 
          MESSAGE  XREA,LOCAL,RCL 
          ABORT 
          JP     XREL.X 
 
 XREA     DATA   C* XREL - UNDEFINED ROUTINE -   FILL-IN.*
 XREL=    SPACE  4,10 
**        XREL= - ILLEGAL ARGUMENT PROCESSOR. 
* 
*         ENTRY  (X1) = LAST 3 CHARACTERS OF COMMON DECK NAME IN 0L FORM
*                (X2) = ILLEGAL ARGUMENT
* 
*         EXIT   DOES NOT EXIT
* 
*         USES   A6  B1  X0,X1,X2,X6
* 
*         CALLS  SFW
* 
*         NEEDS  MACROS ABORT, MESSAGE
 
 
 XREL=    SUBR   =           ENTRY/EXIT 
          SB1    1
          BX0    X2          SAVE SECOND ARGUMENT 
          LX1    -6 
          SX2    1R-
          BX1    X1+X2
          RJ     =XZTB= 
          BX1    X0 
          SA6    XREB 
          RJ     =XZTB= 
          SA6    XREB+3 
          MESSAGE  XREB,LOCAL,RCL 
          ABORT 
          JP     XREL=X 
 
 XREB     DATA   C* FILL-IN - ILLEGAL ARGUMENT  >FILL-IT-IN<.*
 
          END 
          IDENT  XCDD 
          ENTRY  XCDD 
          B1=1
          LIST   F
          TITLE  XCDD - CONVERT INTEGER TO DECIMAL DISPLAY CODE.
          COMMENT   CONVERT INTEGER TO DECIMAL DISPLAY CODE.
 XCDD     SPACE  4,10 
***       XCDD - CONVERT INTEGER TO DECIMAL DISPLAY CODE. 
* 
*         HOLLERITH = XCDD (INTEGER)
* 
*         XX = XCDD(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 
 
 
 XCDD     SUBR   =           ENTRY/EXIT 
          SB1    1
          SA1    X1+
          RJ     =XCDD= 
          JP     XCDDX       RETURN, RESULT IN X6 
 
          END 
          IDENT  XCFD 
          ENTRY  XCFD 
          B1=1
          LIST   F
          TITLE  XCFD - CONVERT INTEGER TO F10.3 FORMAT.
          COMMENT   CONVERT INTEGER TO F10.3 FORMAT.
 XCFD     SPACE  4,10 
***       XVFD - CONVERT INTEGER TO F10.3 FORMAT. 
* 
*         HOLLERITH = XCFD (INTEGER)
* 
*         XX = XCFD(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 
 
 
 XCFD     SUBR   =           ENTRY/EXIT 
          SB1    1
          SA1    X1+
          RJ     =XCFD=          CONVERT
          JP     XCFDX       RETURN, RESULT IN X6 
 CFD      SPACE  4,10 
          END 
          IDENT  XCHD 
          ENTRY  XCHD 
          B1=1
          LIST   F
          TITLE  XCHD - CONVERT HEXIDECIMAL INTEGER TO DISPLAY CODE.
          COMMENT  CONVERT HEXIDECIMAL INTEGER TO DISPLAY CODE. 
          SPACE  4,10 
***       XCHD - CONVERT HEXIDECIMAL INTEGER TO DISPLAY CODE. 
* 
*         CONVERT RIGHT MOST 40 BITS OF A BINARY WORD ( 10/4 BIT
*         HEX DIGITS) TO 10 HEXIDECIMAL DISPLAY CODE CHARACTERS 
*         ( LEFT ZEROES SUPPRESSED )
* 
*         XX = XCHD(YY);     ( SYMPL CALL ) 
* 
*         ENTRY - XY, AN ITEM CONTAINING THE WORD TO BE CONVERTED 
* 
*         EXIT - XX, HEX DISPLAY CODE EQUIVILENCE OF THE RIGHT MOST 
*                    10 HEX DIGIT IN YY 
 
 
 XCHD     SUBR   =           ENTRY/EXIT 
          SB1    1           B1=1 
          SA4    XCHDA       =1H
          SA1    X1          (X1) = HEXIDECIMAL INTEGER IN BINARY 
          MX2    -40         RIGHT MOST 40 BITS MASK
          BX1    -X2*X1      EXTRACT RIGHT MOST 40 BITS 
          SB7    1R0         (B7) = CHARACTER ZERO
          MX2    -4          (X2) = DIGIT MASK
          SB3    6           (B3) = SHIFT COUNT FOR EACH CHARACTER
          SB6    1R          (B6) = CHARACTER BLANK 
          SB5    1R9         (B5) = CHARACTER 9 
          SB2    -B3         INITIALIZE SHIFT COUNT 
          SB4    B7-B6       (B4) = CONVERSION VALUE FOR NUMERIC
 XCHD1    BSS    0
          BX7    -X2*X1      EXTRACT DIGIT
          SX5    X7+B7       ADD CHAR. ZERO TO DIGIT
          SB2     B2+B3      BUMP JUSTIFY COUNT 
          LX4     -6         SHIFT ASSEMBLY 
          SX3     X7+B4      CONVERT DIGIT ( W/BLANK BIAS ) 
          AX1    4           SHIFT OFF DIGIT FROM INPUT WORD
          SX5     X5-1R9     SEE IF CHARACTER GREATER THAT NINE 
          NG   X5,XCHD2      IF LESS THAN NINE
          ZR   X5,XCHD2      IF EQUAL TO NINE 
          SX3    X5-1R       BIAS DIGIT BY CHAR. BLANK INVERSE
 XCHD2    BSS     0 
          IX4     X4+X3      ADD DIGIT TO ASSEMBLY
          NZ   X1,XCHD1      LOOP TO ZERO DIGIT 
          LX6     X4,B2      RIGHT JUSTIFY ASSEMBLY 
          JP      XCHDX 
 XCHDA    CON     1H
          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  XSFN 
          ENTRY  XSFN 
          B1=1
          LIST   F
          TITLE  XSFN - SPACE FILL NAME.
          COMMENT   SPACE FILL NAME.
 XSFN     SPACE  4,10 
***       XSFN - SPACE FILL NAME. 
* 
*         HOLLERITH = XSFN (NAME) 
* 
*         XX = XSFN(NAME);   ( SYMPL CALL ) 
* 
*         ENTRY - NAME, AN ITEM CONTAINING THE NAME, LEFT JUSTIFIED,
*                       ZERO FILLED 
* 
*         EXIT - XX, A CHAR. ITEM TO CONTAIN DISPLAY CODE ON EXIT 
 
 
 XSFN     SUBR   =           ENTRY/EXIT 
          SB1    1
          SA1    X1+
          RJ     =XSFN=       SPACE FILL NAME 
          JP     XSFNX       RETURN, RESULT IN X6 
 SFN      SPACE  4,10 
          END 
          IDENT  XSFW 
          ENTRY  XSFW 
          B1=1
          LIST   F
          TITLE  XSFW - SPACE FILL WORD.
          COMMENT   SPACE FILL WORD.
 XSFW     SPACE  4,10 
***       XSFW - SPACE FILL WORD. 
* 
*         HOLLERITH = XSFW (WORD) 
* 
*         XX = XSFW(WORD) 
* 
*         ENTRY - WORD, AN ITEM CONTAINING TO WORD TO CHANGE ZEROES TO
*                       BLANKS
* 
*         EXIT - XX, A CHAR. ITEM TO CONTAIN DISPLAY CODE ON EXIT 
 
 
 XSFW     SUBR   =           ENTRY/EXIT 
          SB1    1
          SA1    X1+
          RJ     =XZTB=       SPACE FILL WORD 
          JP     XSFWX       RETURN, RESULT IN X6 
 
          END 
          IDENT  XWHD 
          ENTRY  XWHD 
          B1=1
          LIST   F
          TITLE  XWHD - CONVERT HEXIDECIMAL WORD TO DISPLAY CODE. 
          COMMENT  CONVERT HEXIDECIMAL WORD TO DISPLAY CODE.
          SPACE  4,10 
***       XWHD - CONVERT HEXIDECIMAL WORD TO DISPLAY CODE.
* 
*         CONVERT A 60 BIT BINARY WORD (15/4 BIT HEX DIGITS) TO 
*         TWO WORDS OF HEXIDECIMAL DISPLAY CODE CHARACTERS ( THE
*         SECOND WORD IS BLANK FILLED TO THE RIGHT) 
* 
*         XWHD (W,A);        (SYMPL CALL) 
* 
*         ENTRY - W,  AN ITEM CONTAINING THE WORD TO BE CONVERTED 
* 
*         EXIT - A , HEX DISPLAY CODE EQUIVILENCE OF THE 15 HEX 
*                    DIGITS IN W, THE LEFT 10 DIGITS IN A AND 
*                    THE RIGHT 5 DIGITS LEFT JUSTIFIED, BLANK 
*                    FILLED IN A + 1
 
 
 XWHD     SUBR   =           ENTRY/EXIT 
          SB1    1           B1=1 
          SA4    XCHDB       10H    00000 
          SB5    A1          SAVE (A1)
          SA1    X1          (X1) = HEXIDECIMAL INTEGER IN BINARY 
          SB3    6           (B3) = SHIFT COUNT FOR EACH CHARACTER
          SB2    24          INITIALIZE SHIFT COUNT 
          RJ     XCHD        CONVERT LOWER 5 DIGITS 
          SA3    B5+B1       FETCH LOCATION OF RETURN PARAMETER 
          SA6    X3+B1       STORE LOWER 5 CHARACTERS 
 
          SB2    -B3         INITIALIZE COUNT FOR LEFT 10 DIGITS
          SA4    XCHDA       10H0000000000
          RJ     XCHD        CONVERT UPPER 10 DIGITS
          SA6    X3          STORE UPPER 10 CHARACTERS
          JP     XWHDX       RETURN 
 
 XCHD     BSSZ   1
 XCHD1    BSS    0
          MX2    -4          (X2) = DIGIT MASK
          BX7    -X2*X1      EXTRACT DIGIT
          LX4     -6         SHIFT ASSEMBLY 
          AX1    4           SHIFT OFF DIGIT FROM INPUT WORD
          SX5     X7-9       SEE IF CHARACTER GREATER THAT NINE 
          NG   X5,XCHD2      IF LESS THAN NINE
          ZR   X5,XCHD2      IF EQUAL TO NINE 
          SX7    X5-1R0      BIAS DIGIT BY CHAR. ZERO INVERSE 
 XCHD2    BSS     0 
          IX4     X4+X7      ADD DIGIT TO ASSEMBLY
          SB2     B2+B3      BUMP JUSTIFY COUNT 
          SB4    B2-54
          NZ     B4,XCHD1    NOT END OF WORD
          LX6    X4,B2       RIGHT JUSTIFY WORD 
          EQ     XCHD 
 
 XCHDA    CON    10H0000000000
 XCHDB    CON    10H    00000 
 
          END 
          IDENT  XWOD 
          ENTRY  XWOD 
          B1=1
          LIST   F
          TITLE  XWOD - CONVERT WORD TO OCTAL DISPLAY CODE. 
          COMMENT CONVERT WORD TO OCTAL DISPLAY CODE. 
 XWOD     SPACE  4,8
***       XWOD - CONVERT WORD TO OCTAL DISPLAY CODE 
* 
*         M. D. PICKARD.     77/03/15 
* 
*         SYMPL CALLABLE ROUTINE TO CONVERT ONE 60 BIT WORD INTO
*         TWO 60 BIT WORDS CONTAINING THE THE OCTAL REPRESENTATION
*         OF THE INPUT WORD.
* 
*         XWOD(W,A);         ( SYMPL CALL ) 
* 
*         ENTRY - W, AN ITEM THAT CONTAINS THE WORD TO BE CONVERTED 
*                 A, A 20 CHARACTER BUFFER FWA
*                    ( AN ARRAY OR ITEM 20 CHARACTERS LONG )
* 
*         EXIT - A AND A+1, CONTAIN CONVERTED WORD
 
 
 XWOD     SUBR   =           ENTRY/EXIT 
          SB1    1           (B1) = 1 
          SB7    A1          SAVE (A1)
          SA1    X1          FETCH W
          RJ     =XWOD= 
          SA2    B7+B1       FETCH LOC (A)
          SA6    X2          STORE UPPER 10 CHARACTERS
          SA7    X2+B1       STORE LOWER 10 CHARACTERS
          JP     XWODX       RETURN 
 
          END 
          IDENT  DFC
          ENTRY  DFC
          B1=1
          TITLE  DFC - DECREMENT FAMILY COUNT OF USERS. 
*COMMENT  DECREMENT FAMILY COUNT OF USERS.
          SPACE  4,10 
***       DFC - DECREMENT FAMILY COUNT OF USERS.
* 
*         D. G. DEPEW        81/11/23.
          SPACE  4,10 
***       DFC PROVIDES A HIGH LEVEL LANGUAGE INTERFACE TO THE *CPM* 
*         FUNCTION HAVING THE FUNCTION CODE 73B, WHICH DECREMENTS THE 
*         COUNT OF USERS FOR A SPECIFIED FAMILY.
          SPACE  4,10 
***       SYMPL CALLING SEQUENCE. 
* 
*         DFC (FAMILY); 
* 
*         ENTRY  FAMILY = ARRAY NAME OF THE DECREMENT FAMILY COUNT
*                         FUNCTION (*CPM* FUNCTION 73B) PARAMETER WORD. 
          SPACE  4,10 
***       FORTRAN CALLING SEQUENCE. 
* 
*         CALL DFC (FAMILY) 
* 
*         ENTRY  FAMILY = NAME OF THE DECREMENT FAMILY COUNT FUNCTION 
*                         (*CPM* FUNCTION 73B) PARAMETER WORD.
          SPACE  4,10 
 DFC      EQ     *+1S17D
 DFCX     EQU    *
          SB1    1
          SYSTEM CPM,R,X1,7300B 
          JP     DFCX 
 
          END 
          IDENT  APPLS
          ENTRY  APPLS
          LIST   X
          TITLE  APPLS - GET LOC AND SIZE OF NETWORK APPLICATION TABLE. 
*COMMENT  NETWORK APPLICATION TABLE.
          SPACE  4,10 
***       APPLS - GET LOCATION AND SIZE OF NETWORK APPLICATION TABLE. 
* 
*         D. G. DEPEW.       82/01/13.
          SPACE  4,10 
***       APPLS PROVIDES A HIGH LEVEL LANGUAGE INTERFACE TO THE NOS 
*         COMMON DECK *COMTNAP*, WHICH IS ASSEMBLED LOCAL TO APPLS. 
          SPACE  4,10 
***       SYMPL CALLING SEQUENCE. 
* 
*         APPLS (ADDRESS, SIZE);
* 
*         ENTRY  ADDRESS = NAME OF A WHOLE WORD SCALER ITEM TO RECEIVE
*                          THE ADDRESS OF THE NETWORK APPLICATION TABLE.
*                   SIZE = NAME OF A WHOLE WORD SCALER ITEM TO RECEIVE
*                          THE SIZE OF THE NETWORK APPLICATION TABLE. 
* 
*         EXIT   (ADDRESS) = ADDRESS OF THE NETWORK APPLICATION TABLE.
*                   (SIZE) = SIZE (CM WORDS) OF THE NETWORK APPLICATION 
*                            TABLE. 
          SPACE  4,10 
OPL       XTEXT  COMTNAP
          SPACE  4,10 
 APPLS    EQ     *+1S17D
 APPLSX   EQU    *
          SA2    A1+1        ADDRESS OF SIZE PARAMETER
          SX6    TNAV        ADDR OF TABLE
          SX7    TNAVL       SIZE OF TABLE
          SA6    X1 
          SA7    X2 
          JP     APPLSX 
 
          LIST   *
 
          END 
 
          IDENT  JROUTE 
          ENTRY  JROUTE 
          B1=1
          TITLE  JROUTE - ROUTE JOB FILE TO INPUT QUEUE.
*COMMENT  ROUTE JOB FILE TO INPUT QUEUE.
          SPACE  4,10 
***       JROUTE - ROUTE JOB FILE.
*         C. BRION           83/05/05.
          SPACE  4,10 
***       JROUTE PROVIDES THE HIGH LEVEL LANGUAGE INTERFACE TO THE *DSP*
*         FUNCTION (ROUTE). 
          SPACE  4,10 
***       SYMPL CALLING SEQUENCE. 
* 
*         JROUTE(RFPB); 
* 
*         ENTRY  RFPB = ROUTE FUNCTION PARAMETER BLOCK. 
          SPACE  4,10 
 JROUTE   EQ     *+1S17D     ENTRY/EXIT 
 JROUTEX  EQU    *
          SB1    1
          ROUTE  X1,R 
          JP     JROUTEX
 
          END 
 
          IDENT  GETFIL 
          B1=1
          LIST   F
          TITLE  GETFIL - GET A PERMANENT FILE. 
          COMMENT   GET A PERMANENT FILE. 
          IPARAMS 
 GETFIL   SPACE  4,10 
 NOSPFM   IFC    EQ,*"OS.NAME"*KRONOS*
***       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,15 
***       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 
          RECALL PFMFET 
          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 
 NOSPFM   ENDIF 
          END 
          IDENT  GLIDC
          ENTRY  GLIDC
          B1=1
          LIST   F
          TITLE  GLIDC - GET LID CONFIGURATION .
          COMMENT   GET LID CONFIGURATION . 
 OPL      XTEXT  COMSSFM
 OPL      XTEXT  COMCCMD
 OPL      XTEXT  COMCSFM
 GLIDC    SPACE  4,10 
***       GLIDC - GET LID CONFIGURATION . 
* 
*         CALL GLIDC (ARGUMENT) 
* 
*         ENTRY  (ARGUMENT) = ADDRESS OF PARAMETER BUFFER.
* 
*         GLIDC(ARGUMENT);  ( SYMPL CALL )
* 
*         ENTRY - ARGUMENT, AN ITEM CONTAINING THE ADDRESS OF THE 
*                 PARAMETER BUFFER. 
* 
*         EXIT   RETURN INFORMATION INTACT IN PARAMETER BUFFER. 
 
 
 GLIDC    SUBR   =
          SB1    1
          SA1    X1          GET LID CONFIGURATION PARM BUFFER
          LIST   M
          GETLIDC X1
          LIST   -M 
          JP     GLIDCX 
 
          END 
          IDENT  GPIDA
          ENTRY  GPIDA
          B1=1
          LIST   F
          TITLE  GPIDA - GET PID ATTRIBUTES . 
          COMMENT   GET PID ATTRIBUTES .
 OPL      XTEXT  COMSSFM
 OPL      XTEXT  COMCCMD
 OPL      XTEXT  COMCSFM
 GPIDA    SPACE  4,10 
***       GPIDA - GET PID ATTRIBUTES .
* 
*         CALL GPIDA (ARGUMENT) 
* 
*         ENTRY  (ARGUMENT) = ADDRESS OF PARAMETER BUFFER.
* 
*         GPIDA(ARGUMENT);  ( SYMPL CALL )
* 
*         ENTRY - ARGUMENT, AN ITEM CONTAINING THE ADDRESS OF THE 
*                 PARAMETER BUFFER. 
* 
*         EXIT   RETURN INFORMATION INTACT IN PARAMETER BUFFER. 
 
 
 GPIDA    SUBR   =
          SB1    1
          SA1    X1          GET PID ATTRIBUTES PARM BUFFER 
          LIST   M
          GETPIDA X1
          LIST   -M 
          JP     GPIDAX 
 
          END 
          IDENT MACHID
          ENTRY MACHID
          B1=1
          LIST   F
          COMMENT   OBTAIN MACHINE ID.
 
***       MACHID - OBTAIN MACHINE ID
* 
*         CALL MACHID (ID)
* 
*         EXIT   (ID) = MACHINE ID IN LOWER 2 CHARACTERS
* 
*         MACHID(ID)                 ( SYMPL CALL ) 
* 
 
 MACHID   SUBR   =           ENTRY/EXIT 
          SB1    1
          MACHID X1          GET MACHINE ID 
          EQ     MACHIDX     RETURN 
 
          END 
          IDENT  SPIDA
          ENTRY  SPIDA
          B1=1
          LIST   F
          TITLE  SPIDA - SET PID ATTRIBUTES . 
          COMMENT   SET PID ATTRIBUTES .
 OPL      XTEXT  COMSSFM
 OPL      XTEXT  COMCCMD
 OPL      XTEXT  COMCSFM
 SPIDA    SPACE  4,10 
***       SPIDA - SET PID ATTRIBUTES .
* 
*         CALL SPIDA (ARGUMENT) 
* 
*         ENTRY  (ARGUMENT) = ADDRESS OF PARAMETER BUFFER.
* 
*         SPIDA(ARGUMENT);  ( SYMPL CALL )
* 
*         ENTRY - ARGUMENT, AN ITEM CONTAINING THE ADDRESS OF THE 
*                 PARAMETER BUFFER. 
* 
*         EXIT   RETURN INFORMATION INTACT IN PARAMETER BUFFER. 
 
 
 SPIDA    SUBR   =
          SB1    1
          SA1    X1          SET PID ATTRIBUTES PARM BUFFER 
          LIST   M
          SETPIDA X1
          LIST   -M 
          JP     SPIDAX 
          END 
          IDENT  VALIDU 
          ENTRY  VALIDU 
          B1=1
          TITLE  VALIDU - VALIDATE USER FOR NVF.
*COMMENT  VALIDATE USER FOR NVF.
          SPACE  4,10 
***       VALIDU - VALIDATE USER FOR NVF. 
* 
*         D. G. DEPEW.       81/11/23.
          SPACE  4,10 
***       VALIDU PROVIDES A HIGH LEVEL LANGUAGE INTERFACE TO THE *CPM*
*         FUNCTION HAVING THE FUNCTION CODE 56B (VALIDATE USER FOR NVF).
          SPACE  4,10 
***       SYMPL CALLING SEQUENCE. 
* 
*         VALIDU (VFPB);
* 
*         ENTRY  VFPB = ARRAY NAME OF THE VALIDATION FUNCTION (*CPM*
*                       FUNCTION 56B) PARAMETER BLOCK.
          SPACE  4,10 
***       FORTRAN CALLING SEQUENCE. 
* 
*         CALL VALIDU (VFPB)
* 
*         ENTRY  VFPB = FIRST WORD OF THE VALIDATION FUNCTION (*CPM*
*                       FUNCTION 56B) PARAMETER BLOCK.
          SPACE  4,10 
 VALIDU   EQ     *+1S17D     ENTRY/EXIT 
 VALIDUX  EQU    *
          SB1    1
          SYSTEM CPM,R,X1,5600B 
          JP     VALIDUX
 
          END 
          IDENT  WRITEWC
          ENTRY  WRITEWC
          SYSCOM B1 
 WRIF$    EQU    1           WTW= WILL REISSUE EXISTING FUNCTION CODE.
          TITLE  WRITEWC - WRITE DATA FROM WORKING BUFFER.
          COMMENT   WRITE DATA FROM WORKING BUFFER. 
 WRITEWC  SPACE  4,10 
***       WRITEWC - WRITE DATA FROM WORKING BUFFER. 
* 
*         CALL WRITEWC (FILE,BUF,N) 
* 
*         ENTRY  (FILE) = FIRST WORD OF THE FET 
*                (BUF) = FIRST WORD OF THE WORKING BUFFER 
*                (N) = WORD COUNT OF THE WORKING BUFFER 
* 
*         WRITEWC(FILE,BUF,N);  ( SYMPL CALL )
* 
*         ENTRY - FILE, AN ARRAY THAT CONTAINS THE FET
*                 BUF, AN ARRAY TO BE USED AS READ BUFFER 
*                 N, AN ITEM THAT CONTAINS THE NUMBER OF WORD IN BUF
* 
*                 THIS ROUTINE DIFFERS FROM *WRITEW* ONLY IN THAT 
*                 *WTW=* HAS BEEN ASSEMBLED SO THAT THE PREVIOUS
*                 FUNCTION CODE IS REISSUED RATHER THAN ASSUMING
*                 THAT A *WRITE* IS TO BE ISSUED. 
 
 
 WRITEWC  EQ     *+1S17D
 WRITEWCX EQU    *
          SB1    1
          SA3    A1+B1       FWA OF WORKING BUFFER
          SA4    A3+B1       ADDRESS OF WORD COUNT
          SA4    X4          WORD COUNT 
          WRITEW X1,X3,X4 
          EQ     WRITEWCX 
 
 
*CALL     COMCWTW - WRITE WORDS FROM WORKING BUFFER.
 
          END 
          IDENT  XSST 
          B1=1
          TITLE  XSST - SHELL SORT TABLE. 
          ENTRY  XSST 
*COMMENT  SHELL SORT TABLE. 
 XSST     SPACE  4,10 
***       XSST - SHELL SORT TABLE.
* 
*         SORTS A TABLE OF ONE WORD ENTRIES INTO ASCENDING ORDER. 
*         ALL ENTRIES SHOULD BE OF THE SAME SIGN. 
* 
*         CALL XSST (TABLE,COUNT) 
 
 
 XSST     EQ     *+1S17D     ENTRY/EXIT 
 XSSTX    EQU    *
          SB1    1
          SB7    X1          FWA OF TABLE 
          SA2    A1+B1       ADDRESS OF COUNT 
          SA1    X2+         COUNT
          RJ     =XSST=      SORT 
          JP     XSSTX
 
 
*CALL COMCSST 
 
          END 
         IDENT   RSJCR
         ENTRY   RSJCR
         B1=1 
         COMMENT RETRIEVE/SET JOB CONTROL REGISTER. 
 
 
***      RSJCR - RETRIEVE/SET JOB CONTROL REGISTER. 
* 
*        CALL RSJCR(RNUM,TYPE,RVAL) 
* 
*        RSJCR(RNUM,TYPE,RVAL);     (SYMPL CALL)
* 
*        ENTRY - RNUM, NUMBER OF REGISTER TO BE RETRIEVE/SET (1-3)
*                TYPE, = 0, RETURN CONTENTS OF REGISTER.
*                      = 1, SET REGISTER. 
*                RVAL, VALUE TO SET REGISTER IF TYPE = NONZERO. 
* 
*        EXIT -  RVAL, CONTENTS OF REGISTER IF TYPE = 0.
* 
 
 
 RSJCR   EQ      *+1S17D
 RSJCRX  EQU     *
         SB1     1
         SA3     A1+B1
         SA4     A3+B1
         SA3     X3          GET THE TYPE OF CALL 
         SA5     X1          GET THE REGISTER NUMBER
         SB6     X5 
         GT      B6,JCR1     IF RNUM IS LESS THAN 1,
         SX6     -B1
         SA6     X4            SET VALUE TO -1 INDICATING ERROR 
         EQ      RSJCRX        **** RETURN **** 
 JCR1    BSS     0
         SB5     3
         LE      B6,B5,JCR2  IF RNUM GREATER THAN 3,
         SX6     -B1
         SA6     X4             SET VALUE TO -1 INDICATING ERROR
         EQ      RSJCRX         **** RETURN ****
 JCR2    BSS     0
         SX7     B6-B1       CALCULATE SHIFT VALUE TO PUT 
         SX6     18            REGISTER VALUE IN LOWER 18 BITS
         IX7     X6*X7
         SB6     X7 
 
         GETJCR  REGWORD     GET THE CURRENT JCR VALUES 
         SA5     REGWORD
         SB5     60 
         SB7     B5-B6
         LX5     B7          PUT REG VALUE IN LOWER 18 BITS 
 
         NZ      X3,JCR3     IF TYPE = 0 (RETURN VALUE) 
         MX0     18 
         LX0     18 
         BX6     X0*X5       MASK OFF THE REGISTER VALUE
         SA6     X4          SET RVAL TO VALUE
         EQ      RSJCRX      **** RETURN **** 
 
 JCR3    BSS     0
         MX0     42          TYPE = NONZERO (SET REGISTER)
         BX5     X0*X5
         MX0     18 
         LX0     18 
         SA4     X4          GET NEW VALUE FOR REGISTER 
         BX4     X0*X4
         BX6     X4+X5       PUT NEW VALUE
         LX6     B6 
         SA6     REGWORD
         SETJCR  REGWORD     SET THE REGISTER WITH NEW VALUE
         EQ      RSJCRX      **** RETURN **** 
 
 REGWORD BSSZ    1
 
         END
*CWEOR,0
Retro1.org codex

Table of Contents

MACREL

Table Of Contents

Source Code
