; UPD ID= 3578 on 6/10/81 at 2:36 PM by MAYBERRY TITLE CBLIO FOR LIBOL V12B ;COPYRIGHT (C) 1974, 1981 BY ;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ; ; ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ; ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. SUBTTL PICK UP UNIVERSALS AND SET UP JOBDAT. SEARCH LBLPRM,COBVER ;DEFINE PARAMETERS. %%LBLP==:%%LBLP SEARCH COMUNI %%COMU==:%%COMU INFIX% ISAM==:ISAM EBCMP.==:EBCMP. SEARCH FTDEFS ;FILE-TABLE DEFINITIONS %%FTDF==:%%FTDF IFN LSTATS,< SEARCH METUNV > SEARCH UUOSYM IFN TOPS20,< SEARCH MONSYM, MACSYM> IFE TOPS20,< SEARCH MACTEN> IFN TOPS20, IFE TOPS20, LOC 124 ;.JBREN EXP RENDP ;TO FORCE A DUMP. LOC 137 ;.JBVER EXP LBLVER IFNDEF TOPS2X, ; [667] THIS CODE HAS NOT BEEN TESTED YET IFNDEF SIRUS, ; [403] SPECIAL CODE FOR SIRUS IFNDEF SUPPTB, ; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES. IFNDEF ISTKS, ;TYPE # OF IN'S AND OUT'S SUPP==SIRUS!SUPPTB ; [403] SUPPRESS TRALING BLANKS FOR SIRUS IFNDEF EBCMP., HISEG SALL MLON SUBTTL CONSTANTS ;AC ASSIGNMENTS FLG=7 C=11 I12=12 LVL=13 FLG1=14 I16=16 BUFLOC==4000 ;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF F.WDNM(I16) ; FLAG BITS IN D.RFLG RIGHT HALF SASCII==1 ; REQUEST FOR STANDARD ASCII, IN D.RFLG RDDREV==2 ; OPEN REVERSED ACTIVE FSTIDX==4 ;[605] FIRST ISAM READ IS SEQ, FOR IBS SCAN CODE RDRVBK==10 ; READ REV BLOCKED GTR 10 RDLAST==20 ; = 1 IF LAST ISAM IO OPERATION WAS READ SAVNXT==40 ; = 1 IF LAST I-O WAS DELETE OR REWRITE (NXT REC SAVED) EXTOPN==100 ; =1 IF FILE WAS OPENED EXTEND AFTADV==200 ; =1 IF LAST WRITE WAS AFTER-ADVANCING ("CR" BEFORE BFR-ADV) ;RPW BIT FOR TERMINATE HAS BEEN DONE ==400 INDASC==1000 ; =1 IF MTA STD ASCII NEEDS INDUSTRY-COMP MODE (TM03 TROUBLE) ; DON'T CLEAR AT CLOSE TIME RF1CLR==376 ; BITS TO CLEAR AT CLOSE TIME ;RMSIO BITS: (DEFINED IN LBLPRM IN THE FUTURE) LF%INP==1B33 ;FILE IS OPEN FOR INPUT LF%OUT==1B34 ;FILE IS OPEN FOR OUTPUT ; USE PROCEDURE TABLE OFFSET VALUES USESEC==5 ; USE PROCEDURE TABLE SECTION SIZE EXTUSE==^D15 ; OFFSET TO EXTEND ERROR USE PRODECURE ;VALUES FOR FILE STATUS CODE FSNRCF==23 ;NO RECORD FOUND ON READ,REWRITE,DELETE ;VALUES FOR FILE ACCESS MODE %FAM.S==0 ;SEQUENTIAL %FAM.R==1 ;RANDOM %FAM.D==2 ;DYNAMIC ;[566] LOOKUP BLK OFFSETS LKPSIZ==3 ;[566] OFFSET TO FILE SIZE RETURNED IN LOOKUP BLOCK ;MTOPR CONSTANTS MTOSIZ==15 ;SIZE OF TEMP TABLE USED BY .MORLI MTOPR FUNCTION ;COMPT. UUO FUNCTIONS IFN TOPS20,< CMP.1==1 ;SIMULATE LOOKUP OR ENTER CMP.3==3 ;TRANSLATE PPN TO STRING CMP.10==10 ;GET JFN FROM CHANNEL NUMBER > ;MTA CONSTANTS IFNDEF .TFKD2,<.TFKD2==6> ; [645] DX20 CONTROLLER CODE FOR TAPOP. MXTPRC==20000 ;MAX. MTA REC SIZE (IN WORDS) MINMTA==4 ;MINIMUM MTA OUTPUT SIZE ; OFFSETS INTO LABEL INFORMATION BLOCK LABTYP==1 ; TO LABEL TYP IFN TOPS20,< LABFOR==4 ; LABEL FORMAT CHARACTER > IFE TOPS20,< LABFOR==.TPREC ; LABEL FORMAT CODE LABFMS==0 ; FORMS CONTROL HERE > ; BIT DEFINITIONS FOR LABELED TAPE FORMAT FRMATU==10 ; "U" FORMAT FRMATS==4 ; "S" FORMAT FRMATD==2 ; "D" FORMAT FRMATF==1 ; "F" FORMAT ;DEF SYMBOLS FOR DISK BLOCK SIZE DSKBSZ==200 ;SIZE OF A DISK BLOCK (BUFFER) DSKMSK==177 ;MASK FOR BITS TO RIGHT OF DSKBSZ DFLTBF==2 ; DEFAULT NUMBER OF SEQ (RING) BUFFERS ;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.VEXT==^D800000000 ; OPEN EXTEND E.VSTR==^D900000000 ; START 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.MTAP==^D8000000 ; TAPOP. E.FIDX==^D10000 ;ISAM INDEX FILE E.FIDA==^D20000 ;ISAM DATA FILE E.FSEQ==^D30000 ;SEQUENTIAL FILE E.FRAN==^D40000 ;RANDOM FILE E.FMTA==^D50000 ; LABEL PROCESSING ERROR (MTA 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 EBCDIC DDMBIN==40000 ;DEVICE DATA MODE IS BINARY OPNIN==20000 ;FILE IS OPEN FOR INPUT OPNOUT==10000 ;FILE IS OPEN FOR OUTPUT OPNIO==30000 ;[622] FILE IS OPEN FOR I-O IOFIL==4000 ;[622] 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 MSTNDR==20000 ;STANDARD BUT MONITOR DOES LABEL PROCESSING MTNOLB==10000 ;MOUNTR HANDLING LABELS,BUT NO LABELING IFN TOPS20,< F1CLR==7777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME > IFE TOPS20,< F1CLR==37777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME > ; BITS IN LEFT HALF OF AC15 DURING WADV. WDVADR==40 ; BIT18-35 IS THE ADDRESS OF THE ADVANCING COUNT WDVBFR==20 ; =1 IF BEFORE ADVANCING WDVPOS==10 ; POSITIONING FOPERR==2 ; FILOP.UUO FAILED IFN ISAM,< KEYSIZ==7777 ; MASK TO GET KEY SIZE FIELD OF ISAM KEY DESCRIPTOR NOTEST==2000 ;[276] SKIPE THE CONVERSION TEST AT ADJKEY 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 > SUBTTL EXTERNALS. ENTRY C.RSET ;MAKE SURE WE GET LOADED. ENTRY DSPL.6,DSPL.7,DSPLY. ;FOR OVERLAYS ENTRY METER. IFN LSTATS,< ;ROUTINES IN METIO EXTERN MRLSET,MRDMPT,MRDMP ;LOWSEG LOCATIONS EXTERN MBTIM.,MRTMB.,MRTDBP EXTERN MRBKO.,MRBLKO,MRBNUM EXTERN MRFPGT,MRKILL,MROPTT,MRPSTM,MRRERN >;END IFN LSTATS EXTERNAL LIBIMP ;CAUSES LIBREL ( LIBOL.LOW) TO BE LOADED FOR /R ; [440] REMOVE EXTERNAL SYMBOL FOR EDIT 414 EXTERNAL IIN,IOUT,ISETI,ISETO,ICLOS,IRELE,IGETS,IWAIT,IRNAM EXTERNAL MWAIT.,MREW.,MREWU.,MBSPR.,MBSPF.,MADVR.,MADVF.,MWEOF.,MTIND. EXTERNAL MERAS. ;[470] EXTERNAL SOBOT.,SZBOT.,SZEOF.,SZEOT. EXTERNAL UOPEN.,UENTR.,ULKUP.,UOBUF.,UIBUF.,UCLOS.,URELE.,USETI. EXTERNAL USETO.,UOUT.,UIN.,USETS.,UGETS.,UWAIT.,URNAM. EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV.,AUTOLB,TMP.BK EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB. EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,SEGNO.,AINFO.,OVRBF.,FLDCT.,OVRIX. EXTERNAL SHRDX. ;[556] 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] EXTERN TODAY.,TODA1. EXTERNAL RN.PPN, RUN.TM, RN.DEV, RN.NAM ;[333] EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,COBSW.,SBPSA. 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 EXTERN SU.FRF ;FAKE READ FLAG EXTERN .JBSA,.JBFF,.JBREL,.JBAPR,.JBTPC,.JBCNI,.JBDA,.JBOPC,.JBREN IFN ISAM, ;[447]SIMULTANEOUS UPDATE INTERN CHTAB ;[455] SIMULTANEOUS UPDATE INTERN SEQFIL ;[455] SIMULTANEOUS UPDATE IFN ANS74, ;FOR SIM. UPDATE INTERN FAKER.,IGSS,RANFIL,E.VRET INTERN C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH. INTERN OUT6B.,OUTBF.,READ.,RSTAB.,STOPR.,C.STOP,TRAP.,WRITE.,WADV.,WRPW. INTERN WADVV.,WRITV. INTERN GOTO.,KILL.,PPOUT.,PPOT4.,SAVAC.,RSTAC. INTERN KPROG. ;NO UNCONDITIONAL TRANSFER AT END OF PROGRAM INTERN KDECL. ;NO UNCONDITIONAL TRANSFER AFTER DECLARATIVES INTERN ILLC. ;RECURSIVE CALL INTERN SEEK. EXTERN USEEK. INTERN C.STRT,RDNXT. EXTERNAL RET.1,RET.2,RET.3 INTERN DELET.,RERIT.,PURGE. EXTERNAL HLOVL. ;[346] XWD HIGHEST OVERLAY LOC , LOWEST LOC IFN ISAM, ;[370] IFN ISAM, EXTERNAL FILES.,USES.,OVRFN.,TRAC1. EXTERN FUSIA.,FUSOA.,FUSCP. ;[523] FILOP. ARG-BLOCK INTERN LIBVR.,LIBSW. IFN LSTATS,< ;EXTERNALIZE LIBOL METERING ROUTINES INTERN LMETR.,MRACDP IFN TOPS20,< INTERN MRTM.S,MRTM.E > > 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 TABADR PAGBUF,1 ;I/O SW.. 0 = SECTOR MULTIPLES, NONZERO = PAGES 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 OKEYDS,1 ;[515] KEY DESCRIPTOR AT RESET TIME TABADR ORCBYT,1 ;[515] RECORD SIZE AT RESET TIME TABADR OEPIB,1 ;[515] ENTRIES PER INDEX BLOCK AT RESET TIME 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 INTERN CNTRY ;[650] MAKE INTERNAL FOR LSU 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 IFN ANS74,< TABADR RWDLKY,1 ; NNTRY,,ADDR OF CNTRY KEY COPYS FOR RWT/DEL TABADR RCARSZ,1 ; ReCord ARea SiZe in words TABADR RWDLRT,1 ; NNTRY,,Addr of RWDLKY during RETAIN TABADR SVNXRT,1 ; Saves D.RFLG during RETAIN, when none zero flags that ; RWDLKY points to RETAINS del/rewrt key save area, ; that RWDLKY must be restored at the end of RETAIN > 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 IFN ISTKS,< TABADR INSSS0,1 ;EXP (LVL)INSSSS TABADR OUTSS0,1 ;EXP (LVL)OUTSSS TABADR INSSSS,16 ;NUMBER OF INS/LEVEL TABADR OUTSSS,16 ;NUMBER OF OUTS/LEVEL > 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 LIBVR.: EXP LBLVER ;LIBOL VERSION NUMBER LIBSW.: EXP SWSET% ;LIBOL ASSEMBLY SWITCHES SRTVR.: EXP V%SORT## ;SORT VERSION NUMBER 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. RUNTIM AC11, ;[346]GET THE RUNTIME. MOVEM AC11,RUN.TM ;[346]SAVE IT. IFN LSTATS,< ;(LSTATS) SAVE STARTING RUNTIME IFE TOPS20,< MOVEM AC11,MRPSTM ;SAVE RUNTIME AT START > IFN TOPS20,< MTRJS% ;GET STARTING TICKS ERJMP .+2 ;MOVE ZER0 IF NO CLOCK DMOVEM AC1,MRPSTM ;SAVE VALUE > >;END IFN LSTATS IFN DBMS,< MOVE AC1,DBSTP%## ;GET FROM VISIBLE, BUT NOT SAFE PLACE MOVEM AC1,DBSTP.## ;PUT IN INVISIBLE (FROM USER) BUT SAFE PLACE SETZM DBSTP% ;CLEAN UP (ITS REALLY LEVEL.) > ;;12B HACK - IN V13, THE FOLLOWING THREE LINES SHOULD BE DELETED MOVE AC1,OVFLO.## ;COPY OVFLO. TO SLRSW. MOVEM AC1,SLRSW.## SETZM OVFLO. ;CLEAN UP 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,[OUTSTR [ASCIZ/COBOL programs may only be started through use of "GET and ST" or "RUN" monitor commands./] EXIT] HRRM AC0,.JBSA 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 CSORT MOVNI PP,(AC10) ;0,,-LENGTH HRL PP,.JBFF ;START-LOC,,-LENGTH MOVSS PP,PP ;POINTER IS SET UP. MOVEI AC10,20(AC10) ;[660] LENGTH+20 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. CORE AC10, ;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,AP.POV!AP.ILM!AP.NXM ;[312] PDLOV - MPVIO - NXM APRENB AC0, ;[312] APRENB UUO PUSH PP,AC14 ;SO WE CAN PRINT PC ON ERRORS 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 SKIPE AC1,OVRFN. ;DOES OVERLAY FILE HAVE TO BE OPENED? PUSHJ PP,SETOVR ;YES, SET UP OVERLAY FILE SETZM RMFLG.## ;CLEAR "RMS NEEDED" FLAG PUSHJ PP,RSTAB. ;ASSIGN THE BUFFER AREA ; THIS WILL SET "RMFLG." TO -1 IF ANY RMS ; FILES ARE DEFINED IN THE PROGRAM IFE TOPS20,< PUSHJ PP,SETALB ;SET AUTOLB IF AUTO MTA LABEL PROCESSING > POP PP,(PP) ;CLEAN UP STACK IFN CSTATS,< SKIPE METR.## ;METER--ING SETUP? PUSHJ PP,SETMTR ;YES, SET UP FOR IT > IFN LSTATS,< PUSHJ PP,MRLSET ;SETUP FOR LSTATS FILE WRITING > IFN ANS74,< SKIPE RMFLG.## ;SKIP IF RMS NOT USED PUSHJ PP,RMSGET## ; ** GO GET RMS ** > SETOM OSHOOT## ;[530] SET END OF RESET FLAG HRRZ AC10,COBSW. ;GET COMPILER ASSEMBLY SWITCHES HRRZ AC3,LIBSW. ;GET LIBOL ASS-SWITCHES CAME AC10,AC3 ;THE SAME? OUTSTR [ASCIZ /%Compiler-OTS assembly switches mismatched. /] HLRZ AC10,COBVR.## ;GET COMPILER VERSION NUMBER HLRZ AC3,LIBVR. ;GET OTS VERSION NUMBER TRZ AC10,700000 ;GET RID OF CUSTOMER BITS TRZ AC3,700000 ;... CAMGE AC3,AC10 ;OTS THE SAME OR NEWER? OUTSTR [ASCIZ /%Compiler-OTS version number mismatch. /] IFE TOPS20,< MOVE AC10,[%CNVER] ;CONFIG TABLE GETTAB AC10, SETZ AC10, ;MUST BE VERY OLD LDB AC10,[POINT 5,AC10,23] ;MONITOR VERSION NO. CAIN AC10,7 ;TEST FOR 7.00 SERIES MONITOR SETOM M7.00## ;SET FLAG IF TRUE > 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 SETZM OVRFN. ;CLEAR THE OVR FILE PTR TO START RSTL10: HRRZ AC5,(AC1) ;[346] CHECK TO SEE IF THIS SUBROUTINE JUMPN AC5,RSTLNX ;[471] IS IN A LINK-10 OVERLAY AREA. ; ((AC1)) = SKIPA 0,0 ==> IT ISN'T ; ((AC1)) = JSP 1,MUMBLE ==> IT IS. MOVE AC1,1(AC1) ;ADDRESS 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 MOVEI AC10,%OVRFN(AC1) ;[453] GET OVRFN ADDR MOVE AC10,(AC10) ;[453] GET OVR FILE NAME JUMPE AC10,RSTL13 ;[453] JUMP IF NO OVR FILE SKIPE OVRFN. ;[453] ALREADY SEEN ONE? JRST RSOVE1 ;[453] YES--ERROR MOVEM AC10,OVRFN. ;[453] SAVE OVR FILE NAME RSTL13: JUMPE AC4,RSTL12 ;[453] 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 SKIPE 1(AC2) ;ANY MORE SUBPRGMS? AOJA AC2,RSTL20 ;INCREMENT POINTER AND TRY AGAIN RSTLNX: POPJ PP, ;[312];NO--DONE. RSOVE1: OUTSTR [ASCIZ /?Only one module in a COBOL run-unit may have segmentation. /] ;[453] JRST KILL ;[453] ;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 SETZM SHRDX. ;[556] CLEAR SHARED ISAM BUF AREA FLAG 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 LDB AC5,[POINT 4,UFRST.,12] ; GET CHAN FROM UUO DPB AC5,DTCN. ;SAVE IT 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? JRST RSTNFL ; [377A] YES-NEXT FILE IFN ANS74,< LDB AC1,F.BRMS ; GET RMS FLAG BIT JUMPE AC1,RSTIF2 ; JUMP IF NOT AN RMS FILE SETOM RMFLG.## ;SET FLAG SAYING RMS IS NEEDED MOVSI AC15,BUFLOC ; NOTE WE ARE DONE IORM AC15,F.WDNM(I16) ; WITH THIS FILE TABLE JRST RSTNFL ; AND GET NEXT FILE RSTIF2:> 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/ IFN SIRUS, DEVCHR AC3, ;DEVCHR UUO TXNN AC3,DV.CDR!DV.LPT!DV.PTP!DV.PTR!DV.TTY ;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR JRST RSTDE0 ; TXC AC3,DV.DSK!DV.CDR ;[506] IF A DSK AND A CDR ... TXCE AC3,DV.DSK!DV.CDR ;[506] THEN IT'S DEVICE NUL: JRST RSTDV1 ;[506] NOT NUL:, CONTINUE TXZ AC3,DV.MTA!DV.TTY ;[506] NUL:, SO NOT MTA OR TTY LDB AC12,[POINT 3,FLG,14] ;[506] CORE DATA MODE DPB AC12,[POINT 3,FLG,2] ;[506] MAKE DEV DATA MODE SAME MOVEM FLG,F.WFLG(I16) ;[506] SAVE IT JRST RSTDE0 ;[506] CONTINUE 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 ; IFN SIRUS,< MOVE AC3,(AC13) ; [403] GET DEVICE NAME CAME AC3,SIRDEV ; [403] IS IT SIRUS DEVICE? JRST RSTDE1 ; [403] NO-ERROR MOVSI AC3,'NUL' ; [403] YES-MAKE IT NULL DEVICE JRST RSTDEV+1 ; [403] TRY AGAIN >; END OF IFN SIRUS 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 SKIPN SHRDX. ;[556] IF ISAM SHARED BUF, D.BL ALREADY SET HRLM AC12,D.BL(I16) ;SET BUFFER LOCATION IFN SIRUS,< MOVE AC12,AC1 ; [403] GET BACK DEVICE > IFE SIRUS,< MOVE AC12,(AC13) ;SIXBIT /DEVNAM/> MOVEM AC12,UOBLK.+1 ;FOR THE INIT BLOCK HRLZI AC12,D.OBH(I16) ;LOC OF OBUF HDR TLNE FLG,IOFIL ;[622] SKIP IF NOT IO HRRI AC12,D.IBH(I16) ;LOC OF IBUF HDR MOVEM AC12,UOBLK.+2 ;INIT BLOCK IFN ISAM,< MOVEI AC1,.IODMP ;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 SUBTTL LABELED TAPE RESET CODE TXNN AC3,DV.MTA ; SKIP IF MTA JRST MTOXX0 ; ELSE GO ON MOVE AC12,AC3 ;SAVE AC3, CLOBERED LATER IFN TOPS20,< ; THIS IS STUFF FOR VERSION 4 OF TOPS20, TO TAKE ; CARE OF TAPE HANDLING BY MOUNTR , INCLUDING LABEL ; PROCESSING. HLLZ AC6,D.F1(I16) ; GET SECOND FLAG WORD ; NOW CHECK FOR MONITOR LABEL PROCESSING PUSHJ PP,MTALAB ; GET MTA LABEL INFO JRST MTOXXY ; NON SYS-LABELING, CONT LDB AC2,F.BLBT ; GET LABEL TYPE FROM FILTAB SOSE AC2 ; SKIP IF NO LABELING, TYP=1 IF NO LABELING TLOA AC6,MSTNDR ;INDICATE MONITOR IS LABELING TLOA AC6,MTNOLB ;SET MOUNTR WITH NO LABELING FLAG TLZ AC6,STNDRD!NONSTD ;CLEAR LABEL BITS IN D.F1 HLLM AC6,D.F1(I16) ;RESET IN FILTAB > ;END IFN TOPS20 JRST MTOXXY ; CONT WITH OTHER CHECKS ; GTDFLT ROUTINE TO GET DEFAULT DATA MODE SETTING ; ; RETURNS AC3=DEFAULT MODE ; USES AC1-AC3 ; GTDFLT: IFN TOPS20,< SETO AC1, ; AC1=-1, THIS JOB HRROI AC2,3 ; DATA MODE AT AC3 MOVEI AC3,.JIDM ; START BLOCK AT THE DEFAULT DATA MODE WORD GETJI% ; GET THE DATA MODE JRST KILL. ; ASSUME IT WORKS, SHOULD ALWAYS POPJ PP, ; RET >; END IFN TOPS20 IFE TOPS20,< MOVE AC3,[2,,1] ; 2 ARGS START AT AC1 MOVEI AC1,.TFMOD ; DATA MOD FUNCTION MOVE AC2,UOBLK.+1 ; DEVICE NAME TAPOP. AC3, ; GET DEFAULT DEVICE DATA MODE JRST [MOVE AC2,AC3 ; ERROR, PUT ERROR CODE INTO AC2 JRST OMTA93 ] ; AND GIVE ERROR POPJ PP, ; OK, RET >; END IFE TOPS20 IFN TOPS20,< ; GETJFN ROUTINE TO GET JFN FROM PA1050 USING COMPT. UUO ; ; ARGS AC2=CHAN NUMBER ; ; RETURNS NON-SKIP ERROR RETURN ; SKIP OK, AC1=JFN ; ; USES AC1,AC2 ; GETJFN: HRLZ AC2,AC2 ;GET CHAN NUM IN LEFT,AS ARG TO COMPT. HRRI AC2,CMP.10 ;SET COMPT. FUNCTION NUM FOR CHAN TO JFN MOVE AC1,[1,,2] ;INDICATE 1 ARG IN ADDR 2 COMPT. AC1, ;GET JFN ************* POPJ PP, ; ERROR RETURN JRST RET.2 ; OK, RETURN >;END IFN TOPS20 ; MTALAB A ROUTINE TO READ MTA LABEL INFO ; ; USES AC1-AC3, TEMP AREA (SIZE MTOSIZ+1) ON STACK ; ; RETURNS NON-SKIP IF LAB-BYPASS (NO MOUNTR CONTROL) ; SKIP IF LABELED, LABEL INFORMATION IS LOCATED ; AT TMP.BK MTALAB: IFN TOPS20,< LDB AC2,UUOCHN ;GET CHANNEL NUM PUSHJ PP,GETJFN ; GET JFN IN AC1 JRST [OUTSTR [ASCIZ/RESET get JFN /] ;ERROR, ISSUE MESSAGE JRST OCPERR ] ;MORE MESS AND KILL ;GET AND CLEAR A TEMP TABLE AREA FOR MTOPR ;PUT TABLE LENGTH IN FIRST WORD,AS MTOPR WANTS MOVE AC3,AC1 ; SAVE JFN IN CASE OF OPEN ERROR GTSTS% ; GET FILE STATUS HRR AC2,AC3 ; SAV JFN HERE PUSH PP,AC2 ; SAV STATUS,,JFN JUMPL AC2,MTLAB1 ; JUMP IF ALREADY OPEN MOVE AC2,[440000,,OF%RD] ;INDICATE SIMPLE 36 BIT BYTE,INPUT OPENF% ;OPEN THE JFN*************** ERCAL OPNFER ;ERROR?, THEN GO CHECK IT (RETURNS IF OK) MTLAB1: MOVEI AC3,TMP.BK ; INDICATE THAT THE TEMP AREA WILL BE TMP.BK MOVEI AC2,1(AC3) ;GET TEMP TAB ADDR SETZM (AC3) ;ZERO FIRST WORD HRLI AC2,-1(AC2) ;MAKE BLT PTR BLT AC2,MTOSIZ-1(AC3) ;ZERO TEMP AREA,TO MAKE SURE NO INFO FROM ;MTOPR WILL BE STUCK IN A BAD PLACE MOVEI AC2,MTOSIZ ;GET MTOPR SIZE MOVEM AC2,(AC3) ;INITIALIZE TAB LENGTH MOVEI AC2,.MORLI ;SET MTOPR FUNCTION CODE FOR READING LABELS MTOPR% ;GET LABEL INFO *************** ERJMP MTOPER ;ERROR, CHECK FOR ILLEGAL FUNCTION ;INDICATING MOUNTR NOT AROUND MOVE AC5,TMP.BK+LABFOR ; GET LABEL FORMAT CHAR PUSHJ PP,SETFMT ; SET LABEL FORMAT BITS MOVE AC2,TMP.BK+LABTYP ; GET LABEL TYPE DPB AC2,F.BLBT ; SET LABEL TYPE INTO FILTAB CAIE AC2,.LTEBC ; IS LABEL TYPE EBCDIC? JRST MTLAB2 ; NO, CONT ; IF EBCDIC LABELS, SET NO TRANSLATE HRRZ AC1,(PP) ; GET JFN FROM SAVED POSITION ON STACK MOVEI AC2,.MONTR ; INDICATE NO TRANSLATE SETO AC3, ; TO BE SET MTOPR% ; DO IT ERJMP MTOERR ; ERROR, ISSUE MESSAGE AND QUIT MTLAB2: POP PP,AC3 ; RESTORE INITIAL FILE STATUS JUMPL AC3,RET.2 ; RETURN IF OPEN AT START HRRZ AC1,AC3 ; GET JFN TXO AC1,CO%NRJ ; DON'T RELEASE IT CLOSF% ; CLOSE THE FILE JRST CLSERR ; ERROR, MESSAGE AND QUIT JRST RET.2 ; OK, LABELING OF SOME KIND, GIVE SKIP RETURN ; ERROR ON GET-LABEL-INFO MTOPR, CHECK FOR ILLEGAL OPERATION, ; INDICATING NO MOUNTR, OR LABELS-BYPASS MTOPER: POP PP,AC3 ; RESTORE GTSTS CODE MOVEI AC1,.FHSLF ;INDICATE CURRENT PROCESS GETER% ;GET LAST ERROR NUM IN AC2 (RT HALF) CAME AC2,[.FHSLF,,MTOX1] ; AN INVALID FUNCTION ERROR (VER. 4)? JRST MTOERR ; NO, MTOPR ERROR, ISSUE MESSAGE AND QUIT ; YES,THEN THIS INDICATES THAT NO MOUNTR JUMPL AC3,RET.1 ; RETURN, NON-SKIP IF FILE WAS OPEN HRRZ AC1,AC3 ; ELSE,GET JFN TXO AC1,CO%NRJ ; DON'T RELEASE IT CLOSF% ; CLOSE THE FILE JRST CLSERR ; ERROR, MESSAGE AND QUIT POPJ PP, ; GIVE NON-SKIP RETURN >;END IFN TOPS20 IFE TOPS20,< ; FOR TOPS10 NEED TO DO A COUPLE OF UUOS TO GET INFO ; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING ; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS ; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS. SKIPN AUTOLB ; DO WE HAVE AUTO LABEL PROCESSING? POPJ PP, ; NO, GIVE NO-LABELS RETURN ; YES MOVEI AC3,TMP.BK ; INDICATE THAT THE TEMP AREA WILL BE TMP.BK MOVEI AC2,1(AC3) ;GET TEMP TAB ADDR SETZM (AC3) ;ZERO FIRST WORD HRLI AC2,-1(AC2) ;MAKE BLT PTR BLT AC2,MTOSIZ-1(AC3) ;ZERO TEMP AREA HRLZI AC3,2 ; LENGTH ,, ADDRESS MOVEI AC0,.TFLBL ; FUNCT - LABEL PROCESSING MOVE AC1,UOBLK.+1 ; SIXBIT /DEVICE NAME/ MOVEM AC1,TMP.BK+1 ; ALSO SET IN ARG BLK FOR LABEL INFO TAPOP. AC3, ; GET TYPE OF LABEL PROCESSING JRST OMTA96 ; OOPS - COMPLAIN CAIN AC3,.TFLNV ; WAS THAT "USER EOV , UNLABELED"? MOVEI AC3,.TFLNL ; YES, INDICATE UNLABELED DPB AC3,F.BLBT ; SET LABEL TYPE IN FILTAB CAIN AC3,.TFLBP ; LABEL-BYPASS? POPJ PP, ; YES,GIVE NON-LABELING RETURN IF BYPASS ; NOW GET OTHER LABEL INFO MOVE AC2,[XWD .TPLEN,TMP.BK] ; INDICATE SIZE AND POSITION OF ARGBLK MOVEI AC1,.TFLPR ; INDICATE GET LABEL INFORMATION MOVEM AC1,TMP.BK ; TAPOP. AC2, ; GET LABEL INFORMATION JRST LBTPER ; ERROR, COMPLAIN MOVEM AC3,TMP.BK+LABTYP ; SET LABEL TYPE MOVE AC1,TMP.BK+.TPREC ; GET FORMAT AND FORMS CONTROL INFO HLRZM AC1,TMP.BK+LABFMS ; RESET FORMS CONTROL WORD HRRZM AC1,TMP.BK+LABFOR ; AND FORMAT WORD TLZ AC1,-1 ; CLEAR LEFT HALF MOVEI AC2,1 ; SET A BIT SOJLE AC1,.+2 ; IF "F" (OR DEFAULT) USE 1 LSH AC2,(AC1) ; SHIFT BIT TO INDICATE FORMAT DPB AC2,F.BFMT ; SET LABEL FORMAT BITS JRST RET.2 ; GIVE LABELED RETURN ; HERE IF LABELED TAPOP. ERROR ; ASSUMES THAT AC2 HAS ERROR CODE LBTPER: JUMPN AC2,OMTA96 ; GO GIVE ERROR IF REAL ONE ; HERE FOR UNIMPLEMENTED FEATURE ERROR MOVEI AC3,.TFLNL ; SET UNLABELED DPB AC3,F.BLBT ; SET LABEL TYPE IN FILTAB JRST RET.2 ; GIVE LABELED RETURN >;END IFE TOPS20 ; TM03AS ROUTINE TO CHECK FOR ANSI-ASCI SUPPORT ON TAPE ; ; IF STD-ASCII NOT SUPPORTED, INDASC FLAG SET TO ; INDICATE THAT STD-ASCII MUST BE DONE WITH INDUSTRY ; COMPATIBLE MODE TAPE SETTING ; ; RETURNS CALL +1 ALWAYS ; TM03AS: IFN TOPS20,< PUSHJ PP,MTASTS ; GET MTA STATUS INTO TMP.BK JRST TM03AY ; ERROR, ASSUME NO STD-ASCII SUPPORT MOVE AC2,TMP.BK+.MODDM ; GET DATA MODES WORD TXNE AC2,SJ%CMA ; IS STD-ASCII SUPPORTED? TM03X: POPJ PP, ; YES,RETURN NOW >;END IFN TOPS20 IFE TOPS20,< HRLZI AC3,2 ; LENGTH ,, ADDR MOVEI AC0,.TFKTP ; FUNCTION MOVE AC1,UOBLK.+1 ; GET DEVICE NAME TAPOP. AC3, ; GET CONTROLER TYPE JRST TM03AY ; ERROR, ASSUME NOT SUPPORTED CAIE AC3,.TFKTX ; TX01 CONTROLLER (TU70/TU71)? CAIN AC3,.TFKD2 ; SKIP IF DX20/TX02 CONTROLLER (OK TOO) POPJ PP, ; YES, RETURN, STDASC IS SUPPORTED ; NO, NOT SUPPORTED FOR SURE >; END IFE TOPS20 ; NOT SUPPORTED,SET INDASC FLAG, INDUSTRY-COMPT. NEEDED TM03AY: HRRZ AC2,D.RFLG(I16) ; GET STANDARD ASCII FLAG TRO AC2,INDASC ; SET IT HRRM AC2,D.RFLG(I16) ; AND PUT IT BACK POPJ PP, ; RETURN NOW MTOXXY: ; CHECK TO SEE IF AN ASCII TAPE IS TO BE WRITTEN TO ; A DRIVE WITH STANDARD-ASCII DATA MODE SET. IFSO, SET STD-ASCII ; RECORDING MODE. HRRZ AC1,D.RFLG(I16) ; GET STANDARD ASCII FLAG TRNE AC1,SASCII ; IS IT? JRST MTALB0 ; YES, ALL OK ; NO ATTRIBUTES SET, HOW ABOUT DEFAULT DATA MODE? MTLB0D: PUSHJ PP,GTDFLT ; GET DEFAULT DATA MODE IN AC3 IFN TOPS20,< CAIE AC3,.SJDMA ; IS DATA MODE ANSI-ASCII? > IFE TOPS20,< CAIE AC3,.TFM7B ; IS DATA MODE ANSI-ASCII? > JRST MTLB0F ; NO, SKIP THIS MTLB0E: JUMPGE FLG,MTLB0A ; JUMP IF NOT AN ASCII DEVICE MODE MTLB0C: HRRZ AC3,D.RFLG(I16) ; GET SOME RUNTIME FLAGS TRO AC3,SASCII ; SET STD-ASCII BIT HRRM AC3,D.RFLG(I16) ; AND PUT IT BACK ; THIS WILL INDICATE THAT DEFAULT ; ADVANCING WILL BE 0 ADVANCING ; CHECK FOR BLK-FTR = 0 CASE, HERE IF STD-ASCII MTALB0: IFN TOPS20,< TLNN AC6,MSTNDR ; WAS THAT A LABELED TAPE? > ; TOPS20 DOES PROPER MAP TO 7-BIT ; NO NEED TO CHECK (CAN'T SET HARDWARE MODE ; IF WE WANTED TO ) PUSHJ PP,TM03AS ; NO, CHECK FOR TM03: (MAYBE SET INDASC BIT) MTAB0A: LDB AC5,F.BBKF ; GET BLOCKING FACTOR JUMPN AC5,MTOXXX ; CONTINUE IF BLK-FTR NOT 0 MOVEI AC2,1 ; ELSE BLK-FTR DEFAULTS TO 1 MOVE AC3,AC12 ; GET DEVICE CHAR AGAIN DPB AC2,F.BBKF ; PUSHJ PP,RSTBPB ; CALC BUFFS PER BLOCK JRST MTOXXX ; CONT ; HERE IF STD-ASCI TAP FORMAT, BUT NOT ASCII RECORDING MODE ; IF RECORDING MODE IS DEFAULT, THEN SET TO ASCII ; IN THOSE CASES THAT MAKE SENSE MTLB0A: LDB AC3,F.BDRM ; GET DEFAULT DDM MODE FLAG JUMPE AC3,MTOXXX ; IS DEV-DATA-MODE DEFAULT? ; NO, JUMP ASSUMING HE KNOWS WHAT HES DOING TLCN FLG,DDMSIX ; SKIP IF MODE SIXBIT TLCA FLG,DDMSIX ; NO, CLEAR IT , ERROR CONDITION, SKIP JRST MTLB0B ; YES, ITS CLEARED, GO SET ASCII ; HERE IF NOT SIXBIT DEFAULT RECORDING MODE, ASSUMES ITS AN ERROR ; CONDITION TO TRY WRITING OTHER DATA MODES ON STD-ASCII TAPE PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Tape data mode mismatchs file default recording mode./] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN MTLB0B: TLO FLG,DDMASC ; SET ASCII RECORDING MODE MOVEM FLG,F.WFLG(I16) ; AND UPDATE FLAG WORD JRST MTLB0C ; AND GO BACK AS IF ASCII RECORDING MODE SET MTLB0F: ; HERE IF NOT STD-ASCII HARD MODE TLNN AC6,MSTNDR ; WAS THAT A LABELED TAPE? JRST MTOXXX ; NO, CONT IFE TOPS20,< ; IF ANSI LABELED TAPE WITH ASCII DDM, MAKE ; SURE HE WILL WRITE COMPATIBLE TAPE MODE (ANSI-ASC OR IND-CMP) JUMPGE FLG,MTOXXX ; CONT IF NOT ASCII RECORDING MODE PUSHJ PP,MTALAB ; GET LABEL INFO (SETS AC3) JRST MTOXXX ; UNLABELED,CONT LDB AC3,F.BLBT ; GET LABEL TYPE FROM FILTAB CAIE AC3,.TFLAL ; IS THE LABEL TYPE ANSI CAIN AC3,.TFLAU ; OR ANSI WITH USER LABELS? JRST MTALB0 ; YES, CHECK BLOCKING AND HARD MODE JRST MTOXXX ; NO, CONT >; END IFE TOPS20 IFN TOPS20,< ; IF ASCII WITH F OR D ATTRIBUTE ; THEN CHANGE UNBLOCKED TO BLOCK 1 JUMPGE FLG,MTOXXX ; CONT IF NOT ASCII LDB AC1,F.BLBT ; GET LABEL TYPE CAIE AC1,.LTEBC ; SKIP IF EBCDIC LABEL PUSHJ PP,GETATB ; GET FILE FORMAT ATTRIBUTES JRST MTOXXX ; NONE SET, DO OTHER CHECK CAIE AC5,"F" ; IS FORMAT "F"? CAIN AC5,"D" ; IS FORMAT "D"? JRST MTAB0A ; YES, CHECK BLOCKING JRST MTOXXX ; NO, CONT >; END IFN TOPS20 MTOXXX: MOVE AC3,AC12 ; RESTORE AC3 MTOXX0: SUBTTL MORE RESET TXNN AC3,DV.MTA ;SKIP IF A MTA TLNE FLG,RANFIL+IOFIL ;[622] 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,IOFIL ;[622] THE XCT UIBUF. ;BUFFERS ************** HLLZ AC6,D.F1(I16) ; GET SECOND FLAG WORD ; CALC THE BUFFS/BLOCK FOR BLOCKED CASES LDB AC5,F.BBKF ; GET BLOCKING FACTOR JUMPE AC5,RSTDE5 ; GO ON IF UNBLOCKED PUSHJ PP,RSTBPB ; CALC BUFFS PER BLOCK 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 SETZM SHRDX. ;[556] CLEAR ISAM SHARED BUF FLAG 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, ; CALCULATE THE NUMBER OF BUFFERS PER LOGICAL BLOCK RSTBPB: PUSH PP,AC13 ; SAVE AC13,OPNWPB ASSUMES DEVICE CHAR IN AC13 MOVE AC13,AC3 ; GET DEVICE CHAR PUSHJ PP,OPNWPB ; AC10= WORDS PER LOGICAL BLOCK PUSH PP,AC10 ; SAVE AC10 FOR CALLER MOVEI AC0,DSKBSZ ;DSK BUFFER SIZE TLNE FLG,IOFIL!RANFIL!IDXFIL ;[622] SKIP IF NOT RANDOM OR IO JRST RSTBP3 ; TXNN AC13,DV.MTA ;SKIP IF A MTA JRST RSTBP1 ;JUMP, NOT A MTA JUMPE AC5,RSTBP1 ;JUMP IF BLK-FTR IS ZERO (AC5) MOVEI AC10,1 ;ONE BUFFER PER LOGICAL BLOCK JRST RSTBP2 ; RSTBP1: HRRZ AC11,D.OBH(I16) ; RESET ASSUMES USE OF AT LEAST OUTBUF HLRZ AC0,(AC11) ;BUFFER SIZE + 1 IN WORDS SUBI AC0,1 ;SIZE RSTBP3: IDIV AC10,AC0 ;/BUF-SIZE SKIPE AC10+1 ;ROUND UP ADDI AC10,1 ;AC10=BUFFERS PER LOGICAL BLOCK ;BL; 2 LINES INSERTED AT RSTBP3+3 TO FIX ISAM/RANDOM SHARED BUFFR BUG TLNE FLG,IDXFIL ;ISAM FILE? SKIPN PAGBUF(I12) ;YES, & PAGE I/O TOO? JRST RSTBP2 ; NO ADDI AC10,3 ; YES, ADD 3 SECTORS LSH AC10,-2 ; AND LSH AC10,2 ; ROUND OFF RSTBP2: MOVEM AC10,D.BPL(I16) ;BUFBLK POP PP,AC10 ; RESTORE AC10, WDS/LOG-BLK POP PP,AC13 ; RESTORE AC13 POPJ PP, ; ALL DONE RETURN ;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 TXNN AC3,DV.MTA ; AND DEVICE IS A MTA JRST RSTD40 ; MOVEI AC5,1 ; THEN BLK-FTR DEFAULTS TO 1 DPB AC5,F.BBKF ; RSTD40: JUMPE AC5,RSTDE7 ;JUMP IF BLOCKING FACTOR IS 0 PUSHJ PP,RSTBPB ; CALC BUFFS PER LOG-BLK,AC10=WDS PER LOG-BLK TXNN AC3,DV.MTA ;SKIP IF A MTA JRST RSTDE6 ;JUMP ITS NOT A MTA CAIL AC10,MXTPRC ;SKIP IF LOG. BLK NOT TOO LARGE JRST MXTPER ;JUMP IF TOO LONG ADDI AC10,3 ; PLUS 3 FOR BOOKEEPING WORDS 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 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? JRST RSTD11 ; YES, DON'T MULTIPLY IFN ANS68,< IMULI AC10,DFLTBF(I12) ; NO,REC TIMES NUMBER OF ALTERNATE BUFFERS > IFN ANS74,< REPEAT 0,< ;V13 INCOMPATIBLE CODE - NEEDS COMPILER CHANGE JUMPN AC12,.+2 ; SKIP IF NOT ZERO RESERVED MOVEI AC12,DFLTBF ; 0 MEANS DEFAULT NUMBER IMULI AC10,(I12) ; NO,REC TIMES NUMBER OF BUFFERS > REPEAT 1,< ;COMPATIBLE WITH 12A IMULI AC10,DFLTBF(I12) ; NO,REC TIMES NUMBER OF ALTERNATE BUFFERS >> JRST RSTD11 ; OK, NOW GET MEM RSTDE6: TXNN AC3,DV.DSK ;SKIP IF DEV IS A DSK JRST RSTER0 ;COMPLAIN TRZE AC10,DSKMSK ;ALLOCATE FULL DISK BLKS ADDI AC10,DSKBSZ ;ROUND UP TO NEXT DISK BLK IFN ANS68,< ADDI AC10,12 ;3+7=12 FLAG WORDS REQD FOR RANDOM OR IO > IFN ANS74,< ADDI AC10,13 ;3+8=13 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: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Only DSK may be used for RANDOM, I-O or INDEX-SEQUENTIAL processing./] RSTERR: MOVE AC2,[BYTE (5)10,31,20] PUSHJ PP,MSOUT. MXTPER: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Mag tape logical block size too large./] MOVE AC2,[BYTE (5) 25,4,10,31,20] ;INDICATE WHICH FILE AND ;WHICH DEVICE HAS TROUBLE PUSHJ PP,MSOUT. ;THEN QUIT IFE ISAM,< RERIT.: OUTSTR [ASCIZ /REWRITE ?/] SKIPA DELET.: OUTSTR [ASCIZ /DELETE ?/] RSTIDX: OUTSTR [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: ; IF THERE ARE ANY FILES THAT SHARE THE SAME BUFFER AREA ; THEN ALLOCATE THE SPACE FOR THE "SAVE" AREAS NOW. ; THE "SAVE" AREAS, ONE PER FILE, ARE LOCATED DIRECTLY ; BEFORE THE SHARED BUFFER AREA AND ARE POINTED TO BY D.IBL. HLRZ AC12,F.LSBA(I16); [377A] GET LINK TO FILE TBL THAT SHARES JUMPE AC12,RSTI05 ; [377A] [556] JUMP IF NONE HRRZ AC6,D.IBL(I16) ; [377A] GET ADR OF "SAVE" AREA JUMPN AC6,RSTI05 ; [377A] [556] JUMP IF ALREADY DONE SETOM SHRDX. ;[556] SET SHARED ISAM BUF FLAG,INDICATING THAT ;[556] ALL FILES IN THIS SHARE CHAIN WILL HAVE ;[556] THEIR D.BL LOCATIONS SET BELOW AT RSTI04 MOVE AC12,I16 ; [377A] GET FIRST LINK HLRZ AC4,D.BL(I16) ; [377A] ADR OF SBA (SHARED BUFFER AREA) RSTI01: MOVEI AC0,ISMCLR+1 ; [377A] GET SIZE OF "SAVE" AREA PUSHJ PP,GETSPC ; [377A] GET THE CORE SPACE JRST GETSPK ; [377A] OOPS HRRM AC4,D.IBL(AC12) ; [377A] SAVE ADR OF "SAVE" AREA HRLZI AC6,ISMCLR+1 ; [377A] SIZE OF "SAVE" AREA ADDM AC6,D.BL(I16) ; [377A] MOVE SBA TO OTHER SIDE OF "SAVE" AREA MOVEI AC6,ISMCLR+1 ; [377A] SIZE OF "SAVE" AREA ADDM AC6,(PP) ; [377A] UPDATE SAVED .JBFF RSTI02: HLRZ AC12,F.LSBA(AC12);[377A] GET LINK TO NEXT FILE TBL CAMN AC12,I16 ; [377A] HAVE WE CIRCLED THE CHAIN? JRST RSTI03 ; [377A] YES - THEN DONE LDB AC0,[POINT 2,F.WFLG(AC12),17]; [377A] GET ACCESS MODE CAIE AC0,2 ; [377A] IS THIS AN ISAM FILE? JRST RSTI02 ; [377A] NO - TRY NEXT LINK HRRZ AC4,.JBFF ; [377A] GET ADR OF NEXT FREE LOC JRST RSTI01 ; [377A] LOOP ;[556] NOW UPDATE BUF LOCATIONS FOR ALL THAT SHARE WITH THIS ;[556] INDEX FILE,SINCE ALLOCATION OF SAVE AREAS HAS MOVED IT ;[556] DOWN AT LEAST ONCE. ; [556] THIS CROCK UPDATES MORE THAN NECESSARY,SINCE THOSE IN ; [556] CHAIN FOLLOWING THE FIRST ISAM FILE WILL BE UPDATED ; [556] AT RSTDE2+2. THIS IS EASIEST WAY TO GET AT ALL ; [556] THAT MAY HAVE COME BEFORE THE FIRST ISAM FILE. RSTI03: MOVE AC0,D.BL(I16) ;[556] GET NEW BUF LOC FOR ALL THIS SHARE CHAIN RSTI04: HLRZ AC12,F.LSBA(AC12) ;[556] GET FILTAB OF NEXT FILE THAT SHARES CAMN AC12,I16 ;[556] ALL WHO SHARE UPDATED? JRST RSTI05 ;[556] YES,CONT. HLLM AC0,D.BL(I12) ;[556] NO,UPDATE BUF LOC OF NEXT THAT SHARES JRST RSTI04 ;[556] CONT. AROUND CHAIN RSTI05: ;[556] 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 LDB AC0,[POINT 4,UFRST.,12] ;[467] USE ALREADY ALLOCD CHAN MOVEM AC0,ICHAN(I12) ;SAVE IT AWAY PUSHJ PP,OCPT ;USE TOPS20 COMPT. UUO JRST [CAIE AC1,600130 ;INVALID SMU ACCESS? JRST [OUTSTR [ASCIZ /RESET time /] JRST OCPERR ] HRRZI AC0,OF%THW ;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 [OUTSTR [ASCIZ /RESET time /] JRST OCPERR ] JRST .+1] POP PP,AC13 ;RESTORE AC13 MOVE AC3,(AC13) ;GET DEVICE NAME DEVCHR AC3, ;RESTORE DEVICE CHARACTERISTICS > MOVEI AC0,ITABL ; 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 AC2,1+MXLVL(AC1);[442] GET ORIGINAL # OF IDX LEVELS JRST RSTIER ; HLRZ I12,D.BL(I16) ;[442] GET BUFFER LOCATION MOVNM AC2,OMXLVL(I12) ;[442] SAVE FOR OPNI22 MOVE AC12,1+ISPB(AC1);[442] INDEX SECTORS / BLK 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 OUTSTR [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) ;[377] GET FLG1 PARMS TLNN AC1,FILOPT ;[374] OPTIONAL FILE? 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 OUTSTR [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) ; LDB AC6,F.BBKF ;[515] BLOCKING FACTOR IN PROGRAM CAMLE AC2,AC6 ;[535] [515] IF NOT LESS OR EQUAL ERROR JRST RSTER1 ;[515] TELL USER AND GET OUT CAMLE AC2,MXBF ; MOVEM AC2,MXBF ; MOVE AC4,KEYDES+1(AC1) ;[515] GET ISAM KEY DESCRIPTION MOVEM AC4,OKEYDS+1(AC1) ;[515] SAVE KEY FOR OPEN CHECKING MOVE AC4,RECBYT+1(AC1) ;[515] GET SIZE OF DATA BLOCK IN BYTES MOVEM AC4,ORCBYT+1(AC1) ;[515] SAVE IT FOR CHECKING AT OPEN MOVE AC4,EPIB+1(AC1) ;[515] GET NUM OF ENTRIES/INDEX BLOCK MOVEM AC4,OEPIB+1(AC1) ;[515] SAVE IT FOR CHECKING AT OPEN 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 IFN ANS68,< IMULI AC4,3 ;RESERVE 3 KEY AREAS > IFN ANS74,< IMULI AC4,7 ;RESERVE 7 KEY AREAS (2 FOR DEL/RWT CNTRY ) > JRST RSTID3 ; RSTER1: OUTSTR [ASCIZ/ Reset blocking factor for/] ;[515] PUSHJ PP,MSFIL. ;[515] OUTPUT FILE NAME OUTSTR [ASCIZ/ differs from user's program ./] ;[515] PUSHJ PP,KILL ;[515] FATAL ERROR RSTER2: PUSH PP,AC1 ;[515] SAVE IT FOR LATER PUSH PP,AC4 ;[515] SAVE IT FOR LATER OUTSTR [ASCIZ/ Reset key descriptor for/] ;[515] PUSHJ PP,MSFIL. ;[515] GIVE HIM FILE NAME OUTSTR [ASCIZ/ differs from program key descriptor. /] POP PP,AC4 ;[515] GET AC4 BACK POP PP,AC1 ;[515] GET AC1 BACK POPJ PP, ;[515] PROCEED AT YOUR OWN RISK RSTID2: IFN ANS68,< MOVEI AC4,6 ;(1+1)*3 TRNN AC6,1 ;ODD = 1 WRD, EVEN = 2 WRDS MOVEI AC4,9 ;(2+1)*3 > IFN ANS74,< MOVEI AC4,12 ; (1+1)*5 TRNN AC6,1 ; ODD = 1, EVEN = 2 MOVEI AC4,17 ; (2+1)*5 > RSTID3: IFN ANS68,< ADDI AC12,2(AC4) ;NUMBER OF WORDS ALLOCATED > IFN ANS74,< ADDI AC12,4(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 DEVCHR AC2, ;DEVCHR TXNE AC2,DV.DSK ;DATA FILE TXNN AC3,DV.DSK ;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 PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Data-mode discrepancy/] MOVE AC2,[BYTE (5)10,31,20,4] JRST MSOUT1 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 IFN ANS74,< ; make sure that the internal record area will fit in AUXBUF LDB AC5,F.BMRS ; Get record size LDB AC4,[POINT 2,FLG,14] ; Get internal mode HRRZ AC4,RBPTBL(AC4) ; Get bytes per internal record word IDIVI AC5,(AC4) ; Get words in record area SKIPE AC6 ; Skip if no round up ADDI AC5,1 ; Round up CAIGE AC10,(AC5) ; Is record area larger than aux buf? MOVE AC10,AC5 ; Yes, reset so it will hold record area >; END IFN ANS74 ;BL; 2 LINES INSERTED AT RSTID5 + 3 TO FIX ISAM/RANDOM SHARED BUFFR BUG TLNE FLG,IDXFIL ;ISAM FILE? SKIPN ,PAGBUF(I12) ;YES, & PAGE I/O TOO? JRST RSTID6 ; NO ADDI AC10,777 ; YES, AT LEAST 512 WD/PG LSH AC10,-9 ; ROUND LSH AC10,9 ; OFF RSTID6: 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 IFN ANS74,< HLRZ AC4,D.BL(I16) ; Reget buffer location MOVEM AC5,RCARSZ(AC4) ; Save record area length for START checks > SETZM UOBLK. ; ;NOW SAVE INITIAL CONDITIONS FOR OPEN LOGIC HRRZ AC4,D.IBL(I16) ; [377A] GET ADR OF "SAVE" AREA HRLI AC4,ISCLR1+1(AC1); [377A] ADR OF AREA TO BE SAVED MOVEI AC2,ISMCLR(AC4) ; [377A] END OF AREA TO BE SAVED TRNE AC4,-1 ; [377A] SKIP IF NOTHING TO SAVE BLT AC4,(AC2) ; [377A] DOIT PUSH PP,AC12 ; SAV REG 12 MOVEI AC12,1(AC1) ; POINT AT STAT BLOCK PUSHJ PP,RSTBPB ; CALC BUFFS PER LOG-BLK POP PP,AC12 ; RESTORE AC12 JRST RSTDE5 ;RETURN RSTIER: XCT UGETS. ;INPUT ERROR DURING RESET UUO TXNE AC2,IO.EOF ;[376] EOF? OUTSTR [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 CORE AC0, ;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: OUTSTR [ASCIZ/Insuficient core for buffer requirements./] POPJ PP, GETSPK: PUSHJ PP,GETSP9 JRST KILL IFE TOPS20,< ;SEE IF MONITOR HAS AUTO LABELING FACILITY. ;SET SUTOLB TO NON-ZERO IF IT DOES. SETALB: SETZM AUTOLB ; INIT TO NO AUTO FACILITY MOVE AC1,[%SITLP] GETTAB AC1, SETZ AC1, ; ERROR SO OLD STYLE PROCESSING SKIPE AC1 ; WHAT IS IT? SETOM AUTOLB ; AUTO FACILITY! POPJ PP, > ;SUBROUTINE TO SET UP OVERLAY FILE ;ENTER WITH AC1 = FILE NAME SETOVR: HRLZI AC0,577774 ;[342]TURN OFF CHAN 1 ANDM AC0,OPNCH. ;DOIT SETO AC0, ;DSK = -1 SKIPN AC3,RN.DEV ;[333]IF DEVICE SPECIFIED, GET IT HRLZI AC3,'DSK' SETOV1: MOVEI AC2,IO.SYN+.IOBIN ;SET UP DEVICE HRRZI AC4,OVRBF. ; OPEN 1,AC2 ;[342]INIT JRST SETOV4 ; MOVSI AC2,'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 MOVE AC1,.JBFF ;GET NEXT FREE WORD MOVEM AC1,OVRIX. ;WHERE INDEX BLOCK WILL BE MOVEI AC0,400 ;SIZE WE NEED PUSHJ PP,GETSPC ;GET IT JRST GETSPK ;FAILED MOVE AC1,OVRIX. ; PUSHJ PP,SETOV2 ; MOVE AC1,OVRIX. ADDI AC1,200 SETOV2: IN 1, ;[342] SKIPA AC2,OVRBF. ; JRST SETOV6 ; MOVSI AC2,2(AC2) ; HRR AC2,AC1 ; BLT AC2,177(AC1) ; POPJ PP, SETOV4: OUTSTR [ASCIZ "Cannot initialize overlay."] ;[536] JRST SETOV7 ;[536] SETOV5: HRLZI AC3,'SYS' ;[536]TRY SYS IF DSK FAILS AOJE SETOV1 OUTSTR [ASCIZ "Cannot find overlay file ."] SKIPN AC3,RN.DEV ;[536] MOVSI AC3,'DSK' ;[536] PUSHJ PP,MSDEV1 ;[536] PRINT DEVICE PART PUSHJ PP,COLON ;[536] PRINT ":" MOVE AC3,OVRFN. ;[536] FILE NAME PUSHJ PP,MSDEV1 ;[536] PRINT IT OUTSTR [ASCIZ /.OVR/] ;[536] EXT SKIPE AC3,RN.PPN ;[536] ANY PPN? PUSHJ PP,MSDIR. ;[536] YES, PRINT IT JRST KILL SETOV6: OUTSTR [ASCIZ "INPUT error on overlay."] SETOV7: SKIPN AC3,RN.DEV ;[536] MOVSI AC3,'DSK' ;[536] MOVEI AC1,AC3 ;[536] POINT TO WHERE IT IS PUSHJ PP,MSDEVA ;[536] PRINT DEVICE PART JRST KILL ;ROUTINE TO REORGANIZE THE FLAGS RSTFLG: MOVE FLG,F.WFLG(I16) ;GET FLAGS MOVX AC15,BR%IO!BR%RER!BR%RRC 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 ; TXNE FLG,BR%OPF ;FILOPT? TRO AC15,FILOPT ; TXNE FLG,BR%NSL ;NONSTD? TRO AC15,NONSTD ; TXNE FLG,BR%STL ;STNDRD? TRO AC15,STNDRD ; TLNN AC15,DDMEBC ;ONLY EBCDIC HAS VAR-LEN RECORDS JRST RSTFL1 ; TXNE FLG,BR%VLE ;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 ;TRAP INTERUPT ROUTINE TRAP.: IFE TOPS20,< PORTAL .+1 ; SET EXECUTE ONLY ENTRY POINT > SKIPE INTRAP## ;ARE WE ALREADY IN A TRAP? EXIT ;YES, JUST QUIT SETOM INTRAP## ;SET THE FLAG TO PREVENT LOOPING MOVE AC0,.JBCNI ; APR STATUS TXNE AC0,AP.ILM OUTSTR [ASCIZ/Memory protection violation at user loc /] TXNE AC0,AP.NXM OUTSTR [ASCIZ/Non-ex-mem request at user loc /] TXNE AC0,AP.POV JRST TRAP1 ;PDLOV TRAP0: PUSHJ PP,OUTBF1 ;REINIT THE TTY BUFFER HRLO AC12,.JBTPC ;THE GUILTY LOCATION PUSHJ PP,PPOUT4 ;OUTPUT THE LOC HRRZ AC0,.JBTPC ;[312] SEE IF ERROR IS CAIL AC0,RSTLNK ;[312] IN RSTLNK CAIL AC0,RSTLNX ;[312] ROUTINE. JRST KILL ;[312] NO OUTSTR [ASCIZ /$Failing routine is RSTLNK in CBLIO MACRO routine loaded in place of COBOL subroutine?/] JRST KILL ;AND KILL TRAP1: OUTSTR [ASCIZ/?LBLPDL Push-down-list overflow at /] JRST TRAP0 KPROG.: TTCALL 3,[ASCIZ "?LBLADP Attempt to drop off end of program."] JRST KILL. KDECL.: TTCALL 3,[ASCIZ "?LBLADD Attempt to drop off end of DECLARATIVES."] JRST KILL. ILLC.: TTCALL 3,[ASCIZ "?LBLRCL Recursive call."] JRST KILL. ;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO" ;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME. GOTO.: OUTSTR [ASCIZ /?LBLEUG Encountered an unaltered GOTO with no destination. /] ;FALL THRU ;KILL TYPES OUT THE LOCATION OF THE LAST COBOL VERB, ;STOPS ALL IO AND EXITS TO THE MONITOR. KILL: PUSHJ PP,TYPSTS ;TYPE ERROR-NUMBER, BLOCK # + REC # KILL.: IFN LSTATS, SETOM MRKILL ;NOTE PROGRAM WAS ABORTED PUSHJ PP,VEROUT ;TYPE THE VERSION NUMBER OUTSTR [ASCIZ / ?/] SKIPE TRAC1. ;[270] IS THIS A PRODUCTION PROGRAM (I.E. /P)? PUSHJ PP,@TRAC1. ;NO, CALL BTRAC. IN TRACE ROUTINE PUSHJ PP,PPOUT. ;TYPE THE LOCATION OF LAST COBOL VERB HRRZ AC16,FILES. ;[444] GET START OF FILE TABLES JUMPE AC16,STOPR2 ;[444] NO FILES, DON'T BOTHER KILL1: MOVE FLG,F.WFLG(I16) ;[444] GET FLAGS FOR THIS FILE TLNE FLG,OPNOUT ;[622][444] OPEN FOR OUTPUT TLNE FLG,OPNIN ;[622][444] YES, OPEN FOR OUTPUT ONLY JRST KILL4 ;[444] NO, CHECK NEXT ONE MOVE AC13,D.DC(I16) ;[444] GET DEV CHARACTERISTICS TXNN AC13,DV.DSK ;[444] DISK? JRST KILL4 ;[444] NO, TRY NEXT FILE SETZB AC2,AC3 ;[444] MOVE AC10,[POINT 6,2] ;[444] SET UP TO PUT VID IN 2 AND 3 MOVE AC5,F.WVID(I16) ;[444] GET PTR TO VALUE OF ID PUSHJ PP,OPNVID ;[444] GET IT INTO AC2 AN AC3 HRRZ AC1,FILES. ;[444] SET UP FOR SUB-LOOP KILL2: CAIN AC16,(AC1) ;[444] COMPARING AGAINST ITSELF JRST KILL3 ;[444] YES, DON'T BOTHER MOVE AC13,D.DC(AC1) ;[444] GET DEV CHARS TXNN AC13,DV.DSK ;[444] IS IT A DISK? JRST KILL3 ;[444] NO, IGNORE MOVE FLG,F.WFLG(AC1) ;[444] GET FLAGS TLNN FLG,OPNIN ;[444] IS IT OPEN FOR INPUT JRST KILL3 ;[444] NO, CAN'T BE SUPERSEDING SETZB AC14,AC15 ;[444] MOVE AC10,[POINT 6,14] ;[444] PUT VID IN 14 AND 15 MOVE AC5,F.WVID(AC1) ;[444] BYTE PTR TO VALUE OF ID PUSHJ PP,OPNVID ;[444] GET IT CAMN AC2,AC14 ;[444] FILENAMES EQUAL? CAME AC3,AC15 ;[444] YES, EXTENSIONS EQUAL? JRST KILL3 ;[444] NO, FORGET IT LDB AC4,DTCN. ;[444] GET CHANNEL NUMBER LSH AC4,27 ;[444] POSITION IT MOVE AC5,[CLOSE CL.RST] ;[444] SET UP A CLOSE ADD AC5,AC4 ;[444] ADD CHANNEL XCT AC5 ;[444] CLOSE FILE, DELETING NEW ;[444] FILE, LEAVING OLD INPUT JRST KILL4 ;[444] GO CHECK ANOTHER ONE KILL3: HRRZ AC1,F.RNFT(AC1) ;[444] GET ANOTHER FILE FOR SUB-LOOP JUMPN AC1,KILL2 ;[444] GO CHECK, IF ANY LEFT KILL4: HRRZ AC16,F.RNFT(AC16) ;[444] GET ANOTHER FILE TO CHECK JUMPN AC16,KILL1 ;[444] GO CHECK IF ANY LEFT JRST STOPR2 ;TYPE OUT SOME ERROR INFORMATION TYPSTS: OUTSTR [ASCIZ / $ Error-number = /] TYPST1: MOVE AC0,FS.EN ;ERROR-NUMBER PUSHJ PP,PUTDEC ;TYPE IT MOVE AC0,FS.BN ;BLOCK-NUMBER JUMPE AC0,TYPST2 ; OUTSTR [ASCIZ / Block-number = /] PUSHJ PP,PUTDEC ; TYPST2: MOVE AC0,FS.RN ;RECORD-NUMBER JUMPE AC0,RET.1 ; OUTSTR [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 IFN ANS68,< TLNE FLG,OPNIN+OPNOUT; IF THE FILE IS OPEN PUSHJ PP,C.CLOS ; CLOSE IT >;END IFN ANS68 IFN ANS74,< LDB AC1,F.BRMS ; Get RMS flag bit JUMPN AC1,STOP1C ;Jump if this is an RMS file. TLNE FLG,OPNIN+OPNOUT; Skip if the file is not open PUSHJ PP,C.CLOS ;Close file JRST STOPRA ;and continue ;Check RMS file to see if it is open STOP1C: HRRZ AC1,D.F1(I16) ;Get flag bits TXNN AC1,LF%INP!LF%OUT ;Is file open? JRST STOPRA ;No PUSH PP,AC16 ;SAVE AC16 HRRZ AC1,I16 ;NO FLAG BITS,,FILTAB PUSH PP,AC1 ;STORE ARGLIST ON THE STACK MOVEI AC16,(PP) ;POINT TO THE STACK ARG LIST PUSHJ PP,CL.MIX## ;CALL RMS CLOSE POP PP,(PP) ;THROW AWAY ARGLIST POP PP,AC16 ;RESTORE AC16 STOPRA:>;END IFN ANS74 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 OUTSTR [ASCIZ /%LBLIGN /] ; CAIE AC0,1 ; ONLY ONE? JRST STPR2A ; NO OUTSTR [ASCIZ/ 1 error ignored./] JRST STOPR3 ; CONT STPR2A: PUSHJ PP,PUTDEC ; TYPE NUMBER OUTSTR [ASCIZ/ errors ignored./] STOPR3: PUSHJ PP,@HPRT.## ; PRINT HISTORY REPORT IF ANY IFN CSTATS,< SKIPE METR.## ;WERE METER POINTS ENABLED? PUSHJ PP,WRTMET ;YES, WRITE THE FILE > IFN LSTATS,< PUSHJ PP,MRDMPT ;DUMP ALL LSTATS DATA > IFN DBMS,< SKIPE DBSTP. ;IGNORE IF BEFORE VERSION 12A PUSHJ PP,@DBSTP. ;CLEANUP DBMS > EXIT ;CALLI EXIT JRST .-1 ;For TOPS20: Stay stopped. ; C.STOP IS CALLED WITH A "PUSHJ PP,C.STOP" AFTER THE OPERATOR ; TYPES "CONTINUE" IT RETURNS TO THE CALLING ROUTINE C.STOP: OUTSTR [ASCIZ / $ type CONTINUE to proceed .../] EXIT 1, ; WAIT FOR CONT POPJ PP, ; ;TYPE THE VERSION NUMBER OF COBOL, LIBOL, SORT, DBMS, RMS, etc. VEROUT: PUSHJ PP,OUTBF. ;DUMP THE CURRENT BUFFER TO SYNC WITH TTCALLS IFN ANS68,< OUTSTR [ASCIZ / COBOL-68 /] > IFN ANS74,< OUTSTR [ASCIZ / COBOL-74 /] > MOVE AC12,COBVR. ;GET COBOL VERSION NUMBER PUSHJ PP,VEROU0 ;TYPE VERSION NUMBER IN STANDARD FORMAT IFN ANS68,< OUTSTR [ASCIZ /, LIBOL /] > IFN ANS74,< OUTSTR [ASCIZ /, C74OTS /] > MOVE AC12,LIBVR. ;GET VERSION NUMBER PUSHJ PP,VEROU0 ;TYPE THE VERSION NUMBER IN STANDARD FORMAT SKIPE AC12,SRTVR. ;GET SORT VERSION NUMBER PUSHJ PP,[OUTSTR [ASCIZ /, SORT /] JRST VEROU0] ;TYPE THE VERSION NUMBE IN STANDARD FORM IFN DBMS,< SKIPE AC12,DBMVR.## ;GET DBMS VERSION NUMBER PUSHJ PP,[OUTSTR [ASCIZ /, DBMS /] JRST VEROU0] ;TYPE THE VERSION NUMBER IN STANDARD FORM > IFN ANS74,< SKIPE AC12,RMSVR.## ;GET RMS VERSION NUMBER PUSHJ PP,[OUTSTR [ASCIZ /, RMS /] JRST VEROU0] ;TYPE THE VERSION NUMBER IN STANDARD FORM > JRST DSPL1. ;"CRLF" AND EXIT VEROU0: ROT AC12,3 ;GET WHO FIELD OUT OF THE WAY MOVEI AC0,3 ; PUSHJ PP,NUMOUT ;THE VERSION NUMBER LDB AC1,[POINT 6,AC12,5] ;GET MINOR VERSION SOJL AC1,VEROU2 ;DON'T OUTPUT IF NULL IDIVI AC1,^D26 ;^D26="Z", ^D27="AA" JUMPE AC1,VEROU1 ; DON'T OUTPUT FIRST IF NULL PUSH PP,AC2 ;SAVE 2ND MOVEI C,100(AC1) ;GET 1ST LETTER PUSHJ PP,OUTCH. ;OUTPUT IT POP PP,AC2 VEROU1: MOVEI C,101(AC2) ;GET 2ND LETTER PUSHJ PP,OUTCH. ;OUTPUT IT VEROU2: MOVEI AC0,6 ; LSH AC12,6 ;SHIFT EDIT # INTO LEFT HALF TLNN AC12,-1 JRST VEROU3 ;DONE IF NO EDIT NUMBER MOVEI C,"(" ; PUSHJ PP,OUTCH. ; PUSHJ PP,NUMOUT ;THE EDIT NUMBER MOVEI C,")" ; PUSHJ PP,OUTCH. ; VEROU3: ROT AC12,3 ;GET WHO FIELD BACK IN RHS JUMPE AC12,OUTBF. ;DON'T OUTPUT IF NULL MOVEI C,"-" ;SEPARATE BY HYPHEN PUSHJ PP,OUTCH. MOVEI C,"0"(AC12) ;TURN INTO ASCII PUSHJ PP,OUTCH. ;STORE JRST OUTBF. ;OUTPUT AND RETURN 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 LSHC C,-3 ;RESTORE LAST DIGIT 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.: OUTSTR [ASCIZ /Last COBOL 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 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 PPOT4.: OUTSTR [ASCIZ/ in program /] SKIPN AC3,SBPSA. ; SKIP IF ANY SUBPRGMS JRST PPOUT6 ; NONE PPOUT5: OUTSTR [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 OUTSTR [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 OUTSTR [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 ; 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.EQT ;[437] IMULI AC0,4 ;[437] ADD AC0,SU.RRT ;[437] (THERE ARE FOUR ENQ/DEQ TABLES) ADD AC0,SU.FBT JUMPE AC0,RET.1 ;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: OUTSTR [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 SUBTTL SEEK VERB ;A SEEK VERB LOOKS LIKE: ;FLAGS,,ADR ADR = FILE TABLE ADDRESS ;CALL+1: ;POPJ RETURN SEEK.: IFN ANS68,< 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*** ;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 POPJ PP, SUBTTL DISPLAY VERB ;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING ARG-LIST IN AC 16. ;THE AC16'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: 15,11,7,6,AND 1. ;AC16= ;THE CALLING ARG-LIST ;AC15= ;BYTE POINTER ;AC6= ;CHARACTER COUNT ;AC1= ;TOPS-20 ONLY (LSTATS ALSO) ;AC2= ;LSTATS ARG REGISTER ;AC4= ;BLANK COUNTER (TO SUPPRESS TRAILING BLANKS) ;AC12 ;MUST NOT BE USED DOPFS.: POINT 10,(I16),17 ;DISPLAY OPERAND FIELD SIZE DSPLY.: IFN LSTATS,< MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2) > 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. SETZ AC4, ;CLEAR BLANK COUNTER TXNN FLG,DIS%NM ;NUMERIC?, SUPPRESS LEADING SPACES AND TABS JRST DSPL4 ;NO DSPL2: ILDB C,AC15 ;GET A CHARACTER. JUMPE C,DSPL3 ;DON'T PASS NULLS BUT COUNT THEM CAIE C," " ;SPACE CAIN C," " ;OR TAB? JRST DSPL3 ;YES JRST DSPL5 ;NO, FIRST OUTPUT CHAR FOUND DSPL3: SOJG AC6,DSPL2 ;LOOP JRST DSPL7 ;END OF INPUT DSPL4: ILDB C,AC15 ;GET A CHARACTER JUMPE C,DSPL6 ;COUNT NULLS BUT DON'T OUTPUT THEM CAIN C," " ;BLANK? AOJA AC4,DSPL6 ; YES, DON'T OUTPUT IF TRAILING BLANK JUMPE AC4,DSPL5 ;JUMP IF NO ACCUMULATED BLANKS PUSH PP,C ; SAVE THIS NON-BLANK MOVEI C," " ;THE BLANKS WE SAW WERE NOT TRAILING BLANKS PUSHJ PP,OUTCH. ; SO OUTPUT THEM SOJG AC4,.-1 ;[673] REPLACE EDIT 651 POP PP,C ;RESTORE THE CHARACTER AFTER THE BLANKS DSPL5: IDPB C,TTOBP. ;DEPOSIT CHARACTER IN BUFFER SOSG TTOBC. ;BUFFER FULL? PUSHJ PP,OUTBF. ;YES DSPL6: SOJG AC6,DSPL4 ;LOOP DSPL7: TXNN FLG,DIS%LF ;LAST FIELD?, APPEND CR-LF AT END? JRST DSPL8 ;[533] NO, JUST OUTPUT WHAT WE HAVE DSPL1.: MOVEI C,$CR ;APPEND CR-LF PUSHJ PP,OUTCH. ; . MOVEI C,$LF ; . PUSHJ PP,OUTCH. ; . PUSHJ PP,OUTBF. ;DUMP BUFFER IFN LSTATS,< MRTME. (AC1) ;END METER TIMING > POPJ PP, ; AND EXIT. DSPL8: JUMPE AC4,DSPL8A ;[533] IF NO MORE TRAILING SPACES, EXIT MOVEI C," " ;[533] GET ONE PUSHJ PP,OUTCH. ;[533] AND OUTPUT IT SOJG AC4,.-1 ;[533] LOOP BACK FOR ALL SPACES DSPL8A: PUSHJ PP,OUTBF. ; OUTPUT BUFFER AND EXIT IFN LSTATS,< MRTME. (AC1) ;END METER TIMING > POPJ PP, ;HERE FOR DISPLAY OF SIXBIT DATA DSPL.6: IFN LSTATS,< MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2) > 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,600 ;(AC15) IS BYTE POINTER TO CHARS. SETZ AC4, ;CLEAR BLANK COUNTER TXNN FLG,DIS%NM ;NUMERIC?, SUPPRESS LEADING SPACES AND TABS JRST DSPL64 ;NO DSPL62: ILDB C,AC15 ;GET A CHARACTER. JUMPN C,DSPL65 ;OUTPUT FIRST NON-SPACE SOJG AC6,DSPL62 ;LOOP JRST DSPL7 ;END OF INPUT DSPL64: ILDB C,AC15 ;GET A CHARACTER DSPL65: ADDI C," " ;CONVERT TO ASCII CAIN C," " ;A BLANK? AOJA AC4,DSPL67 ; YES, DON'T OUTPUT TRAILING BLANKS JUMPE AC4,DSPL66 ;CHECK FOR BLANKS FOLLOWED BY NON-BLANKS PUSH PP,C ; (YUP) OUTPUT BLANKS IN THE MIDDLE MOVEI C," " PUSHJ PP,OUTCH. SOJG AC4,.-1 ;[673] REPLACE 664 LEAVE AS IT WAS BEFORE POP PP,C ;GET THE NON-BLANK CHAR BACK DSPL66: IDPB C,TTOBP. ;DEPOSIT CHARACTER IN BUFFER SOSG TTOBC. ;BUFFER FULL? PUSHJ PP,OUTBF. ;YES DSPL67: SOJG AC6,DSPL64 ;LOOP JRST DSPL7 ;SEE IF CR-LF NEEDED ;HERE FOR ASCIZ TEXT DSPL.7: IFN LSTATS,< MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2) > SKIPE TTYOPN ;IS THERE A TTY FILE OPEN? PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING ;IFE TOPS20,< OUTSTR (I16) ;OUTPUT THE TEXT STRING ;> REPEAT 0,< ;ALTMODE COMES OUT AS DOLLAR SIGN IFN TOPS20,< MOVEI 1,(I16) HRLI 1,(POINT 7,) ;BUILD BYTE PTR PSOUT% ;OUTPUT THE STRING >;END IFN TOPS20 >;END REPEAT 0 MRTME. (AC1) ;END METER TIMING POPJ PP, 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 OUT6B.: ADDI C," " ;CONVERT A SIXBIT CHAR OUTCH.: IDPB C,TTOBP. ;DEPOSIT CHAR. IN BUFFER. SOSLE TTOBC. ;DUMP THE BUFFER? POPJ PP, ; NO. ;OUTPUT A TTY BUFFER. ***POPJ*** OUTBF.: PUSH PP,C ;[673] SAVE C SETZ C, ;ASCIZ TERMINATOR IDPB C,TTOBP. ; OUTSTR TTOBF. ;DUMP THE BUFFER REPEAT 0,< ;*** FIX DURING FIELD TEST *** IFN TOPS20,< PUSH PP,1 MOVE 1,[POINT 7,TTOBF.] PSOUT% ;DUMP THE BUFFER POP PP,1 > >;END REPEAT 0 TRNA ;WE HAVE C SAVED ALREADY OUTBF1: PUSH PP, C ;SAVE C 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 POP PP,C ;[673] RESTORE C 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.: INCHWL C ;[267] INPUT A LINE, FIRST CHAR TO C CAIN C,$CR JRST GETCH. CAIN C,$ALT JRST GETCH1 CAIG C,$FF CAIGE C,$LF AOSA (PP) GETCH1: MOVEI C,$LF POPJ PP, SUBTTL OPEN VERB ;AN OPEN VERB LOOKS LIKE: ;FLAGS,,ADR WHERE ADR = FILE TABLE ADDRESS ;OPN%OU OPEN FOR OUTPUT ;OPN%IN OPEN FOR INPUT ;OPN%NR DON'T REWIND ;OPN%EX [74] OPEN EXTENDED (APPEND FILOP.) ;OPN%RV [74] OPEN REVERSED ;CALL+1: POPJ RETURN ;MAKE PRELIMINARY CHECKS: ALREADY OPEN, OPTIONAL FILE PRESENT, ;ANOTHER FILE USING SHARED BUFFER AREA ***OPNDEV*** C.OPEN: IFN LSTATS,< ;LIBOL METER TIMING SKIPE F.WSMU(I16) ;SKIP TIME START IF SIM. UPDATE JRST C.OMRX ;SKIP MRTMS. (AC1) ;START OPEN TIMING C.OMRX:>;END IFN LSTATS TXO AC16,V%OPEN ;OPEN VERB 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 HRRZ AC0,D.RFLG(I16) ; GET FLAGS ; BL/10/27/80 TRO AC0,AFTADV ; SET SO BFR-ADV WILL WRITE "CR" FIRST TRZ AC0,AFTADV ;RESET SO BFR-ADV WILL NOT WRITE 'CR' FIRST ;BL HRRM AC0,D.RFLG(I16) ; RESET IT LDB AC0,F.BBLC ;[346] CHECK FLAG TO SEE IF THIS JUMPE AC0,OOVLER ; FILE TABLE HAS BEEN LINKED TO THE CHAIN. TLNE FLG,OPNIN+OPNOUT ;IS THE FILE OPEN? JRST OPNFAO ;YES, ERROR SETZM D.RP(I16) ;INITIALIZE THE RECORD SEQUENCE NUMBER SETZM D.EXOF(I16) ; INITIALIZE THE RES SEQ OFFSET FOR SIXBIT LDB AC5,F.BLF ;IS THE FILE IS LOCKED? JUMPN AC5,OPNFAL ;YES, ERROR TXNE AC16,OPN%OU ;SKIP IF NOT OUTPUT TLO FLG,OPNOUT ; TXNE AC16,OPN%IN ;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 IFN ANS68,< 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 LDB AC1,[POINT 1,F.RMS(AC4),7] ;RMS BIT FOR THIS FILE JUMPN AC1,OPNSB3 ; JUMP IF THIS SBA FILE IS AN RMS FILE ; NON-RMS, V12B FILES: HLL AC4,F.WFLG(AC4) ;GET THE FLAGS TLNE AC4,OPNIN!OPNOUT ;SKIP IF ANY FILES ARE NOT OPEN JRST OPNSB2 ;GIVE AN ERROR MESSAGE JRST OPNSB4 ;OK FOR THIS FILE ; RMS FILES ONLY FOR V12B, OPNSB3: HRR AC1,D.F1(AC4) ;GET V13 STYLE FLAGS FOR THIS FILE TXNE AC1,LF%INP!LF%OUT ;IS THIS FILE OPEN? JRST OPNSB2 ;YES, GIVE AN ERROR MESSAGE OPNSB4: HLRZ AC4,F.LSBA(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 PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [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 PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /IO cannot be done from an overlay./] ;[346] OOVLE2: 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 PUSHJ PP,$SIGN ;[277] OUTPUT "$" FOR .OPERATOR OUTSTR [ASCIZ /Is /] ;OPTIONAL FILE PRESENT? PUSHJ PP,MSFIL. OUTSTR [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 OUTSTR [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: CLRBFI ;CLEAR THE BUFFER OUTSTR [ASCIZ /$ Type YES or NO. /] YES.NO: MOVE AC5,[POINT 7,[ASCIZ /ES/],] PUSHJ PP,GETCH. JRST .-1 CAIE C,"Y" CAIN C,"Y"+40 ;ALLOW LOWERCASE CAIA ;LOOKS LIKE "YES" SO FAR.. JRST YESNO2 ;DIDN'T START WITH "Y", TRY "NO" YESNO1: PUSHJ PP,GETCH. POPJ PP, ;IS THE "YES" RETURN ILDB AC4,AC5 JUMPE AC4,YSNOFN ;[564] [V10] YES FOUND, EAT INPUT UNTIL EOL CAIE C,(AC4) ;IS THIS A "YES" CHARACTER? CAIN C,40(AC4) ; CHECK LOWER-CASE CHARACTER TOO JRST YESNO1 ;YES, KEEP CHECKING AS LONG ; AS HE SPELLED IT OUT JRST YESNO ;NO, GO ASK AGAIN YESNO2: MOVE AC5,[POINT 7,[ASCIZ /NO/],] YESNO3: ILDB AC4,AC5 JUMPN AC4,YESNO4 ;[564] [V10] CHECK NEXT 'NO' CHAR,IF GOT ONE AOS (PP) ;[564] ELSE, GIVE SKIP RETURN YSNOFN: PUSHJ PP,GETCH. ;[564] GET ANOTHER CHAR POPJ PP, ;[564] GOT EOL, RETURN JRST YSNOFN ;[564] EAT CHARS UNTIL EOL YESNO4: CAIE C,(AC4) ;SKIP IF A "NO" CHARACTER CAIN C,40(AC4) ; CHECK LOWERCASE ALSO CAIA ;SO FAR, SO GOOD JRST YESNO ;?BAD INPUT, GO PROMPT AGAIN 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, ; IFN ANS68,< ;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. TXNN AC13,DV.AVL ;SKIP IF AVAILABLE TO JOB JRST OPNDNA TXNN AC13,DV.DSK ;SKIP IF A DSK TRNN AC13,DV.ASP ;SKIP IF DEV IS INITED JRST OPNDE5 MOVE AC2,[BYTE (5)10,2,4,20,16] ;FCBO,DIATAF. MOVEI AC0,^D14 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE5: TXNN AC16,OPN%EX ; OPEN EXTEND? JRST OPNDE6 ; NO TLNN FLG,IOFIL ; DUMP MODE FILE? JRST OPDE5A ; NO, CONT ; YES, ERROR, RESET TIME BUFFER ALLOCATION CAUSES TROUBLE ; HERE, WANTS BOTH DUMP MODE AND RING BUFFERS MOVEI AC0,^D55 ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Program may not have OPEN I-O and OPEN EXTEND for same file FD./] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN OPDE5A: HRRZ AC0,D.RFLG(I16) ; YES,GET RUN FLAGS TRO AC0,EXTOPN ; SET OPEN WAS EXTEND HRRM AC0,D.RFLG(I16) ; AND PUT IT BACK TXNE AC13,DV.MTA ;MTA? TLZ FLG1,STNDRD!NONSTD ;YES, DON'T CREATE A NEW LABEL OPNDE6: TLNE FLG,IOFIL ;[622] SKIP UNLESS IO TYPE FILE (DUMP MODE) JRST OPNDE7 ;IO REQUESTED OPND6A: TXNN AC16,OPN%EX ; OPEN EXTEND? TLNE FLG,OPNIN ; OR INPUT ? TXNE AC13,DV.IN ; YES,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: TXNN AC16,OPN%EX ; OPEN EXTEND TLNE FLG,OPNOUT ; OR OUTPUT? TXNE AC13,DV.OUT ; YES,SKIP IF DEVICE CANNOT DO OUTPUT JRST OPNCHN ; OK,FIND A FREE CHAN MOVE AC2,[BYTE (5)10,2,4,20,22] MOVEI AC0,^D17 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE7: TXNE AC13,DV.DSK ;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 DEVCHR: MOVE AC13,D.ICD(I16) ;ADR OF DEV. NAME MOVE AC13,(AC13) ;SIXBIT/DEVICE NAME/ MOVEM AC13,UOBLK.+1 ;FOR OPEN DEVCHR AC13, ;DEVCHR UUO TXC AC13,DV.DSK!DV.CDR ;[330] IF A DSK AND A CDR TXCN AC13,DV.DSK!DV.CDR ;[330] THEN ITS DEVICE 'NUL' TXZ AC13,DV.MTA!DV.TTY ;[506] SO ITS NOT A MTA OR TTY DEVCH1: MOVEM AC13,D.DC(I16) ;[330] SAVE THE CHARACTERISTICS JUMPN AC13,RET.1 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,.IOBIN ;PERHAPS BINARY TLNE FLG,RANFIL!IOFIL!IDXFIL ;[622] SKIP IF BUFFERED IO MOVEI AC6,.IODMP ;DUMP MODE HRRM AC6,UOBLK. ;UOBLK.+1 SET AT DEVCHR IFE TOPS20,< PUSHJ PP,OPNCKP ;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE > 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:> TXNN AC16,OPN%EX ;OPEN EXTENDED? JRST OPNC3A ; NO OPNC3B: PUSHJ PP,OPNFOP ; [431] YES OPEN FILE VIA FILOP JRST OFERRI ; [576] [431] ERROR RETURN JRST OPNC41 ; CONT NORMALLY OPNC3A: SKIPN F.WSMU(I16) ; SKIP IF SIMULTANEOUS UPDATE JRST OPNC31 ; NO, CONT IFE TOPS20,< JRST OPNC3B ; OPEN VIA FILOP > IFN TOPS20,< OPNC3C: PUSHJ PP,OCPT ; [431] OPEN FILE VIA DEC-SYS-20 COMPT. IFN ANS74,< JRST OCPER ; ERROR FOR 74,FNF IS ALSO ERROR > IFN ANS68,< TRNA ;ERROR, CHECK FOR FNF > JRST OPNC41 ; CONT NORMALLY, ALL OK IFN ANS68,< TLNE FLG,IDXFIL ;IS IT AN ISAM FILE JRST OCPER ;YES, GIVE THE ERROR CAIG AC1,GJFX21 ;IS IT ONE OF FILE NOT FOUND CAIGE AC1,GJFX17 CAIN AC1,GJFX24 JRST OPNFNF ;YES FNF!! CAIE AC1,GJFX32 ;STILL MORE FNF POSSIBILITIES CAIN AC1,OPNX2 ;LAST ONE TO CHECK FOR JRST OCPER ;NOT FNF, SCREW IT OPNFNF: MOVX AC1,GJ%SHT ;DO FILE CREATE OPEN MOVEM AC1,CP.BK1 MOVE AC1,[10,,CP.BLK] COMPT. AC1, ;DO IT JRST OCPER ;FAILED AGAIN, SCREW IT JRST OPNC41 ;GOOD CONTINUE WITH NEW FILE >;END IFN ANS68 >;END IFN TOPS20 OPNC31: IFN TOPS2X,< TLNN FLG,OPNOUT ;[667] IF INPUT (READ) ONLY TXNN AC13,DV.DSK ;[667] FOR A DSK FILE TRNA ;[667] NO JRST OPNC3C ;[667] YES, USE COMPT. WITH OF%RDU ON > IFE TOPS20,< TXNN AC13,DV.MTA ; SKIP IF A MTA JRST OPC31X ; ELSE CONT ; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING ; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS ; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS. SKIPN AUTOLB ; DO WE HAVE AUTO LABEL PROCESSING? JRST OPC31X ; NO PUSHJ PP,MTALAB ; GET LABEL INFORMATION (AC3 GETS LABEL TYPE) JRST OPC31X ; NO SYS LABELS,LEAVE IT AS IT IS, LDB AC3,F.BLBT ; GET LABEL TYPE CAIE AC3,.TFLNL ; UNLABELED? JRST OPC31L ; NO, SYS-LABELS, CLEAR COBOL LABELING TLO FLG1,MTNOLB ; YES, SET IT TO INDICATE SO HLLM FLG1,D.F1(I16) ; SAVE IT FOREVER JRST OPC31X ; CONT OPC31L: TLZ FLG1,STNDRD!NONSTD ; SYS LABELS,THEN LET PULSAR DO LABELS CAIE AC3,.TFLNS ; "NON-STANDARD"? TLO FLG1,MSTNDR ; NO, SET MONITOR DOING LABELING HLLM FLG1,D.F1(I16) ; SAVE IT FOREVER TLNN FLG1,MSTNDR ; WAS THAT SYS-LABELS? JRST OPC31X ; NO, CONT WITHOUT CHECKS TLNE FLG,OPNOUT ; AND OPEN OUTPUT? JRST OPC31X ; YES, CONT ; NO,CHECK INPUT LABEL ; HERE FOR OPEN INPUT OPC31F: LDB AC1,F.BFMT ; GET LABEL FORMAT BITS TXNE AC1,FRMATU ; "U" FORMAT? JRST OPC31J ; YES, NO CHECKS NECESSARY CAIE AC3,.TFLAL ; IS THE LABEL TYPE ANSI CAIN AC3,.TFLAU ; OR ANSI WITH USER LABELS? JRST OPC31H ; YES,JUMP ; ASSUME IBM LABELS HERE TXNE AC1,FRMATS ; IS IT "S" FORMAT? JRST RERE6 ; YES, ERROR SPANNED EBCDIC NOT SUPPORTED TXNN AC1,FRMATD ; IS IT "D" FORMAT? JRST OPC31I ; NO,CONT JUMPL FLG1,OPC31X ; JUMP IF VARIABLE EBCDIC, OK JRST OMTA0E ; ERROR, WRONG FORMAT FOR RECORDING MODE ; HERE IF "F" FORMAT, DDM MUST MATCH OPC31I: JUMPL FLG1,OMTA0E ; IF VARIABLE EBCDIC, ERROR JRST OPC31X ; ELSE OK,CONT ; HERE FOR ANSI LABELED INPUT, CHECK FORMATS OPC31H: TXNE AC1,FRMATS+FRMATD ; IS IT "D" OR "S" FORMAT? JRST OPC31K ; YES,ERROR JUMP ; OPEN INPUT ANSI-LABELED "F FORMAT" ; MAKE SURE COMPATIBLE DATA MODE IS SET JUMPGE FLG,OMTA0E ; ERROR IF NOT ASCII RECORDING MODE PUSHJ PP,CMPASC ; NO,MAKE SURE WE GET COMPATIBLE ASCII JRST OPC31X ; CONT ; CMPASC ROUTINE TO MAKE SURE COMPATIBLE ASCII WILL BE WRITTEN ; FOR ANSI LABELED TAPES ON TOPS 10 (F FORMAT) ; RETURNS +1 ALWAYS CMPASC: PUSHJ PP,TM03AS ; ENSURE COMPATIBLE DATA MODE HRRZ AC0,D.RFLG(I16) ; GET RUNTIME FLAGS TRNE AC0,INDASC ; IND-ASC? POPJ PP, ; YES, RETURN, IND-CMP MODE SET LATER PUSHJ PP,STDASC ; NO, SET ANSI ASCII MODE TROA AC0,INDASC ; ERROR SET INDASC MODE AND SKIP POPJ PP, ; OK, RETURN HRRM AC0,D.RFLG(I16) ; RESET (IF CHANGED) POPJ PP, ; RETURN OPC31K: MOVE AC0,[E.MTAP+^D54] ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /ANSI labeled "S" and "D" format mag tape not supported./] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN ; HERE IF OPEN INP ANSI LABELED "U FORMAT" OPC31J: HRRZ AC0,D.RFLG(I16) ; GET STANDARD ASCII FLAG TRNN AC0,SASCII ; DOES HE WANT IT? TRZ AC0,INDASC ; NO, CLEAR ANY INDASC SETTING DONE AT RESET HRRM AC0,D.RFLG(I16) ; PUT IT BACK JRST OPC31X ; CONT OPC31X: > ;END OF IFE TOPS20 PUSHJ PP,SETBM ;SET BYTE MODE IF REQUIRED XCT UOPEN. ;OPEN THE DEVICE *************** 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)) IFE TOPS20,< ;[561] TXNE AC13,DV.MTA ;SKIP IF NOT A MTA > ;[561] IFN TOPS20,< TXNN AC13,DV.MTA ;[561] MTA?? JRST OPNC4X ;[561] NO,SKIP FOLLOWING ENTER/LOOKUP TXNE AC16,OPN%EX ; OPEN EXTEND? JRST OPNC4D ; YES,SKIP THIS PUSH PP,AC5 ;[561] YES,SAVE REGS PUSH PP,AC6 ;[561] PUSH PP,AC10 ;[561] TLNN FLG,OPNIN ;[561] OPEN FOR INPUT? JRST OPNC4A ;[561] NO PUSHJ PP,OPNLID ;[561] YES,SET UP FOR LOOKUP XCT ULKUP. ;[561] LOOKUP JRST OLERR ;[561] ERROR IN LOOKUP JRST OPNC4F ;[561] RESTORE AND CONT OPNC4A: PUSHJ PP,OPNEID ;[561] SET UP FOR ENTER XCT UENTR. ;[561] ENTER JRST OEERR ;[561] ERROR IN ENTER OPNC4F: POP PP,AC10 ;[561] RESTORE AC'S POP PP,AC6 ;[561] POP PP,AC5 ;[561] OPNC4D: >;END IFN TOPS20 JUMPN AC5,OPNNSB ;[561] NON STANDARD BUFFER SETUP OPNC4X: ;[561] IFN ISAM,< TLNE FLG,IDXFIL ;ISAM ? JRST OPNIDX ;YES > TLNE FLG,IOFIL+RANFIL ;[622] IOFIL=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. TXNE AC16,OPN%EX ;APPEND? JRST OPNC45 ;YES, DO FILOP NOW TLNE FLG,OPNIN ;INPUT? XCT UIBUF. ;********** TLNE FLG,OPNOUT ;OUTPUT? XCT UOBUF. ;********** JRST OPNC46 OPNC45: MOVEI AC1,2(AC6) ;GET NO. OF BUFFERS HRLZM AC1,FOP.BN## ;SET FOR OUTPUT PUSHJ PP,OPNEXT ; DO THE APPEND OPEN LDB AC0,F.BBKF ; GET BLOCKING FACTOR JUMPE AC0,OPNC46 ; CONTINUE IF NOT BLOCKED MOVEM AC0,D.RCL(I16) ; SET NUMBER RECORDS IN LOG BLOCK MOVE AC1,ARGBK.+.RBSIZ ; GET FILE SIZE RETURNED BY FILOP MOVE AC3,D.BPL(I16) ; GET NUMBER OF BUFFERS PER LOG-BLK IMULI AC3,DSKBSZ ; CALC NUMBER WORDS PER LOG-BLK (FULL BLKS) IDIVI AC1,(AC3) ; CALC NUMBER OF LOG-BLKS, LEAVING REMAINDER IN ; AC2 INDICATING THE NUMBER OF WORDS IN THE ; CURRENT LOG-BLK. JUMPGE FLG1,OPC45A ; CONT IF NOT VARIABLE LENGTH EBCDIC MOVEI AC3,-2(AC2) ; NUMBER OF WORDS WRITTEN IN LOG-BLK ; TAKE CARE OF POSSIBLE LAST PARTIAL WORD (-1) ; AND THE BDW (-2) IMULI AC3,4 ; CALC NUMBER OF CHARS IN LOG-BLK SUB AC3,D.TCPL(I16) ; CALC NUMBER OF FREE CHARS MOVNM AC3,D.FCPL(I16) ; SET NUMBER OF CHARS LEFT IN LOG-BLK OPC45A: IDIVI AC2,DSKBSZ ; CALC NUMBER OF FULL BUFFERS IN THIS LOG BLK ; THAT HAVE ALREADY BEEN WRITTEN (IN AC2) MOVE AC3,D.BPL(I16) ; CALC NUMBER OF BUFFS LEFT SUBI AC3,(AC2) ; IN THE CURRENT LOG-BLK MOVEM AC3,D.BCL(I16) ; AND RESET JUMPL FLG1,OPNC46 ; VAR LENGTH EBCDIC ENDS NOW IMULI AC2,DSKBSZ ; CALC NUMBER OF WORDS OF FULL BUFFERS WRITTEN TLNE FLG,DDMEBC!DDMASC ; IF ASCII OR IF EBCDIC JRST OPC45B ; WE WANT THE CHARACTER CASE MOVE AC1,D.WPR(I16) ; FOR SIXBIT AND BINARY JRST OPC45C ; USE WORDS PER RECORD OPC45B: MOVE AC1,D.CPR(I16) ; GET CHARS PER RECORD (INCLUDING OVERHEAD) ; ***NOTE*** ; THIS WILL ASSUME THAT NOT VARIABLE LENGTH ; RECORDS IN THE BUFFERS PERVIOUS TO THIS ONE IMUL AC2,D.BPW(I16) ; CALC CHARS IN FULL BUFFERS OPC45C: IDIVI AC2,(AC1) ; CALC RECORDS IN FULL BUFS OF LOG-BLK SUB AC2,D.RCL(I16) ; RESET THE MOVNM AC2,D.RCL(I16) ; NUMBER OF RECORDS LEFT IN LOG-BLK PUSHJ PP,EXTSCN ; SCAN THE CURRENT BUFFER TO CALC ; NUMBER OF RECORDS LEFT IN LOG-BLK JRST OPNC46 ; AND CONTINUE ; OPNEXT ASSUMES FOP.BK SET FOR BUFFER NUMBER ; IT SETS UP AND EXECUTES THE APPEND FILOP, AND ADJUSTS ; THE BYTE COUNT FOR THE BUFFER READ IN, TO REFLECT ; THE CURRENT BYTE SIZE. OPNEXT: TXNN AC13,DV.MTA ; SKIP IF MAG TAPE JRST OPNEX0 ; ELSE CONT ; HERE WE MUST CHECK FOR PROPER DENSITY, PARITY AND DATA MODE FOR ; THE APPEND FILOP. LDB AC0,F.BPAR ; GET THE PARITY INDICATED IN THE PROGRAM DPB AC0,[POINT 1,FOP.IS,26] ; SET IT IN THE FILOP. STATUS FIELD LDB AC0,F.BDNS ; GET DENISTY INDICATED BY PROGRAM IFN TOPS20,< ; FOR THE 20 GET DEFAULT TAPE SETTINGS AND CHECK AGAINST REQUESTED PUSHJ PP,GTDFLT ; GET DEFAULT DATA MODE IN AC3 MOVE AC4,AC3 ; SAVE DATA MODE SETO AC1, ; AC1=-1, THIS JOB HRROI AC2,3 ; DENSITY AT AC3 MOVEI AC3,.JIDEN ; START BLOCK AT THE DEFAULT DEN WORD GETJI% ; GET THE DENSITY JRST KILL. ; ASSUME IT WORKS, SHOULD ALWAYS CAIGE AC0,.TFD16 ; IS REQUESTED DEN 1600 OR GTR ? JRST EXTMT0 ; NO, SET IN STATUS FIELD CAIN AC0,(AC3) ; IS DEFAULT SAME AS REQUESTED? JRST EXTMT1 ; YES, GO CHECK DATA MODE >;END IFN TOPS20 IFE TOPS20,< ; FOR THE 10 CHECK FOR CONTROLLERS THAT READ DENISTY. IF NOT ; THEN CHECK DEFAULT SETTING CAIGE AC0,.TFD16 ; IS REQUESTED DEN 1600 OR GTR ? JRST EXTMT0 ; NO, SET IN STATUS FIELD MOVE AC1,[2,,2] ; 2 ARGS START AT AC2 MOVEI AC2,.TFKTP ; GET CONTROLLER TYPE MOVE AC3,UOBLK.+1 ; GET DEVICE NAME TAPOP. AC1, ; GET CONTROLLER TYPE INTO AC1 JRST EXTPER ; ERROR IN TAPOP. CAIE AC1,.TFKTX ; TX01 CAIN AC1,.TFKD2 ; OR DX20/TX02? JRST EXTMT1 ; YES, DENSITY IS READ FROM TAPE ; NO,CHECK DEFAULT DENISTY SETTING MOVE AC1,[3,,2] ; 3 ARGS START AT AC2 MOVEI AC2,.TFDEN+.TFSET ; SET TAPE DENSITY SETZ AC4, ; SET TO UNIT DEFAULT TAPOP. AC1, ; SET THE DENSITY JRST EXTPER ; FILOP ERROR MOVE AC1,[2,,2] ; 2 ARGS START AT AC2 MOVEI AC2,.TFDEN ; DENSITY AGAIN TAPOP. AC1, ; GET THE UNIT DEFAULT JRST EXTPER ; TAPOP. ERROR CAIN AC0,(AC1) ; IS DEFAULT THE REQUESTED? JRST EXTMT1 ; YES, GO CHECK DATA MODE >;END IFE TOPS20 ; HERE IF DENSITY CAN'T BE SET FOR THE APPEND FILOP. POP PP,(PP) ; DISCARD OPNEXT POPJ LDB AC0,F.BBKF ; GET BLOCKING FACTOR JUMPN AC0,.+2 ; SKIP IF BLOCKED POP PP,(PP) ; DISCARD .JBFF SAV MOVEI AC0,^D49 ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Unable to set requested density for OPEN EXTEND./] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN IFE TOPS20,< ; HERE WITH TAPOP. ERROR EXTPER: POP PP,(PP) ; DISCARD OPNEXT POPJ LDB AC0,F.BBKF ; GET BLOCKING FACTOR JUMPN AC0,.+2 ; SKIP IF BLOCKED POP PP,(PP) ; DISCARD .JBFF SAV MOVE AC0,[E.MTAP+^D50] ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /TAPOP. error processing OPEN EXTEND for mag tape./] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN >;END IFE TOPS20 ; HERE TO SET DENSITY IN STATUS FIELD EXTMT0: DPB AC0,[POINT 2,FOP.IS,28] ; DENSITY IN STATUS BITS ; HERE TO CHECK THAT DATA MODE IS PROPER EXTMT1: IFE TOPS20,< PUSH PP,D.OBH(I16) ; SAVE OUT BUFF HEADER PUSH PP,D.OBB(I16) ; SAVE OUT BUFF PTR XCT UOPEN. ; OPEN THE DEVICE JRST [ POP PP,AC0 ; THROW OUT BUFF POP PP,AC0 ; HEADER AND PTR JRST OERRIF] ; ERROR MOVE AC1,[2,,2] ; 2 ARGS START AT AC2 MOVEI AC2,.TFMOD ; DATA MOD FUNCTION MOVE AC3,UOBLK.+1 ; DEVICE NAME TAPOP. AC1, ; GET DEFAULT DEVICE DATA MODE JRST [ POP PP,AC0 ; THROW OUT BUFF POP PP,AC0 ; HEADER AND PTR JRST EXTPER] ; TAPOP. ERROR XCT UCLOS. ; CLOSE IT FOR APPEND FILOP. XCT URELE. ; RELEASE IT TOO (WACHS SAYS SO) POP PP,D.OBB(I16) ; RESTORE BUFF PTR POP PP,D.OBH(I16) ; AND HEADER >;END IFE TOPS20 TLNN FLG,DDMEBC ; SKIP IF DEVICE MODE EBCDIC JRST EXTMT2 ; ELSE GO ON IFE TOPS20,< CAIE AC1,.TFM8B ; IS DEFAULT MODE INDUSTRY COMPATIBLE JRST EXTDER ; NO, ERROR JRST OPNEX0 ; YES, ALL OK, GO DO FILOP. >;END IFE TOPS20 IFN TOPS20,< CAIE AC4,.SJDM8 ; IS DEFAULT MODE INDUSTRY COMPATIBLE? JRST EXTDER ; NO, ERROR JRST OPNEX0 ; YES, ALL OK, GO DO FILOP. >;END IFN TOPS20 ; NOT EBCDIC IS IT ANSI ACSII ? EXTMT2: HRRZ AC0,D.RFLG(I16) ; GET STANDARD ASCII FLAG TRNN AC0,SASCII ; DOES HE WANT IT? JRST OPNEX0 ; NO, ALL OK GO DO FILOP. IFE TOPS20,< CAIE AC1,.TFM7B ; IS DEFAULT MODE ANSI ASCII ? JRST EXTDER ; NO, ERROR JRST OPNEX0 ; YES, ALL OK CONT >; END IFE TOPS20 IFN TOPS20,< CAIE AC4,.SJDMA ; IS DEFAULT MODE ANSI ASCII ? JRST EXTDER ; NO, ERROR JRST OPNEX0 ; YES, ALL OK CONT >; END IFN TOPS20 ; HERE IF DATA MODE CAN'T BE SET EXTDER: POP PP,(PP) ; DISCARD OPNEXT POPJ LDB AC0,F.BBKF ; GET BLOCKING FACTOR JUMPN AC0,.+2 ; SKIP IF BLOCKED POP PP,(PP) ; DISCARD .JBFF SAV MOVEI AC0,^D51 ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Unable to set requested data mode for OPEN EXTEND./] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN OPNEX0: MOVE AC1,UOBLK.+2 ;GET BUFFER HEADERS MOVEM AC1,FOP.BH## ;STORE IN FILOP. BLOCK MOVE AC1,[7,,FOP.BK] FILOP. AC1, JRST [ POP PP,(PP) ; DISCARD OPNEXT RETURN LDB AC0,F.BBKF ; GET BLOCKING FACTOR JUMPN AC0,OFERR ; JUMP IF BLOCKED POP PP,(PP) ; DISCARD .JBFF SAV JRST OFERR ] ; FAILED JUMPL FLG,OPNEX1 ;JUMP IF ASCII TLNE FLG,DDMBIN POPJ PP, ;DON'T CHANGE IF BINARY HLRZ AC6,FOP.BH ;GET OUTPUT BUFFER HEADER TLNN FLG,DDMEBC JRST OPNEXS ; SIXBIT, CONTINUE MOVEI AC1,9 ; EBCDIC TXNE AC13,DV.MTA ; SKIP IF NOT MTA IFN TOPS20,< MOVEI AC1,8 ; ELSE IT IS INDUSTRY COMPATIBLE > IFE TOPS20,< JRST EX10ER ; EBCIDC TAPE EXTEND NOT SUPPORTED ON 10 > DPB AC1,[POINT 6,1(AC6),11] ; RESET BYTE SIZE MOVEI AC1,4 ; IMULM AC1,2(AC6) ;ADJUST BYTE COUNT IFE TOPS20,< EX10ER: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /OPEN EXTEND for EBCDIC tapes currently not supported./] MOVE AC2,[BYTE (5)10,31,20,2] ; FILENAME AND DEVICE MESSAGE AND KILL PUSHJ PP,MSOUT. > ; RESET THE BYTE PTR TO FIRST FREE CHAR OPNEX1: ;BL; INSERTED AT OPNEX1 TO FIX OPEN-EXTEND BUG HRRZ AC4,D.OBB(I16) ;GOOD DEST ADDR IN BPTR? JUMPE AC4,OPNEXX ; NO, WAIT FOR DUMMYOUT SOS AC1,D.OBB(I16) ; GET BUF BYT PTR HRRZ AC2,D.OBH(I16) ; GET ADDR OF BUF HEADER CAIE AC2,(AC1) ; BYT PTR AT BUF BEGINING? JRST OPNX1A ; NO AOS D.OBB(I16) ; YES, RESET BYT PTR OPNEXX: POPJ PP, ; , THEN ALL SET, RETURN OPNX1A: HRRZ AC2,D.BPW(I16) ; GET BYTS PER WORD ADDI AC2,1 ; SET BYT COUNT RIGHT FOR LOOP ; SCAN THRU LAST DATA WORD FOR FIRST NULL CHAR OPNEX2: MOVE AC3,AC1 ; SAVE CURRENT POSITION SOJE AC2,OPNEX3 ; END SCAN IF NO CHARS LEFT ILDB AC0,AC1 ; GET CHAR JUMPN AC0,OPNEX2 ; END SCAN IF NULL FOUND MOVE AC1,AC3 ; RESET PTR TO WRITE OVER NULL FOUND OPNEX3: ADDM AC2,D.OBC(I16) ; ADD PARTIAL WORDS CHARS TO AVAILABLE COUNT MOVEM AC1,D.OBB(I16) ; RESET OUT BUF BYT PTR (IF NO NULL,UNCHANGED) POPJ PP, ; RETURN, ALL DONE ; THE SIXBIT CASE OPNEXS: MOVEI AC1,6 ;ASSUME SIXBIT DPB AC1,[POINT 6,1(AC6),11] ;RESET BYTE SIZE IMULM AC1,2(AC6) ;ADJUST BYTE COUNT POPJ PP, ; END NOW,SIXBIT IS WORD ALLIGNED OPNC46: HLRZ AC2,F.LSBA(I16) ;[507] FILTAB THAT SHARES SAME BUFFER JUMPN AC2,ZROBUF ;[507] CLEAR ANY POSSIBLE PREVIOUS JUNK POP PP,.JBFF ;RESTORE .JBFF OPNCH2: IFN ANS74,< TLNN FLG,IDXFIL!RANFIL!OPNIN ;[622] TLNN FLG,OPNOUT ;TEST FOR SEQ. OUTPUT JRST OPNC21 ;NO SKIPN F.LCP(I16) ;LINAGE-COUNTER? JRST OPNC21 ;NO MOVEI AC6,1 MOVEM AC6,F.LCP(I16) ;YES, SET TO 1 OPNC21:> TXNE AC13,DV.DIR ;SKIP IF NON-DIRECTORY DEVICE TLNE FLG1,STNDRD ;SKIP IF NOT STANDARD LABELS JRST OPNBSI ;SET THE BYTE SIZE TXNE AC13,DV.CDR ;[531] IF DIRECTORY AND CDR JRST OPNBSI ; THEN ITS NUL: WHICH IS OK 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. ;[507] ZERO BUFFERED I/O BUFFER AREA. ZROBUF: HLRZ AC3,D.BL(I16) ;[507] ORIGINAL BUFFER LOCATION MOVE AC1,AC3 ;[507] SET UP FOR LOOP ZRBUF2: SETZM (AC1) ;[507] INITIALIZE FILE STATUS HLRZ AC2,1(AC1) ;[507] SIZE OF DATA BUFFER ( +1 ) HRRZ AC4,1(AC1) ;[507] ADDR 2ND WORD NEXT BUFFER HRRZI AC1,2(AC1) ;[507] 3RD WORD OF HEADER SETZM (AC1) ;[507] THE ZERO ADDI AC2,-1(AC1) ;[507] UNTIL... HRLS AC1 ;[507] FROM... ADDI AC1,1 ;[507] TO... BLT AC1,(AC2) ;[507] CLEAR THE BUFFER HRRZI AC1,-1(AC4) ;[507] TOP OF NEXT BUFFER CAME AC3,AC1 ;[507] AT BEGINNING OF RING? JRST ZRBUF2 ;[507] NO, LOOP POP PP,.JBFF ;[507] RESTORE JRST OPNCH2 ;[507] CONTINUE ;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK). ***OPNCH2*** OPNNSB: CAIN AC6,77 ;[477] REALLY WANTS ONE BUFFER? SETO AC6, ;[477] YES, SET TO DEFAULT TO 1 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,(BF.VBR) ; 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... TXNN AC16,OPN%EX ;APPEND? JRST OPNCH2 ;NO SETZM FOP.BN ;DON'T CHANGE BUFFER ALLOCATION PUSHJ PP,OPNEXT ; GO OPEN VIA APPEND FILOP LDB AC0,F.BBKF ; GET BLOCKING FACTOR MOVEM AC0,D.RCL(I16) ; SET NUMBER RECORDS IN LOG BLOCK MOVE AC3,D.BPL(I16) ; GET NUMBER OF BUFFS PER LOG-BLK MOVEM AC3,D.BCL(I16) ; AND RESET IT PUSHJ PP,EXTSCN ; SCAN THE CURRENT BLOCK TO CALC THE NUMBER OF ; RECORDS LEFT IN THE LOGICAL BLOCK JRST OPNCH2 ; CONTINUE AT MAIN LINE ; NOW MUST SCAN FROM BEGINING OF BLOCK TO CALC HOW ; MANY RECORDS HAVE BEEN WRITTEN SO FAR. ; THE NUMBER OF RECORDS LEFT IN THE LOGICAL BLOCK (D.RCL) HAS ; BEEN RESET TO INDICATE THE NUMBER OF RECORDS LEFT AT THE BEGINING ; OF THE CURRENT BLOCK. EXTSCN: HRRZ AC1,D.OBB(I16) ; GET ADDR NEW WRITE POSITION HRRZ AC2,D.OBH(I16) ; CALC ADDR OF START ADDI AC2,1 ; OF DATA SUB AC1,AC2 ; CALC NUMBER OF WORDS OF DATA IN BUFFER JUMPLE AC1,OPNNXX ; EXIT IF BUFFER EMPTY JUMPGE FLG,OPNNXS ; JUMP IF NOT ASCII HRLI AC2,000700 ; SET UP 7-BIT BYTE PTR ; AC2 ADDR SET TO WORD BEFORE DATA ABOVE OPNXA1: SOJLE AC1,OPNNXX ; JUMP IF SCAN COMPLETE ILDB AC3,AC2 ; GET A CHAR CAIL AC3,40 ; SKIP IF NOT "REAL" DATA CHAR JRST OPNXA2 ; ELSE WE HAVE FOUND THE START OF A RECORD MOVE AC3,CHTAB(AC3) ; GET CONVERSION TABLE ENTRY (NEG IF IGNORE CHR) JUMPLE AC3,OPNXA1 ; JUMP IF CHAR TO BE IGNORED OPNXA2: SOS D.RCL(I16) ; NOW DECREMENT AVAILABLE RECORDS IN BLOCK COUNT ; SCAN TO END OF RECORD OPNXA3: SOJE AC1,OPNNXX ; JUMP IF REACHED NEW WRITE POSITION ILDB AC3,AC2 ; GET CHAR CAIL AC3,40 ; SKIP IF NOT "REAL" DATA CHAR JRST OPNXA3 ; ELSE CONTINUE WITH RECORD SCAN MOVE AC3,CHTAB(AC3) ; GET CONVERSION TABLE ENTRY (NEG IF IGNORE CHR) JUMPGE AC3,OPNXA1 ; JUMP IF CHAR IS PART OF RECORD JRST OPNXA1 ; CONTINUE SCAN THRU BLOCK ; HERE FOR NON-ASCII CASES OPNNXS: TLNE FLG,DDMSIX ; SKIP IF DEVICE MODE SIXBIT TXNN AC13,DV.MTA ; AND IF A MTA JRST OPNNXE ; ELSE CHECK FOR EBCDIC OR BINARY AOS AC1,AC2 ; AC2 WAS SET TO WORD BEFORE DATA ABOVE ; ADDRESS FIRST DATA WORD HRRZ AC0,D.OBB(I16) ; GET ADDR LAST DATA WORD CAIG AC0,(AC1) ; SKIP IF NOT EMPTY BUFFER JRST OPNNXX ; ELSE NOTHING TO UPDATE ; SCAN DOWN SIXBIT RECORD COUNTING RECORDS OPNXS1: CAIL AC0,(AC1) ; SKIP IF MORE TO SCAN JRST OPNNXX ; ELSE DONE SOS D.RCL(I16) ; DECREMENT RECORDS LEFT IN BLOCK HLRZ AC2,(AC1) ; GET RECORD SEQ NUMBER MOVEM AC2,D.RP(I16) ; RESET REC SEQ NUMBER FOR WRITING HRRZ AC2,(AC1) ; GET RECORD SIZE JUMPN AC2,.+2 ; SKIP IF NOT NULL RECORD AOJA AC1,OPNXS1 ; ELSE ADVANCE, NULL 6-BIT IS ONE WORD ; IN THE RANDOM FORMAT ; THIS WILL NOT WORK CORRECTLY FOR THE SEQ CASE IDIVI AC2,6 ; CALC NUMBER WORDS JUMPE AC3,.+2 ; IN THE ADDI AC2,1 ; RECORD ADDI AC1,(AC2) ; ADVANCE TO NEXT RECORD JRST OPNXS1 ; CONTINUE TO SCAN BLOCK ; HERE FOR EBCDIC AND BINARY CASES OPNNXE: JUMPL FLG1,OPNNXV ; JUMP IF VARIABLE LENGTH EBCDIC ; HERE IF DSK SIXBIT AND, DSK OR MTA ; BINARY OR FIXED LENGTH EBCDIC, CALCULATE NUMBER ; OF RECORDS TO CURRENT POSITION TLNE FLG,DDMBIN ; IS DEVICE MODE BINARY? JRST OPNNXB ; YES, SET UP FOR WORDS IMUL AC1,D.BPW(I16) ; CALC NUMBER OF BYTES DATA ON BUFFER LDB AC2,F.BMRS ; GET MAX RECORD SIZE OPNXE2: IDIVI AC1,(AC2) ; CALC NUMER OF MAX RECORDS IN BUFFER JUMPE AC2,OPNXE1 ; SOME LEFT OVER ? TXNN AC13,DV.MTA ; YES, MTA?? ADDI AC1,1 ; NO, ROUND UP FOR PARTIAL RECORD OPNXE1: SUB AC1,D.RCL(I16) ; AC1=-(NUMBER RECORDS LEFT IN BUFFER) MOVNM AC1,D.RCL(I16) ; RESET NUMBER OF RECORDS LEFT IN BUFFER JRST OPNNXX ; ALL FINISHED CONTINUE ; BINARY CASE MUST BE DONE USING THE WORD NUMBERS OPNNXB: HRRZ AC2,D.WPR(I16) ; GET REC SIZE IN WORDS JRST OPNXE2 ; GO DO CALC WITH AC1 AND AC2 WORDS ; FOR VARIABLE LENGTH EBCIDC WE MUST CHAIN DOWN THE RDWS ; COUNTING THE RECORDS SEEN OPNNXV: MOVE AC1,D.OBC(I16) ; GET NUMBER AVAILABLE CHARS MOVEM AC1,D.FCPL(I16) ; RESET NUMBER FREE CHARS IN LOG-BLK POPJ PP, ; RETURN, ALL DONE ; ALL DONE WITH BUFFER SCAN, IF BUFFER FULL, WRITE IT OUT ; AND SET UP FOR NEXT ONE OPNNXX: SKIPE D.RP(I16) ; SKIP IF NO SIXBIT REC SEQ NUMBER SET AOS D.RP(I16) ; ELSE SET SO IT WILL START ONE GTR THAN LAST SKIPLE D.RCL(I16) ; SKIP IF NO RECORDS LEFT IN BLOCK POPJ PP, ; ELSE BACK TO MAIN LINE, ALL DONE HERE PUSHJ PP,WRTOUT ; ADVANCE BUFFERS LDB AC0,F.BBKF ; GET BLOCKING FACTOR MOVEM AC0,D.RCL(I16) ; RESET NUMBER RECORDS IN LOG BLOCK POPJ PP, ;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 MOVE AC6,AC10 ;GET WDS/LBLK TRZE AC6,DSKMSK ;FILL TO DISK BLK SIZE, ADDI AC6,DSKBSZ ;ROUNDING UP IF NECESSARY MOVN AC6,AC6 ;GET 0,,-N IFN ANS68,< HRLI AC6,R.FLMT(I12) ;LOC-1,,-N > IFN ANS74,< HRLI AC6,R.DLRW(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 IFN ANS68,< HRRI AC6,1+R.FLMT(I12);FIRST DATA WORD > IFN ANS74,< SETZM R.DLRW(I12) ; CLEAR DEL/RWT SAVE BLK NUM HRRI AC6,1+R.DLRW(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 HLRZ AC2,F.LSBA(I16) ;[507] FILTAB THAT SHARES SAME BUFFER SKIPE AC2 ;[507] SHARES BUFFER? PUSHJ PP,ZDMBUF ;[507] YES, CLEAR IT 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 IFN TOPS2X,< TLNE FLG,IOFIL!OPNOUT ;[667] IF OPEN READ ONLY OR > SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNIX2 ; YES ;IFN TOPS20,< ;[570] ; TLNE FLG,IOFIL!OPNOUT ;[570] OPEN READ ONLY? ; JRST ONIX1A ;[570] NO, DO LOOKUP ; PUSHJ PP,OCPT ;[570] YES, OPEN IN THAWED MODE ; JRST OCPER ;[570] ERROR IN THAWED OPEN ; JRST OPNIX2 ;[570] OK,CONT ;ONIX1A: >;[570] END IFN TOPS20 XCT ULKUP. ;LOOKUP JRST OLERRI ;LOOKUP AND(OR) COMPT. 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. ; IFN ISTKS, 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 OUTSTR [ASCIZ /OPEN failed - 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,.IODMP ;DUMP MODE HRRM AC0,UOBLK. ;SETUP OPEN BLOCK IFE TOPS20,< PUSHJ PP,OPNCKP ;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE > MOVE AC1,F.WDNM(I16) ; MOVE AC1,1(AC1) ;[522] GET STRUCTURE MOVEM AC1,UOBLK.+1 ; SETZM UOBLK.+2 ; PUSHJ PP,SETCN. ;SET DATA FILE CHANNEL SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE? IFN TOPS2X,< TLNN FLG,IOFIL!OPNOUT ;[667] IF OPEN READ ONLY OR TRNA ;[667] YES > JRST OPNI21 ; NO IFE TOPS20,< PUSHJ PP,OPNFPD ; [431] OPEN FILE VIA FILOP UUO JRST OFERR ; [576] [431] ERROR RETURN >; [431] END IFE TOPS20 IFN TOPS20,< PUSHJ PP,OCPTD ; [431] OPEN FILE VIA DEC-SYS-20 COMPT. JRST OCPERI ; [431] ERROR RETURN >; [431]END IFN TOPS20 JRST OPNI22 ; SKIP THE OPEN UUO OPNI21: XCT UOPEN. ;OPEN THE DATA FILE JRST OERRDF ;ERROR RETURN ;SETUP IOWRD TABLE OPNI22: IFN ANS74,< ; Set record area length for START LDB AC1,F.BMRS ; Get record size LDB AC3,[POINT 2,FLG,14] ; Get internal mode HRRZ AC3,RBPTBL(AC3) ; Get bytes per internal record word IDIVI AC1,(AC3) ; Get words in record area SKIPE AC2 ; Skip if no round up ADDI AC1,1 ; Round up MOVEM AC1,RCARSZ(I12) ; Save for START checks >; end ifn ans74 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 MOVE AC4,OMXLVL(I12) ;[442] USE ORIGINAL # OF INDEX LEVELS ;[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 JUMPGE AC5,OPNI06 ;[504] SKIP THE FOLLOWING IF NOT HRL AC4,AC5 ;NEW LEVEL(S) HRRZ AC5,ISPB(I12) ;[306] SECTORS PER BLOCK IMULI AC5,200 ;[306] WORDS PER SECTOR MOVN AC6,AC5 ;[306] NEGATE THE LENGTH HRLZS AC6 ;[306] -LENGTH,,0 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 ;[306] SET UP AC0 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 ;[371] GET PROGRAMS MAX REC SIZE CAMN AC0,RECBYT(I12) ;[371] SEE IF SAME AS ISAM PARM JRST OPNI07 ;[371] IT DOES- OF CAML AC0,RECBYT(I12) ; [375] WHICH WAY IS FD DIFFERENT? JRST OPNGR ; [375] FD GT ISAM TLNN FLG,OPNIN ;[622] [375] FD LT IDX-FILE, OPN OUTPUT ONLY? JRST OPNI07 ; [375] YES OKAY JRST OPNER1 ; [375] NO-INPUT OR I/O ERROR OPNGR: TLNN FLG,OPNOUT ; [622][375] FD GT IDXFIL - OPN FOR INPUT ? JRST OPNI07 ; [375] YES OKAY OPNER1: ; [375] OUTSTR [ASCIZ /Users maximum record size /] ; [371] PUSHJ PP,PUTDEC ;[371] TYPE IT OUTSTR [ASCIZ / differs from ISAM parameter ./] ;[371] MOVE AC0,RECBYT(I12) ;[371] GET ISAM MAX REC SIZE PUSHJ PP,PUTDEC ;[371] TYPE IT JRST OPNERX ;[371] FINISH UP MSG AND STOP RUN OPNI07: ;[371] MOVE AC6,ORCBYT(I12) ;[515] GET BLOCKFTR AT RESET CAMGE AC6,RECBYT(I12) ;[535] [515] MUST = OR LESS THAN FILE OPENED JRST OPNER2 ;[515] NOT THE SAME TROUBLE MOVE AC6,F.WIKD(I16) ;[535] [515] GET KEY DESC. FROM PROG CAMN AC6,KEYDES(I12) ;[515] MUST BE THE SAME AS FILE OPENED JRST OPNI7A ; ELSE CONT NEXT TEST LDB AC10,KY.TYP ; GET KEY TYPE IN AC10 CAIL AC10,3 ; CHECK FOR VARIOUS FLAVORS OF COMP KEYS; CAILE AC10,5 ; 3= 1WD COMP, 4=2WD COMP, 5=COMP-1 JRST OPNI7D ; NOT COMP, GIVE WARNING ; COMP, CHECK WITHOUT SIZE FIELD TRZ AC6,KEYSIZ ; CLEAR SIZE FIELD MOVE AC10,KEYDES(I12) ; GET ISAM DESCP. TRZ AC10,KEYSIZ ; CLEAR SIZE HERE TOO CAIN AC6,(AC10) ; OK NOW? JRST OPNI7A ; YES, CONT OPNI7D: OUTSTR [ASCIZ / [Key descriptor of /] PUSHJ PP,MSFIL. ; PRINT FILE NAME OUTSTR [ASCIZ / differs from program] /] ;[535] YOUR ON YOUR OWN AFTER THIS OPNI7A: MOVE AC6,F.WBRK(I16) ;[574] GET PROGRAM KEY POINTER CAMN AC6,DBPRK(I12) ;[574] MUST BE SAME AS FILE OPENED JRST OPNI7B ; ELSE CONT ;[617] BYTE PTRS ARE NOT THE SAME, MAY BE BECAUSE OF MODE TRANSLATION ;[617] CALC BYTE OFFSET TO THE BEGINING OF THE KEY AND COMPARE THIS ;[617] CHECK FOR THE SPECIAL CASE OF COMP LDB AC10,KY.TYP ;[617] GET KEY TYPE IN AC10 CAIL AC10,3 ;CHECK FOR VARIOUS FLAVORS OF COMP KEYS; CAILE AC10,5 ;3= 1WD COMP, 4=2WD COMP, 5=COMP-1 JRST OPNI7C ;[617] NOT COMP, JUMP TO BYTE POS CHECK ; 4/28/80: EDIT 617 ENHANCED TO ALSO CHECK FOR COMP-1. ; THE COMPILER GENERATES A 9-BIT BYTE PTR FOR COMP THINGS, ;; AND ISAM DOES NOT. SOMEDAY THE COMPILER COULD BE FIXED SO ;; THIS CODE IS UNNECESSARY. HRRZ AC10,F.WBRK(I16) ;[617] PUT WORD OFFSET OF KEY IN AC10 HRRZ AC6,DBPRK(I12) ;[617] PUT ISAM-GENERATED WORD OFFSET IN AC6 CAMN AC10,AC6 ;[617] IF THEY MATCH, SKIP PRINTING JRST OPNI7B ;[617] OF ERROR MESSAGE ; ELSE ERROR, RESET WORD OFFSET TO BYTE OFFSET FOR MESSAGES LDB AC3,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC3,RBPTBL(AC3) ; AND THEN CHARS PER WORD IMULI AC10,(AC3) ; RESET PRG OFFSET TO BYTES IMULI AC6,(AC3) ; RESET ISAM OFFSET TO BYTES JRST OPNERR ; ERROR ;[617] FIRST CALC BYTE OFFSET FOR THE IDX STAT DESCRIPTION OPNI7C: LDB AC3,KY.MOD ;[617] GET MODE OF KEY HRRZ AC3,RBPTB1(AC3) ;[617] GET BYTES PER WORD LDB AC0,[POINT 6,DBPRK(I12),5] ;[617] GET BIT OFFSET FOR IDX STAT LDB AC1,[POINT 6,DBPRK(I12),11] ;[617] GET BITS PER BYTE IDIV AC0,AC1 ;[617] CALC NUMBER BYTES IN FIRST WORD OF KEY MOVE AC1,AC3 ;[617] GET BYTES PER WORD SUB AC1,AC0 ;[617] CALC NUMBER OF BYTES BFR KEY IN FIRST WD HRRZ AC6,DBPRK(I12) ;[617] GET NUM FULL WORDS TO KEY IMULI AC6,(AC3) ;[617] CALC NUMBER BYTES TO KEY (FULL WDS) ADD AC6,AC1 ;[617] PLUS PARTIAL = BYTES TO KEY FOR IDX STAT ;[617] CALC NUMBER OF BYTES TO BEGIN OF KEY IN INTERNAL RECORD FORMAT LDB AC3,[POINT 2,FLG,14] ;[617] GET CORE DATA MODE HRRZ AC3,RBPTBL(AC3) ;[617] AND THEN CHARS PER WORD LDB AC0,[POINT 6,F.WBRK(I16),5] ;[617] GET BIT OFFSET FOR IDX STAT LDB AC1,[POINT 6,F.WBRK(I16),11] ;[617] GET BITS PER BYTE IDIV AC0,AC1 ;[617] CALC NUMBER BYTES IN FIRST WORD OF KEY MOVE AC1,AC3 ;[617] GET BYTES PER WORD SUB AC1,AC0 ;[617] CALC NUMBER OF BYTES BFR KEY IN FIRST WD HRRZ AC10,F.WBRK(I16) ;[617] GET NUM FULL WORDS TO KEY IMULI AC10,(AC3) ;[617] CALC NUMBER BYTES TO KEY (FULL WDS) ADD AC10,AC1 ;[617] PLUS PARTIAL = BYTES TO KEY FOR PROGRAM CAIN AC6,(AC10) ;[617] IS THE BYTE OFFSET TO THE KEY THE SAME?? JRST OPNI7B ;[617] YES, CONT ;[617] NO, TOO BAD OPNERR: OUTSTR [ASCIZ /?Key pointer of /] PUSHJ PP,MSFIL. ;[617] PRINT FILE NAME OUTSTR [ASCIZ / differs from program ./] ;[617][574] OUTSTR [ASCIZ / Program key starts at byte /] MOVE AC0,AC10 ; GET OFFSET TO PROGRAM KEY PUSHJ PP,PUTDEC ; PRINT IT OUTSTR [ASCIZ / ISAM file key starts at byte /] MOVE AC0,AC6 ; GET ISAM KEY START POSITION PUSHJ PP,PUTDEC ; PRINT IT JRST OPNERX ; ERROR MESS AND KILL OPNI7B: PUSHJ PP,OPNWPB ;AC5 = BLKFTR, AC10 = WPB ;BL; 2 LINES INSERTED AT OPN17B + 1 TO FIX ISAM/RANDOM SHARED BUFFR BUG TLNE FLG,IDXFIL ;ISAM FILE? SKIPN PAGBUF(I12) ;YES, & PAGE I/O TOO? JRST OPNI7E ; NO ADDI AC10,777 ; YES, AT LEAST 512 WD/PG LSH AC10,-9 ; ROUND LSH AC10,9 ; OFF OPNI7E: 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 PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Users blocking factor /] ; [371] MOVE AC0,AC5 ;[371] GET USER BF PUSHJ PP,PUTDEC ;[371] TYPE IT OUTSTR [ASCIZ / differs from ISAM parameter /] ;[371] MOVE AC0,AC6 ;[371] GET ISAM BF PUSHJ PP,PUTDEC ;[371] TYPE IT OPNERX: MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. OPNER2: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /RESET maximum record size /] ;[515] MOVE AC0,AC6 ;[515] GIVE HIM RESET VALUE PUSHJ PP,PUTDEC ;[515] TYPE IT OUTSTR [ASCIZ / differs from OPEN maximum size /] ;[515] MOVE AC0,RECBYT(I12) ;[515] GET OPEN VALUE PUSHJ PP,PUTDEC ;[515] TYPE IT JRST OPNERX ;[515] FINISH UP AND GET OUT OPNER4: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF OUTSTR [ASCIZ /Entries per index block at OPEN /] PUSHJ PP,PUTDEC ;[515] TYPE OPEN VALUE OUTSTR [ASCIZ / differs from RESET value /] MOVE AC0,OEPIB(I12) ;[515] GET RESET VALUE PUSHJ PP,PUTDEC ;[515] TYPE VALUE JRST OPNERX ;[515] AND GET OUT ;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) ; CAMLE AC0,OEPIB(I12) ;[535] [515] IS IT THE SAME AS RESET? JRST OPNER4 ;[515] NO TROUBLE 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 # IFN ISTKS,< MOVE AC0,[INSSSS(LVL)] ADD AC0,I12 MOVEM AC0,INSSS0(I12) MOVE AC0,[OUTSSS(LVL)] ADD AC0,I12 MOVEM AC0,OUTSS0(I12) > ;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 ; FOR ANS74 RESERVE ANOTHER COPY OF THE KEY FOR REWRT/DEL ; SAVE OF CNTRY KEY VALUE, THE INDEXED ADJ VERSION OF THE KEY ; (LEFT JUSTIFIED) WILL BE KEPT IFN ANS74,< MOVEM AC1,RWDLKY(I12) ; SAVE ADDR OF KEY SAV AREA MOVE AC2,IESIZ(I12) ; RESERVE ROOM FOR SUBI AC2,1 ; COPIES OF IAK AND DAK KEYS LSH AC2,1 ; MULTIPLE BY 2 ADDI AC1,2(AC2) ; AND ADD IN EXTRA 2 WORDS ALLOWED FOR ; IN OPNI05 FRO INDEX HDR WDS MOVEM AC1,RWDLRT(I12) ; And a save area for RETAIN too ADDI AC1,2(AC2) ; > ;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 OUTSTR [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, IC