*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