*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