TITLE CBLIO FOR LIBOL 16-JAN-75 SUBTTL EDIT HISTORY ;COPYRIGHT 1974, 1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS. EDIT==420 ;********* MODIFIED TO SUPPORT RPGII 5/29/76 ********* ; ;ALL RPGII MODIFICATIONS COPYRIGHT 1976, BOB CURRIER AND CERRITOS COLLEGE ;***** V10 ***** ; 420 17-OCT-75 JEC ; FIX SPACING WITH NO PAGE HEADER. - LINE - ; 417 21-OCT-75 JEC ; MAKE SURE THAT CSORT TAKES NO MORE THAN 6 CHANNELS - CSORT - ; 416 25-SEP-75 JEC ; FIXED FUNCOR ROUTINE TO RETURN START ADDRESS. ; NOT IN V10 - COBFUN WAS EXTENSIVLY MODIFIED WHICH FIXED THE PROBLEM. ; 415 25-SEP-75 JEC ; FIX EDIT 334 SO THAT SINGLE DIGTIT TESTS WORK. ; NOT IN V10 - NUMBRS WAS REWRITTEN. ; 414 27-AUG-75 JEC SPR-16722 ; PUT IN INTERRUPT CODE FOR ON-LINE PRINTER AND SET LPT BUFFER TO 1. ; 413 30-JUN-75 JEC SPR-16266 ; FIX MESSAGE THAT BEGINS WITH " SO IT DOESN'T GO TO CTY. ; 412 30-JUN-75 JEC SPR-16175 ; FIX CALCULATION OF POINTER FOR UNSTRING WHEN DELIMITER IS "ALL". ; MARCH 12, 1975 ADDITION OF SUSPC, SUSPC1 SUBROUTINES TO ; RESET FOR THE PURPOSE OF COMPUTING THE SPACE REQUIRED BY ; SIMULTANEOUS UPDATE, AND GETTING IT. ALSO ADDITION OF THE ; CALL TO THESE SUBROUTINES IN RESET. GIL STEIL ; 16-JAN-75 /ACK 1. CHANGE REFERENCE TO PARAMETER FILE ; LBLPRM TO REFERENCE UNIVERSAL ; FILE LBLPRM. ; 2. ADD CODE FOR SETTING UP THE PUSH DOWN ; LIST WITH THE VALUE SUPPLIED BY ; THE USER WHEN HE COMPILED THE ; PROGRAM ;********** VERSION 7A RELEASE ********** ; EDIT 411 MAKE SURE LPT DEVICE DOES NOT CAUSE "ILLEGAL MODE" MONITOR MESSAGE AT RESET TIME. ; ALSO FIX RECOVERY FROM "EOF FOUND INSTEAD OF A LABEL". ; EDIT 410 PUT OUT "$" IN MESSAGE TO TRY ANOTHER MAG TAPE SO OPERATOR SEES THE ; MESSAGE, WHEN THE JOB IS RUNNING UNDER BATCH ; SPR 15662 ; EDIT 407 IF POSSIBLE OUTPUT PHYSICAL DEVICE NAME ; AS WELL AS LOGICAL DEVICE NAME- FOR DEVICE MESSAGES ; SPR 15184 ; EDIT 406 FIX SORT RELEASE LENGTH CALCULATION SO WORD SIZE AGREES WITH INTERNAL RECORD MODE ; SPR 15189. ; EDIT 405 SET UP REF I12 FOR ISAM FILES AT MSVID FOR FILE VALUE OF ID PRINTOUT. ; EDIT 404 IN LINE.MAC FIX SPACING FOR RPT WRITER ; SPR 14927 ; EDIT 403 PUT IN SIRUS CODE AND TRAILING BLANK SUPPRESSION (SWITCH OPTION) ; EDIT 402 FIX CORE PROBLEM IN CSORT; FOR .JBFF VS .JBREL ; EDIT 401 FIX EDIT SO THAT ZERO SUPPRESSION NO LONGER HAPPENS AFTER A 9'S FIELD IS SEEN ; SPR 14617 ; EDIT 400 FIX COBFUN SO THAT CHANNEL 0 IS OBTAINED LAST ; EDIT 377 FIX ISAM BUFFER PROBLEM IF ISAM FILE IS ; SHARED AREA (BUFFER) WITH ANY OTHER FILE. ; EDIT 376 GIVE A MEANINFUL ERROR MSG IF UNEXPECTED EOF ON ISAM IDX FILE IS SEEN ; SPR 14453 ; EDIT 375 ADD TO EDIT 371- IF ISAM FILE OPEN FOR INPUT ALLOW ; FD > OR = TO ISAM MAX REC SIZE- AND IF FILE OPEN FOR OUTPUT ALLOW ; FD < OR = TO ISAM MAX REC SIZE. ; EDIT 374 FIX TEST FOR OPTIONAL ISAM FILE AT RESET TIME ; EDIT 373 FIX UP CLOSE WITH DELETE FOR DTA FILES. ; EDIT 372 CORRECT BLOCK FACTOR CALC FOR ASCII NON-ISAM FILES ; EDIT 371 CHECK THAT USERS MAX REC DESC SAME AS ISAM MAXREC PARM. ; SPR 13772 ;EDIT 370 SEQUENTIAL READING OF AN ISAM FILE MAY OCCASIONALLY ; MISS SEVERAL RECORDS. THE PROBLEM OCCURS WHEN THE ; SYMBOLIC KEY IS A NUMERIC DISPLAY ITEM AND A VERSION ; NUMBER ERROR OCCURS. ;EDIT 343 THROUGH 367 ARE RESERVED FOR DEVELOPMENT ;********* VERSION 7 RELEASE ********** ;EDIT 347 FIX STRING TO SPACE FILL EVEN IF NO UNSTRING ;EDIT 346 CBLIO - LIBIMP - CSORT ; MAKE OVERLAYS WORK. CHECK THAT NO IO IS DONE IN AN ; OVERLAY. WHEN ALLOCATING ISAM BUFFER SPACE BE SURE ; YOU DON'T OVERLAP THE OVERLAY AREA, GIVE ERROR MESSAGE. ;EDIT 345 RE-ADJUST SUBROUTINES DISPATCH TABLE SIZE FOR MCS ;EDIT 344 FIX MEMORY MANAGEMENT BUG IN CSORT ;EDIT 343 THIS FIX PREVENTS AN EXTRA BLOCK FROM BEING APPENDED TO ; A BINNARY FILE WHEN THE OUTPUT DEVICE IS A DTA (QAR-40) ;EDIT 342 MAKE EDIT 333 WORK FOR PROGRAMS WO/R SWITCH ; AND MAKE CHN 0 THE LAST ONE USED (FOR RERUN) ; CHANGES TO OVRLAY.MAC AND COBRG OF COMPILER ; ALSO REQUIRES COBST ROUTINE IN LIBOL ;EDIT 341 FIX POSITIONING ; MULTI-FILE LABELLED REELS W/NO ; POSITION CLAUSES ;EDIT 340 UPDATE JOBDAT SYMBOLS, CHANGES IN CSORT,UUO ;EDIT 337 FIX IN ACCEPT, NOT IN CBLIO, SEE JC ;EDIT 336 FIX FILE POSITIONING FOR MULTI-FILE TAPES ;EDIT 335 FIX GARBAGE IN RECORD W/VARIABLE LENGTH ISAM RECS ;EDIT 334 NOT IN CBLIO. JOHN DID EM ;EDIT 333 GET OVERLAY FILE FROM SAME PLACE AS MAIN PROGRAM ;EDIT 332 HANDLE VARIABLE LENGTH RECORDS FOR STAND ALONE SORT ;EDIT 330 FIX READING FROM NUL DEVICE SO THAT CBLIO DOESN'T CONFUSE IT WITH MTA ;EDIT 327 FIX STD LABELS FOR MTA WHEN READING > REEL 9 ;EDIT 326 CHANGED CHTAB SO THAT 173 TO 20(ZERO) AND 175 TO 32 (:) ; WHEN READING ASCII FILE TO SIXBIT RECORD JEC ;EDIT 325 FIX SPACING AND REPORT CODE FOR REPORT GEN IN LINE.325 JEC 4/5/74 ;EDIT 324 FIX APPENDING TO RANDOM ACCESS FILES READ TO END ;EDIT 323 DONT DO ENTER WHEN LOOKUP OF ISAM DATA FILE FAILS ;EDIT 322 FIX APPENDING OF RECORDS FOR SEQUENTIAL I/O ;EDIT 321 LIBOL REFUSES TO TAKE A RERUN DUMP IF A FILE IS ASSIGNED ; TO THE NULL DEVICE ;EDIT 320 ISAM - "MEM-PRO-VIO..." WHEN ZEROING FREE CORE AT UDIF11 ;EDIT 317 MOVE THE TEST FOR EBCDIC FILES INTO THE MAIN LOOP ;EDIT 316 FIXES "ADDRESS CHECK..." WHEN SORT FILE SHARES SAME BUFFER AREA ;EDIT 315 FIX TO EDIT 301 ILG 1-FEB-74 ;EDIT 314 *CSORT* PREFIX "?" TO "ERROR IN SORT I-O" MESSAGE ;EDIT 313 *CSORT* FIX REDUNDANT "RECORDS SORTED" ;EDIT 312 IF "ILL-MEM-REF" IN RSTLNK ROUTINE TELL USER HE MAY HAVE LOADED A MACRO ROUTINE IN PLACE OF COBOL SUBROUTINE ;EDIT 311 ISAM - "MEMORY PROTECTION VIOLATION" WHEN WRITING AFTER SPLITING THE TOP INDEX BLOCK ;EDIT 310 ISAM - "?KEYS OUT OF ORDER" CAUSED BY TESTING THE WRONG FLAG WORD ;EDIT 307 ISAM FILE READER GETS "VERSION NUMBER DISCREPANCY" WHEN A WRITER CREATES A NEW INDEX LEVEL ;EDIT 306 ISAM - OPNI03 ASSUMES A 200 WORD BUFFER SIZE BUT IT MAY BE LARGER ;EDIT 305 CHANGE "NOT A LEGAL SIXBIT FILE" ERROR MS TO INDICATE THAT INCORRECT BLOCKING FACTOR COULD BE CAUSE. ;EDIT 304 CORRECT VALUE OF ID AS GIVEN AFTER LOOKUP OR ENTER FAILS ;EDIT 303 FIX TO REPORT-WRITER ;EDIT 302 CORRECT MAG-TAPE POSITION AFTER READING LABELLED FILE ;EDIT 301 DO AN ENTER ON NON-DIRECTORY DEVICES FOR DIRECT,LPTSPL,ETC. ;EDIT 300 HANDLE NULLS IN ASCII RANDOM FILES CORRECTLY ;EDIT 277 PRECEDE ALL ERROR MESSAGES HAVING TO DO WITH POSSIBLE WRONG REELS OR OPTIONAL FILES WITH "$" ;EDIT 276 DUPLICATE ISAM RECORDS IF DATA MODE DIFFERS BTWN RECORD AND DATA FILE ;EDIT 275 CODE TO CORRECT LOW-VALUES READ FOR ISAM AFTER INVALID KEY PATH TAKEN ;EDIT 274 CODE TO SUPPORT THE DATE75 FORMAT I.E. 15 BIT WIDE DATES ;EDIT 273 FIRST RANDOM READ WITH AN ACTUAL KEY POINTING BEYOND THE "EOF" DOES NOT TAKE THE INVALID KEY RETURN ;EDIT 272 TYPE THE VERSION # NOT JUST EDIT # WITH ERROR MESSAGES ;EDIT 271 FIXES "VERSION NUMBER DISCREPANCY..." WHEN MORE THAN ONE SECTOR PER LOGICAL BLOCK ;EDIT 270 STOPS "ILL-UUO-AT-PC..." WHEN TYPING OUT LIBOL ERROR MESSAGE ;EDIT 267 CHANGE GETCH. ROUTINE SO ^U WILL RUBOUT TYPED AHEAD CHARACTERS SUBTTL PICK UP UNIVERSALS AND SET UP JOBDAT. IFE %%RPG,< SEARCH LBLPRM ;DEFINE PARAMETERS. %%LBLP==:%%LBLP > IFN %%RPG,< SEARCH RPGPRM, RPGUNV > SEARCH COMUNI %%COMU==:%%COMU INFIX% ISAM==:ISAM EBCMP.==:EBCMP. SEARCH FTDEFS ;FILE-TABLE DEFINITIONS %%FTDF==:%%FTDF IFE %%RPG,< ENTRY C.RSET ;MAKE SURE WE GET LOADED. LOC 124 ;.JBREN EXP RENDP ;TO FORCE A DUMP. VERWHO==0 VERMJR==10 VERMNR==0 VEREDT==EDIT VERSION==BYTE(3)VERWHO(9)VERMJR(6)VERMNR(18)VEREDT PURGE VERWHO,VERMJR,VERMNR,VEREDT LOC 137 ;.JBVER EXP VERSION VERSION==B53&77777 ;FOR LATER REFERENCE. > ; END OF IFE %%RPG IFNDEF EBCLBL, IFNDEF TOPS20, ; JSYS SWITCH IFNDEF SUPPTB, ; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES. IFNDEF EBCMP., HISEG SUBTTL CONSTANTS AC0==0 ;AC ASSIGNMENTS AC1==1 AC2==2 AC3==3 AC4==4 AC5==5 AC6==6 FLG==7 AC10==10 AC11==11 C==11 AC12==12 I12==12 AC13==13 LVL==13 AC14==14 FLG1==14 AC15==15 AC16==16 I16==16 PP==17 REPEAT 0,< ;FLAGS IN LEFT SIDE OF "F.WFLG(I16)" BEFORE RESET 400000==400000 ;VARIABLE LENGTH EBCDIC RECORDS NONSTD==100000 ;NON STANDARD LABELS STNDRD==40000 ;STANDARD LABELS OPNIO==4000 ;FILE IS AN INPUT/OUTPUT FILE BIT 7-9 ;0 = SIXBIT DEVICE DATA MODE ;1 = BINARY ;2 = ASCII ;3 = EBCDIC ;4 = ASCII-8 ;5-7 NOT USED RRUNER==200 ;RERUN DUMP AT END-OF-REEL RRUNRC==100 ;RERUN DUMP VIA RECORD-COUNT FILOPT==20 ;OPTIONAL FILE BIT 14-15 ;0 = SIXBIT CORE DATA MODE ;1 = BINARY ;2 = ASCII ;3 = EBCDIC BIT 16-17 ;0 = SEQUENTIAL FILE ;1 = RANDOM FILE ;2 = INDEXED-SEQ FILE ;3 = NOT USED > HUF==1 LOCK==2 ;CONSTANTS FOR CONSTRUCTION OF ERROR NUMBERS E.VOPE==^D100000000 ;COBOL VERB OPEN E.VCLO==^D200000000 ; CLOSE E.VWRI==^D300000000 ; WRITE E.VREW==^D400000000 ; REWRITE E.VDEL==^D500000000 ; DELETE E.VREA==^D600000000 ; READ E.VRET==^D700000000 ; RETAIN E.MINP==^D1000000 ;MONITOR INPUT ERROR E.MOUT==^D2000000 ; OUTPUT E.MLOO==^D3000000 ; LOOKUP E.MENT==^D4000000 ; ENTER E.MREN==^D5000000 ; RENAME E.MOPE==^D6000000 ; OPEN E.MFOP==^D7000000 ; FILOP E.FIDX==^D10000 ;ISAM INDEX FILE E.FIDA==^D20000 ;ISAM DATA FILE E.FSEQ==^D30000 ;SEQUENTIAL FILE E.FRAN==^D40000 ;RANDOM FILE E.BSTS==^D1000 ;ISAM STATISTICS BLOCK E.BSAT==^D2000 ;ISAM SAT BLOCK E.BIDX==^D3000 ;ISAM INDEX BLOCK E.BDAT==^D4000 ;ISAM DATA BLOCK ;FLAGS IN LEFT SIDE OF "FLG" & F.WFLG(I16) AFTER RESET. ; **WARNING** DO NOT DISTURB DDM??? OR CDM??? DDMASC==400000 ;DEVICE DATA MODE IS ASCII DDMSIX==200000 ;DEVICE DATA MODE IS SIXBIT DDMEBC==100000 ;DEVICE DATA MODE IS IBCDIC DDMBIN==40000 ;DEVICE DATA MODE IS BINARY OPNIN==20000 ;FILE IS OPEN FOR INPUT OPNOUT==10000 ;FILE IS OPEN FOR OUTPUT OPNIO==4000 ;FILE IS AN INPUT/OUTPUT FILE ATEND==2000 ;AN "EOF" WAS SEEN CONNEC==1000 ;DEVICE & CORE DATA MODES DIFFER NOTPRS==400 ;OPTIONAL FILE NOT PRESENT RRUNER==200 ;RERUN DUMP AT END-OF-REEL RRUNRC==100 ;RERUN DUMP VIA RECORD-COUNT CDMASC==40 ;CORE DATA MODE IS ASCII CDMSIX==20 ;CORE DATA MODE IS SIXBIT CDMEBC==10 ;CORE DATA MODE IS EBCDIC IDXFIL==4 ;ACCESS MODE IS INDEX-SEQUENTIAL SEQFIL==2 ;ACCESS MODE IS SEQUENTIAL RANFIL==1 ;ACCESS MODE IS RANDOM ;FLAGS IN LEFT SIDE OF FLG1 & D.F1(I16) AFTER RESET. VLREBC==400000 ;VARIABLE LENGTH EBCDIC RECORDS FILOPT==200000 ;FILE IS OPTIONAL NONSTD==100000 ;LABELS ARE NON-STANDARD STNDRD==40000 ;LABELS ARE STANDARD F1CLR==3777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME FOPERR==2 ; FILOP.UUO FAILED IFN ISAM,< NOTEST==2000 ;SKIPE THE CONVERSION TEST AT ADJKEY [EDIT#276] WSTB==1000 ;WRITE THE STATISTICS BLOCK IIAB==400 ;INSERTION IS IN AUX BUFFER TRYAGN==200 ;MAKE A SECOND PASS AT ALC01 OR DON'T AT VNDE BVN==100 ;BUMP-VERSION-NUMBER SPLITTING A BLOCK WSB==40 ;WRITE THE SAT BLOCK BLK2==20 ;REQ FOR 2ND DATA BLOCK SEQ==10 ;SEQUENTIAL READ VERR==4 ;VERSION NUMBER DISCREPANCY BTWEEN INDEX LEVELS WIVK==2 ;WRITE INVALID-KEY FOPIDX==2 ;FILOP OF NAME.IDX IN PROGRESS RIVK==1 ;READ, RERIT OR DELET INVALID-KEY EIX==1 ;ENTER OF NAME.IDX IN PROGRESS > ;FLAGS IN LEFT SIDE OF AC16 FOR DURATION OF CURRENT COBOL UUO WADV==400000 WRITE==200000 READ==100000 OPEN==40000 CLOSEF==20000 ;EOF CLOSER==10000 ;EOV CLOSEB==4000 ;HDR RERIT==10 ;ISAM REWRITE DELET==4 ;ISAM DELETE SLURP==2 ;WRITE REEL CHANGE, RESTORE THE RECORD AREA MTAEOT==1 ;END-OF-TAPE BUFLOC==4000 ;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF 5(I16) SRTFIL==2000 ;[316];THIS IS A SORT FILE, LEFT-HALF OF 5(I16) OEUP==4000 ;OPEN ERROR USE PROCEDURE - ENTER ERROR FILE BEING MODIFIED, BIT 6 OF 22(I16) SASCII==1 ; REQUEST FOR STANDARD ASCII, IN D.RFLG TAPOP.==CALLI 154 ; FOR TU70'S 1600 BPI AND STANDARD ASCII .TFKTP==1002 ; FUNCT TO GET CONTROLER TYPE .TC10C==2 ; CONTROLLER FOR A TU43 .TX01==3 ; CONTROLLER FOR A TU70 .TM02==4 ; CONTROLLER FOR A TU16 .TFMOD==2007 ; FUNCT TO SET STANDARD ASCII MODE .TFM8B==2 ; CODE FOR INDUSTRY-COMPATIBLE .TFM7B==4 ; CODE FOR STANDARD ASCII .TFSDN==2001 ; FUNCT TO SET DENSITY .TFGDN==1001 ; FUNCT TO GET DENSITY FILOP.==CALLI 155 ; FOR SIMULTANEOUS UPDATE ;CONSTANTS FOR EXTENDED LOOKUP BLOCK .RBPPN==1 .RBNAM==2 .RBEXT==3 .RBPRV==4 .RBSIZ==5 R.IOWD==0 ; IOWRD FOR RANDOM/IO FILES R.TERM==1 ; IOWRD TERMINATOR R.BPNR==2 ; BYTE POINTER TO NEXT RECORD IN BUFFER R.BPLR==3 ; LAST RECORD R.BPFR==4 ; FIRST RECORD R.DATA==6 ; BUFFER HAS ACTIVE DATA TO BE WRITTEN OUT R.WRIT==7 ; LAST IO OPERATION FOR THIS FILE WAS A WRITE R.FLMT==10 ; AOBJ POINTER TO FILE LIMITS SUBTTL EXTERNALS. EXTERNAL LIBIMP ;CAUSES LIBREL ( LIBOL.LOW) TO BE LOADED FOR /R EXTERNAL INTBLK,.JBINT ; [414] EXTERNAL IIN,IOUT,ISETI,ISETO,ICLOS,IRELE,IGETS,IWAIT,IRNAM EXTERNAL MWAIT.,MREW.,MREWU.,MBSPR.,MBSPF.,MADVR.,MADVF.,MWEOF.,MTIND. EXTERNAL SOBOT.,SZBOT.,SZEOF.,SZEOT. EXTERNAL UOPEN.,UENTR.,ULKUP.,UOBUF.,UIBUF.,UCLOS.,URELE.,USETI. EXTERNAL USETO.,UOUT.,UIN.,USETS.,UGETS.,UWAIT.,USEEK.,URNAM. EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV. EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB. EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,AINFO.,OVRBF.,FLDCT.,OVRIX. EXTERNAL NOCR.,PRGFLG,TTYOPN,ACSAV0,MXIE,IESAVE,MXBUF,AUXBUF,AUXIOW,AUXBNO,CMDLST,NEWBK1 EXTERNAL NEWBK2,OLDBK,MXBF,DRTAB,LRWA EXTERNAL FS.ZRO,FS.FS,FS.EN,FS.BN,FS.RN,FS.UPD,FS.IGE,FS.IF,ISETS,FS.IEC EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6 IFN EBCMP. < EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9 > EXTERNAL FRSTIC,LASTIC,PFRST.,UFRST.,ULAST.,IFRST.,ILAST. EXTERNAL RELEN. ;[332] EXTERNAL RUN.TM ;[333] EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,SBPSA. IFE %%RPG,< EXTERNAL SU.RBP,SU.CL,SU.WR,SU.RD,SU.DL,SU.RW ;SIMULTANEOUS UPDATE > EXTERN FOP.BK,FOP.IS,FOP.DN,FOP.LB ;SIMULTANEOUS UPDATE IFE %%RPG,< EXTERN SU.FRF ;FAKE READ FLAG INTERN FAKER.,IGSS,RANFIL,IDXFIL,E.VRET,D.RP,D.CBN,D.CN,D.BL ;SIMULTANEOUS UPDATE INTERN DSPLY. > EXTERN .JBSA,.JBFF,.JBREL,.JB41,.JBAPR,.JBTPC,.JBCNI,.JBVER,.JBDA,.JBOPC,.JBREN EXTERN .JBOPS INTERN C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH. INTERN OUT6B.,OUTBF.,READ.,RSTAB.,SEEK.,STOPR.,C.STOP,TODAY.,TRAP.,WRITE.,WADV.,WRPW. INTERN GOTO.,KILL.,PPOUT.,ULOSE. EXTERNAL RET.1,RET.2,RET.3,UUO. INTERN DELET.,RERIT.,PURGE. EXTERNAL HLOVL. ;[346] XWD HIGHEST OVERLAY LOC , LOWEST LOC IFN ISAM, ;[370] IFN ISAM, EXTERNAL FILES.,USES. IFE %%RPG,< EXTERN RN.PPN,RN.DEV,RN.NAM,OVRFN.,TRAC1.,SEGNO. > IFN %%RPG,< INTERN OUTBF1, WAD2, SETCN. > IFN ISAM,< ADR==0 DEFINE TABADR(N,L) < N==ADR ADR==ADR+L > TABADR STAHDR,1 ;SIZE OF STATISTICS BLOCK IN SIXBIT BYTES TABADR DDEVNM,1 ;DATA FILE'S DEVICE NAME TABADR DFILNM,1 ;DATA FILE'S FILE NAME TABADR DEXT,1 ;DATA FILE'S EXTENSION TABADR DCDATE,1 ;DATA FILE'S CREATION DATE TABADR DADATE,1 ;DATA FILE'S ACCESS DATE TABADR MXLVL,1 ;NUMBER OF LEVELS IN INDEX FILE TABADR DBF,1 ;DATA FILE BLOCKING FACTOR TABADR DMTREC,1 ;NUMBER OF EMPTY RECORDS PER DATA BLOCK TABADR EPIB,^D20 ;TWO WORDS PER INDEX LEVEL ;FIRST WORD: NUMBER OF ENTRIES PER INDEX BLOCK ;SECOND WORD: NUMBER OF EMPTY ENTRIES TABADR DMXBLK,1 ;TOTAL BLOCKS IN DATA FILE TABADR DMTBLK,1 ;EMPTY BLOCKS IN DATA FILE TABADR IMXSCT,1 ;TOTAL SECTORS IN INDEX FILE TABADR IMTSCT,1 ;EMPTY SECTORS IN INDEX FILE TABADR FMTSCT,1 ;FIRST EMPTY SECTOR IN INDEX FILE TABADR DMXREC,1 ;MAXIMUM DATA RECORD SIZE IN WORDS TABADR DBPRK,1 ;BYTE POINTER TO RECORD KEY RELATIVE TO DATA RECORD TABADR RWRSTA,1 ;NUMBER OF READ, WRITE, REWRITE STATEMENTS SINCE INITIALIZATION TABADR IOUUOS,1 ;NUMBER OF IN'S AND OUT'S SINCE INITIALIZATION TABADR SBLOC,1 ;RELATIVE ADR OF FIRST SAT BLOCK TABADR SBTOT,1 ;TOTAL SAT BLOCKS TABADR ISPB,1 ;INDEX FILE, SECTORS PER LOGICAL BLOCK TABADR FILSIZ,1 ;MAXIMUM POSSIBLE NUMBER OF DATA BLOCKS IN FILE TABADR KEYTYP,0 ;KEY-TYPE IN LEFT HALF TABADR KEYDES,1 ;DESCRIPTION OF RECORD KEY TABADR IESIZ,1 ;INDEX ENTRY SIZE IN WORDS TABADR TOPIBN,1 ;TOP INDEX BLOCK NUMBER TABADR %DAT,1 ;% OF DATA FILE EMPTY TABADR %IDX,1 ;% OF INDEX FILE EMPTY TABADR RECBYT,1 ;SIZE OF LARGEST DATA BLOCK IN BYTES TABADR MAXSAT,1 ;MAX # OF RECORDS FILE CAN BECOME TABADR ISAVER,1 ;"ISAM" VERSION NUMBER STABL==ADR ;EQUALS SIZE OF STATISTICS BLOCK TABADR IOWRD,14+1 ;TABLE OF DUMP MODE IOWD'S FOR EACH INDEX LEVEL ;0 DATA BLOCK ;1-12 INDEX BLOCKS ;13 SAT BLOCK ;14 STATISTICS BLOCK TABADR OMXLVL,1 ;ORIGINAL MAX NUMBER OF LEVELS IN INDEX FILE TABADR CORE0,1 ;LAST,,FIRST - CORE AREA CLEARED AT CLOSE TABADR ICHAN,1 ;CHANNEL NUMBER FOR INDEX DEVICE TABADR USOBJ,14+1 ;USETI/O OBJECT: DATA, 10 INDEX, SAT & STA TABADR CNTRY,14+1 ;CURRENT INDEX ENTRY TABADR NNTRY,14+1 ;FLAG, CNTRY POINTS TO NEXT ENTRY NOT CURRENT TABADR LIVE,1 ;(-1) IF DATA NOT YET OUTPUT TABADR BRISK,1 ;IF -1 OUTPUT ONLY WHEN INPUT IS EMINENT TABADR CLVL,1 ;CURRENT LEVEL TABADR IAKBP,1 ;INDEX ADJUSTED SYMBOLIC KEY BYTE-POINTER TABADR IAKBP1,1 ;POINTER TO SECOND KEY WORD TABADR DAKBP,1 ;DATA ADJUSTED SYMBOLIC KEY BP TABADR DAKBP1,1 ;POINTER TO THE SECOND KEY WORD TABADR SINC,1 ;BINARY SEARCH INCREMENT TABADR IBLEN,1 ;INDEX BLOCK LENGTH NOT COUNTING HEADERS TABADR IKWCNT,1 ;INDEX, NUMBER OF WORDS IN THE KEY TABADR DKWCNT,1 ;DATA, NUMBER OF WORDS IN KEY TABADR FWMASK,1 ;MASK FOR FIRST WORD OF DATA KEY TABADR LWMASK,1 ;MASK FOR LAST WORD OF DATA KEY TABADR ICMP,1 ;HOLDS ADR OF THE INDEX COMPARE ROUTINE TABADR DCMP,1 ;HOLDS ADR OF DATA COMPARE OR CONVERT ROUTINE TABADR DCMP1,1 ;HOLDS ADR OF DATA COMPARE ROUTINE IF KEY IS NUMERIC DISPLAY TABADR GDX.I,1 ; ADR OF CONVERT ROUTINE -- SK VS INDEX-ENTRY TABADR GDX.D,1 ; ADR OF CONVERT ROUTINE -- SK VS DATA FILE KEY TABADR GDPSK,1 ;PARAMETER FOR SYM-KEY CONVERSION TABADR GDPRK,1 ;PARAMETER FOR REC-KEY CONVERSION TABADR GDPRK1,1 ; TABADR GETSET,1 ;DISPATCH LOC: ADJKEY OR GD67 OR FPORFP TABADR RECBP,1 ;RECORD AREA BYTE-POINTER TABADR RSBP,1 ;BYTE POINTER TO RECORD SIZE IN BUFFER TABADR RSBP1,1 ;ANOTHER BP TO RECORD SIZE TABADR LRW,1 ;FIRST FREE RECORD WORD, USED BY SETLRW TABADR IOWRD0,1 ;POINTS TO CURRENT IOWRD TABADR USOBJ0,1 ;POINTS TO CURRENT USOBJ TABADR CNTRY0,1 ;POINTS TO CURRENT CNTRY TABADR NNTRY0,1 ;FLAG, CNTRY POINTS TO NEXT ENTRY TABADR BPSB,1 ;NUMBER OF BITS PER SAT BLOCK ITABL==ADR-STABL ;INDEX TABLE LEN TABADR BA,0 ;START OF BUFFER AREA ISCLR1==IOWRD ; [432] [377] START OF ISAM SHARED BUFFER AREA TO SAVE ISCLR2==ICHAN-1 ; [377] END OF ISAM SHARED BUFFER TO SAVE ISMCLR==ISCLR2-ISCLR1 ; [377] DIFFERENCE OR SIZE OF AREA LESS 1 TO SAVE > ;END OF 'IFN ISAM' SUBTTL RESET ;RESET IS CALLED WITH A JSP 14,C.RSET MLON IFE %%RPG,< LIBSW.: SWSET% ;LIBOL ASSEMBLY SWITCHES C.RSET: JRST .+2 ;ENTRY FOR 'C.RSET' JRST STOPR. ;ENTRY FOR 'STOP RUN' CALLI ;RESET MOVE AC1,(AC14) ; GET ADDRESS OF ENTRY POINT MOVEM AC1,%F.PTR ; (%F.PTR)+1 IS ADR OF FILES. CALLI AC11,27 ;[346]GET THE RUNTIME. MOVEM AC11,RUN.TM ;[346]SAVE IT. HRRZ AC1,.JBSA ;[START.] MOVEM AC1,JSARR. ;SAVE FOR RRDMP HRRZ AC1,.JBFF ;TO-1 CAMG AC1,.JBREL ;SKIP ILL-MEM-REF SETZM (AC1) ;ZERO WORD HRL AC1,AC1 ;FROM,,TO-1 ADDI AC1,1 ;FROM,,TO HRRZ AC2,.JBREL ;UNTIL CAIL AC2,(AC1) ;SKIP ILL-MEM-REF IF .JBFF = .JBREL BLT AC1,(AC2) ;ZERO FREE COR RESET1: MOVEI AC0,[TTCALL 3,[ASCIZ/COBOL PROGRAMS MAY ONLY BE STARTED THROUGH USE OF "GET AND ST" OR "RUN" MONITOR COMMANDS/] CALLI 12] ;EXIT HRRM AC0,.JBSA MOVE PP,[PUSHJ PP,UUO.] MOVEM PP,41 HLRZ PP,.JBOPS ;START OF IMPURE AREA RSET1A: MOVE PP,[XWD PFRST.,IFRST.] TLNE PP,777777 ;NO BLT IF PFRST. = 0 - LOW SEG WAS LOADED BLT PP,ILAST. ;THE IO UUO'S MOVEI AC10,MEMRY.## ;SET UP MEMRY. POINTER MOVEM AC10,MEMRY%## HRRZ AC10, (AC14) ;GET THE PROGRAM'S ENTRY POINT. HRRZ AC10, 1(AC10) ;GET THE ADDRESS OF %FILES. SKIPN AC10, %PUSHL(AC10) ;GET THE PDL SIZE. MOVEI AC10, 200 ;THIS IS FOR SORT MOVNI PP, (AC10) ;0,,-LENGTH HRL PP, .JBFF ;START-LOC,,-LENGTH MOVSS PP, PP ;POINTER IS SET UP. MOVEI AC10, 1(AC10) ;LENGTH+1 ADDB AC10, .JBFF ;ADJUST .JBFF IORI AC10, 1777 ;MOVE UP TO THE NEXT K BOUNDARY CAMG AC10, .JBREL ;ARE WE BEYOND .JBREL? JRST RESET2 ;NO, GO ON. CALLI AC10, 11 ;YES, GO ASK FOR MORE CORE. JRST GETSPK ;CAN'T HAVE ANY MORE, ERROR. ;SET FLAGS TO TRAP ON RESET2: MOVEI AC0,TRAP. ;[312];INTERUPT ROUTINE ADR MOVEM AC0,.JBAPR ;[312]; MOVEI AC0,230000 ;[312];PDLOV - MPVIO - NXM CALLI AC0,16 ;[312];APRENB UUO PUSHJ PP,RSAREN ;[312];INIT .JBSA AND .JBREN PUSHJ PP,OUTBF1 ;SETUP TTY BYTE-POINTER AND BYTE-COUNT PUSHJ PP,RSTLNK ;LINK ALL SUB-PROGRAM'S FILE-TABLES PUSHJ PP,SUSPC ;COMPUTE SPACE REQUIRED FOR SIMULTANEOUS ;UPDATE, AND GET IT PUSHJ PP,SETOVR ;SET UP OVERLAY FILE PUSHJ PP,RSTAB. ;ASSIGN THE BUFFER AREA SKIPE KEYCV.## ;WERE WE CALLED BY SORT? JRST 1(AC14) ;YES, RETURN. HRRZ AC10,COBSW. ;GET COMPILER ASSEMBLY SWITCHES HRRZ AC3,LIBSW. ;GET LIBOL ASS-SWITCHES CAME AC10,AC3 ;THE SAME? TTCALL 3,[ASCIZ /% COBOL-LIBOL ASSEMBLY SWITCHES MISMATCHED /] JRST 1(AC14) ;RETURN ;HERE TO CHAIN FILE-TABLES OF ALL SUBPROGRAMS TOGETHER ;POINTERS ARE AS FOLLOWS ;AC14/ ADR OF SP1 ;ADR OF ADR OF "MAIN" PROGRAM ;THE FOLLOWING ARE THE SAME FOR ALL SUBPROGRAMS ;SP1+1/ LST,,FILES. ;FILES. HAS ADR OF FIRST FILE-TABLE ;LST/ SP2 ;ADR OF SUBPROGRAMS CALLED BY SP1 ;LST+1/ SP4 ; . ;LST+N/ 0 ;TERMINATES WITH A ZERO RSTLNK: MOVEI AC3,AC3 ;THWART THE FIRST LINK HRR AC1,(AC14) ;ADDRESS OF "MAIN" PRG + 1 HRL AC2,1(AC1) ;SETUP THE HRRI AC2,FILES. ; FIXED HRRZI AC4,FILES. ; PARAMETERS BLT AC2,FIXNUM-1(AC4); %FILES THRU %PR RSTL10: HRRZ AC5,(AC1) ;[346] CHECK TO SEE IF THIS SUBROUTINE JUMPN AC5,RSTL30 ; IS IN AN LINK-10 OVERLAY AREA. ;; ((AC1)) = SKIPA 0,0 == IT ISN'T ;; ((AC1)) = JSP 1,MUMBLE == IT IS. MOVE AC1,1(AC1) ;ADDRES OF [LIST ,, FILES.] HLRZ AC2,AC1 ;ADR OF LIST OF CALLED SUBPROGRAMS SKIPGE AC4,(AC1) ;HAVE WE BEEN HERE BEFORE? POPJ PP, ;YES, -1 IN LEFT HALF JUMPE AC4,RSTL12 ;JUMP IF SUBPRG HAS NO FILE-TABLES SKIPN FILES. ;HAS FILES. BEEN SETUP YET? HRRM AC4,FILES. ;NO - SO DOIT HRRM AC4,(AC3) ;LINK THIS FILE-TABLE GROUP TO LAST GROUP RSTL11: HRRZI AC3,F.RNFT(AC4) ;GET ADR OF LINK TO NEXT TABLE HRRZ AC4,(AC3) ;GET THE LINK TO NEXT TABLE JUMPN AC4,RSTL11 ;LOOP IF NOT THE LAST TABLE RSTL12: HRROS (AC1) ;MARK THIS FILE-TABLE GROUP DONE RSTL20: SKIPN AC1,(AC2) ;ANY SUBPRGMS? POPJ PP, ;NO -- BACK TO THE LAST SUBPRG OR EXIT PUSH PP,AC2 ;SAVE POINTER TO SUBPROGRAM LIST PUSHJ PP,RSTL10 ;GO LINK THE FILE-TABLES POP PP,AC2 ;RETREIVE LIST POINTER RSTL30: SKIPE 1(AC2) ;ANY MORE SUBPRGMS? AOJA AC2,RSTL20 ;INCREMENT POINTER AND TRY AGAIN RSTLNX: POPJ PP, ;[312];NO--DONE. > ; END OF IFE %%RPG ;ASSIGN THE BUFFER AREA. ***POPJ*** RSTAB.: PUSHJ PP,GCHAN ;FIND A FREE CHANNEL PUSHJ PP,SETC1. ; ASSIGN TO IO UUOS SETOM FS.IF ;IDX FILE SETZM TEMP.1 ;ZERO THE ERROR COUNT HRRZ AC16,FILES. ;FIRST FILE TABLE JUMPE AC16,RET.1 ;THERE ARE NO FILES RSTIFI: SETZM TEMP. ;MAX SIZE OF BUF AREA RSTIF1: MOVE AC15,F.WDNM(I16);IF THIS IS FIRST TLNN AC15,BUFLOC ;[316] TIME THROUGH TABLE, PUSHJ PP,RSTFLG ;REORGANIZE THE FLAGS MOVE FLG,F.WFLG(I16) ;GET THE FLAGS HRLOI AC15,4077 ;[316];#OF DEVICES,,LOC OF FIRST ONE AND AC15,F.WDNM(I16) ; TLZE AC15,BUFLOC ;IS BUFLOC SET? IFE ISAM,< JRST RSTNFL ; [377] YES-NEXT FILE > IFN ISAM,< JRST RSTSAL ; [377] YES- SET UP SAVE AREA FOR ISAM FILES > MOVEM AC15,AC13 ; TLC AC13,777777 ;MAKE AOBJP AC13, .+1 ;KIND OF HRR AC13,AC15 ;AN IOWD MOVEM AC13,D.ICD(I16) ;%-<#OF DEVS>,,LOC OF FIRST DEVNAM RSTDEV: MOVE AC3,(AC13) ;SIXBIT /DEVICE NAME/ CALLI AC3,4 ;DEVCHR UUO TLNN AC3,140610 ;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR JRST RSTDE0 ; TLNN AC3,40000 ; [414] LPT? JRST RSTDV1 ; [414] NO MOVE AC12,(AC13) ; [414] LPT - GET NAME DEVTYP AC12, ; [414] SEE IF REAL LPT. JRST RSTDV1 ; [414] CAN'T, SKIP THIS. TLNE AC12,20 ; [414] IF SPOOLED SKIP THIS. JRST RSTDV1 ; [414] IT IS PUSHJ PP,INTINT ; [414] REAL LPT SET UP TRAPPING. RSTDV1: TLO FLG,DDMASC ;FORCE ASCII MODE TLZ FLG,DDMBIN!DDMSIX!DDMEBC ; FOR THE ABOVE DEVICES MOVEM FLG,F.WFLG(I16) ; RSTDE0: JUMPN AC3,RSTDE2 ; RSTDE1: MOVE AC2,[BYTE(5)25,4,20,13,23,15,14];"NOT A DEVICE OR PUSHJ PP,MSOUT. ;NOT AVAILABLE TO THIS JOB AOS TEMP.1 ;COUNT THE ERRORS JRST RSTLOO ; RSTDE2: SETZM UOBLK. ;[411] MAKE SURE WE DONT GET ILLEGAL MODE IF ASCII DEV MOVE AC12,.JBFF HRLM AC12,D.BL(I16) ;SET BUFFER LOCATION MOVE AC12,(AC13) ;SIXBIT /DEVNAM/ MOVEM AC12,UOBLK.+1 ;FOR THE INIT BLOCK HRLZI AC12,D.OBH(I16) ;LOC OF OBUF HDR TLNE FLG,OPNIO ;SKIP IF NOT IO HRRI AC12,D.IBH(I16) ;LOC OF IBUF HDR MOVEM AC12,UOBLK.+2 ;INIT BLOCK IFN ISAM,< MOVEI AC1,17 ;DUMP MODE TLNE FLG,IDXFIL ;INDEX-FILE? HRRZM AC1,UOBLK. ;YES > IFN TOPS20,< TLNE FLG,IDXFIL ;ISAM FILE? JRST RSTD21 ;YES > XCT UOPEN. ;******************** JRST RSTDE1 ;INIT FAILED, ERROR RETURN RSTD21: PUSH PP,.JBFF ; TLNE FLG,IDXFIL ; JRST RSTIDX ;SETUP FOR AN INDEX FILE TLNN AC3,20 ;SKIP IF A MTA TLNE FLG,RANFIL+OPNIO ;SKIP IF NOT RANDOM OR IO JRST RSTDE4 ;SETUP FOR NON-STD OR DUMP MODE BUFFERS RSTDE7: LDB AC6,F.BNAB ;NUMBER OF BUFFERS CAIN AC6,77 ; [414] REALLY WANTS ONE? SETOI AC6, ; [414] YES ONE BUFFER. XCT UOBUF. ;ALLOCATE ************** TLNE FLG,OPNIO ;THE XCT UIBUF. ;BUFFERS ************** RSTDE5: HLRZ AC12,D.BL(I16) ;CALCULATE SUB AC12,.JBFF ;THE SIZE POP PP,.JBFF ; MOVNS AC12 ;OF THE RSTDE3: CAML AC12,TEMP. ;BUFFER AREA MOVEM AC12,TEMP. ;SAVE SIZE OF LARGER ;LOOP AGAIN RSTLOO: IFN ISAM, AOBJN AC13,RSTDEV ;JUMP IF MORE DEV/FILTAB RSTLO1: MOVSI AC15,BUFLOC ;[316];NOTE WE ARE DONE IORM AC15,F.WDNM(I16);WITH THIS FILE TABLE HLRZ AC1,F.LSBA(I16) ;SEE IF ANY SHARING OF BUFFERS JUMPE AC1,RSTNFL ;GET THE NEXT FILE TABLE MOVEM AC1,AC16 ; JRST RSTIF1 ;SHARES THE SAME BUFFER AREA RSTNFL: MOVE AC12,TEMP. ;INCREASE .JBFF BY ADDM AC12,.JBFF ;THE BUFFER AREA SIZE HRRZ AC16,F.RNFT(I16);LOCATE THE NEXT FILE TABLE JUMPN AC16,RSTIFI ;AND JUMP IF THERE IS ONE. SKIPE TEMP.1 ;ANY ERRORS ? JRST KILL ;YES XCT URELE. ;RELEASE THE CHANNEL IFN ISAM,< ;GRAB SPACE FOR THE AUX BLOCK SKIPE MXBUF ;EXIT IF NO INDEXED FILES SKIPE KEYCV. ;SKIP IF RESET UUO JRST RSTXIT ;EXIT - ITS A SORT CALL MOVE AC0,MXBUF ;SIZE OF AUX BLOCK MOVE AC1,.JBFF ; HRRZM AC1,AUXBUF ;LOCATION OF AUX BLK PUSHJ PP,GETSPC ; JRST GETSPK ;ERROR RETURN ;SPACE FOR DATA-RECORD-TABLE FOR SPLITTING BLOCKS MOVE AC0,MXBF ;MAX-BLOCKING FACTOR OF ALL IDXFIL'S ADDI AC0,1 ;TERMINATOR MOVE AC1,.JBFF ; HRRZM AC1,DRTAB ; PUSHJ PP,GETSPC ; JRST GETSPK ;ERROR RETURN ;SPACE FOR INDEX ENTRY WHEN SPLITTING TOP INDEX BLOCK MOVE AC0,MXIE ;SIZE OF LARGEST INDEX ENTRY MOVE AC1,.JBFF ; HRRZM AC1,IESAVE ;LOC OF SAVE AREA PUSHJ PP,GETSPC ; JRST GETSPK > RSTXIT: LDB AC2,[POINT 4,UOPEN.,12] ;FREE THE CHANNEL PUSHJ PP,FRECH2 ; AND POPJ HRLZI AC0,577774 ;[342]TURN OFF CHAN 1 SKIPN TEMP.2 ;ANY RERUNS? POPJ PP, ;NO ANDM AC0,OPNCH. ;YES, DOIT SETOM RRFLG.## ;REMEMBER POPJ PP, IFN ISAM,< ; THIS ROUTINE GOES ALL FILES IN A SAME RECORD AREA CHAIN TO ;SET UP A SAVE AREA FOR ISAM FILES. THIS SAVE AREA WILL BE USED TO SAVE ;THE SECTION OF THE SHARED BUFFER AREA THAT ISAM FILE EXPECTS TO ;BE TRUE VALUES RSTSAL: SKIPE KEYCV. ; [377] SKIP THIS IS HERE ON SORT JRST RSTNFL ; [377] PUSH PP,AC16 ; [377] SAVE CURRENT FILE TABLE ADR MOVE AC12,TEMP. ; [377] UPDATE .JBFF ADDB AC12,.JBFF ; [377] SETZM TEMP. ; [377] CLEAR BUFFER SIZE RSTSL1: MOVE FLG,F.WFLG(I16) ; [377] GET FILE PARAMS TLNN FLG,IDXFIL ; [377] ISAM FILE ? JRST RSTLP ; [377] NO- GET NEXT FILE HRRZ AC2,D.IBL(I16) ; [377] SAVE AREA ALREADY SET UP? JUMPN AC2,RSTLP ; [377] IF SO, GO GET NEXT FILE HRRZ AC12,.JBFF ; [377] GET FREE CORE AREA HRRM AC12,D.IBL(I16) ; [377] SET START OF SAVE AREA TO .JBFF MOVEI AC0,ISMCLR+1 ; [377] AMOUNT OF SPACE FOR SAVE ARE PUSHJ PP,GETSPC ; [377] GET CORE SPACE JRST GETSPK ; [377] NO CORE- QUIT RSTLP: HLRZ AC12,F.LSBA(I16) ; [377] GET NEXT FILE IN SAME AREA CHAIN JUMPE AC12,RSTSL2 ; [377] NO MORE CAMN AC12,(PP) ; [377] SEE IF WE WENT ALL THRU CHAIN JRST RSTSL2 ; [377] YES ALL DONE MOVEM AC12,AC16 ; [377] SET UP NEXT FILE IN SAME AREA CHAIN JRST RSTSL1 ; [377] DO THIS FILE RSTSL2: POP PP,AC16 ; [377] GET BACK FIRST FILE IN CHAIN JRST RSTNFL ; [377] GO ON TO NEXT FILE TABLE > ; [377] END IFN ISAM ;SETUP FOR NONSTD BUFFERS OR DUMP MODE RSTDE4: LDB AC5,F.BBKF ;BLOCKING FACTOR JUMPN AC5,RSTD40 ; IF BLK-FTR = 0 TLNE FLG,DDMEBC ; AND DEVICE DATA MODE IS EBCDIC TLNN AC3,20 ; AND DEVICE IS A MTA JRST RSTD40 ; MOVEI AC5,1 ; THEN BLK-FTR DEFAULTS TO 1 DPB AC5,F.BBKF ; RSTD40: PUSHJ PP,OPNWPB ;AC10= WODRS PER LOGICAL BLOCK JUMPE AC5,RSTDE7 ;JUMP IF BLOCKING FACTOR IS 0 ADDI AC10,3 ; PLUS 3 FOR BOOKEEPING WORDS TLNN AC3,20 ;SKIP IF A MTA JRST RSTDE6 ;JUMP ITS NOT A MTA HLLZ AC6,D.F1(I16) ;SECOND FLAG REG TLNN AC6,STNDRD ;SKIP IF STANDARD LABELS JRST RSTD41 ;MTA W/NONSTD OR OMITTED LABELS CAIGE AC10,^D16+4 ;SKIP IF RECORD IS GE THE LABEL RECORD MOVEI AC10,^D16+4 ;ENSURE LABEL REC WILL FIT IN REC AREA RSTD41: TLNN FLG,DDMEBC ;SKIP IF EBCDIC JRST RSTDE8 ;ITS NOT ;IFN EBCDIC,< TLNN AC3,20 ; DEVICE A MTA? JRST RSTD42 ; NO SKIPGE D.F1(I16) ; VARIABLE LENGTH EBCDIC? ADDI AC10,1 ; YES - ADD IN ONE FOR BLOCK DESCRIPTOR WORD RSTD42: TLNN AC6,STNDRD ; LABELS STANDARD? JRST RSTDE8 ;NO - MUST BE OMITTED CAIGE AC10,^D20+4 ; MOVEI AC10,^D20+4 ;LABEL RECORD IS THE LARGEST RECORD ;> RSTDE8: TLNN AC6,NONSTD ;SKIP IF NON-STANDARD LABELS JRST RSTDE9 ; HLRZ AC1,F.LNLS(I16) ;NONSTD LABEL SIZE JUMPGE FLG,RSTD10 ;JUMP IF NOT ASCII ADDI AC1,2 ;ADD IN "CR-LF" CHARS IDIVI AC1,5 ; RSTD10: TLNN FLG,DDMASC ;SKIP IF ASCII IDIVI AC1,6 ; SKIPE AC2 ; ADDI AC1,1 ;CONVERT CHARS TO WORDS CAIGE AC10,3(AC1) ; MOVEI AC10,3(AC1) ;ENSURE LABEL REC WILL FIT IN REC AREA RSTDE9: MOVEI AC1,-3(AC10) ; HRRM AC1,D.LRS(I16) ;SAVE IT FOR OPNNSB LDB AC12,F.BNAB ;NUMBER OF ALTERNATES CAIN I12,77 ; [414] REALLY WANTS ONE? SETOI I12, ; [414] YES ONE BUFFER. IMULI AC10,2(I12) ;REC TIMES NUMBER OF ALTERNATE BUFFERS JRST RSTD11 ; RSTDE6: TLNN AC3,200000 ;SKIP IF DEV IS A DSK JRST RSTER0 ;COMPLAIN ADDI AC10,7 ;3+7=12 FLAG WORDS REQD FOR RANDOM OR IO RSTD11: MOVE AC0,AC10 ;SETUP AC0 FOR GETSPC PUSHJ PP,GETSPC ;CLAIM THE BUFFER AREA JRST GETSPK ;NO MORE CORE JRST RSTDE5 ;RETURN RSTER0: TTCALL 3,[ASCIZ /ONLY DSK MAY BE USED FOR RANDOM, IO OR INDEX-SEQ PROCESSING/] RSTERR: MOVE AC2,[BYTE (5)10,31,20] PUSHJ PP,MSOUT. IFE ISAM,< RERIT.: TTCALL 3,[ASCIZ /REWRITE ?/] SKIPA DELET.: TTCALL 3,[ASCIZ /DELETE ?/] RSTIDX: TTCALL 3,[ASCIZ / TO PROCESS ISAM FILES CBLIO MUST BE REASSEMBLED WITH THE CONDITIONAL ASSEMBLY SWITCH,ISAM, EQUAL TO A NON-ZERO VALUE./] JRST KILL > IFN ISAM,< ;SETUP FOR AN INDEX FILE RSTIDX: PUSHJ PP,OPNLIX ;IDXFIL FILENAME IFE TOPS20,< XCT ULKUP. ;*************** JRST RSTID1 ; > IFN TOPS20,< PUSH PP,.JBFF ;SAVE IT MOVEI AC0,ICHAN ;MAKE SURE WE HAVE CORE PUSHJ PP,GETSPC ;GO SEE JRST GETSPK ;NO CORE RETURN SO COMPLAIN POP PP,.JBFF ;RESTORE JOBFF PUSH PP,AC13 ;SAVE AC13 HLRZ I12,D.BL(I16) ;GET BUFFER LOCATION MOVEI AC0,1 ;USE CHANNEL ONE MOVEM AC0,ICHAN(I12) ;SAVE IT AWAY PUSHJ PP,OCPT ;USE TOPS20 COMPT. UUO JRST [CAME AC1,[0,,600130] ;INVALID SMU ACCESS? JRST [TTCALL 3,[ASCIZ /RESET TIME /] JRST OCPERR ] HRRZI AC0,1B25 ;YES - SO TRY A VALID ACCESS ANDCAM AC0,CP.BK3 ;TURN OFF THAWED (ON FROZEN) MOVE AC1,[10,,CP.BLK];COUNT,,ADR OF ARG-BLK COMPT. AC1, ;OPEN FILE IN FROZEN MODE JRST [TTCALL 3,[ASCIZ /RESET TIME /] JRST OCPERR ] JRST .+1] POP PP,AC13 ;RESTORE AC13 MOVE AC3,(AC13) ;GET DEVICE NAME CALLI AC3,4 ;RESTORE DEVICE CHARACTERISTICS > MOVEI AC0,STABL ; HRR AC1,.JBFF ; PUSHJ PP,GETSPC ; JRST GETSPK ;ERROR RETURN HRLI AC1,-STABL ; SUBI AC1,1 ;DUMP MODE IOWD SETZ AC2, ;TERMINATOR MOVEI AC6,1 ;LOCATION OF HRRM AC6,UIN. ; IOWD XCT UIN. ;READ IN STATISTICS BLOCK SKIPA AC12,1+ISPB(AC1) ;INDEX SECTORS / BLK JRST RSTIER ; HLRZ AC2,1(AC1) ;GET FILE FORMAT CODE CAIN AC2,401 ;COMPLAIN IF NOT 401 JRST RSTID7 ;OK PUSHJ PP,MSVID ;OUTPUT VALUE-OF-ID TTCALL 3,[ASCIZ/ IS NOT THE INDEX FOR ISAM/] PUSHJ PP,MSFIL. ;OUTPUT FILE NAME AND VID PUSHJ PP,KILL ;KILL NEVER RETURNS ;HERE IF LOOKUP FAILURE RSTID1: HLLZ AC1,D.F1(I16) ; GET FLG1 PARMS [377] TLNN AC1,FILOPT ;OPTIONAL FILE? [374] JRST RSTID8 ;[323]NO, FATAL HRRZ AC1,ULBLK.+1 ;GET THE ERROR CODE TRZ AC1,777740 ;WAS IT FILE NOT FOUND? JUMPN AC1,LUPERR ;EXIT HERE IF OTHER POP PP,.JBFF ;RESTORE THE STACK SETOM D.OPT(I16) ;FILE NOT FOUND - REMEMBER THAT JRST RSTLOO ; AND SHOOT HIM DOWN AT OPEN TIME RSTID8: PUSHJ PP,MSFIL. ; [323]OUTPUT FILE NAME TTCALL 3,[ASCIZ/ NOT FOUND AT RESET TIME/] PUSHJ PP,KILL ;[323] FATAL ERROR RSTID7: HLLZS UIN. ;CLEAR IOWD POINTER IMULI AC12,200 ;WRDS / SECTOR CAMLE AC12,MXBUF ;LARGER THAN LARGEST? MOVEM AC12,MXBUF ;YES, SAVE AS NEW LARGEST MOVE AC6,1+MXLVL(AC1) ;NUMBER OF INDEX LEVELS ADDI AC6,2 ;PLUS ONE FOR SAT BLK & ONE FOR SPLITING TOP-LEVEL IMUL AC12,AC6 ; ;FIND THE LARGEST INDEX ENTRY SIZE MOVE AC2,1+IESIZ(AC1) CAMLE AC2,MXIE ; MOVEM AC2,MXIE ; ;FIND THE MAX BLOCKING-FACTOR MOVE AC2,DBF+1(AC1) ; CAMLE AC2,MXBF ; MOVEM AC2,MXBF ; LDB AC6,KY.TP ; GET KEY TYPE JUMPN AC6,RSTID2 ;BRANCH IF NON-NUMERIC-DISPLAY MOVE AC4,1+IESIZ(AC1) ;INDEX ENTRY BLOCK SIZE SUBI AC4,1 ;-2 HDR WRDS, +1 WRD FOR WRAP-AROUND IMULI AC4,3 ;RESERVE 3 KEY AREAS JRST RSTID3 ; RSTID2: MOVEI AC4,6 ;1+1*3 TRNN AC6,1 ;ODD = 1 WRD, EVEN = 2 WRDS MOVEI AC4,9 ;2+1*3 RSTID3: ADDI AC12,2(AC4) ;NUMBER OF WORDS ALLOCATED MOVE AC2,F.WDNM(I16) MOVE AC2,1(AC2) ;DATA FILE DEVICE NAME MOVEM AC2,UOBLK.+1 ; XCT UOPEN. ;************** JRST RSTDE1 ;ERROR CALLI AC2,4 ;DEVCHR TLNE AC2,200000 ;DATA FILE TLNN AC3,200000 ;IDX FILE JRST RSTER0 ;MUST BE A DSK LDB AC5,KY.MD ; GET DATA MODE FROM STS-BLOCK XCT RSTID4(AC5) ; SAME AS FILE TABLE DATA MODE? JRST RSTID5 ; YES TTCALL 3,[ASCIZ /DATA-MODE DISCREPANCY/] MOVE AC2,[BYTE (5)10,31,20,4] JRST MSOUT. ; RSTID4: TLNE FLG,DDMSIX ; SKIP IF NOT SIXBIT TLNE FLG,DDMEBC ; EBCDIC TLNE FLG,DDMASC ; ASCII Z ; RSTID5: PUSH PP,AC12 ; [375] SAV REG 12 MOVEI AC12,1(AC1) ; [375] SET UP TO GET ISAM REC SIZE PUSHJ PP,OPNWPB ;RETURNS WRDS/LOGICAL BLOCK IN AC10 POP PP,AC12 ; [375]RESTORE AC12 CAMLE AC10,MXBUF ; MOVEM AC10,MXBUF ;SAVE AS LARGEST AUX BUF ADD AC12,AC10 ; ADDI AC12,ITABL ;INDEX TABLE LEN MOVE AC0,AC12 ; MOVEM AC0,D.OBH(I16) ;SAVE AMOUNT OF CORE REQUIRED PUSHJ PP,GETSPC ;GRAB SOME CORE AREA JRST GETSPK ;ERROR RETURN SETZM UOBLK. ; JRST RSTDE5 ;RETURN RSTIER: XCT UGETS. ;INPUT ERROR DURING RESET UUO TRNE AC2,020000 ;[376] EOF? TTCALL 3,[ASCIZ/ UNEXPECTED EOF ON ISAM INDEX FILE/] ;[376] PUSHJ PP,IOERM1 ; MOVE AC2,[BYTE (5)35,4,10,31,20,2] JRST KILL ;&KILL > ;GET CORE SPECIFIED BY (AC0) GETSPC: PUSH PP,.JBFF ;INCASE THE CORE UUO FAILS ADDB AC0,.JBFF ;ASSUME WE'LL GET IT CAMG AC0,.JBREL ;IS THERE ENOUGH IN FREE CORE JRST GETSP1 ;YEP CALLI AC0,11 ;NO, GET SOME MORE CORE JRST GETSP2 ;ERROR RETURN GETSP1: POP PP,(PP) ;.JBFF IS GOOD JRST RET.2 ;NORMAL EXIT GETSP2: POP PP,.JBFF ;RESTORE .JBFF, CORE UUO FAILED POPJ PP, GETSP9: TTCALL 3,[ASCIZ/INSUFICIENT CORE FOR BUFFER REQUIREMENTS/] POPJ PP, GETSPK: PUSHJ PP,GETSP9 JRST KILL ;SUBROUTINE TO SET UP OVERLAY FILE IFE %%RPG,< SETOVR: SKIPN AC1,OVRFN. ;ANY FILE TO BE OPENED POPJ PP, ;NO--RETURN HRLZI AC0,577774 ;[342]TURN OFF CHAN 1 ANDM AC0,OPNCH. ;DOIT HRROI AC0,-1 ;DSK = -1 SKIPN AC3,RN.DEV ;[333]IF DEVICE SPECIFIED, GET IT HRLZI AC3,(SIXBIT /DSK/) ; SETOV1: MOVEI AC2,14+1B30 ;SET UP DEVICE HRRZI AC4,OVRBF. ; OPEN 1,AC2 ;[342]INIT JRST SETOV4 ; MOVSI AC2,(SIXBIT "OVR") SETZB AC3,AC4 ; SKIPE AC0 ;[333]IF NOT TRYING SYS MOVE AC4,RN.PPN ;[333]GET OVERLAY PPN LOOKUP 1,AC1 ;[342] JRST SETOV5 ;LOOKUP FAILED INBUF 1,2 ;GET 2 BUFFERS MOVEI AC1,OVRIX. ; PUSHJ PP,SETOV2 ; MOVEI AC1,OVRIX.+200 ; SETOV2: IN 1, ;[342] SKIPA AC2,OVRBF. ; JRST SETOV6 ; MOVSI AC2,2(AC2) ; HRR AC2,AC1 ; BLT AC2,177(AC1) ; POPJ PP, SETOV4: TTCALL 3,[ASCIZ "CANNOT INITIALIZE OVERLAY DEVICE"] JRST KILL SETOV5: HRLZI AC3,(SIXBIT /SYS/) ;TRY SYS IF DSK FAILS AOJE SETOV1 ; TTCALL 3,[ASCIZ "CANNOT FIND OVERLAY FILE"] JRST KILL SETOV6: TTCALL 3,[ASCIZ "INPUT ERROR ON OVERLAY DEVICE"] JRST KILL > ; END OF IFE %%RPG ;ROUTINE TO REORGANIZE THE FLAGS RSTFLG: MOVE FLG,F.WFLG(I16) ;GET FLAGS HRLZI AC15,4300 ; AND AC15,FLG ;RRUNER & RRUNRC LDB AC1,[POINT 3,FLG,9] HLLZ AC2,FLGTAB(AC1) ;DEVICE DATA MODE TLZ AC2,037777 ; IOR AC15,AC2 ; MOVEI AC0,SASCII ; GET STANDARD ASCII FLAG CAIN AC1,4 ; AND SET IT IF REQUESTED IORM AC0,D.RFLG(I16) ; DOIT LDB AC1,[POINT 2,FLG,15] HLLZ AC2,FLGTAB(AC1) ;CORE DATA MODE TLZ AC2,777707 ; IOR AC15,AC2 ; LDB AC1,[POINT 2,FLG,17] HLLZ AC2,FLGTAB(AC1) ;ACCESS MODE TLZ AC2,777770 ; IOR AC15,AC2 ; TLNE FLG,20 ;FILOPT? TRO AC15,FILOPT ; TLNE FLG,100000 ;NONSTD? TRO AC15,NONSTD ; TLNE FLG,40000 ;STNDRD? TRO AC15,STNDRD ; TLNN AC15,DDMEBC ;ONLY EBCDIC HAS VAR-LEN RECORDS JRST RSTFL1 ; TLNE FLG,400000 ;VARIABLE LENGTH EBCDIC RECORDS? TRO AC15,VLREBC ; RSTFL1: HLLM AC15,F.WFLG(I16);SAVE IT HRLM AC15,D.F1(I16) ;FLG1 TLNE FLG,RRUNER!RRUNRC ;RERUNING? SETOM TEMP.2 ;YES, REMEMBER TO TURN OFF CHAN 17 POPJ PP, ; ;BITS 0-3 DEVICE DATA MODE ; 12-14 CORE DATA MODE ; 15-17 ACCESS MODE FLGTAB: 200022,,0 040001,,0 400044,,0 100010,,0 400000,,0 ; STANDARD ASCII Z Z Z ;**; BEFORE TRAP. [414] ; FOR REAL PRINTER ON-LINE. ; ; ERROR INTERCEPT. INTLOC: PUSH PP,INTBLK+2 ; [414] SAVE RETURN ADDRESS. PUSH PP,AC13 ; [414] SAVE AC13 SETZM INTBLK+2 ; [414] MOVEI AC13,^D30000 ; [414] SLEEP FOR 1/2 MIN. HIBER AC13, ; [414] JFCL ; [414] POP PP,AC13 ; [414] RESTORE AC13 POPJ PP, ; [414] RETURN TO PROGRAM TO RETRY. ; ;INITIALIZE INTERRUPT. ; INTINT: PUSH PP,AC13 ; [414] SAVE MOVEI AC13,INTBLK ; [414] SAVE LOCATION OF INTERRUPT BLOCK MOVEM AC13,.JBINT ; [414] IN JOBDAT. MOVEI AC13,INTLOC ; [414] SAVE INTERRUPT ADDRESS HRLI AC13,4 ; [414] AND ITS LENGTH MOVEM AC13,INTBLK ; [414] INTO INTERRUPT BLOCK MOVEI AC13,1 ; [414] SET FOR OFFLINE DEVICE. MOVEM AC13,INTBLK+1 ; [414] SETZM INTBLK+2 ; [414] CLEAR BLOCK SETZM INTBLK+3 ; [414] POP PP,AC13 ; [414] RESTORE AC13 POPJ PP, ; [414] RETURN. ;TRAP INTERUPT ROUTINE TRAP.: MOVE AC0,.JBCNI ;APR STATUS TRNE AC0,20000 TTCALL 3,[ASCIZ/MEMORY PROTECTION VIOLATION AT USER LOC /] TRNE AC0,10000 TTCALL 3,[ASCIZ/NON-EX-MEM REQUEST AT USER LOC /] TRNE AC0,200000 JRST TRAP1 ;PDLOV TRAP0: HRLO AC12,.JBTPC ;THE GUILTY LOCATION PUSHJ PP,PPOUT4 ;OUTPUT THE LOC IFE %%RPG,< HRRZ AC0,.JBTPC ;[312];SEE IF ERROR IS CAIL AC0,RSTLNK ;[312]; IN RSTLNK CAIL AC0,RSTLNX ;[312]; ROUTINE. JRST KILL ;[312];NO TTCALL 3,[ASCIZ /$FAILING ROUTINE IS RSTLNK IN CBLIO MACRO ROUTINE LOADED IN PLACE OF COBOL SUBROUTINE?/] > JRST KILL ;AND KILL TRAP1: TTCALL 3,[ASCIZ/PUSH-DOWN-LIST OVERFLOW AT /] JRST TRAP0 SRTER.:: TTCALL 3,[ASCIZ /YOU MUST RECOMPILE TO USE THE NEW SORT/] JRST KILL. ;ULOSE. IS THE ERROR EXIT FOR A UUO CALL TO A ROUTINE ;THAT WAS NOT LOADED. THE RUN IS TERMINATED VIA KILL ULOSE.: TTCALL 3,[ASCIZ /ENCOUNTERED A UUOCALL FOR A ROUTINE THAT WAS NOT LOADED /] SKIPA ;TO KILL ;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO" ;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME. GOTO.: TTCALL 3,[ASCIZ /ENCOUNTERED AN UNALTERED GOTO WITH NO DESTINATION /] ;KILL TYPES OUT THE LOCATION OF THE LAST COBOL UUO, ;STOPS ALL IO AND EXITS TO THE MONITOR. KILL: PUSHJ PP,TYPSTS ;TYPE ERROR-NUMBER, BLOCK # + REC # KILL.: PUSHJ PP,VEROUT ;TYPE THE VERSION NUMBER TTCALL 3,[ASCIZ / ?/] IFE %%RPG,< SKIPE TRAC1. ;IS THIS A PRODUCTION PROGRAM (I.E. /P)? [EDIT#270] PUSHJ PP,@TRAC1. ;NO, CALL BTRAC. IN TRACE ROUTINE > PUSHJ PP,PPOUT. ;TYPE THE LOCATION OF LAST COBOL VERB JRST STOPR2 ;TYPE OUT SOME ERROR INFORMATION TYPSTS: TTCALL 3,[ASCIZ / $ ERROR-NUMBER = /] TYPST1: MOVE AC0,FS.EN ;ERROR-NUMBER PUSHJ PP,PUTDEC ;TYPE IT MOVE AC0,FS.BN ;BLOCK-NUMBER JUMPE AC0,TYPST2 ; TTCALL 3,[ASCIZ / BLOCK-NUMBER = /] PUSHJ PP,PUTDEC ; TYPST2: MOVE AC0,FS.RN ;RECORD-NUMBER JUMPE AC0,RET.1 ; TTCALL 3,[ASCIZ / RECORD-NUMBER = /] JRST PUTDEC ;RETURN ;STOPR. IS CALLED WITH A "PUSHJ PP,STOPR." ALL FILES ARE ;CLOSED VIA COBOL CLOSE UUOS AND A CALLI EXIT IS EXECUTED. STOPR.: HRRZ AC16,FILES. ;LOOP THROUGH THE FILE TABLES JUMPE AC16,STOPR2 ;DONE STOPR1: HRLI AC16,001040 ;STANDARD CLOSE UUO MOVE FLG,F.WFLG(I16) ;GET THE FLAGS TLNE FLG,OPNIN+OPNOUT; IF THE FILE IS OPEN PUSHJ PP,C.CLOS ; CLOSE IT HRRZ AC16,F.RNFT(I16);NEXT FILE JUMPN AC16,STOPR1 ;LOOP STOPR2: MOVE AC0,FS.IEC ; NUMBER OF IGNORED ERRORS JUMPE AC0,STOPR3 ; NONE IGNORED TTCALL 3,[ASCIZ /% /] ; PUSHJ PP,PUTDEC ; TYPE NUMBER TTCALL 3,[ASCIZ/ ERRORS IGNORED/] STOPR3: IFE %%RPG,< PUSHJ PP,@HPRT.## ; PRINT HISTORY REPORT IF ANY > CALLI 12 ;CALLI EXIT ;TYPE THE VERSION NUMBER "LIBOL N(M)" VEROUT: SKIPN AC12,.JBVER ;GET VERSION NUMBER JRST VEROU1 ;EXIT IF NOT THERE IFE %%RPG,< TTCALL 3,[ASCIZ / LIBOL /] > IFN %%RPG,< TTCALL 3,[ASCIZ / RPGLIB /] > MOVEI AC0,4 ; PUSHJ PP,NUMOUT ;THE VERSION NUMBER MOVEI AC0,6 ; HRLZ AC12,.JBVER ; JUMPE AC12,VEROU1 ;DONE IF NO EDIT NUMBER MOVEI C,"(" ; PUSHJ PP,OUTCH. ; PUSHJ PP,NUMOUT ;THE EDIT NUMBER MOVEI C,")" ; PUSHJ PP,OUTCH. ; VEROU1: JRST DSPL1. ;"CRLF" AND EXIT NUMOUT: MOVEI C,6 ;HALF AN ASCII ZERO LSHC C,3 TRNN C,7 ;SKIP LEADING ZEROES SOJG AC0,NUMOUT JUMPL AC0,RET.1 PUSHJ PP,OUTCH. MOVEI C,6 LSHC C,3 SOJG AC0,.-3 POPJ PP, ; C.STOP IS CALLED WITH A "PUSHJ PP,C.STOP" AFTER THE OPERATOR ; TYPES "CONTINUE" IT RETURNS TO THE CALLING ROUTINE C.STOP: TTCALL 3,[ASCIZ /$ TYPE CONTINUE TO PROCEED .../] CALLI 1,12 ; WAIT FOR CONT POPJ PP, ; ; TYPES OUT THE LISTING'S LOCATION OF "PUSHJ PP,VERB" ; OR THE PUSHJ'S RETURN ADR IF NO PUSHJ IS FOUND ; (SBPSA.) NON-ZERO IF A SUBPROGRAM CALL IS ACTIVE ; LH IS (RH(17)) I.E. PUSH DOWN STACK ; RH IS ENTRY POINT'S ADDRESS ; ENTRY-1 SIXBIT /NAME-OF-ENTRY-POINT/ ; ENTRY-2 LH: FIRST LOCATION OF CURRENT (SUB)PROGRAM ; RH: SIXBIT /SUBPROGRAM-NAME/ PPOUT.: IFE %%RPG,< TTCALL 3,[ASCIZ /LAST COBOL VERB CALLED FROM /] > IFN %%RPG,< TTCALL 3,[ASCIZ /Last RPGLIB verb called from /] > HLRO AC12,PP ; FIND THE BEG OF THE STACK ADD AC12,PUSHL. ; -- SUBI AC12,(PP) ; -- MOVNS AC12 ; -- SKIPE AC11,SBPSA. ; THIS A SUBPROGRAM OR OVERLAY? HLRZ AC12,AC11 ; YES - GET FIRST ENTRY FROM HERE ADDI 12,1 ; 12 HAS POINTER TO FIRST ENTRY ON STACK MOVEI AC1,0 ; ASSUME NO COBDDT SKIPE CB.DDT ; ANY COBDDT? MOVEI AC1,2 ; YES - THERE ARE 2 ENTRIES ON LIST IFE %%RPG,< MOVE AC2,LIBSW. ; GET MULTIPLE PERFORM FLAG TRNE AC2,MPWC.S ; MULTIPLE-PERFORMS? ADDI AC1,1 ; YES - ANOTHER ENTRY ON PDLIST > IMUL AC1,LEVEL. ; ENTRIES PER LEVEL. ADD AC12,AC1 ; SKIP OVER COBDDT+PERF. STUFF HRRZ AC12,(AC12) ; GET RETURN ADR MINUS ONE MOVEI AC2,5 ; LOOK BACK 5 LOCS FOR A PUSHJ MOVEI AC1,-1(AC12) ; START AT THE RETURN ADR-1 PPOUT1: HLRZ AC3,(AC1) ; GET THE PUSHJ TO THE RIGHT HALF SUBI AC1,1 ; SET UP FOR NEXT COMPARE CAIE AC3,(PUSHJ PP,) ; WHAT IS IT? SOJG AC2,PPOUT1 ; NOT A PUSHJ SO LOOP JUMPE AC2,PPOUT2 ; NOT THERE SO GIVE RET ADR-1 HRRI AC12,1(AC1) ; THE PUSHJ'S ADR PPOUT2: SKIPN AC11,SBPSA. ; IF SUBPROGRAM MOVE AC11,%F.PTR ; NO - MAIN PROGRAM HLRZ AC11,-2(AC11) ; GET START ADR TRZ AC11,400000 ; TURN OFF BIT18 IF ON SUB AC12,AC11 ; GET OFFSET FROM HERE HRLOI AC12,(AC12) ; XWD ADR,,-1 PPOUT4: MOVEI C,6 ; HALF OF AN ASCII ZERO-60 LSHC C,3 ; APPEND THE OCTAL NUMBER PUSHJ PP,OUTCH. ; DEPOSIT IT IN THE TTY BUFFER TRNE AC12,-1 ; HAVE WE SEEN SIX NUMBERS? JRST PPOUT4 ; NO, LOOP PUSHJ PP,OUTBF. ; DUMP IT NOW TTCALL 3,[ASCIZ/ IN PROGRAM /] SKIPN AC3,SBPSA. ; SKIP IF ANY SUBPRGMS JRST PPOUT6 ; NONE PPOUT5: TTCALL 3,[ASCIZ / /] HRRI AC1,(AC3) ; GET ADR OF SUBPRG NAME HRL AC1,-2(AC1) ; TLNE AC1,-1 ; HLRZS AC1 ; IF IT'S ZERO SUBI AC1,1 ; ITS SAME AS ENTRY POINT HRLI AC1,(POINT 6) ; MAKE A BYTE-PTR MOVEI AC4,6 ; ONLY 6 CHARS PER NAME PUSHJ PP,MSVID4 ; TYPE IT TTCALL 3,[ASCIZ / ENTRY /] HRRI AC1,-1(AC3) ; MAKE BYTE-PTR TO ENTRY POINT HRLI AC1,(POINT 6) ; FINISH BYTE-POINTER MOVEI AC4,6 ; 6 IS MAX PUSHJ PP,MSVID4 ; TYPE IT TTCALL 3,[ASCIZ / CALLED FROM/] MOVS AC3,AC3 ; ANY MORE SUBPRGMS? SKIPE AC3,(AC3) ; SKIP IF NOT JRST PPOUT5 ; THERE ARE PPOUT6: MOVE AC1,%F.PTR ; GET THE PROGRAM NAME MOVEI AC1,-1(AC1) ; THIS IS IT HRLI AC1,(POINT 6) ; MAKE BYTE POINTER MOVEI AC4,6 ; NAME HAS 6 CHARS PUSHJ PP,MSVID4 ; DUMP THE NAME JRST DSPL1. ; APPEND "CRLF", THEN EXIT IFE %%RPG,< ; SUSPC: A SUBROUTINE THAT DETERMINES THE AMOUNT OF SPACE REQUIRED ; FOR SIMULTANEOUS UPDATE, AND GETS IT. IT ALSO INITIALIZES THE ; GLOBAL VARIABLES SU.RRT, SU.EQT, SU.DQT, SU.MQT, ; AND SU.FBT TO POINT TO THE RETAINED RECORDS TABLE, THE ENQUEUE ; TABLE, THE DEQUEUE TABLE, THE MODIFY TABLE, AND THE FILL/FLUSH ; BUFFER TABLE. ; ; ARGUMENTS: ; ; AC14 CONTAINS THE ADDRESS OF A WORD CONTAINING THE ; STARTING ADDRESS OF THE MAIN PROGRAM. ; ; CHANGES: ; ; AC0 ; AC1 ; AC2 ; AC3 ; WHATEVER GETSPC CHANGES ; ; CALLS: ; ; SUSPC1 ; GETSPC ; ; ERRORS: ; ; NOT ENOUGH SPACE AVAILABLE FOR SIMULTANEOUS UPDATE ; REQUIREMENTS. IF THIS OCCURS, A MESSAGE IS SENT ; TO TTY AND A JRST KILL. IS EXECUTED. EXTERN SU.RRT, SU.EQT, SU.FBT, SU.DQT, SU.MQT SUSPC: HRRZ AC1,0(AC14) ;GET STARTING ADDRESS OF MAIN PROGRAM SETZM SU.RRT ;INITIALIZE GLOBAL VARIABLES SETZM SU.EQT SETZM SU.FBT PUSHJ PP,SUSPC1 ;EXAMINE THE MAIN PROGRAM AND ALL ITS ;SUBPROGRAMS TO DETERMINE THE MAXIMUM ;REQUIREMENTS FOR SIMULTANEOUS UPDATE ;SPACE MOVE AC0,SU.RRT ADD AC0,SU.EQT ADD AC0,SU.EQT ADD AC0,SU.EQT ;(THERE ARE THREE ENQ/DEQ TABLES) ADD AC0,SU.FBT SKIPN AC0 POPJ PP, ;RETURN IF NO SPACE REQUIRED PUSH PP,.JBFF ;SAVE .JBFF ON THE STACK PUSHJ PP,GETSPC ;GET THE SPACE, IF POSSIBLE JRST SUERR ;JUMP IF NOT POSSIBLE POP PP,AC1 MOVE AC2,AC1 ADD AC2,SU.RRT MOVEM AC1,SU.RRT ;PUT RETAINED RECORDS TABLE AT ADDRESS ;OF FORMER .JBFF MOVE AC1,AC2 ;PUT ENQ/DEQ TABLES AT END OF THE ;RETAINED RECORDS TABLE ADD AC2,SU.EQT MOVEM AC2,SU.DQT ADD AC2,SU.EQT MOVEM AC2,SU.MQT ADD AC2,SU.EQT MOVEM AC1,SU.EQT MOVEM AC2,SU.FBT ;PUT THE FILL/FLUSH BUFFER TABLE AT THE ;END OF THE ENQ/DEQ TABLES POPJ PP, ;WE'RE ALL DONE SUERR: TTCALL 3,[ASCIZ"NOT ENOUGH SPACE AVAILABLE TO MEET THE REQUIREMENTS OF SIMULTANEOUS UPDATE. PLEASE RELINK TO PROVIDE MORE SPACE."] JRST KILL. ; SUSPC1: A SUBOUTINE TO DETERMINE THE MAXIMUM REQUIREMENT FOR SIMULTANEOUS ; UPDATE SPACE OF A PROGRAM AND ITS SUBPROGRAMS ; ; ARGUMENTS: ; ; AC1: THE STARTING ADDRESS OF THE PROGRAM ; ; IN THE %FILES AREA OF THE PROGRAMS THERE ARE THESE QUANTITIES: ; ; %SURRT: THE SPACE REQUIRED BY THE PROGRAM FOR ; THE RETAINED RECORDS TABLE ; ; %SUEQT: THE SPACE REQUIRED BY THE PROGRAM FOR ; EACH OF THE ENQ/DEQ TABLES ; ; %SUFBT: THE SPACE REQUIRED BY THE PROGRAM FOR ; THE FILL/FLUSH BUFFER TABLE ; ; RESULTS: ; ; SU.RRT IS SET TO THE MAX OF SU.RRT AND %SURRT IN THE ; PROGRAM AND EACH OF ITS SUBPROGRAMS ; ; SU.EQT IS SET TO THE MAX OF SU.EQT AND %SUEQT IN THE ; PROGRAM AND EACH OF ITS SUBPROGRAMS ; ; SU.FBT IS SET TO THE MAX OF SU.FBT AND %SUFBT IN THE ; PROGRAM AND EACH OF ITS SUBPROGRAMS ; ; CHANGES: ; ; AC1 ; AC2 ; AC3 ; ; ASSUMPTIONS: ; ; SU.RRT, SU.EQT, SU.FBT ARE INITIALIZED BEFORE THIS ; ROUTINE IS CALLED THE FIRST TIME ; ; NOTES: ; ; THE ROUTINE CALLS ITSELF RECURSIVELY. SUSPC1: HRRZ AC2,(AC1) ;CHECK TO SEE IF THIS SUBROUTINE IS IN JUMPN AC2,RET.1 ; A LINK-10 OVERLAY AREA. ; ((AC1)) = SKIPA 0,0 <==> IT ISN'T ; ((AC1)) = JSP 1,MUMBLE <==> IT IS. HRRZ AC2,1(AC1) ;ADDRESS OF %FILES TO AC2 HLRZ AC3,(AC2) ;HAVE WE BEEN HERE BEFORE? JUMPE AC3,RET.1 ;YES, LEAVE. MOVE AC3,%SURRT(AC2) ;SET SU.RRT TO MAX OF SU.RRT AND %SURRT CAMLE AC3,SU.RRT MOVEM AC3,SU.RRT MOVE AC3,%SUEQT(AC2) ;SET SU.EQT TO MAX OF SU.EQT AND %SUEQT CAMLE AC3,SU.EQT MOVEM AC3,SU.EQT MOVE AC3,%SUFBT(AC2) ;SET SU.FBT TO MAX OF SU.FBT AND %SUFBT CAMLE AC3,SU.FBT MOVEM AC3,SU.FBT HRRZS (AC2) ;MARK THIS SUBPROGRAM AS DONE. HLRZ AC2,1(AC1) ;GET ADDRESS OF SUBPROGRAM LIST SUSPCX: SKIPN AC1,0(AC2) POPJ PP, ;RETURN IF NO MORE SUBPROGRAMS PUSH PP,AC2 ;SAVE AC2 ON STACK PUSHJ PP,SUSPC1 ;CALL OURSELVES TO PROCESS SUBPROGRAM POP PP,AC2 ;RESTORE AC2 AOJA AC2,SUSPCX ;POINT TO NEXT SUBPROGRAM > ; END OF IFE %%RPG SUBTTL SEEK-UUO ;A SEEK UUO LOOKS LIKE: ;002240,,ADR ADR = FILE TABLE ADDRESS ;CALL+1: ;POPJ RETURN SEEK.: MOVE FLG,F.WFLG(I16) ;FLAG REGISTER TLNE FLG,RANFIL ;SKIP IF NOT A RANDOM FILE TLNN FLG,OPNIN!OPNOUT ;SKIP IF RANDOM FILE IS OPEN POPJ PP, ;EXIT TO ***ACP*** HLRZ I12,D.BL(I16) ;SET UP FOR FLIMIT PUSHJ PP,FLIMIT ;CHECK THE FILE LIMITS ;INVALID KEY RETURNS TO ***ACP*** MOVE AC1,AC4 ;ACTUAL KEY PUSHJ PP,SETCN. ;SET UP CHANNEL NUMBER XCT USETI. ; XCT USEEK. ;SEEK UUO POPJ PP, ;EXIT TO ***ACP*** IFE %%RPG,< ;FORCE A CALL TO RRDMP RENDP: SETOM REDMP. ; JRSTF @.JBOPC ;CONTINUE ;RESTORE .JBSA, .JBREN - DESTROYED BY RERUN'S GETSEG RSAREN: HRR AC2,RESET1 HRRM AC2,.JBSA MOVEI AC2,RENDP MOVEM AC2,.JBREN MOVEI AC2,EDIT HRLI AC2,VERSION MOVEM AC2,.JBVER ; [EDIT#272] POPJ PP, > ; END OF IFE %%RPG SUBTTL DISPLAY-UUO IFE %%RPG,< ;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING UUO IN AC 16. ;THE UUO'S EFFECTIVE ADDRESS CONTAINS A MODIFIED BYTE POINTER TO THE ;ASCII CHARACTER STRING. MODIFICATIONS FOLLOW: ; IF BIT 6 IS SET LEADING SPACES AND HOR-TABS ARE SUPPRESSED. ; IF BIT 7 IS SET A "CRLF" IS APPENDED TO THE CHARACTER STRING. ; BITS 8-17 CONTAIN THE NUMBER OF CHARACTERS TO BE DISPLAYED. ;THE ONLY ERROR EXIT IS A CALL TO C.STOP CAUSED BY "TELETYPE OUTPUT ;ERROR". A NORMAL RETURN IS A POPJ PP,. ;MODIFIED ACS ARE: 17,15,11,7,6,AND 4. ;AC16= ;THE CALLING UUO ;AC15= ;UUO'S OPERAND ;AC6= ;CHARACTER COUNT ;AC4= ;BLANK COUNT ;AC12 ;MUST NOT BE USED ;FOLLOWING BITS ARE IN LEFT HALF OF FLG BIT6= 4000 ;NUMERIC, SUPPRESS LEADING SPACES AND TABS BIT7= 2000 ;LAST FIELD, APPEND "CRLF" DSPLY.: SKIPE TTYOPN ;IS THERE A TTY FILE OPEN? PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING MOVE AC15,(I16) ;GET DISPLAY OPERAND MOVE FLG,AC15 ;SAVE IT FOR THE FLAGS LDB AC6,DOPFS. ;NUMBER OF CHARS. TO BE DISPLAYED TLZ AC15,7777 ; TLO AC15,700 ;(AC15) IS BYTE POINTER TO CHARS. TLNE FLG,BIT7 ;APPEND CR-LF AT END? JRST DSPL2 ; YES ILDB C,AC15 ;GET A CHARACTER. SKIPE C ;DONT PASS NULLS BUT COUNT THEM PUSHJ PP,OUTEST ;OUTPUT A CHAR. SOJG AC6,.-3 ;LOOP IF NOT DONE. JRST OUTBF. ;DUMP THE BUFFER AND EXIT. DSPL2: SETZ AC4, ;CLEAR THE BLANK COUNT DSPL23: ILDB C,AC15 ;GET A CHARACTER CAIN C,040 ;A BLANK? AOJA AC4,DSPL21 ; YES JUMPE AC4,DSPL22 ;JUMP IF NO ACCUMULATED BLANKS MOVEI C,040 ;OUTPUT BLANKS PUSHJ PP,OUTEST ; SOJG AC4,.-2 ;LOOP LDB C,AC15 ;RESTORE ORIGINAL CHARACTER DSPL22: SKIPE C ;COUNT NULLS BUT DONT OUTPUT THEM PUSHJ PP,OUTEST ;OUTPUT THE CHARACTER DSPL21: SOJG AC6,DSPL23 ;LOOP > ; end of IFE %%RPG DSPL1.: MOVEI C,15 ;APPEND CR-LF PUSHJ PP,OUTCH. ; . MOVEI C,12 ; . PUSHJ PP,OUTCH. ; . JRST OUTBF. ;DUMP BUFFER AND EXIT. IFE %%RPG,< DSPTO: PUSH PP,AC16 ;SAVE AC16 MOVE AC16,TTYOPN ;GET FILE-TABLE ADR FOR ERROR ROUTINES PUSHJ PP,SETCN. ;SETUP IO CHANNEL PUSHJ PP,WRTOUT ;DUMP THE BUFFER POP PP,AC16 ;RESTORE POPJ PP, ;EXIT OUTEST: TLNN FLG,BIT6 ;SUPPRESS LEADING SPACES? JRST OUTCH. ; NO. CAIE C,40 ; YES, ARE THERE ANY? CAIN C,11 ; POPJ PP, ; YES. TLZA FLG,BIT6 ; NO, AND NONE FOLLOWING. > ; END OF IFE %%RPG OUT6B.: ADDI C,40 ;CONVERT A 6IXBIT CHAR OUTCH.: IDPB C,TTOBP. ;DEPOSIT CHAR. IN BUFFER. SOSLE TTOBC. ;DUMP THE BUFFER? POPJ PP, ; NO. ;OUTPUT A TTY BUFFER. ***POPJ*** OUTBF.: SETZ C, ;ASCIZ TERMINATOR IDPB C,TTOBP. ; TTCALL 3,TTOBF. ;DUMP THE BUFFER OUTBF1: MOVE C,[POINT 7,TTOBF.] MOVEM C,TTOBP. ;INITIALIZE THE BYTE-POINTER MOVEI C,^D132 ;A 132 CHAR BUFFER MOVEM C,TTOBC. ;INITIALIZE THE BYTE-COUNT POPJ PP, ; ;RETURN A CHARACTER IN C ;IGNORE "CARRIAGE-RETURN" ;SKIP EXIT IF NOT AN END-OF-LINE CHAR ;POPJ IF EOL, EOL = LF, VT, FF OR ALT-MODE GETCH.: TTCALL 4,C ;INPUT A LINE, FIRST CHAR TO C [EDIT#267] CAIN C,15 JRST GETCH. CAIN C,33 JRST GETCH1 CAIG C,14 CAIGE C,12 JRST RET.2 GETCH1: MOVEI C,12 POPJ PP, SUBTTL OPEN-UUO ;AN OPEN UUO LOOKS LIKE: ;001000,,ADR WHERE ADR = FILE TABLE ADDRESS ;BIT9 =1 OPEN FOR OUTPUT ;BIT10 =1 OPEN FOR INPUT ;BIT11 =1 DON'T REWIND ;BIT12 =0 ALWAYS 0 (VS. 1 = CLOSE) ;CALL+1: POPJ RETURN ;MAKE PRELIMINARY CHECKS: ALREADY OPEN, OPTIONAL FILE PRESENT, ;ANOTHER FILE USING SHARED BUFFER AREA ***OPNDEV*** C.OPEN: TLO AC16,OPEN ;OPEN-UUO MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR BLT AC0,FS.IF ; STATUS WORDS. SETOM FS.IF ;IDX FILE IS DEFAULT MOVE FLG,F.WFLG(I16) HLLZ FLG1,D.F1(I16) ;MORE FLAGS HLRZ AC0,F.WDNM(I16) ;[346] CHECK FLAG TO SEE IF THIS TRNN AC0,4000 ; FILE TABLE HAS BEEN LINKED TO JRST OOVLER ; THE CHAIN. TLNN FLG,OPNIN+OPNOUT ;IS THE FILE OPEN? JRST OPNLOC ;NO HRLZI AC2,(BYTE (5)10,2,3) ;FCBO,AO. MOVEI AC0,^D10 ;ERROR NUMBER JRST OXITER ;ONLY CLOSED FILES MAY BE OPENED OPNLOC: SETZM D.RP(I16) ;INITIALIZE THE RECORD SEQUENCE NUMBER MOVE AC5,D.LF(I16) ; TLNN AC5,LOCK ;SKIP IF THE FILE IS LOCKED JRST OPNOPT ; MOVEI AC0,^D11 ;ERROR NUMBER PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS TTCALL 3,[ASCIZ /LOCKED /] HRLZI AC2,(BYTE(5)10,2,4) JRST MSOUT. ;EXIT, THE FILE IS LOCKED OPNOPT: TLNE AC16,400 ;SKIP IF NOT OUTPUT TLO FLG,OPNOUT ; TLNE AC16,200 ;SKIP IF NOT INPUT TLO FLG,OPNIN ; TLNE FLG1,FILOPT ;IS FILE OPTIONAL? JRST OPNOP ;YES. RETURNS ONLY IF PRESENT OPNSBA: PUSHJ PP,DEVIOW ;RESET THE DEVICE IOWD TLNE FLG,RANFIL ;SKMFILE PUSHJ PP,OPNSFL ;STORE THE FILE LIMITS SO HE CAN'T DIDDLE HLRZ AC4,F.LSBA(I16) ;FILTAB THAT SHARES THE SAME BUFFER OPNSB1: JUMPE AC4,OPNDEV ;JUMP IF NO ONE SHARES CAIN AC4,(I16) ;HAVE WE CHECKED ALL "SBA" FILTAB'S JRST OPNDEV ;YES HLL AC4,10(AC4) ;GET THE FLAGS TLNE AC4,030000 ;SKIP IF ANY FILES ARE NOT OPEN JRST OPNSB2 ;GIVE AN ERROR MESSAGE HLRZ AC4,15(AC4) ;GET NEXT "SBA FILTAB" JRST OPNSB1 ;+LOOP OPNSB2: MOVEI AC0,^D12 ;ERROR NUMBER PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS MOVE AC5,AC4 ;MSOUT. USES AC4 MOVE AC2,[BYTE (5)10,31,20,2,1,14] PUSHJ PP,MSOUT. HRLZI AC2,(BYTE (5)10,31,20) HRR AC16,AC5 JRST MSOUT. ;SOME OTHER FILE IS USING OUR BUFFER AREA OOVLER: HRRZ AC0,HLOVL. ;[346] GET START OF OVERLAY AREA CAIG AC0,(I16) ;[346] IF FILE-TABLE IN OVL AREA JUMPN AC0,OOVLE1 ;[346] COMPLAIN MOVEI AC0,^D30 ;ERROR NUMBER PUSHJ PP,OXITP ;POPJ TO MAIN LINE IF IGNORING ERRORS TTCALL 3,[ASCIZ "ATTEMPT TO DO I/O FROM A SUBROUTINE CALLED BY A NON RESIDENT SUBROUTINE."] ;[346] JRST OOVLE2 ;[346] OOVLE1: MOVEI AC0,^D31 ;ERROR NUMBER PUSHJ PP,OXITP ;POPJ IF IGNORING ERRORS OOVLE2: TTCALL 3,[ASCIZ /IO CANNOT BE DONE FROM AN OVERLAY/] ;[346] HRLZI AC2,(BYTE (5)10,2) ;[346] GO COMPLAIN PUSHJ PP,MSOUT. ;[346] DOESN'T RETURN OPNOP: TLNE FLG,OPNOUT ;SKIP IF NOT OUTPUT JRST OPNSBA ;OUTPUT FILES ARE NOT OPTIONAL ;OPNOP+2 [277] IG 22-OCT-73 PUSHJ PP,$SIGN ;OUTPUT "$" FOR .OPERATOR [EDIT#277] TTCALL 3,[ASCIZ /IS /] ;OPTIONAL FILE PRESENT? PUSHJ PP,MSFIL. TTCALL 3,[ASCIZ / PRESENT? .../] PUSHJ PP,YES.NO ;SKIP RETURN IF "NO" ANSWER JRST OPNOP1 ;YES TLO FLG,NOTPRS ;NO, "NOT PRESENT" TLZ FLG,OPNIN ;NOTE THAT IT'S NOT OPEN MOVEM FLG,F.WFLG(I16) ;%SAVE THE FLAG WORD POPJ PP, ;RETURN TO MAIN LINE *EXIT************ OPNOP1: TLNN FLG,IDXFIL ;ISAM FILE? JRST OPNSBA ;NO MOVE AC1,D.OPT(I16) ;WERE THE BUFFERS SETUP AT RESET TIME? AOJN AC1,OPNSBA ;EXIT HERE IF THEY WERE MOVEI AC0,^D29 ;ERROR NUMBER PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS TTCALL 3,[ASCIZ /EITHER THE ISAM FILE DOES NOT EXIST OR THE VALUE OF ID CHANGED DURING THE PROGRAM/] ;[374] PUSHJ PP,KILL ;AND DONT RETURN YESNO: TTCALL 11,0 ;CLEAR THE BUFFER TTCALL 3,[ASCIZ /$ TYPE YES OR NO /] YES.NO: MOVE AC5,[POINT 7,[ASCIZ /ES/],] PUSHJ PP,GETCH. JRST .-1 CAIE C,"Y" JRST YESNO2 YESNO1: PUSHJ PP,GETCH. POPJ PP, ;IS THE "YES" RETURN ILDB AC4,AC5 JUMPE AC4,RET.1 ;[V10] CAMN AC4,C JRST YESNO1 JRST YESNO YESNO2: MOVE AC5,[POINT 7,[ASCIZ /NO/],] YESNO3: ILDB AC4,AC5 JUMPE AC4,RET.2 ;[V10] CAME AC4,C JRST YESNO PUSHJ PP,GETCH. JRST RET.2 ;THE NO RETURN JRST YESNO3 ;SETUP DEVICE IOWD DEVIOW: HRLOI AC0,77 ; AND AC0,F.WDNM(I16) ; TLC AC0,-1 ; AOBJP AC0,.+1 ; HRR AC0,F.WDNM(I16) ; IFN ISAM,< TLNE FLG,IDXFIL ;IF INDEX FILE AOBJP AC0,.+1 ; POINT AT DATA DEVICE > MOVEM AC0,D.ICD(I16) ; POPJ PP, ; ;SET THE FILE LIMIT CLAUSES IN THE FILE-TABLE. ***POPJ*** OPNSFL: LDB AC5,F.BNFL ;NUMBER OF FILE LIMIT CLAUSES JUMPE AC5,RET.1 ;RETURN IF NONE MOVNS AC5 ; HRL AC1,AC5 ; HRRI AC1,F.WLHL(I16) ;IOWD NUMBER OF,, FILE LIMIT HLR I12,D.BL(I16) ;PICK UP THE BUFFER LOCATION MOVEM AC1,R.FLMT(I12) ; OPNSF1: MOVE AC5,(AC1) ;LIMIT,,LIMIT MOVE AC6,(AC5) ; MOVSS AC5 ; MOVE AC4,(AC5) ; CAMLE AC4,AC6 ;SKIP IF AC4 IS THE LOW LIMIT EXCH AC4,AC6 ; MOVEM AC4,1(AC1) ;LOW LIMIT MOVEM AC6,2(AC1) ;HIGH LIMIT ADDI AC1,2 ;ACCOUNT FOR TWO WORDS AOBJN AC1,OPNSF1 ;GO AGAIN IF YOU CAN POPJ PP, ; ;GET DEVICE CHARACTERISTICS AND CHECK IF DEVICE CAN DO ;REQUESTED IO FUNCTIONS ***OPNCHN*** ;ENTRY POINT FOR READ GENERATED CLOSE GENERATED OPEN. ***READEF+N*** OPNDEV: SETZM D.OE(I16) ;CLEAR NUMBER OF OUTPUTS SETZM D.IE(I16) ; NUMBER OF INPUTS PUSHJ PP,DEVCHR ;GET THE DEVICE CHAR. TLNE AC13,40 ;SKIP IF NOT AVAILABLE TO JOB JRST OPNDE2 MOVE AC2,[BYTE (5)10,2,4,20,15] ;FCBO,DINATTJ. MOVEI AC0,^D13 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE2: TLNN AC13,200000 ;SKIP IF A DSK TRNN AC13,200000 ;SKIP IF DEV IS INITED JRST OPNDE6 MOVE AC2,[BYTE (5)10,2,4,20,16] ;FCBO,DIATAF. MOVEI AC0,^D14 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE6: TLNN FLG,OPNIO ;SKIP IF IO IS REQUESTED JRST OPNDE7 ;NEXT TEST TLNE AC13,200000 ;SKIP IF DEVICE IS NOT A DSK JRST OPNCHN ;FIND A FREE CHANNEL MOVE AC2,[BYTE (5)10,2,4,20,17] MOVEI AC0,^D15 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE7: TLNE FLG,OPNIN ;SKIP IF NOT AN INPUT REQUEST TLNE AC13,2 ;SKIP IF DEVICE CANNOT DO INPUT JRST OPNDE8 ;NEXTEST MOVE AC2,[BYTE (5)10,2,4,20,21] MOVEI AC0,^D16 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE8: TLNE FLG,OPNOUT ;SKIP IF NOT AN OUTPUT REQUEST TLNE AC13,1 ;SKIP IF DEVICE CANNOT DO OUTPUT JRST OPNCHN ;FIND A FREE CHAN MOVE AC2,[BYTE (5)10,2,4,20,22] MOVEI AC0,^D17 ;ERROR NUMBER JRST OXITER ;COMPLAIN DEVCHR: MOVE AC13,D.ICD(I16) ;ADR OF DEV. NAME MOVE AC13,(AC13) ;SIXBIT/DEVICE NAME/ MOVEM AC13,UOBLK.+1 ;FOR OPEN CALLI AC13,4 ;DEVCHR UUO TLNN FLG,OPNIO+OPNIN ;[330]IF NOT INPUT THEN IGNORE JRST DEVCH1 ;[330] TLC AC13,300000 ;[330]IF A DSK AND A CDR TLCN AC13,300000 ;[330]THEN ITS DEVICE 'NUL' TLZ AC13,20 ;[330]SO ITS NOT A MAGTAPE DEVCH1: MOVEM AC13,D.DC(I16) ;[330]SAVE THE CHARACTERISTICS SKIPE AC13 POPJ PP, MOVE AC2,[BYTE (5)10,2,4,20,13] ;FCBO,DINAD. POP PP,(PP) ;POP OFF THE RETURN MOVEI AC0,^D18 ;ERROR NUMBER JRST OXITER ;COMPLAIN ;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS ;XCT OPEN, INBUF AND/OR OUTBUF ***OPNBSI*** OPNCHN: PUSHJ PP,GCHAN ;LOAD AC5 WITH A CHANNEL NUMBER DPB AC5,DTCN. ;SAVE IT IFN ISAM,< TLNN FLG,IDXFIL ;INDEX FILE ? JRST OPNCH1 ;NO PUSHJ PP,GCHAN ; HLRZ I12,D.BL(I16) ; HRRZM AC5,ICHAN(I12) ;SAVE INDEX FILE CHAN NO. > OPNCH1: PUSHJ PP,SETC1. ;DISTRIBUTE THE CHANNEL NUMBER TLNE FLG,DDMASC ;SKIP IF NOT ASCII TDZA AC6,AC6 ;ASCII MODE AND SKIP MOVEI AC6,14 ;PERHAPS BINARY TLNE FLG,RANFIL!OPNIO!IDXFIL ;SKIP IF BUFFERED IO MOVEI AC6,17 ;DUMP MODE HRRM AC6,UOBLK. ;UOBLK.+1 SET AT DEVCHR HRLI AC6,D.OBH(I16) ;OUTPUT BUFFER HEADER HRRI AC6,D.IBH(I16) ;INPUT BUF HDR MOVEM AC6,UOBLK.+2 IFN ISAM,< TLNN FLG,IDXFIL ;ISAM ? JRST OPNCH3 ;NO MOVE AC1,F.WDNM(I16) ;ADR MOVE AC1,(AC1) ;IDX DEVICE NAME MOVEM AC1,UOBLK.+1 ; OPNCH3:> SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNC31 ; NO IFE TOPS20,< PUSHJ PP,OPNFOP ; YES OPEN FILE VIA FILOP JRST OFERR ; ERROR RETURN >; END OF IFE TOPS20 IFN TOPS20,< PUSHJ PP,OCPT ; OPEN FILE VIA DEC-SYS-20 COMPT. JRST OCPER ; ERROR RETURN >; END IFN TOPS20 JRST OPNC41 ; OPNC31: XCT UOPEN. ;OPEN THE DEVICE *************** OPNCH4: JRST OERRIF ;OPEN FAILED OPNC41: PUSHJ PP,OPNWPB ;RETS LOGICAL BLOCK SIZE IN AC10, BLKFTR IN AC5 LDB AC6,F.BNAB ;NUMBER OF ALTERNATE BUFFERS (FOR INBUF X,2(AC6)) TLNE AC13,20 ;SKIP IF NOT A MTA JUMPN AC5,OPNNSB ;NON STANDARD BUFFER SIZE IFN ISAM,< TLNE FLG,IDXFIL ;ISAM ? JRST OPNIDX ;YES > TLNE FLG,OPNIO+RANFIL ;OPNIO=IOFILE JRST OPNRIO ;RANDOM OR IO DUMP MODE BUFFERS PUSH PP,.JBFF HLRZ AC11,D.BL(I16) ;BUFFER LOCATION MOVEM AC11,.JBFF CAIN AC6,77 ; [414] REALLY WANTS ONE? SETOI AC6, ; [414] YES, ONE BUFFER. TLNE FLG,OPNIN ;INPUT? XCT UIBUF. ;********** TLNE FLG,OPNOUT ;OUTPUT? XCT UOBUF. ;********** POP PP,.JBFF ;RESTORE .JBFF OPNCH2: TLNE AC13,4 ;SKIP IF NON-DIRECTORY DEVICE TLNE FLG1,STNDRD ;SKIP IF NOT STANDARD LABELS JRST OPNBSI ;SET THE BYTE SIZE PUSHJ PP,RCHAN ;RELEASE DEVICE AND CHANNEL MOVEI AC0,^D19 ;ERROR NUMBER PUSHJ PP,OXITP ;RETURN TO CBL-PRG IF IGNORING ERRORS MOVE AC2,[BYTE (5)10,2,4,26] ;FCBO,DDMHSL JRST MSOUT. ;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK). ***OPNCH2*** OPNNSB: ADDI AC6,2 ;ALTERNATE PLUS 2 DEFAULT BUFFERS TLNE FLG1,STNDRD+NONSTD ;SKIP IF OMITTED LABELS HRRZ AC10,D.LRS(I16) ;IN CASE LABEL IS GE TO REC AREA HLRZ AC4,D.BL(I16) ;BUFFER LOCATION ADDI AC4,1 ;BUF1+1 HRLI AC4,400000 ; AND NEVER WAS REFERENCED MOVEM AC4,D.IBH(I16) ;INPUT HEADER MOVEM AC4,D.OBH(I16) ;OUTPUT HEADER HRR AC2,AC4 ;BUF1+1 HRLI AC2,1(AC10) ;SIZE+1,,BUF1+1 SKIPA AC3,AC4 ;BUF1+1 OPNNS1: ADDI AC3,3(AC10) ;LOCATION OF NEXT LINK ADDI AC2,3(AC10) ;SIZE+2,, MOVEM AC2,(AC3) ;SIZE+2,,BUF2+1 SOJG AC6,OPNNS1 ;LOOP IF ANY MORE BUFFERS HRRM AC4,(AC3) ;LAST BUFFER CLOSES THE RING (BUF1+1) ADDI AC4,1 ;BUF1+2 HRRM AC4,D.IBB(I16) ;INPUT HEADER BYTE POINTER HRRM AC4,D.OBB(I16) ;OUTPUT H... JRST OPNCH2 ;RETURN TO MAIN LINE ;AC10 = WORDS PER LOGICAL BLOCK ;INITIALIZE DUMP MODE BUFFERS FOR RANDOM AND IO. ***OPNCON*** OPNRIO: HLRZ I12,D.BL(I16) ;BUFFER LOCATION MOVNM AC10,AC6 ;0,,-N HRLI AC6,R.FLMT(I12) ;LOC-1,,-N MOVSM AC6,R.IOWD(I12) ;-N,,LOC-1 SETZM R.TERM(I12) ;IOWD TERMINATOR SETZM R.DATA(I12) ;NO ACTIVE DATA IN BUFFER SETZM R.BPLR(I12) ;NO INPUTS DONE FOR THIS FILE SETOM R.WRIT(I12) ;LAST UUO WAS A WRITE LDB AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE HLL AC6,RBPTB1(AC6) ; AND BYTE-POINTER HRRI AC6,1+R.FLMT(I12);FIRST DATA WORD TLNE FLG1,VLREBC ; IF VAR-LEN EBCDIC RECORDS ADDI AC6,1 ; SKIP OVER THE BLOCK-DESCRIPTOR-WORD MOVEM AC6,R.BPNR(I12) ; NEXT RECORD MOVEM AC6,R.BPFR(I12) ;BYTE POINTER TO THE FIRST RECORD JRST OPNCON ;RET IFN ISAM,< ;SETUP INDEX FILE BUFFER AND TABLE AREAS OPNIDX: SETZM USOBJ(I12) ;[377] CLEAR THE FIRST WORD OF INDEX TABLE HRRI AC0,USOBJ+1(I12);TO HRLI AC0,USOBJ(I12) ;FROM,,TO HRRZI AC1,ITABL-15+ICHAN(I12) ;UNTIL BLT AC0,(AC1) ;CLEAR REST OF INDEX TABLE HRLZ AC0,D.IBL(I16) ; [377] SEE IF WE HAVE A SAVE AREA JUMPE AC0,OPNIX1 ; [377] NO- GO ON HRRI AC0,ISCLR1(I12) ; [377] SET UP TO HRRZI AC1,ISCLR2(I12) ; [377] MOVE ISAM SAVE AREA TO BLT AC0,(AC1) ; [377] TO SHARED BUFFER AREA OPNIX1: PUSHJ PP,OPNLIX ;INDEX FILE-NAME TO LOOKUP BLOCK SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNIX2 ; YES XCT ULKUP. ;LOOKUP JRST OLERRI ;LOOKUP FAILED OPNIX2: TLNN FLG,OPNOUT ;OPEN FOR UPDATING? JRST OPNI01 ;NO OPNI00: TLO FLG1,EIX ;ENTER OF .IDX FILE IN PROGRESS PUSHJ PP,OPNEIX ;INDEX FILE-NAME TO ENTER BLOCK SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNIX3 ; YES XCT UENTR. ;ENTER, FOR UPDATING JRST OEERRI ;ENTER FAILED OPNIX3: TLZ FLG1,EIX ;FREE THIS BIT FOR "RIVK" FLAG OPNI01: HRLZI AC1,STABL ;STATISTICS BLOCK LEN MOVNS AC1 ; HRR AC1,I12 ; SUBI AC1,1 ;DUMP MODE IOWD MOVEM AC1,IOWRD+14(I12) ;SAVE IN IOWRD TABLE SETZ AC2, ;TERMINATOR MOVEI AC0,1 ; HRRM AC0,UIN. ; XCT UIN. ;READ THE STATISTICS BLOCK JRST OPNI02 ; MOVE AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER PUSHJ PP,IGMIR ;IGNORE THE ERROR? JRST RCHAN ;YES - RELEASE THE IO CHANNELS TTCALL 3,[ASCIZ /OPEN FAILED - /] TTCALL 3,[ASCIZ /CANNOT READ STATISTICS BLOCK/] PUSHJ PP,SETIC ;SET UP IGETS CHANNEL NO. JRST IINER ;OPEN THE DATA FILE OPNI02: HLLZS UIN. ;CLEAR THE IOWR POINTER MOVEI AC0,17 ;DUMP MODE HRRM AC0,UOBLK. ;SETUP OPEN BLOCK MOVE AC1,F.WDNM(I16) ; MOVE AC1,(AC1) ; MOVEM AC1,UOBLK.+1 ; SETZM UOBLK.+2 ; PUSHJ PP,SETCN. ;SET DATA FILE CHANNEL SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNI21 ; NO IFE TOPS20,< PUSHJ PP,OPNFPD ; OPEN FILE VIA FILOP UUO JRST OFERRI ; ERROR RETURN >; END IFE TOPS20 IFN TOPS20,< PUSHJ PP,OCPTD ; OPEN FILE VIA DEC-SYS-20 COMPT. JRST OCPERI ; ERROR RETURN >;END IFN TOPS20 JRST OPNI22 ; SKIP THE OPEN UUO OPNI21: XCT UOPEN. ;OPEN THE DATA FILE JRST OERRDF ;ERROR RETURN ;SETUP IOWRD TABLE OPNI22: MOVEI AC3,BA(I12) ; MOVE AC1,ISPB(I12) ;SECTORS PER BLOCK IMULI AC1,200 ;WORDS PER SECTOR MOVN AC2,AC1 ;-LEN HRLZS AC2 ;-LEN,,0 HRRI AC2,-1(AC3) ;IOWD, -LEN,,LOC-1 SKIPN AC4,OMXLVL(I12) ;USE ORIGINAL # OF LEVELS MOVN AC4,MXLVL(I12) ;MAXIMUM NUMBER OF INDEX LEVELS MOVEM AC4,OMXLVL(I12) ;SAVE INCASE THIS FILE IS OPENED AGAIN ;[V10] SKIPN CORE0(I12) ; SKIP IF NOT FIRST OPEN FOR THIS FILE SUBI AC4,1 ;PLUS ONE FOR SPLITTING THE TOP LEVEL HRLZS AC4 ; HRRI AC4,IOWRD+1(I12) ; SKIPN (AC4) ;IF IOWRD'S ALREADY SETUP MOVEM AC2,(AC4) ; ADD AC2,AC1 ; AOBJN AC4,.-3 ;LOOP MOVN AC5,MXLVL(I12) ;SEE IF ANY NEW INDEX LEVELS WERE SUB AC5,OMXLVL(I12) ; CREATED SINCE LAST TIME FILE WAS OPEN JUMPE AC5,OPNI06 ;SKIP THE FOLLOWING IF NOT HRL AC4,AC5 ;NEW LEVEL(S) HRRZ AC5,ISPB(I12) ; SECTORS PER BLOCK [EDIT#306] IMULI AC5,200 ; WORDS PER SECTOR [EDIT#306] MOVN AC6,AC5 ; NEGATE THE LENGTH [EDIT#306] HRLZS AC6 ; -LENGTH,,0 [EDIT#306] HRR AC6,.JBFF ; SO MAKE SUBI AC6,1 ; ANOTHER IOWD OPNI03: SKIPE (AC4) ;USE ONLY IF JRST OPNI04 ; ANOTHER JOB MADE THE NEW LEVEL SKIPE KEYCV. ;ARE WE SORTING? JRST OPNIR0 ;YES - CANT HANDLE THAT HRRZ AC0,AC5 ;SET UP AC0 [EDIT#306] PUSHJ PP,GETSPC ;GET MORE CORE JRST OPNIR1 ;TOO BAD HRRZ AC0,HLOVL. ;DOES THE SPACE WE GOT CAMGE AC0,.JBFF ; EXTEND INTO THE OVL-AREA? JUMPN AC0,WOVLR1 ;GO COMPLAIN IF IT DOES MOVEM AC6,(AC4) ;USE IT ADD AC6,AC1 ;SET UP FOR NEXT IOWD OPNI04: AOBJN AC4,OPNI03 ;LOOP IF YOU MUST OPNI06: SKIPN IOWRD+13(I12) ; SKIP IF ALREADY DONE MOVEM AC2,IOWRD+13(I12);SAT BLOCK ADD AC2,AC1 ; ;IOWRD0, USOBJ0, CNTRY0, NNTRY0 - SET TO INDEX ON LVL HRLZI AC0,LVL ;HOLDS CURRENT LEVEL OF INDEX HRRI AC0,IOWRD(I12) ; MOVEM AC0,IOWRD0(I12) ; HRRI AC0,USOBJ(I12) ; MOVEM AC0,USOBJ0(I12) ; HRRI AC0,CNTRY(I12) ; MOVEM AC0,CNTRY0(I12) ; HRRI AC0,NNTRY(I12) ; MOVEM AC0,NNTRY0(I12) ; ;SET BRISK FLAG OUTPUT ONLY WHEN YOU MUST LDB AC5,F.BDIO ;GET DEFERRED ISAM OUTPUT FLAG JUMPE AC5,OPNI61 ; 0 = NO DEFERRED OUTPUTS SKIPN F.WSMU(I16) ; NO DEFERRED OUTS IF SIMU-UPDATE SETOM BRISK(I12) ;CHECK FILTAB BLKFTR VS STAT-BLK BLKFTR OPNI61: LDB AC0,F.BMRS ; GET PROGRAMS MAX REC SIZE [371] CAMN AC0,RECBYT(I12) ; SEE IF SAME AS ISAM PARM [371] JRST OPNI07 ; IT DOES- OF [371] CAML AC0,RECBYT(I12) ; [375] WHICH WAY IS FD DIFFERENT? JRST OPNGR ; [375] FD GT ISAM TLNN FLG,OPNIN+OPNIO ; [375] FD LT ISAM-FILE OPEN FOR OUTPUT? JRST OPNI07 ; [375] YES OKAY JRST OPNER1 ; [375] NO-INPUT OR I/O ERROR OPNGR: TLNN FLG,OPNIO+OPNOUT ; [375] FD GT ISAM- IS FILE OPEN FOR INPUT ? JRST OPNI07 ; [375] YES OKAY OPNER1: ; [375] TTCALL 3,[ASCIZ /USERS MAXIMUM RECORD SIZE /] ; [371] PUSHJ PP,PUTDEC ; TYPE IT [371] TTCALL 3,[ASCIZ / DIFFERS FROM ISAM PARAMETER /] ;[371] MOVE AC0,RECBYT(I12) ; GET ISAM MAX REC SIZE [371] PUSHJ PP,PUTDEC ; TYPE IT [371] JRST OPNERX ; FINISH UP MSG AND STOP RUN [371] OPNI07: ; [371] PUSHJ PP,OPNWPB ;AC5 = BLKFTR, AC10 = WPB MOVE AC6,DBF(I12) ;DATA FILE BLOCKING FACTOR VIA STA BLOCK CAMN AC5,AC6 ;AC5 = BLKFTR VIA FILE TABLE JRST OPNI05 ;OK MOVE AC0,[E.FIDX+^D9] ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE THE ERROR? JRST RCHAN ;YES - RELEASE IO CHANS TTCALL 3,[ASCIZ /USERS BLOCKING FACTOR /] ; [371] MOVE AC0,AC5 ; GET USER BF [371] PUSHJ PP,PUTDEC ; TYPE IT [371] TTCALL 3,[ASCIZ / DIFFERS FROM ISAM PARAMETER /] ;[371] MOVE AC0,AC6 ; GET ISAM BF [371] PUSHJ PP,PUTDEC ; TYPE IT [371] OPNERX: ; [371] TTCALL 3,[ASCIZ/ /] ; [371] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;IOWRD(I12) - SET DATA BLOCK IOWD POINTER OPNI05: MOVN AC5,AC10 ; HRL AC2,AC5 ; SKIPN IOWRD(I12) ;SKIP IF ALREADY SETUP BY PREVIOUS OPEN MOVEM AC2,IOWRD(I12) ;DATA BLOCK ADDI AC2,1(AC10) ;AC2 POINT AT NEXT FREE AREA ;IBLEN - LEN OF INDEX BLOCK FOR BINARY SEARCH MOVE AC0,EPIB(I12) ; IMUL AC0,IESIZ(I12) ;NO. OF WRDS IN IDX BLK MOVEM AC0,IBLEN(I12) ;IDX BLK LEN ;SINC - SEARCH INCREMENT FOR BINARY SEARCH MOVE AC1,IESIZ(I12) ;THE INCREMENT TO BE IMULI AC1,2 ; CAMG AC1,AC0 ;INC GT INDEX LENGTH? JRST .-2 ;NO MOVEM AC1,SINC(I12) ;SAVE THE SEARCH INCREMENT ;DAKBP - BYTE POINTER TO DATA ADJUSTED KEY MOVE AC1,DBPRK(I12) ;START WITH RELATIVE DATA KEY BP HRRI AC1,(AC2) ; MOVEM AC1,DAKBP(I12) ;DATA ADJUSTED KEY BYTE POINTER SETZM (AC1) ;ZERO THE FIRST DATA REC-KEY WRD ADDI AC1,1 ; MOVEM AC1,DAKBP1(I12) ;POINTER TO SECOND REC-KEY WRD ADD AC1,IESIZ(I12) ;KEY SIZE PLUS 2 WRD HDR SUBI AC1,2 ;PERMIT 1 EXTRA WRD FOR WRAP-AROUND SETZM -1(AC1) ;ZERO LAST DATA REC-KEY WRD ;RESERVE AREA FOR INDEX ENTRY ADDI AC1,2 ;LOC FOR BLOCK # AND VERSION # ;IAKBP - BYTE POINTER TO INDEX ADJUSTED KEY TLZ AC1,770000 ; TLO AC1,440000 ; MOVEM AC1,IAKBP(I12) ;INDEX ADJUSTED KEY BP ADDI AC1,1 ; MOVEM AC1,IAKBP1(I12) ;POINTER TO SECOND IDX-KEY WRD ADD AC1,IESIZ(I12) ; SUBI AC1,2 ; SETZM -1(AC1) ;ZERO LAST IDX-KEY WRD ;AC1 POINTS TO NEXT FREE AREA HRLI AC1,-1(AC1) ;UNTIL HRRI AC1,ICHAN(I12) ;UNTIL,,FROM SKIPN CORE0(I12) ; SKIP IF NOT THE FIRST OPEN MOVEM AC1,CORE0(I12) ;CLOSE CLEARS THIS CORE AREA ;AUXIOW - SETUP THE IOWD MOVN AC0,MXBUF ;MAX BUFFER SIZE HRL AC0,AC0 ; HRR AC0,AUXBUF ; SUBI AC0,1 ;LOC-1 MOVEM AC0,AUXIOW ;SAVE IT ;KWCNT - NUMBER OF WORDS IN THE KEY MOVE AC1,IESIZ(I12) ;SETUP KWCNT SUBI AC1,2 ; ;HRRM AC1,IKWCNT(I12) ; ;HRRM AC1,DKWCNT(I12) ; MOVNS AC1 ; HRLM AC1,IKWCNT(I12) ;-CNT,,CNT ;FWMASK, LWMASK - CREATE 2 MASK WORDS FOR FIRST AND LAST DATA-KEY WORDS LDB AC0,KY.TYP ; GET KEY TYPE JUMPN AC0,OPNBPS ; JUMP IF NOT NON-NUMERIC DISPLAY LDB AC1,KY.SIZ ; GET KEY SIZE MOVN AC2,AC1 ; HRLZS AC2 ; MOVE AC3,DBPRK(I12) ;RELATIVE DATA-RECORD-KEY POINTER OPNMSK: IBP AC3 AOBJN AC2,.+1 TLNE AC3,760000 ;STAY WITH IN THE FIRST WORD JUMPL AC2,OPNMSK ;UNLESS WE RUN OUT OF BYTES LDB AC4,[POINT 6,DBPRK(I12),5] SETZ AC5, ; SETO AC6, ; LSHC AC5,(AC4) ; MOVEM AC5,FWMASK(I12) ;007777 FIRST WORD MASK TLNN AC3,760000 ; JRST OPNMS1 ; LDB AC4,[POINT 6,AC3,5] ;THE KEY IS LESS THAN ONE WORD MOVNS AC4 ; LSH AC5,(AC4) ; MOVNS AC4 ; LSH AC5,(AC4) ; JRST .+2 ;007700 AC5 HAS MASK OPNMS1: JUMPL AC2,OPNMS2 ;IS KEY GREATER THAN ONE WRD? SETZM FWMASK(I12) ;NO, ONE WRD OR LESS MOVEM AC5,LWMASK(I12) ; JRST OPNBPS ;DONE OPNMS2: LDB AC4,KY.MOD ; GET MODE OF KEY HRRZ AC4,RBPTB1(AC4) ; GET BYTES PER WORD HLRES AC2 ; MOVMS AC2 ;MAKE IT POSITIVE IDIV AC2,AC4 ; SKIPN AC3 ;REMAINDER? SKIPA AC3,AC4 ;NO--BYTES PER WORD ADDI AC2,1 ;YES LDB AC4,[POINT 6,DBPRK(I12),11]; GET BITS PER BYTE MOVNS AC2 ; HRLM AC2,DKWCNT(I12) ;NUMBER OF REC-WRDS -1 THAT CONTAIN THE KEY IMUL AC3,AC4 ; SETO AC6, ; SETZ AC5, ; MOVNS AC3 ROTC AC5,(AC3) ; MOVEM AC5,LWMASK(I12) ;MASK FOR THE LAST REC-DATA-KEY WRD ;BPSB - NUMBER OF BITS PER SAT BLOCK OPNBPS: MOVE AC0,FILSIZ(I12) ;TOTAL NUMBER OF DATA BLOCKS IN FILE IDIV AC0,SBTOT(I12) ; WILL GIVE NUMBER PER SAT BLOCK MOVEM AC0,BPSB(I12) ;SAVIT ;ICMP, DCMP - SETUP DISPATCH ADR FOR COMPARE ROUTINES ;0 = DCDNN, 1 = DC1S/U, 2 = DC2S/U OPNDSP: LDB AC2,KY.TYP ; GET KEY TYPE JUMPE AC2,OPNDS1 ; ZERO STAYS A ZERO TRNE AC2,1 ; TRZA AC2,-2 ; ODD BECOMES 1 HRRZI AC2,2 ; EVEN BECOMES 2 OPNDS1: HRRZ AC0,KEYDES(I12) ; GET KEY SIGN TRNE AC0,100000 ; SKIPA AC3,ICTAB(AC2) ;UNSIGNED MOVS AC3,ICTAB(AC2) ;SIGNED HRRZM AC3,ICMP(I12) ;INDEX COMPARE ROUTINE TRNE AC0,100000 ; SKIPA AC3,DCTAB(AC2) ; MOVS AC3,DCTAB(AC2) ; HRRZM AC3,DCMP(I12) ;DATA COMPARE ROUTINE LDB AC5,KY.TYP ; GET KEY TYPE CAIGE AC5,3 ; 0 THRU 8 JUMPN AC5,OPNDS2 ; 0, 1, 2 CAIGE AC5,7 ; 0, 3, 4, 5, 6, 7, 8 JRST OPNRSB ; 0, 3, 4, 5, 6 ;HERE IF NUMERIC DISPLAY OR COMP-3 ;SETUP CONVERT TO BINARY ROUTINES OPNDS2: HLLZ AC1,F.WBRK(I16) ;POSITION IN DATA-REC TRNE AC0,100000 ; TLZA AC1,4000 ;UNSIGNED TLO AC1,4000 ;SIGNED ??? LDB AC2,KY.SIZ ; GET KEY SIZE DPB AC2,[POINT 11,AC1,17] ; MOVEM AC1,GDPRK(I12) ;GD PARAMETER FOR REC-KEY HRR AC1,F.WBSK(I16) ;ADR OF SYMKEY TLZ AC1,770000 ;MASK HLLZ AC2,F.WBSK(I16) ; TLZ AC2,7777 ; IOR AC1,AC2 ;SYM-KEY BYTE RESIDUE MOVEM AC1,GDPSK(I12) ;GD PARAMETER FOR SYM-KEY LDB AC2,[POINT 2,FLG,14] ; GET KEY MODE HRRZ AC1,GDTBL(AC2) ; GET CONVERSION ROUTINE CAIL AC5,7 ; IF COMP-3 HRRZI AC1,GC3. ; USE THIS ROUTINE MOVEM AC1,GDX.I(I12) ; SYM-KEY VS INDEX ENTRY LDB AC2,KY.MOD ; GET KEY MODE HLRZ AC1,GDTBL(AC2) ; GET CONVERSION ROUTINE CAIL AC5,7 ; IF COMP-3 HRRZI AC1,GC3. ; USE THIS ROUTINE MOVEM AC1,GDX.D(I12) ; SYM-KEY VS DATA FILE KEY ;DCMP,DCMP1 - SETUP TO CONVERT THEN COMPARE HRRZM AC3,DCMP1(I12) ;COMPARE ROUTINE HRRZI AC3,DGD67 ;CONVERSION ROUTINE MOVEM AC3,DCMP(I12) ;CONVERT THEN COMPARE ;RSBP - BR TO SIXBIT/ASCII RECORD SIZE OPNRSB: MOVE AC1,[POINT 12,-1(AC4),35] TLNN FLG,DDMSIX!DDMEBC; MOVE AC1,[POINT 12,-1(AC4),34] MOVEM AC1,RSBP(I12) SUBI AC1,-1 MOVEM AC1,RSBP1(I12) ;GETSET - SETUP KEY FOR SEARCH ROUTINES OPNGST: LDB AC1,KY.TYP ; GET KEY TYPE JUMPN AC1,.+2 ; MOVEI AC2,ADJKEY ;DNN CAIE AC1,1 ; CAIN AC1,2 ; MOVEI AC2,GD67 ;DN CAIL AC1,3 ; MOVEI AC2,FPORFP ;FP CAIE AC1,7 ; COMP-3? CAIN AC1,10 ; ? MOVEI AC2,GD67 ; YES MOVEM AC2,GETSET(I12) ;DISPATCH FOR SEARCH INITIALIZING ;RECBP - SETUP REC AREA BYTE-POINTER LDB AC2,[POINT 2,FLG,14]; GET MODE OF RECORD AREA HLL AC2,RBPTB1(AC2) ; GET A BYTE-PTR HRR AC2,FLG ;ADR OF REC MOVEM AC2,RECBP(I12) ; ;NOW CLEAR SOME IDX BUFFER AREAS MOVEI AC6,IOWRD+2(I12); START WITH SECOND IDX LEVEL OPNZBF: SKIPN AC2,(AC6) ; GET THE IOWRD TO AC2 JRST OPNZB1 ; THERE IS NONE FOR THIS LEVEL HRLI AC1,1(AC2) ; THE "FROM" ADDR HRRI AC1,2(AC2) ; THE "TO" ADDR SETZM -1(AC1) ; ZERO FIRST WORD HLRO AC2,AC2 ; GET THE LENGTH HRRZI AC3,-2(AC1) ; GET "FROM"-1 SUB AC3,AC2 ; GET "UNTIL" ADDR BLT AC1,(AC3) ; SMEAR THE ZERO OPNZB1: CAIE AC6,IOWRD+13(I12);SKIP WHEN DONE AOJA AC6,OPNZBF ; ELSE LOOP JRST OPNCH2 ; OPNIR0: MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS MOVE AC0,[E.FIDX+^D7] ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST RCHAN ;YES - RELEASE IO CHANNELS TTCALL 3,[ASCIZ /CANNOT EXPAND CORE WHILE SORT IS IN PROGRESS/] JRST OMTA99 OPNIR1: MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS MOVE AC0,[E.FIDX+^D8] ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST RCHAN ;YES - RELEASE IO CHANS PUSHJ PP,GETSP9 ;CORE UUO FAILED JRST OMTA99 ;DISPATCH FOR INDEX COMPARE ROUTINES ICTAB: XWD ICDNN, ICDNN ;DISPLAY NON-NUMERIC XWD IC1S, IC1U ;ONE WRD SIGNED / UNSIGNED XWD IC2S, IC2U ;TWO WRD SIGNED / UNSIGNED ;DISPATCH FOR DATA COMPARE ROUTINES DCTAB: XWD DCDNN, DCDNN ;DISPLAY NON-NUMERIC XWD DC1S, DC1U ;ONE WRD SIGNED / UNSIGNED XWD DC2S, DC2U ;TWO WRD SIGNED / UNSIGNED ;DISPATCH FOR DATA CONVERSION ROUTINES PDTBL: PD6.,,GD6. ; SIXBIT TO BINARY PD9.,,GD9. ; EBCDIC PD7.,,GD7. ; ASCII ;INDEX TO LEFT HALF IS KY.MOD FOR DSRCH ;INDEX TO RIGHT-HF IS CORE-DATA-MODE FOR IBS GDTBL: GD6.,,GD7. GD9.,,GD9. GD7.,,GD6. > ;RETURNS IN AC10 NUMBER OF WORDS PER LOGICAL BLOCK ;AND BLOCKING FACTOR IN AC5. ***POPJ*** OPNWPB: LDB AC5,F.BBKF ;BLOCKING FACTOR MOVEM AC5,D.RCL(I16) ; LDB AC10,F.BMRS ;MAX RECORD SIZE IFN ISAM,< TLNE FLG,IDXFIL ; [375] IS THIS AN ISAM FILE? MOVE AC10,RECBYT(I12); [375] YES-USE ISAM PARAM > TLNE FLG,DDMBIN ;IF MODE IS BINARY, JRST OPNWP3 ; CONVERT SIZE TO WORDS LDB AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE HRRZ AC6,RBPTBL(AC6) ; AND THEN CHARS PER WORD HRRZM AC6,D.BPW(I16) ;CHARS PER WORD JUMPL FLG,OPNWP1 ;JUMP IF ASCII TLNE FLG,DDMEBC ; SKIP IF NOT EDCBIC JRST OPNWP4 ; EBCDIC! OPNWP5: ADD AC10,AC6 ; ACCOUNT FOR THE HEADER WORD OPNWP2: ADDI AC10,-1(AC6) ;ROUND UP IDIV AC10,AC6 ;RECSIZ/CPW IMUL AC10,AC5 ;WORDS PER LOGBLK POPJ PP, ; OPNWP4: SKIPGE D.F1(I16) ; IF VARIABLE LEN EBCDIC RECORDS ADDI AC10,(AC6) ; INCLUDE RDW WITH REC-SIZE JRST OPNWP6 ; OPNWP1: ADDI AC10,2 ;FOR CRLF OPNWP6: IFN ISAM,< TLNE FLG,IDXFIL ;INDEX FILE? [372] JRST OPNWP5 ; YES USE DIFFERENT CALC [372] > IMUL AC10,AC5 ; NO. OF CHARS IN LOGIGAL BLOCK [372] PUSH PP,AC10 ; SAVE CPL ADDI AC10,-1(AC6) ; ROUND UP [372] IDIVI AC10,(AC6) ; NO. OF WORDS PER LOGICAL BLOCK [372] POP PP,AC6 ; RESTORE CHARS-PER-LOGI-BLK MOVEM AC6,D.TCPL(I16) ; TOTAL CHARS/LOG-BLOCK TLNE FLG,OPNIN ; D.FCPL MUST BE ZERO FOR SETZ AC6, ; THE FIRST READ UUO MOVEM AC6,D.FCPL(I16) ; FREE CHARS/LOG-BLOCK TLNE FLG1,VLREBC ; VAR-LEN EBCDIC FILE? ADDI AC10,1 ; YES - ADD 1 FOR BDW POPJ PP, ; [372] ;RECORDING MODE IS BINARY--CONVERT SIZE TO WORDS OPNWP3: LDB AC6,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC6,RBPTBL(AC6) ; AND THEN CHARS PER WORD JRST OPNWP2 ;SET DEVICE TABLE BUFFER HEADER BYTE SIZE ;SETUP CONVERSION FLG ***OPNLO*** OPNBSI: JUMPL FLG,OPNCON ;JUMP IF DEVICE IS ASCII TLNE FLG,DDMBIN ;IF MODE IS BINARY, JRST OPNBPB ; DON'T TOUCH BYTE POINTER MOVEI AC6,6 ;SIXBIT BYTE SIZE TLNN FLG,DDMEBC ; SKIP IF EBCDIC JRST OPNBS1 ; NOT EBCDIC MOVEI AC6,^D9 ; EBCDIC IS 9 BITS WIDE TLNN AC13,20 ; IS DEVICE A MTA? JRST OPNBS1 ; NO HRRZ AC1,F.WDNM(I16) ; HOW MANY TRACKS ON THIS DRIVE? MOVE AC1,(AC1) ; SIXBIT DEVICE NAME FOR MTCHR. AC1, ; GET CHARACTERISTICS SETZ AC1, ; ERROR RET - ASSUME ITS OK (IE 9TRK) TRNE AC1,1B31 ; 9 CHANNEL? JRST OPNBS1 ; 7 CHANNEL. MOVEI AC6,^D8 ; 9TRK SO 8 BITS WIDE XCT MTIND. ; AND INDUSTRY COMPATIBLE MODE OPNBS1: DPB AC6,DTIBS. ;INPUT HEADER BYTE-POINTER DPB AC6,DTOBS. ;OUTPUT H... OPNCON: LDB AC0,[POINT 3,FLG,2] ; GET DEVICE DATA MODE LDB AC1,[POINT 3,FLG,14] ; GET CORE DATA MODE CAME AC0,AC1 ; EQUAL? TLO FLG,CONNEC ; NO, SET THE CONVERSION FLAG ;PRESUMES AC10 HAS WRDS/LOGICAL BLOCK ;SETUP BUFFERS PER LOGICAL BLOCK AND ;NUMBER OF RECORDS TO A RERUN DUMP ;AND THE CONVERSION INSTRUCTION. OPNBPB: LDB AC1,[POINT 2,FLG,2] ; GET DEVICE DATA MODE LDB AC2,[POINT 2,FLG,14] ; AND CORE DATA MODE MOVE AC3,@RCTBL(AC1) ; GET CONVERSION INSTRUCTION TLNE FLG,DDMBIN ; IF A BINARY DEVICE MOVSI AC3,(JFCL) ; NO CONVERSION MOVEM AC3,D.RCNV(I16) ; SAVE FOR LATER - READ MOVE AC3,@WCTBL(AC2) ; GET CONVERSION INSTRUCTION TLNE FLG,DDMBIN ; IF A BINARY DEVICE MOVSI AC3,(JFCL) ; NO CONVERSION MOVEM AC3,D.WCNV(I16) ; SAVE FOR LATER - WRITE MOVEI AC0,200 ;DSK BUFFER SIZE TLNE FLG,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT RANDOM OR IO JRST OPNBP3 ; TLNN AC13,20 ;SKIP IF A MTA JRST OPNBP1 ;JUMP, NOT A MTA JUMPE AC5,OPNBP1 ;JUMP IF BLK-FTR IS ZERO (AC5) MOVEI AC10,1 ;ONE BUFFER PER LOGICAL BLOCK JRST OPNBP2 ; OPNBP1: HRRZ AC11,D.IBH(I16) ;ASSUME INPUT TLNN FLG,OPNIN ;SKIP IF INPUT HRRZ AC11,D.OBH(I16) ;MUST BE OUTPUT HLRZ AC0,(AC11) ;BUFFER SIZE + 1 IN WORDS SUBI AC0,1 ;SIZE OPNBP3: IDIV AC10,AC0 ;/BUF-SIZE SKIPE AC10+1 ;ROUND UP ADDI AC10,1 ;AC10=BUFFERS PER LOGICAL BLOCK OPNBP2: MOVEM AC10,D.BPL(I16) ;BUFBLK TLNE FLG1,VLREBC ; IF EBCDIC VARIABLE LEN-RECS INIT SETZ AC10, ; D.BCL TO ZERO FOR FIRST READ UUO MOVEM AC10,D.BCL(I16) ;CURRENT BUFBLK HRR AC10,F.RRRC(I16);GET RERUN RECORD COUNT HRRZM AC10,D.RRD(I16) ;NUMBER OF RECORDS TO A RERUN DUMP OPNBP4: TLNE AC13,20 ;SKIP IF NOT A MAGTAPE JRST OPNMTA ;SET DENSITY, PARITY & POSITION THE MAGTAPE ;DO A LOOKUP OR READ A LABEL. SETUP DEVICE TABLE REEL ;NUMBER AND NUMBER OF FIRST BLOCK OF FILE. ***OPNBBF*** OPNLO: TLNN AC16,OPEN ;OPEN UUO SKIPS JRST OPNLO1 ; MOVEI AC0,2020 ;SIXBIT REEL NUMBER '00' LDB AC1,F.BPMT ;FILE POSITION (ON MTA) SKIPN AC1 ;SKIP IF MULTI-FILE-REEL ADDI AC0,1 ;MULTI-REEL-FILE REEL '01' TLNN AC16,1000 ;SKIP IF A CLOSE REEL GENERATED OPEN DPB AC0,DTRN. ;INITIALIZE THE REEL NUMBER OPNLO1: TLNN FLG,OPNIN!RANFIL!IDXFIL ;SKIP IF INPUT/IO JRST OPNBBF ;OUTPUT. BBF USE PRO. OPNLUP: PUSHJ PP,OPNLID ;SETUP LOOKUP BLOCK WITH ID TLNN AC13,4 ;SKIP IF DIRECTORY DEVICE JRST OPNRLB ;READ LABEL INTO RECORD AREA SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNLU1 ; YES XCT ULKUP. ;*** LOOKUP *************** JRST OPNLER ;ERROR RETURN OPNLU1: TLNE FLG,OPNIO ; TRY FOR EXTENDED LOOKUP PUSHJ PP,OPNELO ; IF VLEN EBCDIC SEQIO FILE SETZM D.CBN(I16) ;THE FIRST BLOCK OF ALL TLNN FLG,RANFIL ; BUT RANDOM FILES AOS D.CBN(I16) ; IS ONE. PUSHJ PP,ZROSLA ;ZERO THE STD LABEL AREA MOVE AC0,ULBLK. ;FILE NAME MOVE AC1,ULBLK.+1 ;EXTENSION TLNE AC13,100 ;SKIP IF NOT A DTA HRRM AC1,D.CBN(I16) ;SAVE AS THE FIRST BLOCK NUMBER TRZ AC1,-1 ;THEN ZERO IT ROTC AC0,14 ; MOVEM AC0,STDLB.+1 ; HLLM AC1,STDLB.+2 ; HRLI AC1,(SIXBIT /HDR/) ;LABEL TYPE IORI AC1,(SIXBIT /1/) MOVEM AC1,STDLB. ; LDB AC4,[POINT 12,ULBLK.+2,35] ;GET LOW ORDER CREA DATE LDB AC1,[POINT 3,ULBLK.+1,20] ;GET HIGH ORDER [EDIT#274] DPB AC1,[POINT 3,AC4,23] ;MERGE THE ORDERS [EDIT#274] PUSHJ PP,TODA1. ;CREATION DATE SETZ AC1, ; ROTC AC0,6 ; MOVEM AC0,STDLB.+7 ;DATE MOVEM AC1,STDLB.+6 ;DATE PUSHJ PP,OPNCA1 ;MOVE STD-LABEL AREA TO RECORD AREA JRST OPNBBF ;THIS ROUTINE FINDS THE NUMBER OF THE FIRST SECTOR OF THE LAST ;LOGICAL BLOCK OF THE SEQIO FILE OPNELO: SKIPE F.WSMU(I16) ; IF SMU-ING POPJ PP, ; WE'VE ALREADY BEEN HERE OPNEL1: HRRZ AC5,F.RPPN(I16) ; GET POINTER TO PPN SKIPE AC5 ; USE DEFAULT PPN IF NONE MOVE AC5,(AC5) ; GET THE PPN MOVEM AC5,ARGBK.##+.RBPPN ; MOVE AC5,[ULBLK.,,ARGBK.+.RBNAM]; GET FILE NAME BLT AC5,ARGBK.+.RBEXT ; AND EXTENSION HLLZS ARGBK.+.RBEXT ; ZERO DATE FIELD SETZM ARGBK.+.RBPRV ; AND PRIVILIGE FIELD SETZM ARGBK.+.RBSIZ ; AND SIZE FIELD MOVE AC0,ULKUP. ; GET A LOOKUP INST HRRI AC0,ARGBK. ; SETUP E FIELD XCT AC0 ; EXTENDED LOOKUP SKIPA AC5,ARGBK.+.RBEXT ; ERROR SO GET ERROR BITS JRST OPNEL2 ; NORMAL RETURN HRRM AC5,ULBLK.+1 ; SAVE BITS FOR OPNLER JRST OPNLER ; COMPLAIN OPNEL2: MOVE AC5,ARGBK.+.RBSIZ ; GET LAST BLOCK OF FILE ADDI AC5,177 ; DIVIDE WORDS WRITTEN BY IDIVI AC5,200 ; WRDS/BLK AND ROUND UP MOVE AC6,D.BPL(I16) ; GET NUMBER OF FIRST ADDI AC5,-1(AC6) ; SECTOR OF THE LAST IDIV AC5,AC6 ; LOGICAL BLOCK SKIPN AC5 ; IF FILE DOESN'T EXIST MOVEI AC5,1 ; ONE IS THE FIRST BLOCK MOVEM AC5,D.LBN(I16) ; SAVE IT FOR SEQIO POPJ PP, ; OPNLER: HRRZ AC2,ULBLK.+1 ; TRNE AC2,37 ;IS IT FILE-NOT-FOUND? JRST OLERR ;NO, OTHER TLNN FLG,IDXFIL ;DONT MAKE FILE IF ISAM FILE TLNE FLG,OPNOUT ; OR IF AN INPUT FILE TLNN FLG,RANFIL!OPNIO ;RANDOM OR IO OUTPUT FILE? JRST OLERR ;NO ;HERE TO CREATE A NULL FILE FOR USER PUSHJ PP,OPNEID ;SETUP FOR AN ENTER XCT UENTR. ;CREATE A NULL FILE JRST OEERR ;ERROR RETURN XCT UCLOS. JRST OPNLUP ;OK TRY THE LOOKUP AGAIN IFE TOPS20,< ; THIS ROUTINE OPENS A FILE VIA THE "FILOP." UUO OPNFOP: MOVE AC0,UOBLK. ;SET THE DATA MODE MOVEM AC0,FOP.IS IFN ISAM,< TLNN FLG,IDXFIL ; ISAM FILE? JRST OPNFPD ; NO TLO FLG1,FOPIDX ; ENTRY FOR ".IDX" FILE PUSHJ PP,OPNLIX ; GET VID TO LOOKUP BLOCK MOVE AC0,ICHAN(I12) ; CHANNEL FOR .IDX FILE JRST OPNFP2 OPNFPD: >;END IFN ISAM PUSHJ PP,OPNLID ; GET VID TO LOOKUP BLOCK TLNN FLG,OPNIO ; IF EXTENDED LOOKUP MUST BE DONE JRST OPNFP1 ; NO XCT UOPEN. ; DO IT BEFORE THE FILOP. UUO JRST OERRIF ; SO WE DONT GET PUSHJ PP,OPNELO ; ILLEGAL SEQUENCE OF UUO'S ERROR OPNFP1: LDB AC0,DTCN. ; GET CHANNEL NUMBER OPNFP2: HRLI AC0,5 ; MULTI ACCESS-UPDATE MOVSM AC0,FOP.BK ; SAVE IN FILOP BLOCK MOVE AC0,UOBLK.+1 ; GET DEVICE NAME MOVEM AC0,FOP.DN ; MOVEI AC0,ULBLK. ; GET ADR OF LOOKUP BLOCK MOVEM AC0,FOP.LB ; MOVE AC1,[7,,FOP.BK] ; SET UP FILOP'S AC FILOP. AC1, ; OPEN THE FILE SIMULTANEOUS-UPDATE POPJ PP, ; ERROR RETURN IFN ISAM, ; CLEAR FLAG JRST RET.2 ; EXIT ; FILOP ERROR OFERR: SETZM FS.IF ; IDA-FILE FLAG IFE ISAM, ; FILOP. FAILED IFN ISAM,< OFERRI: MOVE AC0,[E.MFOP+E.FIDX] ;MAKE AN ERROR NUMBER TLON FLG1,FOPIDX ; REMEMBER IT'S A FILOP ERROR MOVE AC0,[E.MFOP+E.FIDA] TLNN FLG,IDXFIL ; ISAM FILE? >;END IFN ISAM MOVE AC0,[E.MFOP] ; NO PUSHJ PP,ERCDF ; IGNORE ERROR? JRST RCHAN ; YES JRST LUPERR ; NO >; END IFE TOPS20 IFN TOPS20,< SEARCH MONSYM, MACSYM .REQUIRE SYS:MACREL EXTERN CP.BLK,CP.BK1,CP.BK2,CP.BK3,CP.BK4,CP.BK5,CP.BK6,CP.BK7,FID.PT E.MCPT==^D8000000 ; MONITOR COMPT. UUO ERROR ;HERE IF THIS IS A DEC-SYSTEM-20 TO OPEN FILE FOR SIMULTANEOUS UPDATING ;INIT THE CMPT. JSYS ARG BLOCK OCPT: TLNN FLG,IDXFIL ; ISAM FILE? JRST OCPTD ; NO PUSHJ PP,OPNLIX ; YES, GET VID TO LOOKUP BLOCK TLOA FLG1,FOPIDX ; AN IDX FILE OCPTD: ;ENTRY POINT FOR ISAM.IDA FILES PUSHJ PP,OPNLID ; NO, GET VID... SETZM CP.BK1 ; AC1 GTJFN BITS ;BUILD A SNARK FILE-DESCRIPTOR STRING - AC2 GTJFN BITS ;FIRST JUST MOVE THE DEVICE NAME MOVE AC5,FID.PT ; GET POINTER TO FILE-DESCRIPTOR MOVEM AC5,CP.BK2 ; INIT COMPT. ARG BLOCK MOVE AC0,[POINT 6,UOBLK.+1] ; POINTER TO DEVICE NAME MOVEI AC1,6 ; GET MAX OF SIX CHARS OCPT1: ILDB C,AC0 ; GET CHAR JUMPE C,OCPT2 ; DONE IF NULL ADDI C,40 ; CONVERT TO ASCII IDPB C,AC5 ; PUT CHAR IN STRING SOJG AC1,OCPT1 ; LOOP OCPT2: MOVEI C,":" ; DEVICE TERMINATOR IDPB C,AC5 ; TO STRING ;CONVERT PPN TO MOVEI C,"<" ; ORIGINATE DIRECTORY IDPB C,AC5 ; HRRZ AC1,F.RPPN(I16) ; GET ADR OF PPN JUMPN AC1,OCPT3 ; JUMP IF YOU GOT ONE GJINF ; GET CONNECT DIR # IN AC2 MOVE AC1,AC5 ; GET THE STRING POINTER DIRST ; STICK DIR # INTO STRING POPJ PP, ; IMPOSSIBLE! MOVEM AC1,AC5 ; GET STRING PTR BACK TO AC5 JRST OCPT4 ; OCPT3: MOVE AC1,(AC1) ; GET PPN FROM ADR MOVEM AC1,CP.BK1 ; PPN TO THE ARG-BLOCK MOVEM AC5,CP.BK2 ; SUPPLY STRING PTR MOVEI AC0,3 ; FUNCTION 3 MOVEM AC0,CP.BLK ; MOVE AC0,[3,,CP.BLK] ; SETUP FOR COMPT. COMPT. AC0, ; MOVE DIR # TO STRING POPJ PP, ; MOVE AC5,CP.BK2 ; RESTORE STRING PTR OCPT4: MOVEI C,">" ; TERMINATE DIRECTORY IDPB C,AC5 ; ;SETUP THE CP.BK? ARGUMENT BLOCK FOR COMPT. UUO HRLZI AC0,(1B17) ; SPECIFY THE SHORT FORM OF MOVEM AC0,CP.BK1 ; OPENF. JSYS MOVE AC0,FID.PT ; GET POINTER TO FILE DESCRIPTOR STRING MOVEM AC0,CP.BK2 ; FOR OPENF. ARGUMENT ;MOVE VALUE OF ID TO F-D STRING TLNE FLG,IDXFIL ; SKIP IF NOT ISAM FILE TLNE FLG1,FOPIDX ; SKIP IF ISAM .IDA FILE SKIPA AC4,F.WVID(I16) ; BYTE-PTR TO VALUE OF ID MOVE AC4,[POINT 6,DFILNM(I12)]; .IDA - SO VALUE-ID IS HERE MOVEI AC0,11 ; MAX OF 11 CHARS OCPT5: ILDB C,AC4 ; GET A CHAR TLNN AC4,600 ; IS VID IN EBCDIC? LDB C,PTR.96##(C) ; YES - CONVERT IT TLNN AC4,100 ; HOW BOUT SIXBIT? ADDI C,40 ; YES CAIE C," " ; SPACES ARE IGNORED IN FILENAME IDPB C,AC5 ; STUFF IT AWAY CAIE AC0,4 ; IS IT TIME FOR A "."? SOJN AC0,OCPT5 ; NO - LOOP TILL DONE JUMPE AC0,OCPT6 ; JUMP IF DONE MOVEI C,"." ; TERMINATE THE FILENAME IDPB C,AC5 ; SOJN OCPT5 ; BACK FOR THE EXTENSION OCPT6: SETZB C,AC0 ; A NULL IDPB C,AC5 ; TERMINATE THE STRING ;INIT AC2 OPENF BITS TLNE FLG,DDMASC ; DEVICE DATA MODE ASCII? TLO AC0,(7B5) ; YES TLNE FLG,DDMSIX ; SIXBIT? TLO AC0,(6B5) ; YES TLNE FLG,DDMBIN ; BINARY? TLO AC0,(44B5) ; YES TLNN FLG,DDMEBC ; EBCDIC? JRST OCPT10 ; NO TLO AC0,(10B5) ; ASSUME DEVICE IS A MAG-TAPE TLNN AC13,20 ; DEVICE A MTA? TLO AC0,(11B5) ; NO, ITSA DSK OCPT10: TLNE FLG,OPNIO!RANFIL!IDXFIL ; RANDOM, INDEXED OR IO FILES TLO AC0,(17B9) ; ARE DUMP MODE TLNE FLG,OPNIO!RANFIL!IDXFIL!OPNIN; OPEN FOR INPUT? TRO AC0,1B19 ; YES TLNE FLG,OPNOUT ; OPEN FOR OUTPUT? TRO AC0,1B20 ; YES TRO AC0,1B25 ; THAWED I.E. SIMULTANEOUS UPDATE MOVEM AC0,CP.BK3 ; INIT AC2 OPENF BITS ;INITIALIZE TO TOPS-10 OPEN MODE TLNE FLG,DDMASC ; DATA-MODE ASCII? TDZA AC0,AC0 ; YES MOVEI AC0,14 ; NOT ASCII TLNE FLG,RANFIL!IDXFIL!OPNIO ; THESE FILES ARE NOT BUFFERED MOVEI AC0,17 ; DUMP MODE MOVEM AC0,CP.BK4 ; OPEN MODE ;LOCATE THE BUFFER HEADERS AND EXTENDED LOOKUP BLOCK MOVEI AC0,D.IBH(I16) ; MOVEM AC0,CP.BK5 ; INPUT BUFFER HEADER MOVEI AC0,D.OBH(I16) ; MOVEM AC0,CP.BK6 ; OUTPUT BUFFER HEADER MOVEI AC0,ARGBK. ; MOVEM AC0,CP.BK7 ; ADR OF EXTENDED LOOKUP BLOCK ;SET UP EXTENDED LOOKUP BLOCK HRRZ AC1,F.RPPN(I16) ; GET ADR OF PPN SKIPE AC1 ; USE DEFAULT PPN IF ZERO MOVE AC1,(AC1) ; GET PPN MOVEM AC1,ARGBK.##+.RBPPN ; SETUP PPN MOVE AC1,[ULBLK.,,ARGBK.+.RBNAM]; COPY FILE-NAME.EXT BLT AC1,ARGBK.+.RBEXT ; FROM LOOKUP BLOCK HLLZS ARGBK.+.RBEXT ; CLEAR RIGHT HALF SETZM ARGBK.+.RBPRV ; AND PRIV SETZM ARGBK.+.RBSIZ ; AND SIZE TLNE FLG1,FOPIDX ; IF AN ISAM.IDX FILE GET CHAN # SKIPA AC1,ICHAN(I12) ; FROM HERE LDB AC1,DTCN. ; ELSE FROM HERE HRLI AC1,1 ; THE FUNCTION MOVSM AC1,CP.BLK ; ARG ,, FUNCTION MOVE AC1,[10,,CP.BLK] ; COUNT,,ADR FOR ARG-BLOCK COMPT. AC1, ; OPEN FILE FOR SIMULTANEOUS UPDATE POPJ PP, ; ERROR RETURN IFN ISAM, ; CLEAR FLAG JRST RET.2 ; NORMAL RETURN OCPER: SETZM FS.IF ; CLEAR .IDA FILE FLAG IFN ISAM,< OCPERI: MOVE AC0,[E.MCPT+E.FIDX] ; MAKE AN ERROR NUMBER TLZN FLG1,FOPIDX ; IDX OR IDA? MOVE AC0,[E.MCPT+E.FIDA] ; IDA! TLNN FLG,IDXFIL ; SKIP IF AN ISAM FILE >; END IFN ISAM MOVE AC0,[E.MCPT] ; PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RCHAN ; YES OCPERR: TTCALL 3,[ASCIZ /COMPT. UUO FAILED /] MOVEI AC0,.PRIIN ; CFIBF ; CLEAR TYPE AHEAD MOVEI AC0,.PRIOU ; DOBE ;WAIT FOR PREVIOUS OUTPUT TO FINISH HRROI AC1,[ASCIZ / ? JSYS ERROR: /] PSOUT MOVEI AC1,.PRIOU ; HRLOI AC2,.FHSLF ; THIS FORK ,, LAST ERROR SETZ AC3, ; ERSTR ; TYPE THE ERROR JFCL JFCL HRROI AC1,[ASCIZ / /] PSOUT ; APPEND CRLF MOVE AC2,[BYTE (5) 10,2,31,20,4] JRST MSOUT. ; FATAL ERROR MESSAGE >;END OF IFN TOPS20 ;READ A LABEL FROM A NON DIRECTORY DEVICE. ***OPNBBF*** OPNRLB: TLNN AC13,140610 ;SKIP IF DEVICE IS - CDR,LPT,TTY,PTR,OR PTP [RPGLIB EDIT #64] TLNN FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE PRESENT JRST OPNBBF ; OPNRL2: PUSHJ PP,READSY ;READ A LABEL INTO THE BUFFER AREA JRST OPNRL1 ;NORMAL RETURN JRST OPNFW4 ;TRY AGAIN RETURN OPNRL1: PUSHJ PP,BUFREC ;MOVE THE LABEL FROM THE BUFFER TO RECORD AREA ;DO BEFORE BEGINNING FILE USE PROCEDURE. PERFORM STANDARD ;LABEL CHECKS OR CREATE A LABEL. ***OPNABF*** OPNBBF: TLNE FLG,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT DUMP MODE JRST OPNBB1 ; TLNN FLG,OPNOUT ; SKIP IF OUTPUT [EDIT#301] JRST OPNBB1 ;;NOT OUTPUT,SKIP ENTER [EDIT#301] TLNE AC13,4 ;DIRECTORY DEVICE? [EDIT#315] JRST OPNBB2 ;YES, SKIP ENTER [EDIT#315] PUSHJ PP,OPNEID ;SET UP ID FOR ENTER [EDIT#301] XCT UENTR. ;DO AN ENTER [EDIT#301] JRST OEERR ;ERROR RETURN [EDIT#301] OPNBB2: XCT UOUT. ;DUMMY OUTPUT********************[EDIT#315] OPNBB1: MOVEI AC1,1 ;2 WORD CALL, PUSHJ PP,USEPRO ;TO GET THE USE PRO. ADDRESS TLNN AC13,140610 ;NO LABELS - NO CHECKS [RPGLIB EDIT #64] TLNN FLG1,STNDRD ;SKIP IF LABELS ARE STANDARD JRST OPNABF ;AFTER BEG FILE TLNE FLG,OPNIN ;SKIP IF NOT INPUT / IO JRST OPNCSL ;STANDARD LABEL CHECK PUSHJ PP,OPNCAL ;CREATE A LABEL ;DO AFTER BEGINNING FILE LABEL PROCEDURE ;AND WRITE OUT THE LABEL. ***OPNENR*** OPNABF: MOVEI AC1,2 ;TWO WORD CALL PUSHJ PP,USEPRO ;TO GET USE PRO. ADR. TLNN FLG,OPNOUT ;OUTPUT SKIPS JRST OPNDVC TLNE AC13,4 ;SKIP IF NOT DIR. DEV. JRST OPNENR TLNN AC13,140614 ;SKIP IF CDR,LPT,TTY,PTR,PTP,OR DTA,DSK. [RPGLIB EDIT #64] TLNN FLG1,NONSTD+STNDRD ;SKIP IF ANY LABELS JRST OPNDVC ;NO LABELS PUSHJ PP,RECBUF ;MOVE THE LABEL INTO THE BUFFER JUMPGE FLG,OPNAB1 ;JUMP IF DEVICE IS NOT ASCII PUSHJ PP,WRTCR ; PUSHJ PP,WRTLF ; OPNAB1: PUSHJ PP,WRTOUT ;WRITE THE LABEL IFN EBCLBL ,< TLNN FLG,DDMEBC ;EBCDIC? JRST OPNDVC ;NO XCT UCLOS. ;WRITE A TAPE MARK AFTER THE LABELS PUSHJ PP,WRTWAI ;WAIT FOR ERROR CHECKING XCT UOUT. ;DUMMY OUTPUT > JRST OPNDVC ;DO AN ENTER AND SAVE THE FLAG REGISTER. ***EXIT TO THE ACP*** OPNENR: PUSHJ PP,OPNEID ;SETUP UEBLK. (DUMP-MODE) SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNEN1 ; YES - SKIP THE ENTER XCT UENTR. ;ENTER - DIRECTORY DEVICE********** JRST OEERR ;ERROR RETURN OPNEN1: TLNN FLG,RANFIL!OPNIO!IDXFIL ;DUMP MODE HAS NO DUMMY OUTPUTS XCT UOUT. ;DUMMY OUTPUT*****ENTER VOIDS PREVIOUS DUMMY OUTPUTS. OPNDVC: MOVE AC13,UOBLK.+1 CALLI AC13,4 ;THE FINAL DEVCHR TLNN FLG,OPNIO+OPNIN ;[330]IF NOT INPUT THEN IGNORE JRST OPNDV1 ;[330] TLC AC13,300000 ;[330]IF A DSK AND A CDR TLCN AC13,300000 ;[330]THEN ITS DEVICE 'NUL' TLZ AC13,20 ;[330]SO ITS NOT A MAGTAPE OPNDV1: MOVEM AC13,D.DC(I16) ;[330] MOVEM FLG,F.WFLG(I16) ;UPDATE THE FLAGS TLNE AC13,10 ;IS THIS A TTY FILE? HRRZM AC16,TTYOPN ;YES, REMEMBER THAT TLNE FLG1,STNDRD!NONSTD ;SKIP IF LABELS ARE OMITTED PUSHJ PP,ZROREC ;CLEAR THE RECORD AREA I.E.LABEL TLNN AC16,SLURP ;RESTORE THE REC-AREA IF A WRITE REEL CHANGE POPJ PP, ;RETURN TO CBL-PRG POP PP,AC2 ;FROM,,TO POP PP,AC1 ;LENGTH HRRZM AC2,.JBFF ;RESTORE FREE CORE MOVSS AC2 ;THE OTHER WAY ADDI AC1,(AC2) ;UNTIL BLT AC2,(AC1) ;SLURP POPJ PP, ; NOW EXIT TO CBL-PRG ; THE FOLLOWING TABLES ARE USED TO SETUP THE CONVERSION INSTRUCTION RCTBL: RCASC(AC2) ; ASCII TO ? RCEBC(AC2) ; EBCDIC TO ? RCSIX(AC2) ; SIXBIT TO ? RCASC: MOVE C,CHTAB(C) ; ASCII TO ASCII LDB C,PTR.79## ; EBCDIC MOVS C,CHTAB(C) ; SIXBIT RCEBC: LDB C,PTR.97## ; EBCDIC TO ASCII JFCL ; EBCDIC LDB C,PTR.96## ; SIXBIT RCSIX: ADDI C,40 ; SIXBIT TO ASCII LDB C,PTR.69## ; EBCDIC JFCL ; SIXBIT WCTBL: WCASC(AC1) ; ASCII TO ? RCEBC(AC1) ; EBCDIC TO ? RCSIX(AC1) ; SIXBIT TO ? WCASC: JFCL ; ASCII TO ASCII LDB C,PTR.79## ; EBCDIC MOVS C,CHTAB(C) ; SIXBIT ;STANDARD LABELS AND INPUT OR IO ;CHECK THE VALUE OF ID. ***OPNABF*** OPNCSL: PUSHJ PP,RECSLB ;MOVE RECORD AREA TO STD-LABEL AREA PUSHJ PP,OPNLID ;VALUE OF ID TO ULBLK. ;CHECK FOR LABEL TYPE 'HDR1' MOVE AC0,STDLB. ;LABEL TYPE TRZ AC0,7777 ; IFN EBCLBL ,< TLNE FLG,DDMEBC ;IF EBCDIC PUSHJ PP,OECLT ; LOOK FOR 'VOL1' IF FIRST FILE > CAMN AC0,[SIXBIT /HDR1/] ;SKIP INTO ERROR MESSAGE JRST OPNCID ;CHECK VALUE OF ID ;MISSING OR WRONG LABEL TYPE TTCALL 3,[ASCIZ/$ THE BEGINNING FILE LABEL IS MISSING/] OPNCL1: PUSHJ PP,SAVAC. MOVE AC2,[BYTE(5)10,2,31,20,4,14] PUSHJ PP,MSOUT. JRST OPNFW4 ;TRY AGAIN IFN EBCLBL ,< OECLT: LDB AC2,F.BPMT ;GET FILE POSITION SOJG AC2,RET.1 ; AND RETURN IF NOT FIRST FILE ON REEL CAME AC0,[SIXBIT /VOL1/] ;LABEL TYPE MUST BE 'VOL1' JRST OECL1 ; ELSE ERROR MESSAGE PUSHJ PP,READSY ;READ NEXT LABEL, SHLDB 'HDR1' JRST .+2 ;OK JRST OECL2 ;ERROR RETURN, MESSAGE & SECOND CHANCE PUSHJ PP,BUFREC ;MOVE LABEL INTO RECORD AREA PUSHJ PP,RECSLB ; THEN TO LABEL AREA MOVE AC0,STDLB. ;LABEL TYPE TO AC0 TRZ AC0,7777 ; AND CLEAR THE GARBAGE POPJ PP, ;TRY FOR 'HDR1' OECL1: TTCALL 3,[ASCIZ /LABEL "VOL1" IS MISSING/] POP PP,(PP) ; KEEP THE STACK RIGHT JRST OPNCL1 OECL2: POP PP,(PP) ; MAKE THE STACK RIGHT JRST OPNRL2 ; ERROR PATH > OPNCID: HRR AC0,STDLB. ; MOVE AC1,STDLB.+1 ; HLL AC0,STDLB.+2 ; ROTC AC0,30 ;JUSTIFY THE FILENAME CAME AC0,ULBLK. ;CHECK FILE NAMES JRST OPNIDE ;ID ERROR HLLZ AC0,ULBLK.+1 ; TRZ AC1,-1 ;CLEAR THE LABEL NUMBER CAMN AC0,AC1 ;CHECK EXTENSIONS JRST OPNCDW ;CHECK DATE WRITTEN ;ID ERROR. OPNIDE: PUSHJ PP,SAVAC. ; MOVE AC2,[BYTE (5)10,2,31,20,4,14] PUSHJ PP,MSOUT. ; TTCALL 3,[ASCIZ/$ THE VALUE OF ID DOES NOT MATCH THE LABEL ID/] JRST OPNFW4 ;CHECK DATE WRITTEN OPNCDW: SKIPN AC5,F.WVDW(I16) ;VALUE OF DATE WRITTEN JRST OPNCRN ;CHECK REEL NUMBER MOVE AC0,[POINT 6,STDLB.+6,29] MOVEI AC2,6 ;CHECK ONLY FIRST 6 CHARS. OPNCD1: ILDB AC1,AC0 ;ONE FROM THE LABEL AND ILDB AC6,AC5 ;ONE FROM THE FILE TABLE TLNE AC5,100 ;SKIP IF SIXBIT SUBI AC6,40 ;MAKE IT SIXBIT TLNN AC5,600 ; EBCDIC? LDB AC6,PTR.96##(AC6) ; YES CAME AC6,AC1 ;SKIP IF EQUAL JRST OPNCD2 ;WRONG DATE MESSAGE SOJN AC2,OPNCD1 ;LOOP 6 TIMES JRST OPNCRN ; OK SO CHECK THE REEL NUMBER ;WRONG DATE OPNCD2: MOVE AC2,[BYTE (5)10,31,20,2,4,14] PUSHJ PP,MSOUT. TTCALL 3,[ASCIZ /THE FILE TABLE DATE DIFFERS FROM THE FILE LABEL DATE/] JRST KILL ;CHECK THE REEL NUMBER IF THE DEVICE IS A MAGTAPE OPNCRN: TLNN AC13,20 ;MAGTAPE? JRST OPNABF ;NO HRL AC0,STDLB.+4 ;THE HLR AC0,STDLB.+5 ; REAL ROT AC0,-14 ; REEL ANDI AC0,7777 ; NUMBER LDB AC1,DTRN. ;AND WHAT IT OUGHT TO BE CAMN AC0,AC1 ;SKIP IF UNEQUAL JRST OPNCR1 ;MATCH LDB AC2,F.BPMT ; JUMPN AC2,OPNCR1 ;JUMP ITSA MULTI-FILE-REEL PUSHJ PP,SAVAC. ; TTCALL 3,[ASCIZ / $/] MOVE AC2,[BYTE(5)10,31,20,2,4,34,14] ;FODC.R# PUSHJ PP,MSOUT. ; TTCALL 3,[ASCIZ/ WAS MOUNTED, PLEASE MOUNT /] PUSHJ PP,MSDTRN TTCALL 3,[ASCIZ / THEN/] JRST OPNF04 ;TRY AGAIN OPNCR1: IFN EBCLBL ,< TLNE FLG,DDMEBC ;IF EBCDIC XCT MADVF. ; SKIP TO TAPE MARK > JRST OPNABF ;CREATE A STANDARD LABEL. ***@POPJ*** OPNCAL: PUSHJ PP,OPNEID ;LOAD FILENM.EXT INTO ENTER BLOCK PUSHJ PP,ZROSLA ;ZERO THE STD LABEL AREA IFN EBCLBL,< LDB AC0,F.BPMT ;GET FILE POSITION TLNE FLG,DDMEBC ;EBCDIC? SOJLE AC0,[ ;MAKE A 'VOL1' LABEL MOVE AC0,[SIXBIT /VOL1/] MOVEM AC0,STDLB. ;'VOL1' TO THE LABEL AREA PUSHJ PP,SLBREC ;MOVE TO RECORD AREA PUSHJ PP,RECBUF ; THEN TO THE BUFFER PUSHJ PP,WRTOUT ; AND WRITE IT SETZM STDLB. ;ZERO THE LABEL AREA JRST .+1] ;RETURN > MOVE AC0,UEBLK. ;FILENAME HLLZ AC1,UEBLK.+1 ;EXT ROTC AC0,14 ;12 PLACES TO THE LEFT - MARCH. TRO AC1,(SIXBIT /1/);FIRST LABEL MOVEM AC0,STDLB.+1 ;FILE HLLM AC1,STDLB.+2 ;DESCRIPTOR TLNE AC16,OPEN+CLOSEB HRLI AC1,(SIXBIT /HDR/) ;BEGINNING FILE LABEL TLNE AC16,CLOSEF HRLI AC1,(SIXBIT /EOF/) ;END OF FILE LABEL TLNE AC16,CLOSER HRLI AC1,(SIXBIT /EOV/) ;END OF VOLUME LABEL MOVEM AC1,STDLB. ; IFN EBCLBL,< TLNE FLG,DDMEBC ;EBCDIC? PUSHJ PP,JULIA0 ;JULIAN DATE & SKIP EXIT (YYDDD) > PUSHJ PP,TODAY. ;GET TODAY'S DATE (YYMMDD) SETZ AC1, ; ROTC AC0,6 ; MOVEM AC1,STDLB.+6 ;CREATION MOVEM AC0,STDLB.+7 ;DATE OPNCA1: SETZ AC2, LDB AC0,F.BPMT ;FILTAB FILE POSITION ON MAGTAPE IDIVI AC0,^D10 ; ADDM AC1,AC2 ; ROT AC2,6 ; JUMPN AC0,.-3 ;CONVERTED TO DECIMAL ADD AC2,[20202020] ;SIXBITIZED LDB AC1,DTRN. ;DEVTAB MAG-TAPE REEL NUMBER ROT AC2,14 ; ROTC AC1,-6 ; ADDI AC1,202000 ; MOVEM AC1,STDLB.+4 ;REEL NUMBER AND MOVEM AC2,STDLB.+5 ;FILE POSITION SETZ AC1, ; MOVE AC0,[SIXBIT /PDP10 /] MOVEM AC0,STDLB.+12 HRLZ AC0,.JBVER ROTC AC0,14 ROT AC1,3 ROTC AC0,3 ROT AC1,3 ROTC AC0,3 ADDI AC1,202020 HRLZM AC1,STDLB.+13 ;PDP10 VER JRST SLBREC ;MOVE STD-LABEL TO RECORD AREA AND EXIT ;SET MAGTAPE DENSITY & PARITY ;POSITION MAGTAPE VIA FILE TABLE FILE POSITION. ***OPNLO*** OPNMTA: TLNN FLG,DDMEBC ; RECORDING MODE EBCDIC? JRST OMTA10 ; NO TLNE FLG1,NONSTD!STNDRD; LABELS OMITTED? JRST OMTA98 ; NO - ERROR HRRZ AC1,F.WDNM(I16) ; GET THE SIXBIT MOVE AC1,(AC1) ; DEVICE NAME AND MTCHR. AC1, ; GET CHARACTERISTICS SETZ AC1, ; ERROR RET - ASSUME 9TRK TRNE AC1,1B31 ; 9 TRACKS? JRST OMTA10 ; NO - 7 TRK HRLZI AC3,3 ; LENGTH ,, ADDR MOVEI AC0,.TFMOD ; FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME MOVEI AC2,.TFM8B ; INDUSTRY-COMPATIBLE MODE TAPOP. AC3, ; DOIT JRST OMTA93 ; ERROR - COMPLAIN ;SET PARITY OMTA10: XCT UGETS. ; GET STATUS INTO AC2 LDB AC5,F.BPAR ; GET REQUESTED PARITY DPB AC5,[POINT 1,AC2,26]; SET PARITY XCT USETS. ; SET STATUS ;STANDARD-ASCII OR 1600 BPI WANTED? OMTA20: LDB AC5,F.BDNS ; GET DENSITY HRRZ AC6,D.RFLG(I16) ; GET STANDARD ASCII FLAG CAIGE AC5,4 ; SKIP IF 1600 BPI TRNE AC6,SASCII ; DOES HE WANT IT? JRST OMTA21 ; YES ;SET DENSITY XCT UGETS. ;GET STATUS DPB AC5,[POINT 3,AC2,28] XCT USETS. ;SET STATUS JRST OPNPMT ; ;TU16/43/45/70 REQUIRED - DO WE HAVE ONE? OMTA21: HRLZI AC3,2 ; LENGTH ,, ADDR MOVEI AC0,.TFKTP ; FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME TAPOP. AC3, ; GET CONTROLER TYPE JRST OMTA90 ; ERROR TRNN AC6,SASCII ; STD-ASCII REQUEST? JRST OMTA22 ; NO CAIE AC3,.TX01 ; TU70 CONTROLLER? CAIN AC3,.TM02 ; OR A TU16 OR TU45? JRST .+2 ; YES JRST OMTA91 ; ERROR - WRONG TYPE ;SET STANDARD ASCII MODE HRLZI AC3,3 ; LENGTH ,, ADDR MOVEI AC0,.TFMOD ; FUNCTION MOVEI AC2,.TFM7B ; STANDARD ASCII MODE TAPOP. AC3, ; CHANGE MODE JRST OMTA93 ; ERROR - COMPLAIN ;TU16/43/45/70 CAN ONLY DO 800 OR 1600 BPI JUMPE AC5,OPNPMT ; USE DEFAULT DENSITY CAIE AC5,3 ; 800 BPI? CAIN AC5,4 ; 1600? JRST OMTA30 ; YES SO SET IT JRST OMTA94 ; NO COMPLAIN OMTA22: CAIE AC3,.TC10C ; TU43 CONTROLLER? CAIN AC3,.TX01 ; TU70? JRST OMTA30 ; OK CAIE AC3,.TM02 ; TU16/45? JRST OMTA92 ; NO COMPLAIN ;SET DENSITY OMTA30: HRLZI AC3,3 ; LENGTH,,ADR MOVEI AC0,.TFSDN ; SET DENSITY FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME MOVE AC2,AC5 ; REQUESTED DENSITY TAPOP. AC3, ; SET IT JRST OMTA95 ; OOPS ;NOW GET/CHECK DENSITY HRLZI AC3,2 ; LEN,,ADR MOVEI AC0,.TFGDN ; GET DENSITY FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME TAPOP. AC3, ; GET DENSITY JRST OMTA95 ; OOPS CAME AC2,AC3 ; CHECK IT JRST OMTA95 ; ERROR - NOT WHAT 'E ASKED FOR JRST OPNPMT ; ;HERE IF TAPOP. ERROR RET OR NOT A TU16/45/70 DRIVE OMTA90: TRNN AC6,SASCII ; STD-ASCII MESSAGE? JRST OMTA92 ; NO 1600 BPI OMTA91: MOVE AC0,[E.FIDX+^D37]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / STANDARD ASCII RECORDING MODE REQUIRES A TU16, TU45 OR TU70/] JRST OMTA99 ; ;1600 BPI WANTS A TU16/43/45/70 OMTA92: MOVE AC0,[E.FIDX+^D38]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / DENSITY OF 1600 BPI REQUIRES A TU16, TU43, TU45 OR TU70/] JRST OMTA99 ; ;TAPOP. FAILED TO SET STANDARD ASCII MODE OMTA93: MOVE AC0,[E.FIDX+^D45]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / TAPOP. FAILED - UNABLE TO SET STANDARD-ASCII OR INDUSTRY-COMPATIBLE MODE/] JRST OMTA99 ;TU16/43/45/70 CAN DO ONLY 800/1600 BPI OMTA94: MOVE AC0,[E.FIDX+^D46]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ " TU16/43/45/70 CAN HAVE DENSITY OF ONLY 800 OR 1600 BPI"] JRST OMTA99 ;TAPOP. FAILED OR "SET" DOESN'T MATCH "GET" DENSITY OMTA95: MOVE AC0,[E.FIDX+^D47]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / CANNOT SET THE REQUESTED DENSITY/] JRST OMTA99 ;FOR NOW EBCDIC FILES MUST HAVE OMITTED LABELS OMTA98: TTCALL 3,[ASCIZ / EBCDIC MTA FILES MUST HAVE OMITTED LABELS /] OMTA99: MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN OPNPMT: MOVEI AC3,2 ; 2 EOF'S PER FILE IF NOT EBCDIC TLNE FLG,DDMEBC ; DEVICE DATA MODE EBCDIC? MOVEI AC3,3 ; YES, 3 EOF/FILE. TLNN FLG1,NONSTD!STNDRD ; LABELS OMITTED? MOVEI AC3,1 ; YES, 1 EOF/FILE. HRLZI AC5,HUF ;"HEAD UNDER THIS FILE" FLAG LDB AC11,F.BPMT ;POINT 6,6(I16),17 ... FILE POSITION ON REEL JUMPE AC11,OPNF00 ;JUMP IF MULTI REEL FILE WAS OPNREW MOVE AC10,AC16 ;CURRENT FILE TABLE FIRST OPNHUF: TDNE AC5,D.HF(AC10) ;SKIP IF NOT "HUF" JRST OPNFND ;FOUND THE FILE HRRZ AC10,11(AC10) ;NEXT FILE TABLE THAT SHARES THIS REEL CAIE AC10,(I16) ;SKIP IF WE'VE MADE A COMPLETE LOOP JUMPN AC10,OPNHUF ;ZERO=REEL NOT SHARED ;FALL THRU IF REEL NEVER POSITIONED OPNREW: PUSHJ PP,OPNRWD ;REWIND SUBI AC11,1 ;SUB 1 FOR THIS REWIND IMUL AC11,AC3 ; SEE HOW MANY EOF'S TO PASS JUMPG AC11,OPNFWD JRST OPNFW1 OPNRWD: XCT MWAIT. XCT SOBOT. ;STATO BEG-OF-TAPE XCT MREW. ;ELSE REWIND POPJ PP, OPNFND: ANDCAM AC5,D.HF(AC10) ;CLEAR THE HUF FLAG TLNN AC16,100 ;REWIND REQ? JRST OPNREW ;YES LDB AC10,[POINT 6,6(AC10),17] ;FIGURE OUT WHERE TO GO SUB AC11,AC10 ;DIRECTION + MAGNITUDE IMUL AC11,AC3 ; SEE HOW MANY EOF'S TO PASS JUMPE AC11,OPNBOF ;GO TO THE BEG OF FILE JUMPG AC11,OPNFWD ;SPACE FORWARD OPNREV: XCT MWAIT. ;[336]MAKE SURE WE WAIT XCT MBSPF. ;[336]BACKSPACE A FILE XCT MWAIT. ;WAIT FOR COMPLETION XCT SZBOT. ;STATZ BOT JRST OPNRE1 ;PREMATURE BEG-OF-TAPE ERROR AOJL AC11,OPNREV ;LOOP TILL (AC11)=0 OPNBOF: XCT MBSPF. ;MOVE TO BEG OF CURRENT FILE XCT MWAIT. XCT SOBOT. ;SKIP, BIT=BOF XCT MADVF. ;MOVE TO OTHER SIDE OF EOF MARK JRST OPNFW1 OPNFWD: XCT MWAIT. ;AVOID POSITIONING ERRORS XCT SZEOT. ;STATZ EOT JRST OPNFW2 ;END OF TAPE ERROR XCT MADVF. ;ADVANCE A FILE SOJG AC11,OPNFWD OPNFW1: XCT MWAIT. ;[336]WAIT ON MTA ORM AC5,D.HF(I16) ;[336]NOTE CURRENT FILE OVER HEAD JRST OPNLO ;EXIT FROM OPNPMT OPNF00: TLNE AC16,100 ;REWIND REQ ? JRST OPNFW1 ;NO JRST OPNREW ;YES OPNRE1: TTCALL 3,[ASCIZ /$ UNEXPECTED BOT MARKER/] ; [EDIT#277] SKIPA OPNFW2: TTCALL 3,[ASCIZ /$ UNEXPECTED EOT MARKER/] ; [EDIT#277] PUSHJ PP,SAVAC. TTCALL 3,[ASCIZ /$ ENCOUNTERED WHILE POSITIONING /] MOVE AC2,[BYTE (5)10,31,20,14] ;FILE ON DEVICE. PUSHJ PP,MSOUT. OPNFW4: TLNN AC13,120 ;SKIP IF A REEL DEVICE JRST KILL ; TTCALL 3,[ASCIZ / WRONG REEL? /] OPNF04: PUSHJ PP,C.STOP ;TYPE CONTINUE TO RETRY PUSHJ PP,RSTAC. HRLZI AC5,HUF ;ANOTHER TAPE WAS MOUNTED ANDCAM AC5,D.HF(I16) ;CLEAR THE "HEAD-UNDER-FILE" FLAG JRST OPNBP4 ;TRY AGAIN ;PLACE VALUE OF ID IN LOOKUP/ENTER BLOCK OPNLID: SKIPA AC10,[POINT 6,ULBLK.] ;LOOKUP SETUP OPNEID: MOVE AC10,[POINT 6,UEBLK.] ;ENTER SETUP IFN ISAM,< TLNE FLG,IDXFIL ;ISAM ? SKIPA AC5,[POINT 6,DFILNM(I12)] > MOVE AC5,F.WVID(I16) ;BYTE POINTER TO VALUE OF ID MOVEI AC6,11 ;ID HAS 11 CHARACTERS MAX OPNEI1: ILDB C,AC5 ;PICK UP A CHAR TLNN AC5,600 ; IS VID EBCDIC? LDB C,PTR.96##(C) ; YES - CONVERT TO SIXBIT TLNE AC5,1100 ;SKIP IF SIXBIT SUBI C,40 ;CONVERT FROM ASCII IDPB C,AC10 ;STORE IN E BLOCK SOJN AC6,OPNEI1 ;LOOP 11 SETZM ULBLK.+3 ;P,,P SETZM UEBLK.+3 ;PROJ,,PROG HLLZS ULBLK.+1 ;ZERO RIGHT HALF OF EXTENSION WORD HLLZS UEBLK.+1 ; IN LOOKUP AND ENTER BLOCK SETZM UEBLK.+2 ;CLEAR PROTECTION AND DATE OPNPPN: LDB AC5,F.BCVR ;GET COMPILER NUMBER CAIGE AC5,3 ;VERSION 3 OR OLDER? POPJ PP, ;NOP HRRZ AC5,F.RPPN(I16) ;ADR OF PROJ,,PROG JUMPE AC5,RET.1 ;USE DEFAULT MOVE AC5,(AC5) ;PROJECT,,PROGRAMER MOVEM AC5,ULBLK.+3 MOVEM AC5,UEBLK.+3 POPJ PP, ;AND RETURN IFN ISAM,< OPNLIX: MOVEI AC10,OPNLID SKIPA OPNEIX: MOVEI AC10,OPNEID TLC FLG,IDXFIL PUSHJ PP,(AC10) TLC FLG,IDXFIL POPJ PP, > ;PERFORM A USE PROCEDURE ;CALLED WITH AN INDEX IN AC1, ***POPJ*** USEPRO: JUMPE AC1,USEPR0 ;JUMP IF ERROR USEPRO TLNN FLG1,NONSTD!STNDRD POPJ PP, ;EXIT, THERE ARE NO LABELS USEPR0: PUSHJ PP,SAVAC. ;SAVE THE ACS PUSHJ PP,USESUP ;GET USE-PRO ADDRESS INTO AC1 AND AC2 TLNE AC16,CLOSEB+CLOSER ;SKIP IF NOT A REEL PRO JRST USEPR1 ; LDB AC0,F.BPMT ;FILE POSITION ON MTA JUMPN AC0,USEPR2 ;JUMP IF MULTI FILE REEL TLNE AC16,CLOSEF ;SKIP IF AN OPEN USEPRO USEPR1: PUSHJ PP,USESWP ;SET FOR REEL PROCEDURE USEPR2: PUSHJ PP,USEXCT ;EXECUTE A PRO MOVE AC16,-16(PP) ;RESTORE AC16 TLNN AC16,CLOSEB+CLOSER ;EXIT IF A REEL PRO SKIPN -1(PP) ;OR AN ERROR PRO JRST RSTAC1 ;EXIT PUSHJ PP,USESUP ;SETUP TLNN AC16,CLOSEF ;SKIP IF A CLOSE TYPE USEPRO PUSHJ PP,USESWP ;SET FOR REEL PROCEDURE LDB AC0,F.BPMT ;FILE POSITION JUMPN AC0,RSTAC1 ;EXIT, NOT A MULTI-REEL-FILE PUSHJ PP,USEXCT ;ELSE PERFORM THE USE-PRO JRST RSTAC1 ;@POPJ USESUP: MOVE AC1,-2(PP) ;INDEX FOR THE USE TABLES MOVEM AC1,AC2 ; ADDI AC2,F.REUP(I16) ;ADR OF FILE USE PRO ADD AC1,USES. ;ADR OF GENERAL USE PRO MOVE FLG,-10(PP) ;RESTORE AC7 TLNN FLG,OPNOUT ;SKIP IF OUTPUT JRST USESU1 ;INPUT USE PRO TLNE FLG,OPNIN ;SKIP IF NOT INPUT ADDI AC1,5 ;INPUT/OUTPUT USE PRO ADDI AC1,5 ;OUTPUT USE PRO USESU1: MOVE AC1,(AC1) MOVE AC2,(AC2) SKIPN USES. ; SETZ AC1, ;FOR STAND ALONE SORTS POPJ PP, ; USESWP: SKIPN -2(PP) ;IF ERROR USEPRO POPJ PP, ; JUST RETURN HLRZ AC1,AC1 ;USE THE REEL ADDRESS HLRZ AC2,AC2 ;IN THE LEFT HALF POPJ PP, ; USEXCT: MOVE AC3,-2(PP) ;PP-2=AC1; USE TABLE INDEX TRNN AC1,-1 ;SKIP IF THERE IS A GENERAL USEPRO HRRZ AC1,AC2 ;GET SPECIFIC FILTAB USEPRO JUMPN AC1,USEXC1 ;GO PERFORM USEPRO JUMPN AC3,USEXC2 ;IF NO LABEL USEPRO RETURN AOSA -20(PP) ;IF NO ERROR USEPRO SKIP-EXIT USEXC1: PUSHJ PP,(AC1) ;XCT THE USEPRO USEXC2: POPJ PP, ; ;RECSLB.. MOVE RECORD AREA TO SIXBIT STD-LABEL AREA ;SLBREC.. MOVE SIXBIT STD-LABEL AREA TO RECORD AREA. ***POPJ*** RECSLB: TLOA AC0,400000 ; SLBREC: TLZ AC0,400000 ; MOVE AC2,STDLBP ; SET UP TO/FROM POINTERS LDB AC1,[POINT 2,FLG,14] ; GET CORE DATA MODE HLLZ AC1,RBPTBL(AC1) ; AND RECORD BYTE PTR SKIPL AC0 ; WHICH WAY? EXCH AC1,AC2 ; STD-LABEL TO RECORD AREA MOVEI AC0,^D80-2 ; TLNE FLG,DDMEBC ; EBCDIC ALWAYS HAS MOVEI AC0,^D80 ; 80. CHARS SLBRE1: ILDB C,AC1 ; TLNE AC1,1000 ; EBCDIC TO SIXBIT? LDB C,PTR.96## ; YES TLNE AC2,1000 ; SIXBIT TO EBCDIC? LDB C,PTR.69## ; YES TLNN FLG,CDMSIX!CDMEBC ; ADDI C,40 ; ASCII IDPB C,AC2 ; SOJG AC0,SLBRE1 ; POPJ PP, ;;;;; ;READ THE LABEL INTO THE RECORD AREA. ***POPJ*** BUFREC: PUSHJ PP,BUFRE0 ;SETUP MOVE AC10,D.RCNV(I16) ;SETUP AC10 BUFRE1: SOSGE D.IBC(I16) ; PUSHJ PP,READSY ;FILL THE BUFFER JRST BUFR01 ;NORMAL RETURN JRST CLSRL0 ;EOF - COMPLAIN BUFR01: ILDB C,D.IBB(I16) ;PICK UP A LABEL CHAR XCT AC10 ;CONVERT IF NECESSARY IDPB C,AC3 ;TO THE RECORD AREA SOJG AC0,BUFRE1 ;LOOP TILL LABEL IS IN THE RECORD AREA SETZM D.IBC(I16) ;THE BUFFER IS EMPTY POPJ PP, ;WRITE OUT THE LABEL. ***POPJ*** RECBUF: PUSHJ PP,BUFRE0 ;SETUP MOVE AC10,D.WCNV(I16) ;SETUP AC10 RECBU1: SOSGE D.OBC(I16) ; PUSHJ PP,WRTOUT ;WRITE OUT THE BUFFER ILDB C,AC3 ;PICK UP A LABEL CHAR XCT AC10 ;CONVERT IF NECESSARY IDPB C,D.OBB(I16) ;TO THE OUTPUT BUFFER SOJG AC0,RECBU1 ;LOOP TILL DONE POPJ PP, ;SET LABEL POINTER AND SIZE AND POPJ. BUFRE0: LDB AC3,[POINT 2,FLG,14] ; GET CORE DATA MODE HLLZ AC3,RBPTBL(AC3) ; AND THEN RECORD BYTE-PTR MOVEI AC0,^D80-2 ;STD-LABEL SIZE TLNE FLG,DDMEBC ; EBCDIC DEVICE? MOVEI AC0,^D80 ; LABEL SIZE TLNE FLG1,NONSTD ; HLRZ AC0,F.LNLS(I16) ;NON-STD-LABEL SIZE TLNN FLG,DDMBIN ;IS FILE BINARY? POPJ PP, ;NO HRLZI AC3,(POINT 36,(FLG)) ;MAKE ONE BYTE BE ONE WORD LDB AC10,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC10,RBPTBL(AC10) ; GET CHARS PER WORD ADDI AC0,-1(AC10) ; - IDIV AC0,AC10 ; TO WORD COUNT POPJ PP, ;ZERO THE STANDARD LABEL AREA. ***POPJ*** ZROSLA: SETZM STDLB. ; MOVEI AC1,STDLB.+1 ;TO HRLI AC1,STDLB. ;FROM,TO BLT AC1,STDLB.+15 ;ZERO 16 WORD STD LABEL AREA POPJ PP, ;MOVE SPACES TO THE RECORD AREA. ***POPJ*** ZROREC: LDB AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE MOVE AC2,SPCTBL(AC2) ; GET A WORD OF SPACES MOVEM AC2,(FLG) ; TO THE RECORD AREA SETZ AC2, ; INIT AC2 TLNE FLG1,STNDRD ; STANDARD LABELS? MOVEI AC2,^D80 ; YES TLNE FLG1,NONSTD ; NON-STANDARD LABELS? HLRZ AC2,F.LNLS(I16) ; YES LDB AC1,F.BMRS ;MAX REC SIZ CAMGE AC1,AC2 ; USE THE LARGER SIZE MOVE AC1,AC2 ; LABEL LARGER. LDB AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC2,RBPTBL(AC2) ; GET CRARS PER WORD ADDI AC1,-1(AC2) ;CONVERT TO IDIV AC1,AC2 ; WORDS HRLI AC2,(FLG) ;THE FROM ADR HRRI AC2,1(FLG) ;THE TO ADR ADDI AC1,-1(FLG) ;THE UNTIL ADR BLT AC2,(AC1) ;ZRAPP! POPJ PP, ; SPCTBL: ASCII / / ; ASCII SPACES BYTE (9) 100,100,100,100 ; EBCDIC SIXBIT / / ; SIXBIT SPCTB1: 40 ; ONE ASCII SPACE RIGHT JUSTIFIED 100 ; EBCDIC 0 ; SIXBIT ;SAVE THE ACS ON THE PUSH DOWN STACK. ***"POPJ"*** SAVAC.: POP PP,TEMP. ;POP OFF THE RETURN PUSH PP,AC16 ;SAVE AC16 - AC0 MOVEI AC16,15 ; PUSH PP,(I16) ; SOJGE AC16,.-1 ; MOVE AC16,-16(PP) ; JRST @TEMP. ;LAST ENTRY IS AC0 ;RESTORE THE ACS. ***"POPJ"*** ;RSTAC1 MUST -NOT- BE CALLED VIA PUSHJ RSTAC1: HRRZI AC16,RET.1 MOVEM AC16,TEMP. SKIPA ;RSTAC. MUST BE CALLED VIA PUSHJ RSTAC.: POP PP,TEMP. ;RESTORE AC0 - AC16 HRLZI AC16,-16 ; POP PP,(I16) ; AOBJN AC16,.-1 ; POP PP,AC16 ; JRST @TEMP. ; ;FREE THE IO CHANNEL. ***POPJ*** IFN ISAM,< FRECH1: SKIPA AC2,ICHAN(I12) ;IDX-DEV'S CHAN > FRECHN: LDB AC2,DTCN. ;CHANNEL NUMBER FRECH2: MOVNS AC2 ;SHIFT TO THE RIGHT HRLZI AC0,400000 ;MASK BIT LSH AC0,(AC2) ;POSITION THE MASK ORM AC0,OPNCH. ;MAKES THE CHANNEL AVAILABLE POPJ PP, ; ;DISTRIBUTE THE CHANNEL NUMBER THROUGH THE UUO TABLE. ***POPJ*** SETCN.: LDB AC5,DTCN. ; CHANNEL NUMBER SETC1.: HRLZI AC10,ULEN.##-1 ; GET TABLE LENGTH MOVE AC6,[POINT 4,UFRST.(AC10),12] DPB AC5,AC6 ; INSERT THE CHAN NUMBER AOBJN AC10,.-1 ; LOOP TILL THE LAST LOC POPJ PP, ;RETURN A FREE CHANNEL NUMBER IN AC5 GCHAN: SKIPN AC5,OPNCH. ;ANY CHANNELS AVAILABLE? SKIPA AC2,[BYTE (5)10,2,4,5] ;FCBO,TMOF. SKIPA AC6,OPNCBP ;YES, SKIP + GET BYTE POINTER JRST MSOUT. ;ERROR MESSAGE + KILL HRRI AC5,1 ;[342]START WITH 1 MOVEI AC2,17 ;[342]UPPER LIMIT GCHAN2: ILDB AC11,AC6 ;[342]GET FIRST CHAN FLAG SOJE AC11,GCHAN1 ;[342]JUMP IF IT WAS A ONE CAIG AC2,(AC5) ;[342]IF TRIED ALL 17 JRST GCHAN0 ;[342]THEN HAVE TO USE 0 AOJA AC5,GCHAN2 ;[342]AC5 (RIGHT) HAS CHAN NUMBER GCHAN1: DPB AC11,AC6 ;[342]NOTE THAT CHAN UNAVAILABLE POPJ PP, GCHAN0: SETZB AC5,AC11 ;[342]USE CHANNEL 0 MOVE AC6,OPNCBP ;[342]MARK CHAN 0 IN USE JRST GCHAN1 ;[342]AND EXIT ;INCREMENT THE REEL NUMBER BY ONE. ***POPJ*** INCRN.: LDB AC2,DTRN. ;SIXBIT ADD ONE TO CURRENT REEL NUMBER MOVE AC0,AC2 ;SO THE REEL NUMBER MAY BE RESTORED TRNE AC2,10 TRNN AC2,1 ;SKIP IF INC. WILL CAUSE A CARRY OUT AOJA AC2,INCRN1 ;INCREMENT THE REEL NUMBER TRNE AC2,1000 TRNN AC2,100 SKIPA ;[327] JRST INCRN2 ;99 IS MAX ADDI AC2,100 ;[327] ADD 100 TRZ AC2,11 ;THE INCREMENT INCRN1: DPB AC2,DTRN. ;SAVE AS CURRENT REEL NUMBER POPJ PP, INCRN2: MOVE AC2,[BYTE (5)10,31,20,2,4,14] PUSHJ PP,MSOUT. TTCALL 3,[ASCIZ /99 IS THE MAXIMUM ACCEPTABLE REEL NUMBER/] JRST KILL ;OPEN FAILED - GIVE FATAL MESSAGE OR IGNORE IT OERRDF: MOVE AC0,[E.MOPE+E.FIDA];ERROR NUMBER SETZM FS.IF ;IDA FILE JRST OERRI1 ; ;OPEN FAILED OERRIF: MOVE AC0,[E.MOPE+E.FIDX];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MOPE] ;NO OERRI1: PUSHJ PP,IGCVR ;IGNORE? JRST RCHAN ;YES - NO MESSAGE BUT FILE IS NOT OPEN MOVE AC2,[BYTE (5)25,4,20,13,23,15] JRST MSOUT. ;DEVICE IS NOT A DEVICE OR NOT AVAILABLE ;RENAME OF "IDX" FILE FAILED ORERRI: MOVE AC0,[E.MREN+E.FIDX];MAKE AN ERROR NUMBER JRST OEERR1 ; ;RENAME FAILED ORERR: SETZM FS.IF ;IDA FILE MOVE AC0,[E.MREN+E.FIDA];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MREN] ;NO, ERROR NUMBER JRST OEERR1 ; ;ENTER OF "IDX" FILE FAILED OEERRI: MOVE AC0,[E.MENT+E.FIDX];ERROR NUMBER JRST OEERR1 ; ;ENTER FAILED OEERR: SETZM FS.IF ;IDA FILE MOVE AC0,[E.MENT+E.FIDA];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MENT] ;NO, ERROR NUMBER OEERR1: PUSHJ PP,ERCDE ;IGNORE? JRST RCHAN ;YES JRST ENRERR ;GIVE ERROR MESSAGE ;LOOKUP OF "IDX" FILE FAILED OLERRI: MOVE AC0,[E.MLOO+E.FIDX];ERROR NUMBER JRST OLERR1 ; ;LOOKUP FAILED OLERR: SETZM FS.IF ;IDA FILE MOVE AC0,[E.MLOO+E.FIDA];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MLOO] ;NO, ERROR NUMBER OLERR1: PUSHJ PP,ERCDL ;IGNORE? JRST RCHAN ;YES JRST LUPERR ;GIVE ERROR MESSAGE ;GET THE LOOKUP/ENTER/RENAME/FILOP ERROR CODE INTO AC0 ERCDL: SKIPA AC1,ULBLK.+1 ;GET ERROR CODE FROM LOOKUP BLOCK ERCDE: MOVE AC1,UEBLK.+1 ; OR ENTER BLOCK ERCDF: ANDI AC1,37 ;GET ONLY THE ERROR BITS CAIL AC1,10 ;DON'T CONVERT TO ADDI AC0,2 ; DECIMAL CAIL AC1,20 ; GET RID ADDI AC0,2 ; OF 8, 9 CAIL AC1,30 ; 18, 19 ADDI AC0,2 ; 28 AND 29 ADD AC0,AC1 ;ADD IN THE ERROR CODE CAIE AC1,6 ;HARDWARE ERROR? JRST IGCVR ;NO MOVEI AC1,^D30 ;YES MOVEM AC1,FS.FS ;LOAD FILE-STATUS JRST IGCVR ;FINISH UP ;RELEASE THE IO CHANNEL AND NOTE THAT IT'S FREE RCHAN: IFN ISAM< TLNN FLG,IDXFIL ;INDEXD FILE? JRST RCHAN1 ;NO HRRZ AC5,ICHAN(I12) ;GET THE CHANNEL NUMBER PUSHJ PP,SETC1. ;SET UP THE RELEASE UUO XCT URELE. ;RELEASE IT PUSHJ PP,FRECH1 ; AND FREE THE CHAN PUSHJ PP,SETCN. ;SET UP FOR THE "IDA" FILE > RCHAN1: XCT URELE. ;RELEASE IT JRST FRECHN ;FREE THE CHAN AND RET TO CBL-PRG ;CALL VIA JRST ;AC0 HAS ERROR NUMBER FOR IGCV - AC2 HAS ERROR MESSAGE FOR MSOUT. OXITER: TLNE FLG,IDXFIL ;ISAM FILE? ADD AC0,[E.FIDX] ;YES PUSHJ PP,IGCV ;IGNORE ERROR? JRST MSOUT. ;NO POPJ PP, ;YES, BACK TO MAIN LINE ;CALL VIA PUSHJ -- AC0 HAS ERROR NUMBER OXITP: TLNE FLG,IDXFIL ;ISAM FILE? ADD AC0,[E.FIDX] ;YES PUSHJ PP,IGCVR ;IGNORE ERROR ? POP PP,(PP) ;YES, POP OFF RETURN POPJ PP, ; RETURN SUBTTL WRITE OUT THE BUFFER ;ALL BUFFERED OUTPUTS ARE DONE HERE. ***POPJ*** WRTOUT: AOS D.OE(I16) ;BUMP OUTPUT COUNT XCT UOUT. ;DO THE OUTPUT POPJ PP, ;NORMAL RETURN WRTWAI:;**SAVE ACS** PUSHJ PP,SETCN. ; SETUP THE CHANNEL FIELD XCT UWAIT. ;FOR ALL THE ERRORS XCT UGETS. ; TRNE AC2,740000 ;ERRORS? JRST WRTERR ;THERE ARE ERRORS. WRTFIN: MOVE AC13,D.DC(I16) ; GET DEVICE CHARACTERISTICS TLNE AC13,20 ;MTA? TRNN AC2,2000 ;EOT? JRST WRTXIT ;NOT A MAGTAPE EOT TLNE AC16,READ+CLOSEF+CLOSER ;CLOSE OR READ? JRST WRTXIT ;YES TYPE 'F' OR 'R' LABEL OR READ LDB AC0,F.BPMT ;COULD BE WRITE, OPEN, OR CLOSE 'B' JUMPN AC0,WRTMFR ;JUMP IF MFR TLO AC16,MTAEOT ;EOT FLAG JRST WRTXIT ; WRTMFR: MOVE AC0,[E.MOUT] ;OUTPUT ERROR PUSHJ PP,IGMDR ;IGNORE ERROR? JRST WRTXIT ;YES TTCALL 3,[ASCIZ/ENCOUNTERED AN "EOT" ON A MULTI FILE REEL WHILE PROCESSING/] MOVE AC2,[BYTE(5)10,31,20,36] JRST MSOUT. ;/FILE ON DEVICE/ KILL ;READ EOF GETS A SKIP EXIT WRTRSX: TLO FLG,ATEND ;SET READ AN "EOF" WRTRS1: AOS (PP) ;SKIP EXIT VIA WRITE EXIT WRTXIT: XCT UGETS. ;GET STATUS TLNE AC13,20 ;MAGTAPE? TRZA AC2,762000 ;MAGTAPE. TRZ AC2,760000 ;OTHER. XCT USETS. ;SET STATUS POPJ PP, ;RETURN WRTERR: TLNE AC13,20 ;MTA? TRNN AC2,400000 ;WRITE-LOCKED? JRST WRTER1 ;NO PUSHJ PP,SAVAC. ;IT'S A WRITE-LOCKED MAGTAPE TTCALL 3,[ASCIZ /$ /] MOVE AC2,[BYTE(5)22,27,10,31,20,4,14] PUSHJ PP,MSOUT. ;"CANNOT DO OUTPUT TO TTCALL 3,[ASCIZ/IS THE DEVICE WRITE ENABLED?/] PUSHJ PP,C.STOP ;"TYPE CONTINUE TO PROCEDE" PUSHJ PP,RSTAC. ;RESTORE THE ACS TRZ AC2,760000 ;TURN OFF THE ERROR BITS XCT USETS. ;SET STATUS JRST WRTOUT ;TRY AGAIN WRTER1: MOVE AC0,[E.MOUT] ;OUTPUT ERROR PUSHJ PP,IGMDR ;IGNORE ERROR? JRST WRTXIT ;YES MOVE AC2,[BYTE(5)36,31,20,10,4,14] PUSHJ PP,MSOUT. ;"OUTPUT ERROR ON " PUSHJ PP,IOERMS ;THE ERROR JRST KILL ; IOERMS: XCT UGETS. ;GET STATUS AC2************* IOERM1: PUSHJ PP,ERCODE ;OUTPUT ERROR STATUS TRNE AC2,400000 TTCALL 3,[ASCIZ/ IMPROPER MODE/] TRNE AC2,200000 TTCALL 3,[ASCIZ/ DEVICE ERROR/] TRNE AC2,100000 TTCALL 3,[ASCIZ/ DATA ERROR/] TRNN AC2,40000 POPJ PP, TLNE AC13,200000 ;DSK? TTCALL 3,[ASCIZ / QUOTA EXCEEDED, FILE STRUCTURE OR RIB FULL/] TLNE AC13,100 ;DTA? TTCALL 3,[ASCIZ / BLOCK NUMBER TOO LARGE OR DEC-TAPE IS FULL/] TLNN AC13,200100 ;ONLY ONE MESSAGE TTCALL 3,[ASCIZ/ BLOCK TOO LARGE/] POPJ PP, ;OUTPUT CONTENTS OF AC2 BITS 18-35 (ERROR STATUS) ERCODE: MOVEI C,"(" ; TTCALL 1,C ;OUTPUT ( MOVEI AC1,6 ;SIX OCTAL NUMBERS MOVE AC0,[POINT 3,2,17] ERCOD1: ILDB C,AC0 ;GET NUMBER ADDI C,"0" ;ASCIZE IT TTCALL 1,C ;OUTPUT IT SOJG AC1,ERCOD1 ;LOOP MOVEI C,")" ; TTCALL 1,C ;OUTPUT ) POPJ PP, SUBTTL READ INTO THE BUFFER ;ALL BUFFERED INPUTS ARE DONE HERE. ***POPJ*** READIN: AOS D.IE(I16) ;BUMP INPUT COUNT XCT UIN. ;*********************** POPJ PP, ;NORMAL RETURN ;SKIP RETURN IF OPEN/CLOSE/READ EOF READCK: ;**BOMB** PUSHJ PP,SETCN. ; SETUP THE CHANNEL FIELD XCT UGETS. ; GET THE STATUS MOVE AC13,D.DC(I16) ; AND DEVICE CHARACTERISTICS TLNN AC13,20 ; MTA ? JRST READC1 ; NO TRNE AC2,2000 ;SKIP IF NOT AN "EOT" TLO AC16,MTAEOT ;"EOT" FLAG FOR READEF+N READC1: TRNN AC2,760000 ;SKIP IF ANY ERRORS IN THE CURRENT BUFFER JRST WRTXIT ;CLEAR THE ERRORS AND POPJ TRNN AC2,20000 ;SKIP IF AN EOF JRST REAERR ;REAL ERRORS! TLNN AC16,OPEN+CLOSEB+CLOSER+CLOSEF ;SKIP IF OPEN OR CLOSE JRST WRTRSX ;JUMP, IT'S READ OR WRITE "EOF" JRST WRTRS1 ;EXIT BUT DONT SET ATEND REAERR: MOVE AC0,[E.MINP] ;INPUT ERROR PUSHJ PP,IGMDR ;IGNORE ERROR? JRST WRTXIT ;YES MOVE AC2,[BYTE (5) 35,31,20,10,4,14] PUSHJ PP,MSOUT. PUSHJ PP,IOERMS ;THE ERROR JRST KILL ; ;READ IN SYNCHRONOUS MODE READSY: PUSHJ PP,CLSYNC ;SINGLE BUFFERS PUSHJ PP,READIN ;GET A BUFFER JRST .+2 ;NORMAL RET AOS (PP) ;EOF RETURN JRST CLSYNC ;BACK TO MULTI BUFFERS SUBTTL TODAY. 8JAN ;CALLED BY PUSHJ PP,TODAY. ;EXIT WITH DATE IN AC0 YYMMDD ; TIME IN AC1 HHMMSS AC0=0 ;YYMMDD AC1=1 ;HHMMSS AC4=4 ;TEMP AC5=AC4+1 ;TEMP AC6=AC5+1 ;TEMP PP=17 ; INTERN TODAY.,TODA1.,TODA2. ENTRY MCSTIM ;CMCS (LCM) USES THIS ROUTINE TODAY.: CALLI AC4,14 ;DATE UUO ((Y-64)*12+(M-1))*31+D-1 TODA1.: IDIVI AC4,^D31 ;PICK OFF THE DAY ADDI AC5,1 ;MAKE IT RIGHT PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS DPB AC5,DAY ;XXXXDD IDIVI AC4,^D12 ;PICK OFF THE MONTH ADDI AC5,1 ;MAKE IT RIGHT PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS DPB AC5,MONTH ;XXMMDD MOVEI AC5,^D64 ;GET THE BASE YEAR ADD AC5,AC4 ;PLUS YEARS SINCE THEN CAIL AC5,^D100 ;CK FOR YEAR 2000+ [EDIT#274] SUBI AC5,^D100 ;IF SO, CONVERT TO 00+ [EDIT#274] PUSHJ PP,TODA4. ;SIXBIT DPB AC5,YEAR ;YYMMDD-DATE FINISHED CALLI AC4,23 ;TIME UUO GETS TIME IN MILLISECONDS IDIVI AC4,^D1000 ;CONVERT TO SECONDS MCSTIM: PUSHJ PP,TODA3. ;PICK OFF SECONDS IN SIXBIT DPB AC5,SECOND ;XXXXSS TODA2.: PUSHJ PP,TODA3. ;PICK OFF MINUTES IN SIXBIT DPB AC5,MINUTE ;XXMMSS MOVE AC5,AC4 ;WHAT'S LEFT IS HOURS PUSHJ PP,TODA4. ;TO SIXBIT DPB AC5,HOUR ;HHMMSS-TIME FINISHED POPJ PP, ;RETURN TODA3.: IDIVI AC4,^D60 ;DIVIDE BY 60 FOR TIME TODA4.: IDIVI AC5,^D10 ;DIVIDE OUT A DECIMAL NUMBER LSH AC5,6 ;MAKE ROOM FOR THE REMIANDER ADDI AC5,2020(AC6) ;CONVERT TO SIXBIT POPJ PP, ;RETURN YEAR: POINT 12,AC0,11 MONTH: POINT 12,AC0,23 DAY: POINT 12,AC0,35 HOUR: POINT 12,AC1,11 MINUTE: POINT 12,AC1,23 SECOND: POINT 12,AC1,35 IFN EBCLBL,< ;PUSHJ PP,JULIAN ;RETURNS WITH DATE IN AC0 ;AS SIXBIT YYDDD JULIA0: AOS (PP) ;TAKE A SKIP EXIT JULIAN: SETZ AC0, ; CALLI AC4,14 ;GET DATE IDIVI AC4,^D31 ;PICK OFF DAY-1 ADDI AC5,1 ;DAY OF THE MONTH MOVE AC1,AC5 ;SAVE THE DAY IDIVI AC4,^D12 ;PICK OFF MONTH - 1 ADDI AC4,^D64 ;GET YEAR IN AC4 EXCH AC4,AC5 ;SWAP WITH MONTH INDEX PUSHJ PP,TODA4. ;STORE THE SIXBIT YEAR DPB AC5,YEAR ; IN AC0 ADD AC1,DAYTAB(AC4) ;ADD PREVIOUS DAYS TO DAY OF MONTH CAIG AC4,2 ;PAST FEBRUARY? JRST JULIA1 ;YES IDIVI AC4,4 ;CHECK FOR LEAP YEAR CAIG AC5,0 ;LEAP YEAR? ADDI AC1,1 ;YES JULIA1: MOVE AC4,AC1 ; IDIVI AC4,^D10 ;DIVIDE OUT THE MOVE AC1,AC5 ; UINTS AND IDIVI AC4,^D10 ; THE TENS LSH AC4,6 ;SHIFT OVER THE HUNDREDS ADD AC5,AC4 ;ADD IN THE TENS LSH AC5,6 ;MAKE ROOM FOR THE UNITS ADDI AC5,202020(AC1) ;ADDEM IN AND SIXBITIZE LSH AC5,6 ;GET THEM NEXT TO THE YEAR POSITION ADD AC0,AC5 ; YYDDD POPJ PP, DAYTAB: EXP ^D0 ;JAN EXP ^D31 ;FEB EXP ^D59 ;MAR EXP ^D90 ;APR EXP ^D120 ;MAY EXP ^D151 ;JUN EXP ^D181 ;JUL EXP ^D212 ;AUG EXP ^D243 ;SEP EXP ^D273 ;OCT EXP ^D304 ;NOV EXP ^D334 ;DEC > SUBTTL ERROR MESSAGES 5-JAN-70 ;MOVE AC2,[BYTE (5),1,2,3,4] ;CALLING ;JRST MSOUT. ;SEQUENCE MSOUT.: PUSHJ PP,DSPL1. ;OUTPUT BUFFER AND "CRLF" MOVE AC0,[POINT 5,AC2] ;POINT AT INDEX FROM AC0 ILDB AC1,AC0 ;PLACE IT IN AC1 XCT MSAGE(AC1) ;EXECUTE THE TABLE ITEM JRST .-2 ;GO AGAIN ;MSDEV OUTPUTS THE SIXBIT DEVICE NAME MSDEV.: SKIPN .JBAPR ;SKIP IF NOT RESET UUO SKIPA AC1,AC13 ;ELSE MAKE SURE U GET THE RIGHT DEV HRRZ AC1,D.ICD(I16) ;GET THE CURRENT DEVICE MOVE AC6,(AC1) ; [407] GET DEVICE NAME DEVNAM AC6, ; [407] GET PHYSICAL NAME JRST MSDEVA ; [407] NO SUCH DEVICE- DO REGULAR PRINTOUT CAMN AC6,(AC1) ; [407] IS PHYSICAL = LOGICAL? JRST MSDEVA ; [407] YES- NO REASON TO SAY IT TWICE MOVE AC4,(AC1) ; [407] DEVICE NAME DEVTYP AC4, ; [407] GET DEVICE TYPE JRST MSDEVA ; [407] CANT TLNE AC4,20 ; [407] IF SPOOLED FORGET IT JRST MSDEVA TTCALL 3,[ASCIZ/ LOGICAL DEVICE /] ; [407] MOVE AC3,(AC1) ; [407] LOGICAL DEVICE PUSHJ PP,MSDEV1 ; [407] TYPE IT TTCALL 3,[ASCIZ/; PHYSICAL DEVICE /] ; [407] MOVE AC3,AC6 ; [407] PHYSICAL DEVICE JRST MSDEV1 ; [407] TYPE AND RETURN MSDEVA: TTCALL 3,[ASCIZ/ DEVICE /] MOVE AC3,(AC1) ;DEVICE NAME MSDEV1: MOVEI AC4,6 ;6 CHARS SKIPA AC1,[POINT 6,AC3] ;POINT AT IT MSFIL1: PUSHJ PP,OUT6B. ;ASCIZE IT AND PLACE IN BUFFER MSFIL2: ILDB C,AC1 ;PICKUP THE NEXT CHAR CAIE C,0 ;TERMINATE ON A SPACE SOJGE AC4,MSFIL1 ; OR SATISFIED CHAR COUNT JRST OUTBF. ;EXIT ;MSFIL OUTPUTS THE SIXBIT FILE NAME MSFIL.: MOVEI AC4,^D30 ;30 CHARS TTCALL 3,[ASCIZ / FILE /] MOVE AC1,[POINT 6,(I16)] ;POINT AT A FILE NAME PUSHJ PP,MSFIL2 ;OUTPUT FILE NAME ;OUTPUT THE VALUE-OF-ID AS [ FILE EXT ] MSVID: IFN ISAM< TLNE FLG,IDXFIL ;[323]IS THIS AN ISAM FILE? SKIPE FS.IF ;[323]YES,IS ERROR IN DATA FILE? JRST MSVID2 ;[323]"NO" TO EITHER QUESTION MOVE AC1,[POINT 6,DFILNM(I12)] ;[323]WANT DATA FILENAME TLNE I16,777777 ;[323]UNLESS IN RESET JRST MSVID3 ;[323]CONTINUE > MSVID2: SKIPN AC1,F.WVID(I16) ;[323]BP TO VALUE OF ID POPJ PP, ;EXIT IF NO ID MSVID3: MOVEI AC4,11 ;9 CHARACTERS MSVID4: TTCALL 3,[ASCIZ/ [/] ;[323] MSVID1: ILDB C,AC1 TLNN AC1,100 ;SKIP IF ASCII [EDIT#304] ADDI C,40 ;CONVERT SIXBIT TO ASCII [EDIT#304] TLNN AC1,600 ; EBCDIC? LDB AC1,PTR.97##(AC1) ; YES PUSHJ PP,OUTCH. ;OUTPUT TO BUFFER [EDIT#304] SOJG AC4,MSVID1 ;LOOP 9 TIMES PUSHJ PP,OUTBF. ;DUMP THE BUFFER TTCALL 3,[ASCIZ/]/] ; POPJ PP, ;EXIT ;OUTPUT THE SIXBIT REEL NUMBER MSDTRN: LDB AC3,DTRN. ;FROM THE DEVICE TABLE JRST MSSLR1 ; MSSLRN: HRL AC3,STDLB.+4 ;THE HLR AC3,STDLB.+5 ; STANDARD ROT AC3,-14 ; LABEL ANDI AC3,7777 ; REEL NUMBER MSSLR1: TTCALL 3,[ASCIZ/ REEL /] ROT AC3,-14 JRST MSDEV1 ;MSSLR1+3 [277] IG 22-OCT-73 ;ROUTINE TO PRECEDE MESSAGES TO TTY WITH "$" [EDIT#277] $SIGN: TTCALL 3,[ASCIZ/ $ /] ; [EDIT#277] POPJ PP, ; [EDIT#277] ;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES [371] PUTDEC: JUMPGE AC0,PUTDC1 ;IF NEGATIVE, [371] TTCALL 3,[ASCIZ "-"] ; TYPE SIGNED AND [371] MOVMS AC0 ; GET MAGNITUDE [371] PUTDC1: IDIVI AC0,^D10 ; DIVIDE BY RADIX TO [371] HRLM AC1,(PP) ; SAVE RADIX DIGIT [371] SKIPE AC0 ; DONE ? [371] PUSHJ PP,PUTDC1 ; NO-- LOOP [371] HLRZ C,(PP) ; GET SAVED DIGIT [371] ADDI C,"0" ; CONVERT TO ASCII [371] TTCALL 1,C ; TYPE DIGIT [371] POPJ PP, ; [371] ;THE FOLLOWING 40 LO