TITLE CBLIO FOR LIBOL 16-JAN-75 SUBTTL EDIT HISTORY ;COPYRIGHT 1974, 1975 DIGITAL EQUIPMENT CORP., MAYNARD, MASS. EDIT==420 ;********* MODIFIED TO SUPPORT RPGII 5/29/76 ********* ; ;ALL RPGII MODIFICATIONS COPYRIGHT 1976, BOB CURRIER AND CERRITOS COLLEGE ;***** V10 ***** ; 420 17-OCT-75 JEC ; FIX SPACING WITH NO PAGE HEADER. - LINE - ; 417 21-OCT-75 JEC ; MAKE SURE THAT CSORT TAKES NO MORE THAN 6 CHANNELS - CSORT - ; 416 25-SEP-75 JEC ; FIXED FUNCOR ROUTINE TO RETURN START ADDRESS. ; NOT IN V10 - COBFUN WAS EXTENSIVLY MODIFIED WHICH FIXED THE PROBLEM. ; 415 25-SEP-75 JEC ; FIX EDIT 334 SO THAT SINGLE DIGTIT TESTS WORK. ; NOT IN V10 - NUMBRS WAS REWRITTEN. ; 414 27-AUG-75 JEC SPR-16722 ; PUT IN INTERRUPT CODE FOR ON-LINE PRINTER AND SET LPT BUFFER TO 1. ; 413 30-JUN-75 JEC SPR-16266 ; FIX MESSAGE THAT BEGINS WITH " SO IT DOESN'T GO TO CTY. ; 412 30-JUN-75 JEC SPR-16175 ; FIX CALCULATION OF POINTER FOR UNSTRING WHEN DELIMITER IS "ALL". ; MARCH 12, 1975 ADDITION OF SUSPC, SUSPC1 SUBROUTINES TO ; RESET FOR THE PURPOSE OF COMPUTING THE SPACE REQUIRED BY ; SIMULTANEOUS UPDATE, AND GETTING IT. ALSO ADDITION OF THE ; CALL TO THESE SUBROUTINES IN RESET. GIL STEIL ; 16-JAN-75 /ACK 1. CHANGE REFERENCE TO PARAMETER FILE ; LBLPRM TO REFERENCE UNIVERSAL ; FILE LBLPRM. ; 2. ADD CODE FOR SETTING UP THE PUSH DOWN ; LIST WITH THE VALUE SUPPLIED BY ; THE USER WHEN HE COMPILED THE ; PROGRAM ;********** VERSION 7A RELEASE ********** ; EDIT 411 MAKE SURE LPT DEVICE DOES NOT CAUSE "ILLEGAL MODE" MONITOR MESSAGE AT RESET TIME. ; ALSO FIX RECOVERY FROM "EOF FOUND INSTEAD OF A LABEL". ; EDIT 410 PUT OUT "$" IN MESSAGE TO TRY ANOTHER MAG TAPE SO OPERATOR SEES THE ; MESSAGE, WHEN THE JOB IS RUNNING UNDER BATCH ; SPR 15662 ; EDIT 407 IF POSSIBLE OUTPUT PHYSICAL DEVICE NAME ; AS WELL AS LOGICAL DEVICE NAME- FOR DEVICE MESSAGES ; SPR 15184 ; EDIT 406 FIX SORT RELEASE LENGTH CALCULATION SO WORD SIZE AGREES WITH INTERNAL RECORD MODE ; SPR 15189. ; EDIT 405 SET UP REF I12 FOR ISAM FILES AT MSVID FOR FILE VALUE OF ID PRINTOUT. ; EDIT 404 IN LINE.MAC FIX SPACING FOR RPT WRITER ; SPR 14927 ; EDIT 403 PUT IN SIRUS CODE AND TRAILING BLANK SUPPRESSION (SWITCH OPTION) ; EDIT 402 FIX CORE PROBLEM IN CSORT; FOR .JBFF VS .JBREL ; EDIT 401 FIX EDIT SO THAT ZERO SUPPRESSION NO LONGER HAPPENS AFTER A 9'S FIELD IS SEEN ; SPR 14617 ; EDIT 400 FIX COBFUN SO THAT CHANNEL 0 IS OBTAINED LAST ; EDIT 377 FIX ISAM BUFFER PROBLEM IF ISAM FILE IS ; SHARED AREA (BUFFER) WITH ANY OTHER FILE. ; EDIT 376 GIVE A MEANINFUL ERROR MSG IF UNEXPECTED EOF ON ISAM IDX FILE IS SEEN ; SPR 14453 ; EDIT 375 ADD TO EDIT 371- IF ISAM FILE OPEN FOR INPUT ALLOW ; FD > OR = TO ISAM MAX REC SIZE- AND IF FILE OPEN FOR OUTPUT ALLOW ; FD < OR = TO ISAM MAX REC SIZE. ; EDIT 374 FIX TEST FOR OPTIONAL ISAM FILE AT RESET TIME ; EDIT 373 FIX UP CLOSE WITH DELETE FOR DTA FILES. ; EDIT 372 CORRECT BLOCK FACTOR CALC FOR ASCII NON-ISAM FILES ; EDIT 371 CHECK THAT USERS MAX REC DESC SAME AS ISAM MAXREC PARM. ; SPR 13772 ;EDIT 370 SEQUENTIAL READING OF AN ISAM FILE MAY OCCASIONALLY ; MISS SEVERAL RECORDS. THE PROBLEM OCCURS WHEN THE ; SYMBOLIC KEY IS A NUMERIC DISPLAY ITEM AND A VERSION ; NUMBER ERROR OCCURS. ;EDIT 343 THROUGH 367 ARE RESERVED FOR DEVELOPMENT ;********* VERSION 7 RELEASE ********** ;EDIT 347 FIX STRING TO SPACE FILL EVEN IF NO UNSTRING ;EDIT 346 CBLIO - LIBIMP - CSORT ; MAKE OVERLAYS WORK. CHECK THAT NO IO IS DONE IN AN ; OVERLAY. WHEN ALLOCATING ISAM BUFFER SPACE BE SURE ; YOU DON'T OVERLAP THE OVERLAY AREA, GIVE ERROR MESSAGE. ;EDIT 345 RE-ADJUST SUBROUTINES DISPATCH TABLE SIZE FOR MCS ;EDIT 344 FIX MEMORY MANAGEMENT BUG IN CSORT ;EDIT 343 THIS FIX PREVENTS AN EXTRA BLOCK FROM BEING APPENDED TO ; A BINNARY FILE WHEN THE OUTPUT DEVICE IS A DTA (QAR-40) ;EDIT 342 MAKE EDIT 333 WORK FOR PROGRAMS WO/R SWITCH ; AND MAKE CHN 0 THE LAST ONE USED (FOR RERUN) ; CHANGES TO OVRLAY.MAC AND COBRG OF COMPILER ; ALSO REQUIRES COBST ROUTINE IN LIBOL ;EDIT 341 FIX POSITIONING ; MULTI-FILE LABELLED REELS W/NO ; POSITION CLAUSES ;EDIT 340 UPDATE JOBDAT SYMBOLS, CHANGES IN CSORT,UUO ;EDIT 337 FIX IN ACCEPT, NOT IN CBLIO, SEE JC ;EDIT 336 FIX FILE POSITIONING FOR MULTI-FILE TAPES ;EDIT 335 FIX GARBAGE IN RECORD W/VARIABLE LENGTH ISAM RECS ;EDIT 334 NOT IN CBLIO. JOHN DID EM ;EDIT 333 GET OVERLAY FILE FROM SAME PLACE AS MAIN PROGRAM ;EDIT 332 HANDLE VARIABLE LENGTH RECORDS FOR STAND ALONE SORT ;EDIT 330 FIX READING FROM NUL DEVICE SO THAT CBLIO DOESN'T CONFUSE IT WITH MTA ;EDIT 327 FIX STD LABELS FOR MTA WHEN READING > REEL 9 ;EDIT 326 CHANGED CHTAB SO THAT 173 TO 20(ZERO) AND 175 TO 32 (:) ; WHEN READING ASCII FILE TO SIXBIT RECORD JEC ;EDIT 325 FIX SPACING AND REPORT CODE FOR REPORT GEN IN LINE.325 JEC 4/5/74 ;EDIT 324 FIX APPENDING TO RANDOM ACCESS FILES READ TO END ;EDIT 323 DONT DO ENTER WHEN LOOKUP OF ISAM DATA FILE FAILS ;EDIT 322 FIX APPENDING OF RECORDS FOR SEQUENTIAL I/O ;EDIT 321 LIBOL REFUSES TO TAKE A RERUN DUMP IF A FILE IS ASSIGNED ; TO THE NULL DEVICE ;EDIT 320 ISAM - "MEM-PRO-VIO..." WHEN ZEROING FREE CORE AT UDIF11 ;EDIT 317 MOVE THE TEST FOR EBCDIC FILES INTO THE MAIN LOOP ;EDIT 316 FIXES "ADDRESS CHECK..." WHEN SORT FILE SHARES SAME BUFFER AREA ;EDIT 315 FIX TO EDIT 301 ILG 1-FEB-74 ;EDIT 314 *CSORT* PREFIX "?" TO "ERROR IN SORT I-O" MESSAGE ;EDIT 313 *CSORT* FIX REDUNDANT "RECORDS SORTED" ;EDIT 312 IF "ILL-MEM-REF" IN RSTLNK ROUTINE TELL USER HE MAY HAVE LOADED A MACRO ROUTINE IN PLACE OF COBOL SUBROUTINE ;EDIT 311 ISAM - "MEMORY PROTECTION VIOLATION" WHEN WRITING AFTER SPLITING THE TOP INDEX BLOCK ;EDIT 310 ISAM - "?KEYS OUT OF ORDER" CAUSED BY TESTING THE WRONG FLAG WORD ;EDIT 307 ISAM FILE READER GETS "VERSION NUMBER DISCREPANCY" WHEN A WRITER CREATES A NEW INDEX LEVEL ;EDIT 306 ISAM - OPNI03 ASSUMES A 200 WORD BUFFER SIZE BUT IT MAY BE LARGER ;EDIT 305 CHANGE "NOT A LEGAL SIXBIT FILE" ERROR MS TO INDICATE THAT INCORRECT BLOCKING FACTOR COULD BE CAUSE. ;EDIT 304 CORRECT VALUE OF ID AS GIVEN AFTER LOOKUP OR ENTER FAILS ;EDIT 303 FIX TO REPORT-WRITER ;EDIT 302 CORRECT MAG-TAPE POSITION AFTER READING LABELLED FILE ;EDIT 301 DO AN ENTER ON NON-DIRECTORY DEVICES FOR DIRECT,LPTSPL,ETC. ;EDIT 300 HANDLE NULLS IN ASCII RANDOM FILES CORRECTLY ;EDIT 277 PRECEDE ALL ERROR MESSAGES HAVING TO DO WITH POSSIBLE WRONG REELS OR OPTIONAL FILES WITH "$" ;EDIT 276 DUPLICATE ISAM RECORDS IF DATA MODE DIFFERS BTWN RECORD AND DATA FILE ;EDIT 275 CODE TO CORRECT LOW-VALUES READ FOR ISAM AFTER INVALID KEY PATH TAKEN ;EDIT 274 CODE TO SUPPORT THE DATE75 FORMAT I.E. 15 BIT WIDE DATES ;EDIT 273 FIRST RANDOM READ WITH AN ACTUAL KEY POINTING BEYOND THE "EOF" DOES NOT TAKE THE INVALID KEY RETURN ;EDIT 272 TYPE THE VERSION # NOT JUST EDIT # WITH ERROR MESSAGES ;EDIT 271 FIXES "VERSION NUMBER DISCREPANCY..." WHEN MORE THAN ONE SECTOR PER LOGICAL BLOCK ;EDIT 270 STOPS "ILL-UUO-AT-PC..." WHEN TYPING OUT LIBOL ERROR MESSAGE ;EDIT 267 CHANGE GETCH. ROUTINE SO ^U WILL RUBOUT TYPED AHEAD CHARACTERS SUBTTL PICK UP UNIVERSALS AND SET UP JOBDAT. IFE %%RPG,< SEARCH LBLPRM ;DEFINE PARAMETERS. %%LBLP==:%%LBLP > IFN %%RPG,< SEARCH RPGPRM, RPGUNV > SEARCH COMUNI %%COMU==:%%COMU INFIX% ISAM==:ISAM EBCMP.==:EBCMP. SEARCH FTDEFS ;FILE-TABLE DEFINITIONS %%FTDF==:%%FTDF IFE %%RPG,< ENTRY C.RSET ;MAKE SURE WE GET LOADED. LOC 124 ;.JBREN EXP RENDP ;TO FORCE A DUMP. VERWHO==0 VERMJR==10 VERMNR==0 VEREDT==EDIT VERSION==BYTE(3)VERWHO(9)VERMJR(6)VERMNR(18)VEREDT PURGE VERWHO,VERMJR,VERMNR,VEREDT LOC 137 ;.JBVER EXP VERSION VERSION==B53&77777 ;FOR LATER REFERENCE. > ; END OF IFE %%RPG IFNDEF EBCLBL, IFNDEF TOPS20, ; JSYS SWITCH IFNDEF SUPPTB, ; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES. IFNDEF EBCMP., HISEG SUBTTL CONSTANTS AC0==0 ;AC ASSIGNMENTS AC1==1 AC2==2 AC3==3 AC4==4 AC5==5 AC6==6 FLG==7 AC10==10 AC11==11 C==11 AC12==12 I12==12 AC13==13 LVL==13 AC14==14 FLG1==14 AC15==15 AC16==16 I16==16 PP==17 REPEAT 0,< ;FLAGS IN LEFT SIDE OF "F.WFLG(I16)" BEFORE RESET 400000==400000 ;VARIABLE LENGTH EBCDIC RECORDS NONSTD==100000 ;NON STANDARD LABELS STNDRD==40000 ;STANDARD LABELS OPNIO==4000 ;FILE IS AN INPUT/OUTPUT FILE BIT 7-9 ;0 = SIXBIT DEVICE DATA MODE ;1 = BINARY ;2 = ASCII ;3 = EBCDIC ;4 = ASCII-8 ;5-7 NOT USED RRUNER==200 ;RERUN DUMP AT END-OF-REEL RRUNRC==100 ;RERUN DUMP VIA RECORD-COUNT FILOPT==20 ;OPTIONAL FILE BIT 14-15 ;0 = SIXBIT CORE DATA MODE ;1 = BINARY ;2 = ASCII ;3 = EBCDIC BIT 16-17 ;0 = SEQUENTIAL FILE ;1 = RANDOM FILE ;2 = INDEXED-SEQ FILE ;3 = NOT USED > HUF==1 LOCK==2 ;CONSTANTS FOR CONSTRUCTION OF ERROR NUMBERS E.VOPE==^D100000000 ;COBOL VERB OPEN E.VCLO==^D200000000 ; CLOSE E.VWRI==^D300000000 ; WRITE E.VREW==^D400000000 ; REWRITE E.VDEL==^D500000000 ; DELETE E.VREA==^D600000000 ; READ E.VRET==^D700000000 ; RETAIN E.MINP==^D1000000 ;MONITOR INPUT ERROR E.MOUT==^D2000000 ; OUTPUT E.MLOO==^D3000000 ; LOOKUP E.MENT==^D4000000 ; ENTER E.MREN==^D5000000 ; RENAME E.MOPE==^D6000000 ; OPEN E.MFOP==^D7000000 ; FILOP E.FIDX==^D10000 ;ISAM INDEX FILE E.FIDA==^D20000 ;ISAM DATA FILE E.FSEQ==^D30000 ;SEQUENTIAL FILE E.FRAN==^D40000 ;RANDOM FILE E.BSTS==^D1000 ;ISAM STATISTICS BLOCK E.BSAT==^D2000 ;ISAM SAT BLOCK E.BIDX==^D3000 ;ISAM INDEX BLOCK E.BDAT==^D4000 ;ISAM DATA BLOCK ;FLAGS IN LEFT SIDE OF "FLG" & F.WFLG(I16) AFTER RESET. ; **WARNING** DO NOT DISTURB DDM??? OR CDM??? DDMASC==400000 ;DEVICE DATA MODE IS ASCII DDMSIX==200000 ;DEVICE DATA MODE IS SIXBIT DDMEBC==100000 ;DEVICE DATA MODE IS IBCDIC DDMBIN==40000 ;DEVICE DATA MODE IS BINARY OPNIN==20000 ;FILE IS OPEN FOR INPUT OPNOUT==10000 ;FILE IS OPEN FOR OUTPUT OPNIO==4000 ;FILE IS AN INPUT/OUTPUT FILE ATEND==2000 ;AN "EOF" WAS SEEN CONNEC==1000 ;DEVICE & CORE DATA MODES DIFFER NOTPRS==400 ;OPTIONAL FILE NOT PRESENT RRUNER==200 ;RERUN DUMP AT END-OF-REEL RRUNRC==100 ;RERUN DUMP VIA RECORD-COUNT CDMASC==40 ;CORE DATA MODE IS ASCII CDMSIX==20 ;CORE DATA MODE IS SIXBIT CDMEBC==10 ;CORE DATA MODE IS EBCDIC IDXFIL==4 ;ACCESS MODE IS INDEX-SEQUENTIAL SEQFIL==2 ;ACCESS MODE IS SEQUENTIAL RANFIL==1 ;ACCESS MODE IS RANDOM ;FLAGS IN LEFT SIDE OF FLG1 & D.F1(I16) AFTER RESET. VLREBC==400000 ;VARIABLE LENGTH EBCDIC RECORDS FILOPT==200000 ;FILE IS OPTIONAL NONSTD==100000 ;LABELS ARE NON-STANDARD STNDRD==40000 ;LABELS ARE STANDARD F1CLR==3777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME FOPERR==2 ; FILOP.UUO FAILED IFN ISAM,< NOTEST==2000 ;SKIPE THE CONVERSION TEST AT ADJKEY [EDIT#276] WSTB==1000 ;WRITE THE STATISTICS BLOCK IIAB==400 ;INSERTION IS IN AUX BUFFER TRYAGN==200 ;MAKE A SECOND PASS AT ALC01 OR DON'T AT VNDE BVN==100 ;BUMP-VERSION-NUMBER SPLITTING A BLOCK WSB==40 ;WRITE THE SAT BLOCK BLK2==20 ;REQ FOR 2ND DATA BLOCK SEQ==10 ;SEQUENTIAL READ VERR==4 ;VERSION NUMBER DISCREPANCY BTWEEN INDEX LEVELS WIVK==2 ;WRITE INVALID-KEY FOPIDX==2 ;FILOP OF NAME.IDX IN PROGRESS RIVK==1 ;READ, RERIT OR DELET INVALID-KEY EIX==1 ;ENTER OF NAME.IDX IN PROGRESS > ;FLAGS IN LEFT SIDE OF AC16 FOR DURATION OF CURRENT COBOL UUO WADV==400000 WRITE==200000 READ==100000 OPEN==40000 CLOSEF==20000 ;EOF CLOSER==10000 ;EOV CLOSEB==4000 ;HDR RERIT==10 ;ISAM REWRITE DELET==4 ;ISAM DELETE SLURP==2 ;WRITE REEL CHANGE, RESTORE THE RECORD AREA MTAEOT==1 ;END-OF-TAPE BUFLOC==4000 ;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF 5(I16) SRTFIL==2000 ;[316];THIS IS A SORT FILE, LEFT-HALF OF 5(I16) OEUP==4000 ;OPEN ERROR USE PROCEDURE - ENTER ERROR FILE BEING MODIFIED, BIT 6 OF 22(I16) SASCII==1 ; REQUEST FOR STANDARD ASCII, IN D.RFLG TAPOP.==CALLI 154 ; FOR TU70'S 1600 BPI AND STANDARD ASCII .TFKTP==1002 ; FUNCT TO GET CONTROLER TYPE .TC10C==2 ; CONTROLLER FOR A TU43 .TX01==3 ; CONTROLLER FOR A TU70 .TM02==4 ; CONTROLLER FOR A TU16 .TFMOD==2007 ; FUNCT TO SET STANDARD ASCII MODE .TFM8B==2 ; CODE FOR INDUSTRY-COMPATIBLE .TFM7B==4 ; CODE FOR STANDARD ASCII .TFSDN==2001 ; FUNCT TO SET DENSITY .TFGDN==1001 ; FUNCT TO GET DENSITY FILOP.==CALLI 155 ; FOR SIMULTANEOUS UPDATE ;CONSTANTS FOR EXTENDED LOOKUP BLOCK .RBPPN==1 .RBNAM==2 .RBEXT==3 .RBPRV==4 .RBSIZ==5 R.IOWD==0 ; IOWRD FOR RANDOM/IO FILES R.TERM==1 ; IOWRD TERMINATOR R.BPNR==2 ; BYTE POINTER TO NEXT RECORD IN BUFFER R.BPLR==3 ; LAST RECORD R.BPFR==4 ; FIRST RECORD R.DATA==6 ; BUFFER HAS ACTIVE DATA TO BE WRITTEN OUT R.WRIT==7 ; LAST IO OPERATION FOR THIS FILE WAS A WRITE R.FLMT==10 ; AOBJ POINTER TO FILE LIMITS SUBTTL EXTERNALS. EXTERNAL LIBIMP ;CAUSES LIBREL ( LIBOL.LOW) TO BE LOADED FOR /R EXTERNAL INTBLK,.JBINT ; [414] EXTERNAL IIN,IOUT,ISETI,ISETO,ICLOS,IRELE,IGETS,IWAIT,IRNAM EXTERNAL MWAIT.,MREW.,MREWU.,MBSPR.,MBSPF.,MADVR.,MADVF.,MWEOF.,MTIND. EXTERNAL SOBOT.,SZBOT.,SZEOF.,SZEOT. EXTERNAL UOPEN.,UENTR.,ULKUP.,UOBUF.,UIBUF.,UCLOS.,URELE.,USETI. EXTERNAL USETO.,UOUT.,UIN.,USETS.,UGETS.,UWAIT.,USEEK.,URNAM. EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV. EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB. EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,AINFO.,OVRBF.,FLDCT.,OVRIX. EXTERNAL NOCR.,PRGFLG,TTYOPN,ACSAV0,MXIE,IESAVE,MXBUF,AUXBUF,AUXIOW,AUXBNO,CMDLST,NEWBK1 EXTERNAL NEWBK2,OLDBK,MXBF,DRTAB,LRWA EXTERNAL FS.ZRO,FS.FS,FS.EN,FS.BN,FS.RN,FS.UPD,FS.IGE,FS.IF,ISETS,FS.IEC EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6 IFN EBCMP. < EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9 > EXTERNAL FRSTIC,LASTIC,PFRST.,UFRST.,ULAST.,IFRST.,ILAST. EXTERNAL RELEN. ;[332] EXTERNAL RUN.TM ;[333] EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,SBPSA. IFE %%RPG,< EXTERNAL SU.RBP,SU.CL,SU.WR,SU.RD,SU.DL,SU.RW ;SIMULTANEOUS UPDATE > EXTERN FOP.BK,FOP.IS,FOP.DN,FOP.LB ;SIMULTANEOUS UPDATE IFE %%RPG,< EXTERN SU.FRF ;FAKE READ FLAG INTERN FAKER.,IGSS,RANFIL,IDXFIL,E.VRET,D.RP,D.CBN,D.CN,D.BL ;SIMULTANEOUS UPDATE INTERN DSPLY. > EXTERN .JBSA,.JBFF,.JBREL,.JB41,.JBAPR,.JBTPC,.JBCNI,.JBVER,.JBDA,.JBOPC,.JBREN EXTERN .JBOPS INTERN C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH. INTERN OUT6B.,OUTBF.,READ.,RSTAB.,SEEK.,STOPR.,C.STOP,TODAY.,TRAP.,WRITE.,WADV.,WRPW. INTERN GOTO.,KILL.,PPOUT.,ULOSE. EXTERNAL RET.1,RET.2,RET.3,UUO. INTERN DELET.,RERIT.,PURGE. EXTERNAL HLOVL. ;[346] XWD HIGHEST OVERLAY LOC , LOWEST LOC IFN ISAM, ;[370] IFN ISAM, EXTERNAL FILES.,USES. IFE %%RPG,< EXTERN RN.PPN,RN.DEV,RN.NAM,OVRFN.,TRAC1.,SEGNO. > IFN %%RPG,< INTERN OUTBF1, WAD2, SETCN. > IFN ISAM,< ADR==0 DEFINE TABADR(N,L) < N==ADR ADR==ADR+L > TABADR STAHDR,1 ;SIZE OF STATISTICS BLOCK IN SIXBIT BYTES TABADR DDEVNM,1 ;DATA FILE'S DEVICE NAME TABADR DFILNM,1 ;DATA FILE'S FILE NAME TABADR DEXT,1 ;DATA FILE'S EXTENSION TABADR DCDATE,1 ;DATA FILE'S CREATION DATE TABADR DADATE,1 ;DATA FILE'S ACCESS DATE TABADR MXLVL,1 ;NUMBER OF LEVELS IN INDEX FILE TABADR DBF,1 ;DATA FILE BLOCKING FACTOR TABADR DMTREC,1 ;NUMBER OF EMPTY RECORDS PER DATA BLOCK TABADR EPIB,^D20 ;TWO WORDS PER INDEX LEVEL ;FIRST WORD: NUMBER OF ENTRIES PER INDEX BLOCK ;SECOND WORD: NUMBER OF EMPTY ENTRIES TABADR DMXBLK,1 ;TOTAL BLOCKS IN DATA FILE TABADR DMTBLK,1 ;EMPTY BLOCKS IN DATA FILE TABADR IMXSCT,1 ;TOTAL SECTORS IN INDEX FILE TABADR IMTSCT,1 ;EMPTY SECTORS IN INDEX FILE TABADR FMTSCT,1 ;FIRST EMPTY SECTOR IN INDEX FILE TABADR DMXREC,1 ;MAXIMUM DATA RECORD SIZE IN WORDS TABADR DBPRK,1 ;BYTE POINTER TO RECORD KEY RELATIVE TO DATA RECORD TABADR RWRSTA,1 ;NUMBER OF READ, WRITE, REWRITE STATEMENTS SINCE INITIALIZATION TABADR IOUUOS,1 ;NUMBER OF IN'S AND OUT'S SINCE INITIALIZATION TABADR SBLOC,1 ;RELATIVE ADR OF FIRST SAT BLOCK TABADR SBTOT,1 ;TOTAL SAT BLOCKS TABADR ISPB,1 ;INDEX FILE, SECTORS PER LOGICAL BLOCK TABADR FILSIZ,1 ;MAXIMUM POSSIBLE NUMBER OF DATA BLOCKS IN FILE TABADR KEYTYP,0 ;KEY-TYPE IN LEFT HALF TABADR KEYDES,1 ;DESCRIPTION OF RECORD KEY TABADR IESIZ,1 ;INDEX ENTRY SIZE IN WORDS TABADR TOPIBN,1 ;TOP INDEX BLOCK NUMBER TABADR %DAT,1 ;% OF DATA FILE EMPTY TABADR %IDX,1 ;% OF INDEX FILE EMPTY TABADR RECBYT,1 ;SIZE OF LARGEST DATA BLOCK IN BYTES TABADR MAXSAT,1 ;MAX # OF RECORDS FILE CAN BECOME TABADR ISAVER,1 ;"ISAM" VERSION NUMBER STABL==ADR ;EQUALS SIZE OF STATISTICS BLOCK TABADR IOWRD,14+1 ;TABLE OF DUMP MODE IOWD'S FOR EACH INDEX LEVEL ;0 DATA BLOCK ;1-12 INDEX BLOCKS ;13 SAT BLOCK ;14 STATISTICS BLOCK TABADR OMXLVL,1 ;ORIGINAL MAX NUMBER OF LEVELS IN INDEX FILE TABADR CORE0,1 ;LAST,,FIRST - CORE AREA CLEARED AT CLOSE TABADR ICHAN,1 ;CHANNEL NUMBER FOR INDEX DEVICE TABADR USOBJ,14+1 ;USETI/O OBJECT: DATA, 10 INDEX, SAT & STA TABADR CNTRY,14+1 ;CURRENT INDEX ENTRY TABADR NNTRY,14+1 ;FLAG, CNTRY POINTS TO NEXT ENTRY NOT CURRENT TABADR LIVE,1 ;(-1) IF DATA NOT YET OUTPUT TABADR BRISK,1 ;IF -1 OUTPUT ONLY WHEN INPUT IS EMINENT TABADR CLVL,1 ;CURRENT LEVEL TABADR IAKBP,1 ;INDEX ADJUSTED SYMBOLIC KEY BYTE-POINTER TABADR IAKBP1,1 ;POINTER TO SECOND KEY WORD TABADR DAKBP,1 ;DATA ADJUSTED SYMBOLIC KEY BP TABADR DAKBP1,1 ;POINTER TO THE SECOND KEY WORD TABADR SINC,1 ;BINARY SEARCH INCREMENT TABADR IBLEN,1 ;INDEX BLOCK LENGTH NOT COUNTING HEADERS TABADR IKWCNT,1 ;INDEX, NUMBER OF WORDS IN THE KEY TABADR DKWCNT,1 ;DATA, NUMBER OF WORDS IN KEY TABADR FWMASK,1 ;MASK FOR FIRST WORD OF DATA KEY TABADR LWMASK,1 ;MASK FOR LAST WORD OF DATA KEY TABADR ICMP,1 ;HOLDS ADR OF THE INDEX COMPARE ROUTINE TABADR DCMP,1 ;HOLDS ADR OF DATA COMPARE OR CONVERT ROUTINE TABADR DCMP1,1 ;HOLDS ADR OF DATA COMPARE ROUTINE IF KEY IS NUMERIC DISPLAY TABADR GDX.I,1 ; ADR OF CONVERT ROUTINE -- SK VS INDEX-ENTRY TABADR GDX.D,1 ; ADR OF CONVERT ROUTINE -- SK VS DATA FILE KEY TABADR GDPSK,1 ;PARAMETER FOR SYM-KEY CONVERSION TABADR GDPRK,1 ;PARAMETER FOR REC-KEY CONVERSION TABADR GDPRK1,1 ; TABADR GETSET,1 ;DISPATCH LOC: ADJKEY OR GD67 OR FPORFP TABADR RECBP,1 ;RECORD AREA BYTE-POINTER TABADR RSBP,1 ;BYTE POINTER TO RECORD SIZE IN BUFFER TABADR RSBP1,1 ;ANOTHER BP TO RECORD SIZE TABADR LRW,1 ;FIRST FREE RECORD WORD, USED BY SETLRW TABADR IOWRD0,1 ;POINTS TO CURRENT IOWRD TABADR USOBJ0,1 ;POINTS TO CURRENT USOBJ TABADR CNTRY0,1 ;POINTS TO CURRENT CNTRY TABADR NNTRY0,1 ;FLAG, CNTRY POINTS TO NEXT ENTRY TABADR BPSB,1 ;NUMBER OF BITS PER SAT BLOCK ITABL==ADR-STABL ;INDEX TABLE LEN TABADR BA,0 ;START OF BUFFER AREA ISCLR1==IOWRD ; [432] [377] START OF ISAM SHARED BUFFER AREA TO SAVE ISCLR2==ICHAN-1 ; [377] END OF ISAM SHARED BUFFER TO SAVE ISMCLR==ISCLR2-ISCLR1 ; [377] DIFFERENCE OR SIZE OF AREA LESS 1 TO SAVE > ;END OF 'IFN ISAM' SUBTTL RESET ;RESET IS CALLED WITH A JSP 14,C.RSET MLON IFE %%RPG,< LIBSW.: SWSET% ;LIBOL ASSEMBLY SWITCHES C.RSET: JRST .+2 ;ENTRY FOR 'C.RSET' JRST STOPR. ;ENTRY FOR 'STOP RUN' CALLI ;RESET MOVE AC1,(AC14) ; GET ADDRESS OF ENTRY POINT MOVEM AC1,%F.PTR ; (%F.PTR)+1 IS ADR OF FILES. CALLI AC11,27 ;[346]GET THE RUNTIME. MOVEM AC11,RUN.TM ;[346]SAVE IT. HRRZ AC1,.JBSA ;[START.] MOVEM AC1,JSARR. ;SAVE FOR RRDMP HRRZ AC1,.JBFF ;TO-1 CAMG AC1,.JBREL ;SKIP ILL-MEM-REF SETZM (AC1) ;ZERO WORD HRL AC1,AC1 ;FROM,,TO-1 ADDI AC1,1 ;FROM,,TO HRRZ AC2,.JBREL ;UNTIL CAIL AC2,(AC1) ;SKIP ILL-MEM-REF IF .JBFF = .JBREL BLT AC1,(AC2) ;ZERO FREE COR RESET1: MOVEI AC0,[TTCALL 3,[ASCIZ/COBOL PROGRAMS MAY ONLY BE STARTED THROUGH USE OF "GET AND ST" OR "RUN" MONITOR COMMANDS/] CALLI 12] ;EXIT HRRM AC0,.JBSA MOVE PP,[PUSHJ PP,UUO.] MOVEM PP,41 HLRZ PP,.JBOPS ;START OF IMPURE AREA RSET1A: MOVE PP,[XWD PFRST.,IFRST.] TLNE PP,777777 ;NO BLT IF PFRST. = 0 - LOW SEG WAS LOADED BLT PP,ILAST. ;THE IO UUO'S MOVEI AC10,MEMRY.## ;SET UP MEMRY. POINTER MOVEM AC10,MEMRY%## HRRZ AC10, (AC14) ;GET THE PROGRAM'S ENTRY POINT. HRRZ AC10, 1(AC10) ;GET THE ADDRESS OF %FILES. SKIPN AC10, %PUSHL(AC10) ;GET THE PDL SIZE. MOVEI AC10, 200 ;THIS IS FOR SORT MOVNI PP, (AC10) ;0,,-LENGTH HRL PP, .JBFF ;START-LOC,,-LENGTH MOVSS PP, PP ;POINTER IS SET UP. MOVEI AC10, 1(AC10) ;LENGTH+1 ADDB AC10, .JBFF ;ADJUST .JBFF IORI AC10, 1777 ;MOVE UP TO THE NEXT K BOUNDARY CAMG AC10, .JBREL ;ARE WE BEYOND .JBREL? JRST RESET2 ;NO, GO ON. CALLI AC10, 11 ;YES, GO ASK FOR MORE CORE. JRST GETSPK ;CAN'T HAVE ANY MORE, ERROR. ;SET FLAGS TO TRAP ON RESET2: MOVEI AC0,TRAP. ;[312];INTERUPT ROUTINE ADR MOVEM AC0,.JBAPR ;[312]; MOVEI AC0,230000 ;[312];PDLOV - MPVIO - NXM CALLI AC0,16 ;[312];APRENB UUO PUSHJ PP,RSAREN ;[312];INIT .JBSA AND .JBREN PUSHJ PP,OUTBF1 ;SETUP TTY BYTE-POINTER AND BYTE-COUNT PUSHJ PP,RSTLNK ;LINK ALL SUB-PROGRAM'S FILE-TABLES PUSHJ PP,SUSPC ;COMPUTE SPACE REQUIRED FOR SIMULTANEOUS ;UPDATE, AND GET IT PUSHJ PP,SETOVR ;SET UP OVERLAY FILE PUSHJ PP,RSTAB. ;ASSIGN THE BUFFER AREA SKIPE KEYCV.## ;WERE WE CALLED BY SORT? JRST 1(AC14) ;YES, RETURN. HRRZ AC10,COBSW. ;GET COMPILER ASSEMBLY SWITCHES HRRZ AC3,LIBSW. ;GET LIBOL ASS-SWITCHES CAME AC10,AC3 ;THE SAME? TTCALL 3,[ASCIZ /% COBOL-LIBOL ASSEMBLY SWITCHES MISMATCHED /] JRST 1(AC14) ;RETURN ;HERE TO CHAIN FILE-TABLES OF ALL SUBPROGRAMS TOGETHER ;POINTERS ARE AS FOLLOWS ;AC14/ ADR OF SP1 ;ADR OF ADR OF "MAIN" PROGRAM ;THE FOLLOWING ARE THE SAME FOR ALL SUBPROGRAMS ;SP1+1/ LST,,FILES. ;FILES. HAS ADR OF FIRST FILE-TABLE ;LST/ SP2 ;ADR OF SUBPROGRAMS CALLED BY SP1 ;LST+1/ SP4 ; . ;LST+N/ 0 ;TERMINATES WITH A ZERO RSTLNK: MOVEI AC3,AC3 ;THWART THE FIRST LINK HRR AC1,(AC14) ;ADDRESS OF "MAIN" PRG + 1 HRL AC2,1(AC1) ;SETUP THE HRRI AC2,FILES. ; FIXED HRRZI AC4,FILES. ; PARAMETERS BLT AC2,FIXNUM-1(AC4); %FILES THRU %PR RSTL10: HRRZ AC5,(AC1) ;[346] CHECK TO SEE IF THIS SUBROUTINE JUMPN AC5,RSTL30 ; IS IN AN LINK-10 OVERLAY AREA. ;; ((AC1)) = SKIPA 0,0 == IT ISN'T ;; ((AC1)) = JSP 1,MUMBLE == IT IS. MOVE AC1,1(AC1) ;ADDRES OF [LIST ,, FILES.] HLRZ AC2,AC1 ;ADR OF LIST OF CALLED SUBPROGRAMS SKIPGE AC4,(AC1) ;HAVE WE BEEN HERE BEFORE? POPJ PP, ;YES, -1 IN LEFT HALF JUMPE AC4,RSTL12 ;JUMP IF SUBPRG HAS NO FILE-TABLES SKIPN FILES. ;HAS FILES. BEEN SETUP YET? HRRM AC4,FILES. ;NO - SO DOIT HRRM AC4,(AC3) ;LINK THIS FILE-TABLE GROUP TO LAST GROUP RSTL11: HRRZI AC3,F.RNFT(AC4) ;GET ADR OF LINK TO NEXT TABLE HRRZ AC4,(AC3) ;GET THE LINK TO NEXT TABLE JUMPN AC4,RSTL11 ;LOOP IF NOT THE LAST TABLE RSTL12: HRROS (AC1) ;MARK THIS FILE-TABLE GROUP DONE RSTL20: SKIPN AC1,(AC2) ;ANY SUBPRGMS? POPJ PP, ;NO -- BACK TO THE LAST SUBPRG OR EXIT PUSH PP,AC2 ;SAVE POINTER TO SUBPROGRAM LIST PUSHJ PP,RSTL10 ;GO LINK THE FILE-TABLES POP PP,AC2 ;RETREIVE LIST POINTER RSTL30: SKIPE 1(AC2) ;ANY MORE SUBPRGMS? AOJA AC2,RSTL20 ;INCREMENT POINTER AND TRY AGAIN RSTLNX: POPJ PP, ;[312];NO--DONE. > ; END OF IFE %%RPG ;ASSIGN THE BUFFER AREA. ***POPJ*** RSTAB.: PUSHJ PP,GCHAN ;FIND A FREE CHANNEL PUSHJ PP,SETC1. ; ASSIGN TO IO UUOS SETOM FS.IF ;IDX FILE SETZM TEMP.1 ;ZERO THE ERROR COUNT HRRZ AC16,FILES. ;FIRST FILE TABLE JUMPE AC16,RET.1 ;THERE ARE NO FILES RSTIFI: SETZM TEMP. ;MAX SIZE OF BUF AREA RSTIF1: MOVE AC15,F.WDNM(I16);IF THIS IS FIRST TLNN AC15,BUFLOC ;[316] TIME THROUGH TABLE, PUSHJ PP,RSTFLG ;REORGANIZE THE FLAGS MOVE FLG,F.WFLG(I16) ;GET THE FLAGS HRLOI AC15,4077 ;[316];#OF DEVICES,,LOC OF FIRST ONE AND AC15,F.WDNM(I16) ; TLZE AC15,BUFLOC ;IS BUFLOC SET? IFE ISAM,< JRST RSTNFL ; [377] YES-NEXT FILE > IFN ISAM,< JRST RSTSAL ; [377] YES- SET UP SAVE AREA FOR ISAM FILES > MOVEM AC15,AC13 ; TLC AC13,777777 ;MAKE AOBJP AC13, .+1 ;KIND OF HRR AC13,AC15 ;AN IOWD MOVEM AC13,D.ICD(I16) ;%-<#OF DEVS>,,LOC OF FIRST DEVNAM RSTDEV: MOVE AC3,(AC13) ;SIXBIT /DEVICE NAME/ CALLI AC3,4 ;DEVCHR UUO TLNN AC3,140610 ;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR JRST RSTDE0 ; TLNN AC3,40000 ; [414] LPT? JRST RSTDV1 ; [414] NO MOVE AC12,(AC13) ; [414] LPT - GET NAME DEVTYP AC12, ; [414] SEE IF REAL LPT. JRST RSTDV1 ; [414] CAN'T, SKIP THIS. TLNE AC12,20 ; [414] IF SPOOLED SKIP THIS. JRST RSTDV1 ; [414] IT IS PUSHJ PP,INTINT ; [414] REAL LPT SET UP TRAPPING. RSTDV1: TLO FLG,DDMASC ;FORCE ASCII MODE TLZ FLG,DDMBIN!DDMSIX!DDMEBC ; FOR THE ABOVE DEVICES MOVEM FLG,F.WFLG(I16) ; RSTDE0: JUMPN AC3,RSTDE2 ; RSTDE1: MOVE AC2,[BYTE(5)25,4,20,13,23,15,14];"NOT A DEVICE OR PUSHJ PP,MSOUT. ;NOT AVAILABLE TO THIS JOB AOS TEMP.1 ;COUNT THE ERRORS JRST RSTLOO ; RSTDE2: SETZM UOBLK. ;[411] MAKE SURE WE DONT GET ILLEGAL MODE IF ASCII DEV MOVE AC12,.JBFF HRLM AC12,D.BL(I16) ;SET BUFFER LOCATION MOVE AC12,(AC13) ;SIXBIT /DEVNAM/ MOVEM AC12,UOBLK.+1 ;FOR THE INIT BLOCK HRLZI AC12,D.OBH(I16) ;LOC OF OBUF HDR TLNE FLG,OPNIO ;SKIP IF NOT IO HRRI AC12,D.IBH(I16) ;LOC OF IBUF HDR MOVEM AC12,UOBLK.+2 ;INIT BLOCK IFN ISAM,< MOVEI AC1,17 ;DUMP MODE TLNE FLG,IDXFIL ;INDEX-FILE? HRRZM AC1,UOBLK. ;YES > IFN TOPS20,< TLNE FLG,IDXFIL ;ISAM FILE? JRST RSTD21 ;YES > XCT UOPEN. ;******************** JRST RSTDE1 ;INIT FAILED, ERROR RETURN RSTD21: PUSH PP,.JBFF ; TLNE FLG,IDXFIL ; JRST RSTIDX ;SETUP FOR AN INDEX FILE TLNN AC3,20 ;SKIP IF A MTA TLNE FLG,RANFIL+OPNIO ;SKIP IF NOT RANDOM OR IO JRST RSTDE4 ;SETUP FOR NON-STD OR DUMP MODE BUFFERS RSTDE7: LDB AC6,F.BNAB ;NUMBER OF BUFFERS CAIN AC6,77 ; [414] REALLY WANTS ONE? SETOI AC6, ; [414] YES ONE BUFFER. XCT UOBUF. ;ALLOCATE ************** TLNE FLG,OPNIO ;THE XCT UIBUF. ;BUFFERS ************** RSTDE5: HLRZ AC12,D.BL(I16) ;CALCULATE SUB AC12,.JBFF ;THE SIZE POP PP,.JBFF ; MOVNS AC12 ;OF THE RSTDE3: CAML AC12,TEMP. ;BUFFER AREA MOVEM AC12,TEMP. ;SAVE SIZE OF LARGER ;LOOP AGAIN RSTLOO: IFN ISAM, AOBJN AC13,RSTDEV ;JUMP IF MORE DEV/FILTAB RSTLO1: MOVSI AC15,BUFLOC ;[316];NOTE WE ARE DONE IORM AC15,F.WDNM(I16);WITH THIS FILE TABLE HLRZ AC1,F.LSBA(I16) ;SEE IF ANY SHARING OF BUFFERS JUMPE AC1,RSTNFL ;GET THE NEXT FILE TABLE MOVEM AC1,AC16 ; JRST RSTIF1 ;SHARES THE SAME BUFFER AREA RSTNFL: MOVE AC12,TEMP. ;INCREASE .JBFF BY ADDM AC12,.JBFF ;THE BUFFER AREA SIZE HRRZ AC16,F.RNFT(I16);LOCATE THE NEXT FILE TABLE JUMPN AC16,RSTIFI ;AND JUMP IF THERE IS ONE. SKIPE TEMP.1 ;ANY ERRORS ? JRST KILL ;YES XCT URELE. ;RELEASE THE CHANNEL IFN ISAM,< ;GRAB SPACE FOR THE AUX BLOCK SKIPE MXBUF ;EXIT IF NO INDEXED FILES SKIPE KEYCV. ;SKIP IF RESET UUO JRST RSTXIT ;EXIT - ITS A SORT CALL MOVE AC0,MXBUF ;SIZE OF AUX BLOCK MOVE AC1,.JBFF ; HRRZM AC1,AUXBUF ;LOCATION OF AUX BLK PUSHJ PP,GETSPC ; JRST GETSPK ;ERROR RETURN ;SPACE FOR DATA-RECORD-TABLE FOR SPLITTING BLOCKS MOVE AC0,MXBF ;MAX-BLOCKING FACTOR OF ALL IDXFIL'S ADDI AC0,1 ;TERMINATOR MOVE AC1,.JBFF ; HRRZM AC1,DRTAB ; PUSHJ PP,GETSPC ; JRST GETSPK ;ERROR RETURN ;SPACE FOR INDEX ENTRY WHEN SPLITTING TOP INDEX BLOCK MOVE AC0,MXIE ;SIZE OF LARGEST INDEX ENTRY MOVE AC1,.JBFF ; HRRZM AC1,IESAVE ;LOC OF SAVE AREA PUSHJ PP,GETSPC ; JRST GETSPK > RSTXIT: LDB AC2,[POINT 4,UOPEN.,12] ;FREE THE CHANNEL PUSHJ PP,FRECH2 ; AND POPJ HRLZI AC0,577774 ;[342]TURN OFF CHAN 1 SKIPN TEMP.2 ;ANY RERUNS? POPJ PP, ;NO ANDM AC0,OPNCH. ;YES, DOIT SETOM RRFLG.## ;REMEMBER POPJ PP, IFN ISAM,< ; THIS ROUTINE GOES ALL FILES IN A SAME RECORD AREA CHAIN TO ;SET UP A SAVE AREA FOR ISAM FILES. THIS SAVE AREA WILL BE USED TO SAVE ;THE SECTION OF THE SHARED BUFFER AREA THAT ISAM FILE EXPECTS TO ;BE TRUE VALUES RSTSAL: SKIPE KEYCV. ; [377] SKIP THIS IS HERE ON SORT JRST RSTNFL ; [377] PUSH PP,AC16 ; [377] SAVE CURRENT FILE TABLE ADR MOVE AC12,TEMP. ; [377] UPDATE .JBFF ADDB AC12,.JBFF ; [377] SETZM TEMP. ; [377] CLEAR BUFFER SIZE RSTSL1: MOVE FLG,F.WFLG(I16) ; [377] GET FILE PARAMS TLNN FLG,IDXFIL ; [377] ISAM FILE ? JRST RSTLP ; [377] NO- GET NEXT FILE HRRZ AC2,D.IBL(I16) ; [377] SAVE AREA ALREADY SET UP? JUMPN AC2,RSTLP ; [377] IF SO, GO GET NEXT FILE HRRZ AC12,.JBFF ; [377] GET FREE CORE AREA HRRM AC12,D.IBL(I16) ; [377] SET START OF SAVE AREA TO .JBFF MOVEI AC0,ISMCLR+1 ; [377] AMOUNT OF SPACE FOR SAVE ARE PUSHJ PP,GETSPC ; [377] GET CORE SPACE JRST GETSPK ; [377] NO CORE- QUIT RSTLP: HLRZ AC12,F.LSBA(I16) ; [377] GET NEXT FILE IN SAME AREA CHAIN JUMPE AC12,RSTSL2 ; [377] NO MORE CAMN AC12,(PP) ; [377] SEE IF WE WENT ALL THRU CHAIN JRST RSTSL2 ; [377] YES ALL DONE MOVEM AC12,AC16 ; [377] SET UP NEXT FILE IN SAME AREA CHAIN JRST RSTSL1 ; [377] DO THIS FILE RSTSL2: POP PP,AC16 ; [377] GET BACK FIRST FILE IN CHAIN JRST RSTNFL ; [377] GO ON TO NEXT FILE TABLE > ; [377] END IFN ISAM ;SETUP FOR NONSTD BUFFERS OR DUMP MODE RSTDE4: LDB AC5,F.BBKF ;BLOCKING FACTOR JUMPN AC5,RSTD40 ; IF BLK-FTR = 0 TLNE FLG,DDMEBC ; AND DEVICE DATA MODE IS EBCDIC TLNN AC3,20 ; AND DEVICE IS A MTA JRST RSTD40 ; MOVEI AC5,1 ; THEN BLK-FTR DEFAULTS TO 1 DPB AC5,F.BBKF ; RSTD40: PUSHJ PP,OPNWPB ;AC10= WODRS PER LOGICAL BLOCK JUMPE AC5,RSTDE7 ;JUMP IF BLOCKING FACTOR IS 0 ADDI AC10,3 ; PLUS 3 FOR BOOKEEPING WORDS TLNN AC3,20 ;SKIP IF A MTA JRST RSTDE6 ;JUMP ITS NOT A MTA HLLZ AC6,D.F1(I16) ;SECOND FLAG REG TLNN AC6,STNDRD ;SKIP IF STANDARD LABELS JRST RSTD41 ;MTA W/NONSTD OR OMITTED LABELS CAIGE AC10,^D16+4 ;SKIP IF RECORD IS GE THE LABEL RECORD MOVEI AC10,^D16+4 ;ENSURE LABEL REC WILL FIT IN REC AREA RSTD41: TLNN FLG,DDMEBC ;SKIP IF EBCDIC JRST RSTDE8 ;ITS NOT ;IFN EBCDIC,< TLNN AC3,20 ; DEVICE A MTA? JRST RSTD42 ; NO SKIPGE D.F1(I16) ; VARIABLE LENGTH EBCDIC? ADDI AC10,1 ; YES - ADD IN ONE FOR BLOCK DESCRIPTOR WORD RSTD42: TLNN AC6,STNDRD ; LABELS STANDARD? JRST RSTDE8 ;NO - MUST BE OMITTED CAIGE AC10,^D20+4 ; MOVEI AC10,^D20+4 ;LABEL RECORD IS THE LARGEST RECORD ;> RSTDE8: TLNN AC6,NONSTD ;SKIP IF NON-STANDARD LABELS JRST RSTDE9 ; HLRZ AC1,F.LNLS(I16) ;NONSTD LABEL SIZE JUMPGE FLG,RSTD10 ;JUMP IF NOT ASCII ADDI AC1,2 ;ADD IN "CR-LF" CHARS IDIVI AC1,5 ; RSTD10: TLNN FLG,DDMASC ;SKIP IF ASCII IDIVI AC1,6 ; SKIPE AC2 ; ADDI AC1,1 ;CONVERT CHARS TO WORDS CAIGE AC10,3(AC1) ; MOVEI AC10,3(AC1) ;ENSURE LABEL REC WILL FIT IN REC AREA RSTDE9: MOVEI AC1,-3(AC10) ; HRRM AC1,D.LRS(I16) ;SAVE IT FOR OPNNSB LDB AC12,F.BNAB ;NUMBER OF ALTERNATES CAIN I12,77 ; [414] REALLY WANTS ONE? SETOI I12, ; [414] YES ONE BUFFER. IMULI AC10,2(I12) ;REC TIMES NUMBER OF ALTERNATE BUFFERS JRST RSTD11 ; RSTDE6: TLNN AC3,200000 ;SKIP IF DEV IS A DSK JRST RSTER0 ;COMPLAIN ADDI AC10,7 ;3+7=12 FLAG WORDS REQD FOR RANDOM OR IO RSTD11: MOVE AC0,AC10 ;SETUP AC0 FOR GETSPC PUSHJ PP,GETSPC ;CLAIM THE BUFFER AREA JRST GETSPK ;NO MORE CORE JRST RSTDE5 ;RETURN RSTER0: TTCALL 3,[ASCIZ /ONLY DSK MAY BE USED FOR RANDOM, IO OR INDEX-SEQ PROCESSING/] RSTERR: MOVE AC2,[BYTE (5)10,31,20] PUSHJ PP,MSOUT. IFE ISAM,< RERIT.: TTCALL 3,[ASCIZ /REWRITE ?/] SKIPA DELET.: TTCALL 3,[ASCIZ /DELETE ?/] RSTIDX: TTCALL 3,[ASCIZ / TO PROCESS ISAM FILES CBLIO MUST BE REASSEMBLED WITH THE CONDITIONAL ASSEMBLY SWITCH,ISAM, EQUAL TO A NON-ZERO VALUE./] JRST KILL > IFN ISAM,< ;SETUP FOR AN INDEX FILE RSTIDX: PUSHJ PP,OPNLIX ;IDXFIL FILENAME IFE TOPS20,< XCT ULKUP. ;*************** JRST RSTID1 ; > IFN TOPS20,< PUSH PP,.JBFF ;SAVE IT MOVEI AC0,ICHAN ;MAKE SURE WE HAVE CORE PUSHJ PP,GETSPC ;GO SEE JRST GETSPK ;NO CORE RETURN SO COMPLAIN POP PP,.JBFF ;RESTORE JOBFF PUSH PP,AC13 ;SAVE AC13 HLRZ I12,D.BL(I16) ;GET BUFFER LOCATION MOVEI AC0,1 ;USE CHANNEL ONE MOVEM AC0,ICHAN(I12) ;SAVE IT AWAY PUSHJ PP,OCPT ;USE TOPS20 COMPT. UUO JRST [CAME AC1,[0,,600130] ;INVALID SMU ACCESS? JRST [TTCALL 3,[ASCIZ /RESET TIME /] JRST OCPERR ] HRRZI AC0,1B25 ;YES - SO TRY A VALID ACCESS ANDCAM AC0,CP.BK3 ;TURN OFF THAWED (ON FROZEN) MOVE AC1,[10,,CP.BLK];COUNT,,ADR OF ARG-BLK COMPT. AC1, ;OPEN FILE IN FROZEN MODE JRST [TTCALL 3,[ASCIZ /RESET TIME /] JRST OCPERR ] JRST .+1] POP PP,AC13 ;RESTORE AC13 MOVE AC3,(AC13) ;GET DEVICE NAME CALLI AC3,4 ;RESTORE DEVICE CHARACTERISTICS > MOVEI AC0,STABL ; HRR AC1,.JBFF ; PUSHJ PP,GETSPC ; JRST GETSPK ;ERROR RETURN HRLI AC1,-STABL ; SUBI AC1,1 ;DUMP MODE IOWD SETZ AC2, ;TERMINATOR MOVEI AC6,1 ;LOCATION OF HRRM AC6,UIN. ; IOWD XCT UIN. ;READ IN STATISTICS BLOCK SKIPA AC12,1+ISPB(AC1) ;INDEX SECTORS / BLK JRST RSTIER ; HLRZ AC2,1(AC1) ;GET FILE FORMAT CODE CAIN AC2,401 ;COMPLAIN IF NOT 401 JRST RSTID7 ;OK PUSHJ PP,MSVID ;OUTPUT VALUE-OF-ID TTCALL 3,[ASCIZ/ IS NOT THE INDEX FOR ISAM/] PUSHJ PP,MSFIL. ;OUTPUT FILE NAME AND VID PUSHJ PP,KILL ;KILL NEVER RETURNS ;HERE IF LOOKUP FAILURE RSTID1: HLLZ AC1,D.F1(I16) ; GET FLG1 PARMS [377] TLNN AC1,FILOPT ;OPTIONAL FILE? [374] JRST RSTID8 ;[323]NO, FATAL HRRZ AC1,ULBLK.+1 ;GET THE ERROR CODE TRZ AC1,777740 ;WAS IT FILE NOT FOUND? JUMPN AC1,LUPERR ;EXIT HERE IF OTHER POP PP,.JBFF ;RESTORE THE STACK SETOM D.OPT(I16) ;FILE NOT FOUND - REMEMBER THAT JRST RSTLOO ; AND SHOOT HIM DOWN AT OPEN TIME RSTID8: PUSHJ PP,MSFIL. ; [323]OUTPUT FILE NAME TTCALL 3,[ASCIZ/ NOT FOUND AT RESET TIME/] PUSHJ PP,KILL ;[323] FATAL ERROR RSTID7: HLLZS UIN. ;CLEAR IOWD POINTER IMULI AC12,200 ;WRDS / SECTOR CAMLE AC12,MXBUF ;LARGER THAN LARGEST? MOVEM AC12,MXBUF ;YES, SAVE AS NEW LARGEST MOVE AC6,1+MXLVL(AC1) ;NUMBER OF INDEX LEVELS ADDI AC6,2 ;PLUS ONE FOR SAT BLK & ONE FOR SPLITING TOP-LEVEL IMUL AC12,AC6 ; ;FIND THE LARGEST INDEX ENTRY SIZE MOVE AC2,1+IESIZ(AC1) CAMLE AC2,MXIE ; MOVEM AC2,MXIE ; ;FIND THE MAX BLOCKING-FACTOR MOVE AC2,DBF+1(AC1) ; CAMLE AC2,MXBF ; MOVEM AC2,MXBF ; LDB AC6,KY.TP ; GET KEY TYPE JUMPN AC6,RSTID2 ;BRANCH IF NON-NUMERIC-DISPLAY MOVE AC4,1+IESIZ(AC1) ;INDEX ENTRY BLOCK SIZE SUBI AC4,1 ;-2 HDR WRDS, +1 WRD FOR WRAP-AROUND IMULI AC4,3 ;RESERVE 3 KEY AREAS JRST RSTID3 ; RSTID2: MOVEI AC4,6 ;1+1*3 TRNN AC6,1 ;ODD = 1 WRD, EVEN = 2 WRDS MOVEI AC4,9 ;2+1*3 RSTID3: ADDI AC12,2(AC4) ;NUMBER OF WORDS ALLOCATED MOVE AC2,F.WDNM(I16) MOVE AC2,1(AC2) ;DATA FILE DEVICE NAME MOVEM AC2,UOBLK.+1 ; XCT UOPEN. ;************** JRST RSTDE1 ;ERROR CALLI AC2,4 ;DEVCHR TLNE AC2,200000 ;DATA FILE TLNN AC3,200000 ;IDX FILE JRST RSTER0 ;MUST BE A DSK LDB AC5,KY.MD ; GET DATA MODE FROM STS-BLOCK XCT RSTID4(AC5) ; SAME AS FILE TABLE DATA MODE? JRST RSTID5 ; YES TTCALL 3,[ASCIZ /DATA-MODE DISCREPANCY/] MOVE AC2,[BYTE (5)10,31,20,4] JRST MSOUT. ; RSTID4: TLNE FLG,DDMSIX ; SKIP IF NOT SIXBIT TLNE FLG,DDMEBC ; EBCDIC TLNE FLG,DDMASC ; ASCII Z ; RSTID5: PUSH PP,AC12 ; [375] SAV REG 12 MOVEI AC12,1(AC1) ; [375] SET UP TO GET ISAM REC SIZE PUSHJ PP,OPNWPB ;RETURNS WRDS/LOGICAL BLOCK IN AC10 POP PP,AC12 ; [375]RESTORE AC12 CAMLE AC10,MXBUF ; MOVEM AC10,MXBUF ;SAVE AS LARGEST AUX BUF ADD AC12,AC10 ; ADDI AC12,ITABL ;INDEX TABLE LEN MOVE AC0,AC12 ; MOVEM AC0,D.OBH(I16) ;SAVE AMOUNT OF CORE REQUIRED PUSHJ PP,GETSPC ;GRAB SOME CORE AREA JRST GETSPK ;ERROR RETURN SETZM UOBLK. ; JRST RSTDE5 ;RETURN RSTIER: XCT UGETS. ;INPUT ERROR DURING RESET UUO TRNE AC2,020000 ;[376] EOF? TTCALL 3,[ASCIZ/ UNEXPECTED EOF ON ISAM INDEX FILE/] ;[376] PUSHJ PP,IOERM1 ; MOVE AC2,[BYTE (5)35,4,10,31,20,2] JRST KILL ;&KILL > ;GET CORE SPECIFIED BY (AC0) GETSPC: PUSH PP,.JBFF ;INCASE THE CORE UUO FAILS ADDB AC0,.JBFF ;ASSUME WE'LL GET IT CAMG AC0,.JBREL ;IS THERE ENOUGH IN FREE CORE JRST GETSP1 ;YEP CALLI AC0,11 ;NO, GET SOME MORE CORE JRST GETSP2 ;ERROR RETURN GETSP1: POP PP,(PP) ;.JBFF IS GOOD JRST RET.2 ;NORMAL EXIT GETSP2: POP PP,.JBFF ;RESTORE .JBFF, CORE UUO FAILED POPJ PP, GETSP9: TTCALL 3,[ASCIZ/INSUFICIENT CORE FOR BUFFER REQUIREMENTS/] POPJ PP, GETSPK: PUSHJ PP,GETSP9 JRST KILL ;SUBROUTINE TO SET UP OVERLAY FILE IFE %%RPG,< SETOVR: SKIPN AC1,OVRFN. ;ANY FILE TO BE OPENED POPJ PP, ;NO--RETURN HRLZI AC0,577774 ;[342]TURN OFF CHAN 1 ANDM AC0,OPNCH. ;DOIT HRROI AC0,-1 ;DSK = -1 SKIPN AC3,RN.DEV ;[333]IF DEVICE SPECIFIED, GET IT HRLZI AC3,(SIXBIT /DSK/) ; SETOV1: MOVEI AC2,14+1B30 ;SET UP DEVICE HRRZI AC4,OVRBF. ; OPEN 1,AC2 ;[342]INIT JRST SETOV4 ; MOVSI AC2,(SIXBIT "OVR") SETZB AC3,AC4 ; SKIPE AC0 ;[333]IF NOT TRYING SYS MOVE AC4,RN.PPN ;[333]GET OVERLAY PPN LOOKUP 1,AC1 ;[342] JRST SETOV5 ;LOOKUP FAILED INBUF 1,2 ;GET 2 BUFFERS MOVEI AC1,OVRIX. ; PUSHJ PP,SETOV2 ; MOVEI AC1,OVRIX.+200 ; SETOV2: IN 1, ;[342] SKIPA AC2,OVRBF. ; JRST SETOV6 ; MOVSI AC2,2(AC2) ; HRR AC2,AC1 ; BLT AC2,177(AC1) ; POPJ PP, SETOV4: TTCALL 3,[ASCIZ "CANNOT INITIALIZE OVERLAY DEVICE"] JRST KILL SETOV5: HRLZI AC3,(SIXBIT /SYS/) ;TRY SYS IF DSK FAILS AOJE SETOV1 ; TTCALL 3,[ASCIZ "CANNOT FIND OVERLAY FILE"] JRST KILL SETOV6: TTCALL 3,[ASCIZ "INPUT ERROR ON OVERLAY DEVICE"] JRST KILL > ; END OF IFE %%RPG ;ROUTINE TO REORGANIZE THE FLAGS RSTFLG: MOVE FLG,F.WFLG(I16) ;GET FLAGS HRLZI AC15,4300 ; AND AC15,FLG ;RRUNER & RRUNRC LDB AC1,[POINT 3,FLG,9] HLLZ AC2,FLGTAB(AC1) ;DEVICE DATA MODE TLZ AC2,037777 ; IOR AC15,AC2 ; MOVEI AC0,SASCII ; GET STANDARD ASCII FLAG CAIN AC1,4 ; AND SET IT IF REQUESTED IORM AC0,D.RFLG(I16) ; DOIT LDB AC1,[POINT 2,FLG,15] HLLZ AC2,FLGTAB(AC1) ;CORE DATA MODE TLZ AC2,777707 ; IOR AC15,AC2 ; LDB AC1,[POINT 2,FLG,17] HLLZ AC2,FLGTAB(AC1) ;ACCESS MODE TLZ AC2,777770 ; IOR AC15,AC2 ; TLNE FLG,20 ;FILOPT? TRO AC15,FILOPT ; TLNE FLG,100000 ;NONSTD? TRO AC15,NONSTD ; TLNE FLG,40000 ;STNDRD? TRO AC15,STNDRD ; TLNN AC15,DDMEBC ;ONLY EBCDIC HAS VAR-LEN RECORDS JRST RSTFL1 ; TLNE FLG,400000 ;VARIABLE LENGTH EBCDIC RECORDS? TRO AC15,VLREBC ; RSTFL1: HLLM AC15,F.WFLG(I16);SAVE IT HRLM AC15,D.F1(I16) ;FLG1 TLNE FLG,RRUNER!RRUNRC ;RERUNING? SETOM TEMP.2 ;YES, REMEMBER TO TURN OFF CHAN 17 POPJ PP, ; ;BITS 0-3 DEVICE DATA MODE ; 12-14 CORE DATA MODE ; 15-17 ACCESS MODE FLGTAB: 200022,,0 040001,,0 400044,,0 100010,,0 400000,,0 ; STANDARD ASCII Z Z Z ;**; BEFORE TRAP. [414] ; FOR REAL PRINTER ON-LINE. ; ; ERROR INTERCEPT. INTLOC: PUSH PP,INTBLK+2 ; [414] SAVE RETURN ADDRESS. PUSH PP,AC13 ; [414] SAVE AC13 SETZM INTBLK+2 ; [414] MOVEI AC13,^D30000 ; [414] SLEEP FOR 1/2 MIN. HIBER AC13, ; [414] JFCL ; [414] POP PP,AC13 ; [414] RESTORE AC13 POPJ PP, ; [414] RETURN TO PROGRAM TO RETRY. ; ;INITIALIZE INTERRUPT. ; INTINT: PUSH PP,AC13 ; [414] SAVE MOVEI AC13,INTBLK ; [414] SAVE LOCATION OF INTERRUPT BLOCK MOVEM AC13,.JBINT ; [414] IN JOBDAT. MOVEI AC13,INTLOC ; [414] SAVE INTERRUPT ADDRESS HRLI AC13,4 ; [414] AND ITS LENGTH MOVEM AC13,INTBLK ; [414] INTO INTERRUPT BLOCK MOVEI AC13,1 ; [414] SET FOR OFFLINE DEVICE. MOVEM AC13,INTBLK+1 ; [414] SETZM INTBLK+2 ; [414] CLEAR BLOCK SETZM INTBLK+3 ; [414] POP PP,AC13 ; [414] RESTORE AC13 POPJ PP, ; [414] RETURN. ;TRAP INTERUPT ROUTINE TRAP.: MOVE AC0,.JBCNI ;APR STATUS TRNE AC0,20000 TTCALL 3,[ASCIZ/MEMORY PROTECTION VIOLATION AT USER LOC /] TRNE AC0,10000 TTCALL 3,[ASCIZ/NON-EX-MEM REQUEST AT USER LOC /] TRNE AC0,200000 JRST TRAP1 ;PDLOV TRAP0: HRLO AC12,.JBTPC ;THE GUILTY LOCATION PUSHJ PP,PPOUT4 ;OUTPUT THE LOC IFE %%RPG,< HRRZ AC0,.JBTPC ;[312];SEE IF ERROR IS CAIL AC0,RSTLNK ;[312]; IN RSTLNK CAIL AC0,RSTLNX ;[312]; ROUTINE. JRST KILL ;[312];NO TTCALL 3,[ASCIZ /$FAILING ROUTINE IS RSTLNK IN CBLIO MACRO ROUTINE LOADED IN PLACE OF COBOL SUBROUTINE?/] > JRST KILL ;AND KILL TRAP1: TTCALL 3,[ASCIZ/PUSH-DOWN-LIST OVERFLOW AT /] JRST TRAP0 SRTER.:: TTCALL 3,[ASCIZ /YOU MUST RECOMPILE TO USE THE NEW SORT/] JRST KILL. ;ULOSE. IS THE ERROR EXIT FOR A UUO CALL TO A ROUTINE ;THAT WAS NOT LOADED. THE RUN IS TERMINATED VIA KILL ULOSE.: TTCALL 3,[ASCIZ /ENCOUNTERED A UUOCALL FOR A ROUTINE THAT WAS NOT LOADED /] SKIPA ;TO KILL ;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO" ;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME. GOTO.: TTCALL 3,[ASCIZ /ENCOUNTERED AN UNALTERED GOTO WITH NO DESTINATION /] ;KILL TYPES OUT THE LOCATION OF THE LAST COBOL UUO, ;STOPS ALL IO AND EXITS TO THE MONITOR. KILL: PUSHJ PP,TYPSTS ;TYPE ERROR-NUMBER, BLOCK # + REC # KILL.: PUSHJ PP,VEROUT ;TYPE THE VERSION NUMBER TTCALL 3,[ASCIZ / ?/] IFE %%RPG,< SKIPE TRAC1. ;IS THIS A PRODUCTION PROGRAM (I.E. /P)? [EDIT#270] PUSHJ PP,@TRAC1. ;NO, CALL BTRAC. IN TRACE ROUTINE > PUSHJ PP,PPOUT. ;TYPE THE LOCATION OF LAST COBOL VERB JRST STOPR2 ;TYPE OUT SOME ERROR INFORMATION TYPSTS: TTCALL 3,[ASCIZ / $ ERROR-NUMBER = /] TYPST1: MOVE AC0,FS.EN ;ERROR-NUMBER PUSHJ PP,PUTDEC ;TYPE IT MOVE AC0,FS.BN ;BLOCK-NUMBER JUMPE AC0,TYPST2 ; TTCALL 3,[ASCIZ / BLOCK-NUMBER = /] PUSHJ PP,PUTDEC ; TYPST2: MOVE AC0,FS.RN ;RECORD-NUMBER JUMPE AC0,RET.1 ; TTCALL 3,[ASCIZ / RECORD-NUMBER = /] JRST PUTDEC ;RETURN ;STOPR. IS CALLED WITH A "PUSHJ PP,STOPR." ALL FILES ARE ;CLOSED VIA COBOL CLOSE UUOS AND A CALLI EXIT IS EXECUTED. STOPR.: HRRZ AC16,FILES. ;LOOP THROUGH THE FILE TABLES JUMPE AC16,STOPR2 ;DONE STOPR1: HRLI AC16,001040 ;STANDARD CLOSE UUO MOVE FLG,F.WFLG(I16) ;GET THE FLAGS TLNE FLG,OPNIN+OPNOUT; IF THE FILE IS OPEN PUSHJ PP,C.CLOS ; CLOSE IT HRRZ AC16,F.RNFT(I16);NEXT FILE JUMPN AC16,STOPR1 ;LOOP STOPR2: MOVE AC0,FS.IEC ; NUMBER OF IGNORED ERRORS JUMPE AC0,STOPR3 ; NONE IGNORED TTCALL 3,[ASCIZ /% /] ; PUSHJ PP,PUTDEC ; TYPE NUMBER TTCALL 3,[ASCIZ/ ERRORS IGNORED/] STOPR3: IFE %%RPG,< PUSHJ PP,@HPRT.## ; PRINT HISTORY REPORT IF ANY > CALLI 12 ;CALLI EXIT ;TYPE THE VERSION NUMBER "LIBOL N(M)" VEROUT: SKIPN AC12,.JBVER ;GET VERSION NUMBER JRST VEROU1 ;EXIT IF NOT THERE IFE %%RPG,< TTCALL 3,[ASCIZ / LIBOL /] > IFN %%RPG,< TTCALL 3,[ASCIZ / RPGLIB /] > MOVEI AC0,4 ; PUSHJ PP,NUMOUT ;THE VERSION NUMBER MOVEI AC0,6 ; HRLZ AC12,.JBVER ; JUMPE AC12,VEROU1 ;DONE IF NO EDIT NUMBER MOVEI C,"(" ; PUSHJ PP,OUTCH. ; PUSHJ PP,NUMOUT ;THE EDIT NUMBER MOVEI C,")" ; PUSHJ PP,OUTCH. ; VEROU1: JRST DSPL1. ;"CRLF" AND EXIT NUMOUT: MOVEI C,6 ;HALF AN ASCII ZERO LSHC C,3 TRNN C,7 ;SKIP LEADING ZEROES SOJG AC0,NUMOUT JUMPL AC0,RET.1 PUSHJ PP,OUTCH. MOVEI C,6 LSHC C,3 SOJG AC0,.-3 POPJ PP, ; C.STOP IS CALLED WITH A "PUSHJ PP,C.STOP" AFTER THE OPERATOR ; TYPES "CONTINUE" IT RETURNS TO THE CALLING ROUTINE C.STOP: TTCALL 3,[ASCIZ /$ TYPE CONTINUE TO PROCEED .../] CALLI 1,12 ; WAIT FOR CONT POPJ PP, ; ; TYPES OUT THE LISTING'S LOCATION OF "PUSHJ PP,VERB" ; OR THE PUSHJ'S RETURN ADR IF NO PUSHJ IS FOUND ; (SBPSA.) NON-ZERO IF A SUBPROGRAM CALL IS ACTIVE ; LH IS (RH(17)) I.E. PUSH DOWN STACK ; RH IS ENTRY POINT'S ADDRESS ; ENTRY-1 SIXBIT /NAME-OF-ENTRY-POINT/ ; ENTRY-2 LH: FIRST LOCATION OF CURRENT (SUB)PROGRAM ; RH: SIXBIT /SUBPROGRAM-NAME/ PPOUT.: IFE %%RPG,< TTCALL 3,[ASCIZ /LAST COBOL VERB CALLED FROM /] > IFN %%RPG,< TTCALL 3,[ASCIZ /Last RPGLIB verb called from /] > HLRO AC12,PP ; FIND THE BEG OF THE STACK ADD AC12,PUSHL. ; -- SUBI AC12,(PP) ; -- MOVNS AC12 ; -- SKIPE AC11,SBPSA. ; THIS A SUBPROGRAM OR OVERLAY? HLRZ AC12,AC11 ; YES - GET FIRST ENTRY FROM HERE ADDI 12,1 ; 12 HAS POINTER TO FIRST ENTRY ON STACK MOVEI AC1,0 ; ASSUME NO COBDDT SKIPE CB.DDT ; ANY COBDDT? MOVEI AC1,2 ; YES - THERE ARE 2 ENTRIES ON LIST IFE %%RPG,< MOVE AC2,LIBSW. ; GET MULTIPLE PERFORM FLAG TRNE AC2,MPWC.S ; MULTIPLE-PERFORMS? ADDI AC1,1 ; YES - ANOTHER ENTRY ON PDLIST > IMUL AC1,LEVEL. ; ENTRIES PER LEVEL. ADD AC12,AC1 ; SKIP OVER COBDDT+PERF. STUFF HRRZ AC12,(AC12) ; GET RETURN ADR MINUS ONE MOVEI AC2,5 ; LOOK BACK 5 LOCS FOR A PUSHJ MOVEI AC1,-1(AC12) ; START AT THE RETURN ADR-1 PPOUT1: HLRZ AC3,(AC1) ; GET THE PUSHJ TO THE RIGHT HALF SUBI AC1,1 ; SET UP FOR NEXT COMPARE CAIE AC3,(PUSHJ PP,) ; WHAT IS IT? SOJG AC2,PPOUT1 ; NOT A PUSHJ SO LOOP JUMPE AC2,PPOUT2 ; NOT THERE SO GIVE RET ADR-1 HRRI AC12,1(AC1) ; THE PUSHJ'S ADR PPOUT2: SKIPN AC11,SBPSA. ; IF SUBPROGRAM MOVE AC11,%F.PTR ; NO - MAIN PROGRAM HLRZ AC11,-2(AC11) ; GET START ADR TRZ AC11,400000 ; TURN OFF BIT18 IF ON SUB AC12,AC11 ; GET OFFSET FROM HERE HRLOI AC12,(AC12) ; XWD ADR,,-1 PPOUT4: MOVEI C,6 ; HALF OF AN ASCII ZERO-60 LSHC C,3 ; APPEND THE OCTAL NUMBER PUSHJ PP,OUTCH. ; DEPOSIT IT IN THE TTY BUFFER TRNE AC12,-1 ; HAVE WE SEEN SIX NUMBERS? JRST PPOUT4 ; NO, LOOP PUSHJ PP,OUTBF. ; DUMP IT NOW TTCALL 3,[ASCIZ/ IN PROGRAM /] SKIPN AC3,SBPSA. ; SKIP IF ANY SUBPRGMS JRST PPOUT6 ; NONE PPOUT5: TTCALL 3,[ASCIZ / /] HRRI AC1,(AC3) ; GET ADR OF SUBPRG NAME HRL AC1,-2(AC1) ; TLNE AC1,-1 ; HLRZS AC1 ; IF IT'S ZERO SUBI AC1,1 ; ITS SAME AS ENTRY POINT HRLI AC1,(POINT 6) ; MAKE A BYTE-PTR MOVEI AC4,6 ; ONLY 6 CHARS PER NAME PUSHJ PP,MSVID4 ; TYPE IT TTCALL 3,[ASCIZ / ENTRY /] HRRI AC1,-1(AC3) ; MAKE BYTE-PTR TO ENTRY POINT HRLI AC1,(POINT 6) ; FINISH BYTE-POINTER MOVEI AC4,6 ; 6 IS MAX PUSHJ PP,MSVID4 ; TYPE IT TTCALL 3,[ASCIZ / CALLED FROM/] MOVS AC3,AC3 ; ANY MORE SUBPRGMS? SKIPE AC3,(AC3) ; SKIP IF NOT JRST PPOUT5 ; THERE ARE PPOUT6: MOVE AC1,%F.PTR ; GET THE PROGRAM NAME MOVEI AC1,-1(AC1) ; THIS IS IT HRLI AC1,(POINT 6) ; MAKE BYTE POINTER MOVEI AC4,6 ; NAME HAS 6 CHARS PUSHJ PP,MSVID4 ; DUMP THE NAME JRST DSPL1. ; APPEND "CRLF", THEN EXIT IFE %%RPG,< ; SUSPC: A SUBROUTINE THAT DETERMINES THE AMOUNT OF SPACE REQUIRED ; FOR SIMULTANEOUS UPDATE, AND GETS IT. IT ALSO INITIALIZES THE ; GLOBAL VARIABLES SU.RRT, SU.EQT, SU.DQT, SU.MQT, ; AND SU.FBT TO POINT TO THE RETAINED RECORDS TABLE, THE ENQUEUE ; TABLE, THE DEQUEUE TABLE, THE MODIFY TABLE, AND THE FILL/FLUSH ; BUFFER TABLE. ; ; ARGUMENTS: ; ; AC14 CONTAINS THE ADDRESS OF A WORD CONTAINING THE ; STARTING ADDRESS OF THE MAIN PROGRAM. ; ; CHANGES: ; ; AC0 ; AC1 ; AC2 ; AC3 ; WHATEVER GETSPC CHANGES ; ; CALLS: ; ; SUSPC1 ; GETSPC ; ; ERRORS: ; ; NOT ENOUGH SPACE AVAILABLE FOR SIMULTANEOUS UPDATE ; REQUIREMENTS. IF THIS OCCURS, A MESSAGE IS SENT ; TO TTY AND A JRST KILL. IS EXECUTED. EXTERN SU.RRT, SU.EQT, SU.FBT, SU.DQT, SU.MQT SUSPC: HRRZ AC1,0(AC14) ;GET STARTING ADDRESS OF MAIN PROGRAM SETZM SU.RRT ;INITIALIZE GLOBAL VARIABLES SETZM SU.EQT SETZM SU.FBT PUSHJ PP,SUSPC1 ;EXAMINE THE MAIN PROGRAM AND ALL ITS ;SUBPROGRAMS TO DETERMINE THE MAXIMUM ;REQUIREMENTS FOR SIMULTANEOUS UPDATE ;SPACE MOVE AC0,SU.RRT ADD AC0,SU.EQT ADD AC0,SU.EQT ADD AC0,SU.EQT ;(THERE ARE THREE ENQ/DEQ TABLES) ADD AC0,SU.FBT SKIPN AC0 POPJ PP, ;RETURN IF NO SPACE REQUIRED PUSH PP,.JBFF ;SAVE .JBFF ON THE STACK PUSHJ PP,GETSPC ;GET THE SPACE, IF POSSIBLE JRST SUERR ;JUMP IF NOT POSSIBLE POP PP,AC1 MOVE AC2,AC1 ADD AC2,SU.RRT MOVEM AC1,SU.RRT ;PUT RETAINED RECORDS TABLE AT ADDRESS ;OF FORMER .JBFF MOVE AC1,AC2 ;PUT ENQ/DEQ TABLES AT END OF THE ;RETAINED RECORDS TABLE ADD AC2,SU.EQT MOVEM AC2,SU.DQT ADD AC2,SU.EQT MOVEM AC2,SU.MQT ADD AC2,SU.EQT MOVEM AC1,SU.EQT MOVEM AC2,SU.FBT ;PUT THE FILL/FLUSH BUFFER TABLE AT THE ;END OF THE ENQ/DEQ TABLES POPJ PP, ;WE'RE ALL DONE SUERR: TTCALL 3,[ASCIZ"NOT ENOUGH SPACE AVAILABLE TO MEET THE REQUIREMENTS OF SIMULTANEOUS UPDATE. PLEASE RELINK TO PROVIDE MORE SPACE."] JRST KILL. ; SUSPC1: A SUBOUTINE TO DETERMINE THE MAXIMUM REQUIREMENT FOR SIMULTANEOUS ; UPDATE SPACE OF A PROGRAM AND ITS SUBPROGRAMS ; ; ARGUMENTS: ; ; AC1: THE STARTING ADDRESS OF THE PROGRAM ; ; IN THE %FILES AREA OF THE PROGRAMS THERE ARE THESE QUANTITIES: ; ; %SURRT: THE SPACE REQUIRED BY THE PROGRAM FOR ; THE RETAINED RECORDS TABLE ; ; %SUEQT: THE SPACE REQUIRED BY THE PROGRAM FOR ; EACH OF THE ENQ/DEQ TABLES ; ; %SUFBT: THE SPACE REQUIRED BY THE PROGRAM FOR ; THE FILL/FLUSH BUFFER TABLE ; ; RESULTS: ; ; SU.RRT IS SET TO THE MAX OF SU.RRT AND %SURRT IN THE ; PROGRAM AND EACH OF ITS SUBPROGRAMS ; ; SU.EQT IS SET TO THE MAX OF SU.EQT AND %SUEQT IN THE ; PROGRAM AND EACH OF ITS SUBPROGRAMS ; ; SU.FBT IS SET TO THE MAX OF SU.FBT AND %SUFBT IN THE ; PROGRAM AND EACH OF ITS SUBPROGRAMS ; ; CHANGES: ; ; AC1 ; AC2 ; AC3 ; ; ASSUMPTIONS: ; ; SU.RRT, SU.EQT, SU.FBT ARE INITIALIZED BEFORE THIS ; ROUTINE IS CALLED THE FIRST TIME ; ; NOTES: ; ; THE ROUTINE CALLS ITSELF RECURSIVELY. SUSPC1: HRRZ AC2,(AC1) ;CHECK TO SEE IF THIS SUBROUTINE IS IN JUMPN AC2,RET.1 ; A LINK-10 OVERLAY AREA. ; ((AC1)) = SKIPA 0,0 <==> IT ISN'T ; ((AC1)) = JSP 1,MUMBLE <==> IT IS. HRRZ AC2,1(AC1) ;ADDRESS OF %FILES TO AC2 HLRZ AC3,(AC2) ;HAVE WE BEEN HERE BEFORE? JUMPE AC3,RET.1 ;YES, LEAVE. MOVE AC3,%SURRT(AC2) ;SET SU.RRT TO MAX OF SU.RRT AND %SURRT CAMLE AC3,SU.RRT MOVEM AC3,SU.RRT MOVE AC3,%SUEQT(AC2) ;SET SU.EQT TO MAX OF SU.EQT AND %SUEQT CAMLE AC3,SU.EQT MOVEM AC3,SU.EQT MOVE AC3,%SUFBT(AC2) ;SET SU.FBT TO MAX OF SU.FBT AND %SUFBT CAMLE AC3,SU.FBT MOVEM AC3,SU.FBT HRRZS (AC2) ;MARK THIS SUBPROGRAM AS DONE. HLRZ AC2,1(AC1) ;GET ADDRESS OF SUBPROGRAM LIST SUSPCX: SKIPN AC1,0(AC2) POPJ PP, ;RETURN IF NO MORE SUBPROGRAMS PUSH PP,AC2 ;SAVE AC2 ON STACK PUSHJ PP,SUSPC1 ;CALL OURSELVES TO PROCESS SUBPROGRAM POP PP,AC2 ;RESTORE AC2 AOJA AC2,SUSPCX ;POINT TO NEXT SUBPROGRAM > ; END OF IFE %%RPG SUBTTL SEEK-UUO ;A SEEK UUO LOOKS LIKE: ;002240,,ADR ADR = FILE TABLE ADDRESS ;CALL+1: ;POPJ RETURN SEEK.: MOVE FLG,F.WFLG(I16) ;FLAG REGISTER TLNE FLG,RANFIL ;SKIP IF NOT A RANDOM FILE TLNN FLG,OPNIN!OPNOUT ;SKIP IF RANDOM FILE IS OPEN POPJ PP, ;EXIT TO ***ACP*** HLRZ I12,D.BL(I16) ;SET UP FOR FLIMIT PUSHJ PP,FLIMIT ;CHECK THE FILE LIMITS ;INVALID KEY RETURNS TO ***ACP*** MOVE AC1,AC4 ;ACTUAL KEY PUSHJ PP,SETCN. ;SET UP CHANNEL NUMBER XCT USETI. ; XCT USEEK. ;SEEK UUO POPJ PP, ;EXIT TO ***ACP*** IFE %%RPG,< ;FORCE A CALL TO RRDMP RENDP: SETOM REDMP. ; JRSTF @.JBOPC ;CONTINUE ;RESTORE .JBSA, .JBREN - DESTROYED BY RERUN'S GETSEG RSAREN: HRR AC2,RESET1 HRRM AC2,.JBSA MOVEI AC2,RENDP MOVEM AC2,.JBREN MOVEI AC2,EDIT HRLI AC2,VERSION MOVEM AC2,.JBVER ; [EDIT#272] POPJ PP, > ; END OF IFE %%RPG SUBTTL DISPLAY-UUO IFE %%RPG,< ;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING UUO IN AC 16. ;THE UUO'S EFFECTIVE ADDRESS CONTAINS A MODIFIED BYTE POINTER TO THE ;ASCII CHARACTER STRING. MODIFICATIONS FOLLOW: ; IF BIT 6 IS SET LEADING SPACES AND HOR-TABS ARE SUPPRESSED. ; IF BIT 7 IS SET A "CRLF" IS APPENDED TO THE CHARACTER STRING. ; BITS 8-17 CONTAIN THE NUMBER OF CHARACTERS TO BE DISPLAYED. ;THE ONLY ERROR EXIT IS A CALL TO C.STOP CAUSED BY "TELETYPE OUTPUT ;ERROR". A NORMAL RETURN IS A POPJ PP,. ;MODIFIED ACS ARE: 17,15,11,7,6,AND 4. ;AC16= ;THE CALLING UUO ;AC15= ;UUO'S OPERAND ;AC6= ;CHARACTER COUNT ;AC4= ;BLANK COUNT ;AC12 ;MUST NOT BE USED ;FOLLOWING BITS ARE IN LEFT HALF OF FLG BIT6= 4000 ;NUMERIC, SUPPRESS LEADING SPACES AND TABS BIT7= 2000 ;LAST FIELD, APPEND "CRLF" DSPLY.: SKIPE TTYOPN ;IS THERE A TTY FILE OPEN? PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING MOVE AC15,(I16) ;GET DISPLAY OPERAND MOVE FLG,AC15 ;SAVE IT FOR THE FLAGS LDB AC6,DOPFS. ;NUMBER OF CHARS. TO BE DISPLAYED TLZ AC15,7777 ; TLO AC15,700 ;(AC15) IS BYTE POINTER TO CHARS. TLNE FLG,BIT7 ;APPEND CR-LF AT END? JRST DSPL2 ; YES ILDB C,AC15 ;GET A CHARACTER. SKIPE C ;DONT PASS NULLS BUT COUNT THEM PUSHJ PP,OUTEST ;OUTPUT A CHAR. SOJG AC6,.-3 ;LOOP IF NOT DONE. JRST OUTBF. ;DUMP THE BUFFER AND EXIT. DSPL2: SETZ AC4, ;CLEAR THE BLANK COUNT DSPL23: ILDB C,AC15 ;GET A CHARACTER CAIN C,040 ;A BLANK? AOJA AC4,DSPL21 ; YES JUMPE AC4,DSPL22 ;JUMP IF NO ACCUMULATED BLANKS MOVEI C,040 ;OUTPUT BLANKS PUSHJ PP,OUTEST ; SOJG AC4,.-2 ;LOOP LDB C,AC15 ;RESTORE ORIGINAL CHARACTER DSPL22: SKIPE C ;COUNT NULLS BUT DONT OUTPUT THEM PUSHJ PP,OUTEST ;OUTPUT THE CHARACTER DSPL21: SOJG AC6,DSPL23 ;LOOP > ; end of IFE %%RPG DSPL1.: MOVEI C,15 ;APPEND CR-LF PUSHJ PP,OUTCH. ; . MOVEI C,12 ; . PUSHJ PP,OUTCH. ; . JRST OUTBF. ;DUMP BUFFER AND EXIT. IFE %%RPG,< DSPTO: PUSH PP,AC16 ;SAVE AC16 MOVE AC16,TTYOPN ;GET FILE-TABLE ADR FOR ERROR ROUTINES PUSHJ PP,SETCN. ;SETUP IO CHANNEL PUSHJ PP,WRTOUT ;DUMP THE BUFFER POP PP,AC16 ;RESTORE POPJ PP, ;EXIT OUTEST: TLNN FLG,BIT6 ;SUPPRESS LEADING SPACES? JRST OUTCH. ; NO. CAIE C,40 ; YES, ARE THERE ANY? CAIN C,11 ; POPJ PP, ; YES. TLZA FLG,BIT6 ; NO, AND NONE FOLLOWING. > ; END OF IFE %%RPG OUT6B.: ADDI C,40 ;CONVERT A 6IXBIT CHAR OUTCH.: IDPB C,TTOBP. ;DEPOSIT CHAR. IN BUFFER. SOSLE TTOBC. ;DUMP THE BUFFER? POPJ PP, ; NO. ;OUTPUT A TTY BUFFER. ***POPJ*** OUTBF.: SETZ C, ;ASCIZ TERMINATOR IDPB C,TTOBP. ; TTCALL 3,TTOBF. ;DUMP THE BUFFER OUTBF1: MOVE C,[POINT 7,TTOBF.] MOVEM C,TTOBP. ;INITIALIZE THE BYTE-POINTER MOVEI C,^D132 ;A 132 CHAR BUFFER MOVEM C,TTOBC. ;INITIALIZE THE BYTE-COUNT POPJ PP, ; ;RETURN A CHARACTER IN C ;IGNORE "CARRIAGE-RETURN" ;SKIP EXIT IF NOT AN END-OF-LINE CHAR ;POPJ IF EOL, EOL = LF, VT, FF OR ALT-MODE GETCH.: TTCALL 4,C ;INPUT A LINE, FIRST CHAR TO C [EDIT#267] CAIN C,15 JRST GETCH. CAIN C,33 JRST GETCH1 CAIG C,14 CAIGE C,12 JRST RET.2 GETCH1: MOVEI C,12 POPJ PP, SUBTTL OPEN-UUO ;AN OPEN UUO LOOKS LIKE: ;001000,,ADR WHERE ADR = FILE TABLE ADDRESS ;BIT9 =1 OPEN FOR OUTPUT ;BIT10 =1 OPEN FOR INPUT ;BIT11 =1 DON'T REWIND ;BIT12 =0 ALWAYS 0 (VS. 1 = CLOSE) ;CALL+1: POPJ RETURN ;MAKE PRELIMINARY CHECKS: ALREADY OPEN, OPTIONAL FILE PRESENT, ;ANOTHER FILE USING SHARED BUFFER AREA ***OPNDEV*** C.OPEN: TLO AC16,OPEN ;OPEN-UUO MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR BLT AC0,FS.IF ; STATUS WORDS. SETOM FS.IF ;IDX FILE IS DEFAULT MOVE FLG,F.WFLG(I16) HLLZ FLG1,D.F1(I16) ;MORE FLAGS HLRZ AC0,F.WDNM(I16) ;[346] CHECK FLAG TO SEE IF THIS TRNN AC0,4000 ; FILE TABLE HAS BEEN LINKED TO JRST OOVLER ; THE CHAIN. TLNN FLG,OPNIN+OPNOUT ;IS THE FILE OPEN? JRST OPNLOC ;NO HRLZI AC2,(BYTE (5)10,2,3) ;FCBO,AO. MOVEI AC0,^D10 ;ERROR NUMBER JRST OXITER ;ONLY CLOSED FILES MAY BE OPENED OPNLOC: SETZM D.RP(I16) ;INITIALIZE THE RECORD SEQUENCE NUMBER MOVE AC5,D.LF(I16) ; TLNN AC5,LOCK ;SKIP IF THE FILE IS LOCKED JRST OPNOPT ; MOVEI AC0,^D11 ;ERROR NUMBER PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS TTCALL 3,[ASCIZ /LOCKED /] HRLZI AC2,(BYTE(5)10,2,4) JRST MSOUT. ;EXIT, THE FILE IS LOCKED OPNOPT: TLNE AC16,400 ;SKIP IF NOT OUTPUT TLO FLG,OPNOUT ; TLNE AC16,200 ;SKIP IF NOT INPUT TLO FLG,OPNIN ; TLNE FLG1,FILOPT ;IS FILE OPTIONAL? JRST OPNOP ;YES. RETURNS ONLY IF PRESENT OPNSBA: PUSHJ PP,DEVIOW ;RESET THE DEVICE IOWD TLNE FLG,RANFIL ;SKMFILE PUSHJ PP,OPNSFL ;STORE THE FILE LIMITS SO HE CAN'T DIDDLE HLRZ AC4,F.LSBA(I16) ;FILTAB THAT SHARES THE SAME BUFFER OPNSB1: JUMPE AC4,OPNDEV ;JUMP IF NO ONE SHARES CAIN AC4,(I16) ;HAVE WE CHECKED ALL "SBA" FILTAB'S JRST OPNDEV ;YES HLL AC4,10(AC4) ;GET THE FLAGS TLNE AC4,030000 ;SKIP IF ANY FILES ARE NOT OPEN JRST OPNSB2 ;GIVE AN ERROR MESSAGE HLRZ AC4,15(AC4) ;GET NEXT "SBA FILTAB" JRST OPNSB1 ;+LOOP OPNSB2: MOVEI AC0,^D12 ;ERROR NUMBER PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS MOVE AC5,AC4 ;MSOUT. USES AC4 MOVE AC2,[BYTE (5)10,31,20,2,1,14] PUSHJ PP,MSOUT. HRLZI AC2,(BYTE (5)10,31,20) HRR AC16,AC5 JRST MSOUT. ;SOME OTHER FILE IS USING OUR BUFFER AREA OOVLER: HRRZ AC0,HLOVL. ;[346] GET START OF OVERLAY AREA CAIG AC0,(I16) ;[346] IF FILE-TABLE IN OVL AREA JUMPN AC0,OOVLE1 ;[346] COMPLAIN MOVEI AC0,^D30 ;ERROR NUMBER PUSHJ PP,OXITP ;POPJ TO MAIN LINE IF IGNORING ERRORS TTCALL 3,[ASCIZ "ATTEMPT TO DO I/O FROM A SUBROUTINE CALLED BY A NON RESIDENT SUBROUTINE."] ;[346] JRST OOVLE2 ;[346] OOVLE1: MOVEI AC0,^D31 ;ERROR NUMBER PUSHJ PP,OXITP ;POPJ IF IGNORING ERRORS OOVLE2: TTCALL 3,[ASCIZ /IO CANNOT BE DONE FROM AN OVERLAY/] ;[346] HRLZI AC2,(BYTE (5)10,2) ;[346] GO COMPLAIN PUSHJ PP,MSOUT. ;[346] DOESN'T RETURN OPNOP: TLNE FLG,OPNOUT ;SKIP IF NOT OUTPUT JRST OPNSBA ;OUTPUT FILES ARE NOT OPTIONAL ;OPNOP+2 [277] IG 22-OCT-73 PUSHJ PP,$SIGN ;OUTPUT "$" FOR .OPERATOR [EDIT#277] TTCALL 3,[ASCIZ /IS /] ;OPTIONAL FILE PRESENT? PUSHJ PP,MSFIL. TTCALL 3,[ASCIZ / PRESENT? .../] PUSHJ PP,YES.NO ;SKIP RETURN IF "NO" ANSWER JRST OPNOP1 ;YES TLO FLG,NOTPRS ;NO, "NOT PRESENT" TLZ FLG,OPNIN ;NOTE THAT IT'S NOT OPEN MOVEM FLG,F.WFLG(I16) ;%SAVE THE FLAG WORD POPJ PP, ;RETURN TO MAIN LINE *EXIT************ OPNOP1: TLNN FLG,IDXFIL ;ISAM FILE? JRST OPNSBA ;NO MOVE AC1,D.OPT(I16) ;WERE THE BUFFERS SETUP AT RESET TIME? AOJN AC1,OPNSBA ;EXIT HERE IF THEY WERE MOVEI AC0,^D29 ;ERROR NUMBER PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS TTCALL 3,[ASCIZ /EITHER THE ISAM FILE DOES NOT EXIST OR THE VALUE OF ID CHANGED DURING THE PROGRAM/] ;[374] PUSHJ PP,KILL ;AND DONT RETURN YESNO: TTCALL 11,0 ;CLEAR THE BUFFER TTCALL 3,[ASCIZ /$ TYPE YES OR NO /] YES.NO: MOVE AC5,[POINT 7,[ASCIZ /ES/],] PUSHJ PP,GETCH. JRST .-1 CAIE C,"Y" JRST YESNO2 YESNO1: PUSHJ PP,GETCH. POPJ PP, ;IS THE "YES" RETURN ILDB AC4,AC5 JUMPE AC4,RET.1 ;[V10] CAMN AC4,C JRST YESNO1 JRST YESNO YESNO2: MOVE AC5,[POINT 7,[ASCIZ /NO/],] YESNO3: ILDB AC4,AC5 JUMPE AC4,RET.2 ;[V10] CAME AC4,C JRST YESNO PUSHJ PP,GETCH. JRST RET.2 ;THE NO RETURN JRST YESNO3 ;SETUP DEVICE IOWD DEVIOW: HRLOI AC0,77 ; AND AC0,F.WDNM(I16) ; TLC AC0,-1 ; AOBJP AC0,.+1 ; HRR AC0,F.WDNM(I16) ; IFN ISAM,< TLNE FLG,IDXFIL ;IF INDEX FILE AOBJP AC0,.+1 ; POINT AT DATA DEVICE > MOVEM AC0,D.ICD(I16) ; POPJ PP, ; ;SET THE FILE LIMIT CLAUSES IN THE FILE-TABLE. ***POPJ*** OPNSFL: LDB AC5,F.BNFL ;NUMBER OF FILE LIMIT CLAUSES JUMPE AC5,RET.1 ;RETURN IF NONE MOVNS AC5 ; HRL AC1,AC5 ; HRRI AC1,F.WLHL(I16) ;IOWD NUMBER OF,, FILE LIMIT HLR I12,D.BL(I16) ;PICK UP THE BUFFER LOCATION MOVEM AC1,R.FLMT(I12) ; OPNSF1: MOVE AC5,(AC1) ;LIMIT,,LIMIT MOVE AC6,(AC5) ; MOVSS AC5 ; MOVE AC4,(AC5) ; CAMLE AC4,AC6 ;SKIP IF AC4 IS THE LOW LIMIT EXCH AC4,AC6 ; MOVEM AC4,1(AC1) ;LOW LIMIT MOVEM AC6,2(AC1) ;HIGH LIMIT ADDI AC1,2 ;ACCOUNT FOR TWO WORDS AOBJN AC1,OPNSF1 ;GO AGAIN IF YOU CAN POPJ PP, ; ;GET DEVICE CHARACTERISTICS AND CHECK IF DEVICE CAN DO ;REQUESTED IO FUNCTIONS ***OPNCHN*** ;ENTRY POINT FOR READ GENERATED CLOSE GENERATED OPEN. ***READEF+N*** OPNDEV: SETZM D.OE(I16) ;CLEAR NUMBER OF OUTPUTS SETZM D.IE(I16) ; NUMBER OF INPUTS PUSHJ PP,DEVCHR ;GET THE DEVICE CHAR. TLNE AC13,40 ;SKIP IF NOT AVAILABLE TO JOB JRST OPNDE2 MOVE AC2,[BYTE (5)10,2,4,20,15] ;FCBO,DINATTJ. MOVEI AC0,^D13 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE2: TLNN AC13,200000 ;SKIP IF A DSK TRNN AC13,200000 ;SKIP IF DEV IS INITED JRST OPNDE6 MOVE AC2,[BYTE (5)10,2,4,20,16] ;FCBO,DIATAF. MOVEI AC0,^D14 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE6: TLNN FLG,OPNIO ;SKIP IF IO IS REQUESTED JRST OPNDE7 ;NEXT TEST TLNE AC13,200000 ;SKIP IF DEVICE IS NOT A DSK JRST OPNCHN ;FIND A FREE CHANNEL MOVE AC2,[BYTE (5)10,2,4,20,17] MOVEI AC0,^D15 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE7: TLNE FLG,OPNIN ;SKIP IF NOT AN INPUT REQUEST TLNE AC13,2 ;SKIP IF DEVICE CANNOT DO INPUT JRST OPNDE8 ;NEXTEST MOVE AC2,[BYTE (5)10,2,4,20,21] MOVEI AC0,^D16 ;ERROR NUMBER JRST OXITER ;COMPLAIN OPNDE8: TLNE FLG,OPNOUT ;SKIP IF NOT AN OUTPUT REQUEST TLNE AC13,1 ;SKIP IF DEVICE CANNOT DO OUTPUT JRST OPNCHN ;FIND A FREE CHAN MOVE AC2,[BYTE (5)10,2,4,20,22] MOVEI AC0,^D17 ;ERROR NUMBER JRST OXITER ;COMPLAIN DEVCHR: MOVE AC13,D.ICD(I16) ;ADR OF DEV. NAME MOVE AC13,(AC13) ;SIXBIT/DEVICE NAME/ MOVEM AC13,UOBLK.+1 ;FOR OPEN CALLI AC13,4 ;DEVCHR UUO TLNN FLG,OPNIO+OPNIN ;[330]IF NOT INPUT THEN IGNORE JRST DEVCH1 ;[330] TLC AC13,300000 ;[330]IF A DSK AND A CDR TLCN AC13,300000 ;[330]THEN ITS DEVICE 'NUL' TLZ AC13,20 ;[330]SO ITS NOT A MAGTAPE DEVCH1: MOVEM AC13,D.DC(I16) ;[330]SAVE THE CHARACTERISTICS SKIPE AC13 POPJ PP, MOVE AC2,[BYTE (5)10,2,4,20,13] ;FCBO,DINAD. POP PP,(PP) ;POP OFF THE RETURN MOVEI AC0,^D18 ;ERROR NUMBER JRST OXITER ;COMPLAIN ;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS ;XCT OPEN, INBUF AND/OR OUTBUF ***OPNBSI*** OPNCHN: PUSHJ PP,GCHAN ;LOAD AC5 WITH A CHANNEL NUMBER DPB AC5,DTCN. ;SAVE IT IFN ISAM,< TLNN FLG,IDXFIL ;INDEX FILE ? JRST OPNCH1 ;NO PUSHJ PP,GCHAN ; HLRZ I12,D.BL(I16) ; HRRZM AC5,ICHAN(I12) ;SAVE INDEX FILE CHAN NO. > OPNCH1: PUSHJ PP,SETC1. ;DISTRIBUTE THE CHANNEL NUMBER TLNE FLG,DDMASC ;SKIP IF NOT ASCII TDZA AC6,AC6 ;ASCII MODE AND SKIP MOVEI AC6,14 ;PERHAPS BINARY TLNE FLG,RANFIL!OPNIO!IDXFIL ;SKIP IF BUFFERED IO MOVEI AC6,17 ;DUMP MODE HRRM AC6,UOBLK. ;UOBLK.+1 SET AT DEVCHR HRLI AC6,D.OBH(I16) ;OUTPUT BUFFER HEADER HRRI AC6,D.IBH(I16) ;INPUT BUF HDR MOVEM AC6,UOBLK.+2 IFN ISAM,< TLNN FLG,IDXFIL ;ISAM ? JRST OPNCH3 ;NO MOVE AC1,F.WDNM(I16) ;ADR MOVE AC1,(AC1) ;IDX DEVICE NAME MOVEM AC1,UOBLK.+1 ; OPNCH3:> SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNC31 ; NO IFE TOPS20,< PUSHJ PP,OPNFOP ; YES OPEN FILE VIA FILOP JRST OFERR ; ERROR RETURN >; END OF IFE TOPS20 IFN TOPS20,< PUSHJ PP,OCPT ; OPEN FILE VIA DEC-SYS-20 COMPT. JRST OCPER ; ERROR RETURN >; END IFN TOPS20 JRST OPNC41 ; OPNC31: XCT UOPEN. ;OPEN THE DEVICE *************** OPNCH4: JRST OERRIF ;OPEN FAILED OPNC41: PUSHJ PP,OPNWPB ;RETS LOGICAL BLOCK SIZE IN AC10, BLKFTR IN AC5 LDB AC6,F.BNAB ;NUMBER OF ALTERNATE BUFFERS (FOR INBUF X,2(AC6)) TLNE AC13,20 ;SKIP IF NOT A MTA JUMPN AC5,OPNNSB ;NON STANDARD BUFFER SIZE IFN ISAM,< TLNE FLG,IDXFIL ;ISAM ? JRST OPNIDX ;YES > TLNE FLG,OPNIO+RANFIL ;OPNIO=IOFILE JRST OPNRIO ;RANDOM OR IO DUMP MODE BUFFERS PUSH PP,.JBFF HLRZ AC11,D.BL(I16) ;BUFFER LOCATION MOVEM AC11,.JBFF CAIN AC6,77 ; [414] REALLY WANTS ONE? SETOI AC6, ; [414] YES, ONE BUFFER. TLNE FLG,OPNIN ;INPUT? XCT UIBUF. ;********** TLNE FLG,OPNOUT ;OUTPUT? XCT UOBUF. ;********** POP PP,.JBFF ;RESTORE .JBFF OPNCH2: TLNE AC13,4 ;SKIP IF NON-DIRECTORY DEVICE TLNE FLG1,STNDRD ;SKIP IF NOT STANDARD LABELS JRST OPNBSI ;SET THE BYTE SIZE PUSHJ PP,RCHAN ;RELEASE DEVICE AND CHANNEL MOVEI AC0,^D19 ;ERROR NUMBER PUSHJ PP,OXITP ;RETURN TO CBL-PRG IF IGNORING ERRORS MOVE AC2,[BYTE (5)10,2,4,26] ;FCBO,DDMHSL JRST MSOUT. ;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK). ***OPNCH2*** OPNNSB: ADDI AC6,2 ;ALTERNATE PLUS 2 DEFAULT BUFFERS TLNE FLG1,STNDRD+NONSTD ;SKIP IF OMITTED LABELS HRRZ AC10,D.LRS(I16) ;IN CASE LABEL IS GE TO REC AREA HLRZ AC4,D.BL(I16) ;BUFFER LOCATION ADDI AC4,1 ;BUF1+1 HRLI AC4,400000 ; AND NEVER WAS REFERENCED MOVEM AC4,D.IBH(I16) ;INPUT HEADER MOVEM AC4,D.OBH(I16) ;OUTPUT HEADER HRR AC2,AC4 ;BUF1+1 HRLI AC2,1(AC10) ;SIZE+1,,BUF1+1 SKIPA AC3,AC4 ;BUF1+1 OPNNS1: ADDI AC3,3(AC10) ;LOCATION OF NEXT LINK ADDI AC2,3(AC10) ;SIZE+2,, MOVEM AC2,(AC3) ;SIZE+2,,BUF2+1 SOJG AC6,OPNNS1 ;LOOP IF ANY MORE BUFFERS HRRM AC4,(AC3) ;LAST BUFFER CLOSES THE RING (BUF1+1) ADDI AC4,1 ;BUF1+2 HRRM AC4,D.IBB(I16) ;INPUT HEADER BYTE POINTER HRRM AC4,D.OBB(I16) ;OUTPUT H... JRST OPNCH2 ;RETURN TO MAIN LINE ;AC10 = WORDS PER LOGICAL BLOCK ;INITIALIZE DUMP MODE BUFFERS FOR RANDOM AND IO. ***OPNCON*** OPNRIO: HLRZ I12,D.BL(I16) ;BUFFER LOCATION MOVNM AC10,AC6 ;0,,-N HRLI AC6,R.FLMT(I12) ;LOC-1,,-N MOVSM AC6,R.IOWD(I12) ;-N,,LOC-1 SETZM R.TERM(I12) ;IOWD TERMINATOR SETZM R.DATA(I12) ;NO ACTIVE DATA IN BUFFER SETZM R.BPLR(I12) ;NO INPUTS DONE FOR THIS FILE SETOM R.WRIT(I12) ;LAST UUO WAS A WRITE LDB AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE HLL AC6,RBPTB1(AC6) ; AND BYTE-POINTER HRRI AC6,1+R.FLMT(I12);FIRST DATA WORD TLNE FLG1,VLREBC ; IF VAR-LEN EBCDIC RECORDS ADDI AC6,1 ; SKIP OVER THE BLOCK-DESCRIPTOR-WORD MOVEM AC6,R.BPNR(I12) ; NEXT RECORD MOVEM AC6,R.BPFR(I12) ;BYTE POINTER TO THE FIRST RECORD JRST OPNCON ;RET IFN ISAM,< ;SETUP INDEX FILE BUFFER AND TABLE AREAS OPNIDX: SETZM USOBJ(I12) ;[377] CLEAR THE FIRST WORD OF INDEX TABLE HRRI AC0,USOBJ+1(I12);TO HRLI AC0,USOBJ(I12) ;FROM,,TO HRRZI AC1,ITABL-15+ICHAN(I12) ;UNTIL BLT AC0,(AC1) ;CLEAR REST OF INDEX TABLE HRLZ AC0,D.IBL(I16) ; [377] SEE IF WE HAVE A SAVE AREA JUMPE AC0,OPNIX1 ; [377] NO- GO ON HRRI AC0,ISCLR1(I12) ; [377] SET UP TO HRRZI AC1,ISCLR2(I12) ; [377] MOVE ISAM SAVE AREA TO BLT AC0,(AC1) ; [377] TO SHARED BUFFER AREA OPNIX1: PUSHJ PP,OPNLIX ;INDEX FILE-NAME TO LOOKUP BLOCK SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNIX2 ; YES XCT ULKUP. ;LOOKUP JRST OLERRI ;LOOKUP FAILED OPNIX2: TLNN FLG,OPNOUT ;OPEN FOR UPDATING? JRST OPNI01 ;NO OPNI00: TLO FLG1,EIX ;ENTER OF .IDX FILE IN PROGRESS PUSHJ PP,OPNEIX ;INDEX FILE-NAME TO ENTER BLOCK SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNIX3 ; YES XCT UENTR. ;ENTER, FOR UPDATING JRST OEERRI ;ENTER FAILED OPNIX3: TLZ FLG1,EIX ;FREE THIS BIT FOR "RIVK" FLAG OPNI01: HRLZI AC1,STABL ;STATISTICS BLOCK LEN MOVNS AC1 ; HRR AC1,I12 ; SUBI AC1,1 ;DUMP MODE IOWD MOVEM AC1,IOWRD+14(I12) ;SAVE IN IOWRD TABLE SETZ AC2, ;TERMINATOR MOVEI AC0,1 ; HRRM AC0,UIN. ; XCT UIN. ;READ THE STATISTICS BLOCK JRST OPNI02 ; MOVE AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER PUSHJ PP,IGMIR ;IGNORE THE ERROR? JRST RCHAN ;YES - RELEASE THE IO CHANNELS TTCALL 3,[ASCIZ /OPEN FAILED - /] TTCALL 3,[ASCIZ /CANNOT READ STATISTICS BLOCK/] PUSHJ PP,SETIC ;SET UP IGETS CHANNEL NO. JRST IINER ;OPEN THE DATA FILE OPNI02: HLLZS UIN. ;CLEAR THE IOWR POINTER MOVEI AC0,17 ;DUMP MODE HRRM AC0,UOBLK. ;SETUP OPEN BLOCK MOVE AC1,F.WDNM(I16) ; MOVE AC1,(AC1) ; MOVEM AC1,UOBLK.+1 ; SETZM UOBLK.+2 ; PUSHJ PP,SETCN. ;SET DATA FILE CHANNEL SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNI21 ; NO IFE TOPS20,< PUSHJ PP,OPNFPD ; OPEN FILE VIA FILOP UUO JRST OFERRI ; ERROR RETURN >; END IFE TOPS20 IFN TOPS20,< PUSHJ PP,OCPTD ; OPEN FILE VIA DEC-SYS-20 COMPT. JRST OCPERI ; ERROR RETURN >;END IFN TOPS20 JRST OPNI22 ; SKIP THE OPEN UUO OPNI21: XCT UOPEN. ;OPEN THE DATA FILE JRST OERRDF ;ERROR RETURN ;SETUP IOWRD TABLE OPNI22: MOVEI AC3,BA(I12) ; MOVE AC1,ISPB(I12) ;SECTORS PER BLOCK IMULI AC1,200 ;WORDS PER SECTOR MOVN AC2,AC1 ;-LEN HRLZS AC2 ;-LEN,,0 HRRI AC2,-1(AC3) ;IOWD, -LEN,,LOC-1 SKIPN AC4,OMXLVL(I12) ;USE ORIGINAL # OF LEVELS MOVN AC4,MXLVL(I12) ;MAXIMUM NUMBER OF INDEX LEVELS MOVEM AC4,OMXLVL(I12) ;SAVE INCASE THIS FILE IS OPENED AGAIN ;[V10] SKIPN CORE0(I12) ; SKIP IF NOT FIRST OPEN FOR THIS FILE SUBI AC4,1 ;PLUS ONE FOR SPLITTING THE TOP LEVEL HRLZS AC4 ; HRRI AC4,IOWRD+1(I12) ; SKIPN (AC4) ;IF IOWRD'S ALREADY SETUP MOVEM AC2,(AC4) ; ADD AC2,AC1 ; AOBJN AC4,.-3 ;LOOP MOVN AC5,MXLVL(I12) ;SEE IF ANY NEW INDEX LEVELS WERE SUB AC5,OMXLVL(I12) ; CREATED SINCE LAST TIME FILE WAS OPEN JUMPE AC5,OPNI06 ;SKIP THE FOLLOWING IF NOT HRL AC4,AC5 ;NEW LEVEL(S) HRRZ AC5,ISPB(I12) ; SECTORS PER BLOCK [EDIT#306] IMULI AC5,200 ; WORDS PER SECTOR [EDIT#306] MOVN AC6,AC5 ; NEGATE THE LENGTH [EDIT#306] HRLZS AC6 ; -LENGTH,,0 [EDIT#306] HRR AC6,.JBFF ; SO MAKE SUBI AC6,1 ; ANOTHER IOWD OPNI03: SKIPE (AC4) ;USE ONLY IF JRST OPNI04 ; ANOTHER JOB MADE THE NEW LEVEL SKIPE KEYCV. ;ARE WE SORTING? JRST OPNIR0 ;YES - CANT HANDLE THAT HRRZ AC0,AC5 ;SET UP AC0 [EDIT#306] PUSHJ PP,GETSPC ;GET MORE CORE JRST OPNIR1 ;TOO BAD HRRZ AC0,HLOVL. ;DOES THE SPACE WE GOT CAMGE AC0,.JBFF ; EXTEND INTO THE OVL-AREA? JUMPN AC0,WOVLR1 ;GO COMPLAIN IF IT DOES MOVEM AC6,(AC4) ;USE IT ADD AC6,AC1 ;SET UP FOR NEXT IOWD OPNI04: AOBJN AC4,OPNI03 ;LOOP IF YOU MUST OPNI06: SKIPN IOWRD+13(I12) ; SKIP IF ALREADY DONE MOVEM AC2,IOWRD+13(I12);SAT BLOCK ADD AC2,AC1 ; ;IOWRD0, USOBJ0, CNTRY0, NNTRY0 - SET TO INDEX ON LVL HRLZI AC0,LVL ;HOLDS CURRENT LEVEL OF INDEX HRRI AC0,IOWRD(I12) ; MOVEM AC0,IOWRD0(I12) ; HRRI AC0,USOBJ(I12) ; MOVEM AC0,USOBJ0(I12) ; HRRI AC0,CNTRY(I12) ; MOVEM AC0,CNTRY0(I12) ; HRRI AC0,NNTRY(I12) ; MOVEM AC0,NNTRY0(I12) ; ;SET BRISK FLAG OUTPUT ONLY WHEN YOU MUST LDB AC5,F.BDIO ;GET DEFERRED ISAM OUTPUT FLAG JUMPE AC5,OPNI61 ; 0 = NO DEFERRED OUTPUTS SKIPN F.WSMU(I16) ; NO DEFERRED OUTS IF SIMU-UPDATE SETOM BRISK(I12) ;CHECK FILTAB BLKFTR VS STAT-BLK BLKFTR OPNI61: LDB AC0,F.BMRS ; GET PROGRAMS MAX REC SIZE [371] CAMN AC0,RECBYT(I12) ; SEE IF SAME AS ISAM PARM [371] JRST OPNI07 ; IT DOES- OF [371] CAML AC0,RECBYT(I12) ; [375] WHICH WAY IS FD DIFFERENT? JRST OPNGR ; [375] FD GT ISAM TLNN FLG,OPNIN+OPNIO ; [375] FD LT ISAM-FILE OPEN FOR OUTPUT? JRST OPNI07 ; [375] YES OKAY JRST OPNER1 ; [375] NO-INPUT OR I/O ERROR OPNGR: TLNN FLG,OPNIO+OPNOUT ; [375] FD GT ISAM- IS FILE OPEN FOR INPUT ? JRST OPNI07 ; [375] YES OKAY OPNER1: ; [375] TTCALL 3,[ASCIZ /USERS MAXIMUM RECORD SIZE /] ; [371] PUSHJ PP,PUTDEC ; TYPE IT [371] TTCALL 3,[ASCIZ / DIFFERS FROM ISAM PARAMETER /] ;[371] MOVE AC0,RECBYT(I12) ; GET ISAM MAX REC SIZE [371] PUSHJ PP,PUTDEC ; TYPE IT [371] JRST OPNERX ; FINISH UP MSG AND STOP RUN [371] OPNI07: ; [371] PUSHJ PP,OPNWPB ;AC5 = BLKFTR, AC10 = WPB MOVE AC6,DBF(I12) ;DATA FILE BLOCKING FACTOR VIA STA BLOCK CAMN AC5,AC6 ;AC5 = BLKFTR VIA FILE TABLE JRST OPNI05 ;OK MOVE AC0,[E.FIDX+^D9] ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE THE ERROR? JRST RCHAN ;YES - RELEASE IO CHANS TTCALL 3,[ASCIZ /USERS BLOCKING FACTOR /] ; [371] MOVE AC0,AC5 ; GET USER BF [371] PUSHJ PP,PUTDEC ; TYPE IT [371] TTCALL 3,[ASCIZ / DIFFERS FROM ISAM PARAMETER /] ;[371] MOVE AC0,AC6 ; GET ISAM BF [371] PUSHJ PP,PUTDEC ; TYPE IT [371] OPNERX: ; [371] TTCALL 3,[ASCIZ/ /] ; [371] MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;IOWRD(I12) - SET DATA BLOCK IOWD POINTER OPNI05: MOVN AC5,AC10 ; HRL AC2,AC5 ; SKIPN IOWRD(I12) ;SKIP IF ALREADY SETUP BY PREVIOUS OPEN MOVEM AC2,IOWRD(I12) ;DATA BLOCK ADDI AC2,1(AC10) ;AC2 POINT AT NEXT FREE AREA ;IBLEN - LEN OF INDEX BLOCK FOR BINARY SEARCH MOVE AC0,EPIB(I12) ; IMUL AC0,IESIZ(I12) ;NO. OF WRDS IN IDX BLK MOVEM AC0,IBLEN(I12) ;IDX BLK LEN ;SINC - SEARCH INCREMENT FOR BINARY SEARCH MOVE AC1,IESIZ(I12) ;THE INCREMENT TO BE IMULI AC1,2 ; CAMG AC1,AC0 ;INC GT INDEX LENGTH? JRST .-2 ;NO MOVEM AC1,SINC(I12) ;SAVE THE SEARCH INCREMENT ;DAKBP - BYTE POINTER TO DATA ADJUSTED KEY MOVE AC1,DBPRK(I12) ;START WITH RELATIVE DATA KEY BP HRRI AC1,(AC2) ; MOVEM AC1,DAKBP(I12) ;DATA ADJUSTED KEY BYTE POINTER SETZM (AC1) ;ZERO THE FIRST DATA REC-KEY WRD ADDI AC1,1 ; MOVEM AC1,DAKBP1(I12) ;POINTER TO SECOND REC-KEY WRD ADD AC1,IESIZ(I12) ;KEY SIZE PLUS 2 WRD HDR SUBI AC1,2 ;PERMIT 1 EXTRA WRD FOR WRAP-AROUND SETZM -1(AC1) ;ZERO LAST DATA REC-KEY WRD ;RESERVE AREA FOR INDEX ENTRY ADDI AC1,2 ;LOC FOR BLOCK # AND VERSION # ;IAKBP - BYTE POINTER TO INDEX ADJUSTED KEY TLZ AC1,770000 ; TLO AC1,440000 ; MOVEM AC1,IAKBP(I12) ;INDEX ADJUSTED KEY BP ADDI AC1,1 ; MOVEM AC1,IAKBP1(I12) ;POINTER TO SECOND IDX-KEY WRD ADD AC1,IESIZ(I12) ; SUBI AC1,2 ; SETZM -1(AC1) ;ZERO LAST IDX-KEY WRD ;AC1 POINTS TO NEXT FREE AREA HRLI AC1,-1(AC1) ;UNTIL HRRI AC1,ICHAN(I12) ;UNTIL,,FROM SKIPN CORE0(I12) ; SKIP IF NOT THE FIRST OPEN MOVEM AC1,CORE0(I12) ;CLOSE CLEARS THIS CORE AREA ;AUXIOW - SETUP THE IOWD MOVN AC0,MXBUF ;MAX BUFFER SIZE HRL AC0,AC0 ; HRR AC0,AUXBUF ; SUBI AC0,1 ;LOC-1 MOVEM AC0,AUXIOW ;SAVE IT ;KWCNT - NUMBER OF WORDS IN THE KEY MOVE AC1,IESIZ(I12) ;SETUP KWCNT SUBI AC1,2 ; ;HRRM AC1,IKWCNT(I12) ; ;HRRM AC1,DKWCNT(I12) ; MOVNS AC1 ; HRLM AC1,IKWCNT(I12) ;-CNT,,CNT ;FWMASK, LWMASK - CREATE 2 MASK WORDS FOR FIRST AND LAST DATA-KEY WORDS LDB AC0,KY.TYP ; GET KEY TYPE JUMPN AC0,OPNBPS ; JUMP IF NOT NON-NUMERIC DISPLAY LDB AC1,KY.SIZ ; GET KEY SIZE MOVN AC2,AC1 ; HRLZS AC2 ; MOVE AC3,DBPRK(I12) ;RELATIVE DATA-RECORD-KEY POINTER OPNMSK: IBP AC3 AOBJN AC2,.+1 TLNE AC3,760000 ;STAY WITH IN THE FIRST WORD JUMPL AC2,OPNMSK ;UNLESS WE RUN OUT OF BYTES LDB AC4,[POINT 6,DBPRK(I12),5] SETZ AC5, ; SETO AC6, ; LSHC AC5,(AC4) ; MOVEM AC5,FWMASK(I12) ;007777 FIRST WORD MASK TLNN AC3,760000 ; JRST OPNMS1 ; LDB AC4,[POINT 6,AC3,5] ;THE KEY IS LESS THAN ONE WORD MOVNS AC4 ; LSH AC5,(AC4) ; MOVNS AC4 ; LSH AC5,(AC4) ; JRST .+2 ;007700 AC5 HAS MASK OPNMS1: JUMPL AC2,OPNMS2 ;IS KEY GREATER THAN ONE WRD? SETZM FWMASK(I12) ;NO, ONE WRD OR LESS MOVEM AC5,LWMASK(I12) ; JRST OPNBPS ;DONE OPNMS2: LDB AC4,KY.MOD ; GET MODE OF KEY HRRZ AC4,RBPTB1(AC4) ; GET BYTES PER WORD HLRES AC2 ; MOVMS AC2 ;MAKE IT POSITIVE IDIV AC2,AC4 ; SKIPN AC3 ;REMAINDER? SKIPA AC3,AC4 ;NO--BYTES PER WORD ADDI AC2,1 ;YES LDB AC4,[POINT 6,DBPRK(I12),11]; GET BITS PER BYTE MOVNS AC2 ; HRLM AC2,DKWCNT(I12) ;NUMBER OF REC-WRDS -1 THAT CONTAIN THE KEY IMUL AC3,AC4 ; SETO AC6, ; SETZ AC5, ; MOVNS AC3 ROTC AC5,(AC3) ; MOVEM AC5,LWMASK(I12) ;MASK FOR THE LAST REC-DATA-KEY WRD ;BPSB - NUMBER OF BITS PER SAT BLOCK OPNBPS: MOVE AC0,FILSIZ(I12) ;TOTAL NUMBER OF DATA BLOCKS IN FILE IDIV AC0,SBTOT(I12) ; WILL GIVE NUMBER PER SAT BLOCK MOVEM AC0,BPSB(I12) ;SAVIT ;ICMP, DCMP - SETUP DISPATCH ADR FOR COMPARE ROUTINES ;0 = DCDNN, 1 = DC1S/U, 2 = DC2S/U OPNDSP: LDB AC2,KY.TYP ; GET KEY TYPE JUMPE AC2,OPNDS1 ; ZERO STAYS A ZERO TRNE AC2,1 ; TRZA AC2,-2 ; ODD BECOMES 1 HRRZI AC2,2 ; EVEN BECOMES 2 OPNDS1: HRRZ AC0,KEYDES(I12) ; GET KEY SIGN TRNE AC0,100000 ; SKIPA AC3,ICTAB(AC2) ;UNSIGNED MOVS AC3,ICTAB(AC2) ;SIGNED HRRZM AC3,ICMP(I12) ;INDEX COMPARE ROUTINE TRNE AC0,100000 ; SKIPA AC3,DCTAB(AC2) ; MOVS AC3,DCTAB(AC2) ; HRRZM AC3,DCMP(I12) ;DATA COMPARE ROUTINE LDB AC5,KY.TYP ; GET KEY TYPE CAIGE AC5,3 ; 0 THRU 8 JUMPN AC5,OPNDS2 ; 0, 1, 2 CAIGE AC5,7 ; 0, 3, 4, 5, 6, 7, 8 JRST OPNRSB ; 0, 3, 4, 5, 6 ;HERE IF NUMERIC DISPLAY OR COMP-3 ;SETUP CONVERT TO BINARY ROUTINES OPNDS2: HLLZ AC1,F.WBRK(I16) ;POSITION IN DATA-REC TRNE AC0,100000 ; TLZA AC1,4000 ;UNSIGNED TLO AC1,4000 ;SIGNED ??? LDB AC2,KY.SIZ ; GET KEY SIZE DPB AC2,[POINT 11,AC1,17] ; MOVEM AC1,GDPRK(I12) ;GD PARAMETER FOR REC-KEY HRR AC1,F.WBSK(I16) ;ADR OF SYMKEY TLZ AC1,770000 ;MASK HLLZ AC2,F.WBSK(I16) ; TLZ AC2,7777 ; IOR AC1,AC2 ;SYM-KEY BYTE RESIDUE MOVEM AC1,GDPSK(I12) ;GD PARAMETER FOR SYM-KEY LDB AC2,[POINT 2,FLG,14] ; GET KEY MODE HRRZ AC1,GDTBL(AC2) ; GET CONVERSION ROUTINE CAIL AC5,7 ; IF COMP-3 HRRZI AC1,GC3. ; USE THIS ROUTINE MOVEM AC1,GDX.I(I12) ; SYM-KEY VS INDEX ENTRY LDB AC2,KY.MOD ; GET KEY MODE HLRZ AC1,GDTBL(AC2) ; GET CONVERSION ROUTINE CAIL AC5,7 ; IF COMP-3 HRRZI AC1,GC3. ; USE THIS ROUTINE MOVEM AC1,GDX.D(I12) ; SYM-KEY VS DATA FILE KEY ;DCMP,DCMP1 - SETUP TO CONVERT THEN COMPARE HRRZM AC3,DCMP1(I12) ;COMPARE ROUTINE HRRZI AC3,DGD67 ;CONVERSION ROUTINE MOVEM AC3,DCMP(I12) ;CONVERT THEN COMPARE ;RSBP - BR TO SIXBIT/ASCII RECORD SIZE OPNRSB: MOVE AC1,[POINT 12,-1(AC4),35] TLNN FLG,DDMSIX!DDMEBC; MOVE AC1,[POINT 12,-1(AC4),34] MOVEM AC1,RSBP(I12) SUBI AC1,-1 MOVEM AC1,RSBP1(I12) ;GETSET - SETUP KEY FOR SEARCH ROUTINES OPNGST: LDB AC1,KY.TYP ; GET KEY TYPE JUMPN AC1,.+2 ; MOVEI AC2,ADJKEY ;DNN CAIE AC1,1 ; CAIN AC1,2 ; MOVEI AC2,GD67 ;DN CAIL AC1,3 ; MOVEI AC2,FPORFP ;FP CAIE AC1,7 ; COMP-3? CAIN AC1,10 ; ? MOVEI AC2,GD67 ; YES MOVEM AC2,GETSET(I12) ;DISPATCH FOR SEARCH INITIALIZING ;RECBP - SETUP REC AREA BYTE-POINTER LDB AC2,[POINT 2,FLG,14]; GET MODE OF RECORD AREA HLL AC2,RBPTB1(AC2) ; GET A BYTE-PTR HRR AC2,FLG ;ADR OF REC MOVEM AC2,RECBP(I12) ; ;NOW CLEAR SOME IDX BUFFER AREAS MOVEI AC6,IOWRD+2(I12); START WITH SECOND IDX LEVEL OPNZBF: SKIPN AC2,(AC6) ; GET THE IOWRD TO AC2 JRST OPNZB1 ; THERE IS NONE FOR THIS LEVEL HRLI AC1,1(AC2) ; THE "FROM" ADDR HRRI AC1,2(AC2) ; THE "TO" ADDR SETZM -1(AC1) ; ZERO FIRST WORD HLRO AC2,AC2 ; GET THE LENGTH HRRZI AC3,-2(AC1) ; GET "FROM"-1 SUB AC3,AC2 ; GET "UNTIL" ADDR BLT AC1,(AC3) ; SMEAR THE ZERO OPNZB1: CAIE AC6,IOWRD+13(I12);SKIP WHEN DONE AOJA AC6,OPNZBF ; ELSE LOOP JRST OPNCH2 ; OPNIR0: MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS MOVE AC0,[E.FIDX+^D7] ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST RCHAN ;YES - RELEASE IO CHANNELS TTCALL 3,[ASCIZ /CANNOT EXPAND CORE WHILE SORT IS IN PROGRESS/] JRST OMTA99 OPNIR1: MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS MOVE AC0,[E.FIDX+^D8] ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST RCHAN ;YES - RELEASE IO CHANS PUSHJ PP,GETSP9 ;CORE UUO FAILED JRST OMTA99 ;DISPATCH FOR INDEX COMPARE ROUTINES ICTAB: XWD ICDNN, ICDNN ;DISPLAY NON-NUMERIC XWD IC1S, IC1U ;ONE WRD SIGNED / UNSIGNED XWD IC2S, IC2U ;TWO WRD SIGNED / UNSIGNED ;DISPATCH FOR DATA COMPARE ROUTINES DCTAB: XWD DCDNN, DCDNN ;DISPLAY NON-NUMERIC XWD DC1S, DC1U ;ONE WRD SIGNED / UNSIGNED XWD DC2S, DC2U ;TWO WRD SIGNED / UNSIGNED ;DISPATCH FOR DATA CONVERSION ROUTINES PDTBL: PD6.,,GD6. ; SIXBIT TO BINARY PD9.,,GD9. ; EBCDIC PD7.,,GD7. ; ASCII ;INDEX TO LEFT HALF IS KY.MOD FOR DSRCH ;INDEX TO RIGHT-HF IS CORE-DATA-MODE FOR IBS GDTBL: GD6.,,GD7. GD9.,,GD9. GD7.,,GD6. > ;RETURNS IN AC10 NUMBER OF WORDS PER LOGICAL BLOCK ;AND BLOCKING FACTOR IN AC5. ***POPJ*** OPNWPB: LDB AC5,F.BBKF ;BLOCKING FACTOR MOVEM AC5,D.RCL(I16) ; LDB AC10,F.BMRS ;MAX RECORD SIZE IFN ISAM,< TLNE FLG,IDXFIL ; [375] IS THIS AN ISAM FILE? MOVE AC10,RECBYT(I12); [375] YES-USE ISAM PARAM > TLNE FLG,DDMBIN ;IF MODE IS BINARY, JRST OPNWP3 ; CONVERT SIZE TO WORDS LDB AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE HRRZ AC6,RBPTBL(AC6) ; AND THEN CHARS PER WORD HRRZM AC6,D.BPW(I16) ;CHARS PER WORD JUMPL FLG,OPNWP1 ;JUMP IF ASCII TLNE FLG,DDMEBC ; SKIP IF NOT EDCBIC JRST OPNWP4 ; EBCDIC! OPNWP5: ADD AC10,AC6 ; ACCOUNT FOR THE HEADER WORD OPNWP2: ADDI AC10,-1(AC6) ;ROUND UP IDIV AC10,AC6 ;RECSIZ/CPW IMUL AC10,AC5 ;WORDS PER LOGBLK POPJ PP, ; OPNWP4: SKIPGE D.F1(I16) ; IF VARIABLE LEN EBCDIC RECORDS ADDI AC10,(AC6) ; INCLUDE RDW WITH REC-SIZE JRST OPNWP6 ; OPNWP1: ADDI AC10,2 ;FOR CRLF OPNWP6: IFN ISAM,< TLNE FLG,IDXFIL ;INDEX FILE? [372] JRST OPNWP5 ; YES USE DIFFERENT CALC [372] > IMUL AC10,AC5 ; NO. OF CHARS IN LOGIGAL BLOCK [372] PUSH PP,AC10 ; SAVE CPL ADDI AC10,-1(AC6) ; ROUND UP [372] IDIVI AC10,(AC6) ; NO. OF WORDS PER LOGICAL BLOCK [372] POP PP,AC6 ; RESTORE CHARS-PER-LOGI-BLK MOVEM AC6,D.TCPL(I16) ; TOTAL CHARS/LOG-BLOCK TLNE FLG,OPNIN ; D.FCPL MUST BE ZERO FOR SETZ AC6, ; THE FIRST READ UUO MOVEM AC6,D.FCPL(I16) ; FREE CHARS/LOG-BLOCK TLNE FLG1,VLREBC ; VAR-LEN EBCDIC FILE? ADDI AC10,1 ; YES - ADD 1 FOR BDW POPJ PP, ; [372] ;RECORDING MODE IS BINARY--CONVERT SIZE TO WORDS OPNWP3: LDB AC6,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC6,RBPTBL(AC6) ; AND THEN CHARS PER WORD JRST OPNWP2 ;SET DEVICE TABLE BUFFER HEADER BYTE SIZE ;SETUP CONVERSION FLG ***OPNLO*** OPNBSI: JUMPL FLG,OPNCON ;JUMP IF DEVICE IS ASCII TLNE FLG,DDMBIN ;IF MODE IS BINARY, JRST OPNBPB ; DON'T TOUCH BYTE POINTER MOVEI AC6,6 ;SIXBIT BYTE SIZE TLNN FLG,DDMEBC ; SKIP IF EBCDIC JRST OPNBS1 ; NOT EBCDIC MOVEI AC6,^D9 ; EBCDIC IS 9 BITS WIDE TLNN AC13,20 ; IS DEVICE A MTA? JRST OPNBS1 ; NO HRRZ AC1,F.WDNM(I16) ; HOW MANY TRACKS ON THIS DRIVE? MOVE AC1,(AC1) ; SIXBIT DEVICE NAME FOR MTCHR. AC1, ; GET CHARACTERISTICS SETZ AC1, ; ERROR RET - ASSUME ITS OK (IE 9TRK) TRNE AC1,1B31 ; 9 CHANNEL? JRST OPNBS1 ; 7 CHANNEL. MOVEI AC6,^D8 ; 9TRK SO 8 BITS WIDE XCT MTIND. ; AND INDUSTRY COMPATIBLE MODE OPNBS1: DPB AC6,DTIBS. ;INPUT HEADER BYTE-POINTER DPB AC6,DTOBS. ;OUTPUT H... OPNCON: LDB AC0,[POINT 3,FLG,2] ; GET DEVICE DATA MODE LDB AC1,[POINT 3,FLG,14] ; GET CORE DATA MODE CAME AC0,AC1 ; EQUAL? TLO FLG,CONNEC ; NO, SET THE CONVERSION FLAG ;PRESUMES AC10 HAS WRDS/LOGICAL BLOCK ;SETUP BUFFERS PER LOGICAL BLOCK AND ;NUMBER OF RECORDS TO A RERUN DUMP ;AND THE CONVERSION INSTRUCTION. OPNBPB: LDB AC1,[POINT 2,FLG,2] ; GET DEVICE DATA MODE LDB AC2,[POINT 2,FLG,14] ; AND CORE DATA MODE MOVE AC3,@RCTBL(AC1) ; GET CONVERSION INSTRUCTION TLNE FLG,DDMBIN ; IF A BINARY DEVICE MOVSI AC3,(JFCL) ; NO CONVERSION MOVEM AC3,D.RCNV(I16) ; SAVE FOR LATER - READ MOVE AC3,@WCTBL(AC2) ; GET CONVERSION INSTRUCTION TLNE FLG,DDMBIN ; IF A BINARY DEVICE MOVSI AC3,(JFCL) ; NO CONVERSION MOVEM AC3,D.WCNV(I16) ; SAVE FOR LATER - WRITE MOVEI AC0,200 ;DSK BUFFER SIZE TLNE FLG,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT RANDOM OR IO JRST OPNBP3 ; TLNN AC13,20 ;SKIP IF A MTA JRST OPNBP1 ;JUMP, NOT A MTA JUMPE AC5,OPNBP1 ;JUMP IF BLK-FTR IS ZERO (AC5) MOVEI AC10,1 ;ONE BUFFER PER LOGICAL BLOCK JRST OPNBP2 ; OPNBP1: HRRZ AC11,D.IBH(I16) ;ASSUME INPUT TLNN FLG,OPNIN ;SKIP IF INPUT HRRZ AC11,D.OBH(I16) ;MUST BE OUTPUT HLRZ AC0,(AC11) ;BUFFER SIZE + 1 IN WORDS SUBI AC0,1 ;SIZE OPNBP3: IDIV AC10,AC0 ;/BUF-SIZE SKIPE AC10+1 ;ROUND UP ADDI AC10,1 ;AC10=BUFFERS PER LOGICAL BLOCK OPNBP2: MOVEM AC10,D.BPL(I16) ;BUFBLK TLNE FLG1,VLREBC ; IF EBCDIC VARIABLE LEN-RECS INIT SETZ AC10, ; D.BCL TO ZERO FOR FIRST READ UUO MOVEM AC10,D.BCL(I16) ;CURRENT BUFBLK HRR AC10,F.RRRC(I16);GET RERUN RECORD COUNT HRRZM AC10,D.RRD(I16) ;NUMBER OF RECORDS TO A RERUN DUMP OPNBP4: TLNE AC13,20 ;SKIP IF NOT A MAGTAPE JRST OPNMTA ;SET DENSITY, PARITY & POSITION THE MAGTAPE ;DO A LOOKUP OR READ A LABEL. SETUP DEVICE TABLE REEL ;NUMBER AND NUMBER OF FIRST BLOCK OF FILE. ***OPNBBF*** OPNLO: TLNN AC16,OPEN ;OPEN UUO SKIPS JRST OPNLO1 ; MOVEI AC0,2020 ;SIXBIT REEL NUMBER '00' LDB AC1,F.BPMT ;FILE POSITION (ON MTA) SKIPN AC1 ;SKIP IF MULTI-FILE-REEL ADDI AC0,1 ;MULTI-REEL-FILE REEL '01' TLNN AC16,1000 ;SKIP IF A CLOSE REEL GENERATED OPEN DPB AC0,DTRN. ;INITIALIZE THE REEL NUMBER OPNLO1: TLNN FLG,OPNIN!RANFIL!IDXFIL ;SKIP IF INPUT/IO JRST OPNBBF ;OUTPUT. BBF USE PRO. OPNLUP: PUSHJ PP,OPNLID ;SETUP LOOKUP BLOCK WITH ID TLNN AC13,4 ;SKIP IF DIRECTORY DEVICE JRST OPNRLB ;READ LABEL INTO RECORD AREA SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNLU1 ; YES XCT ULKUP. ;*** LOOKUP *************** JRST OPNLER ;ERROR RETURN OPNLU1: TLNE FLG,OPNIO ; TRY FOR EXTENDED LOOKUP PUSHJ PP,OPNELO ; IF VLEN EBCDIC SEQIO FILE SETZM D.CBN(I16) ;THE FIRST BLOCK OF ALL TLNN FLG,RANFIL ; BUT RANDOM FILES AOS D.CBN(I16) ; IS ONE. PUSHJ PP,ZROSLA ;ZERO THE STD LABEL AREA MOVE AC0,ULBLK. ;FILE NAME MOVE AC1,ULBLK.+1 ;EXTENSION TLNE AC13,100 ;SKIP IF NOT A DTA HRRM AC1,D.CBN(I16) ;SAVE AS THE FIRST BLOCK NUMBER TRZ AC1,-1 ;THEN ZERO IT ROTC AC0,14 ; MOVEM AC0,STDLB.+1 ; HLLM AC1,STDLB.+2 ; HRLI AC1,(SIXBIT /HDR/) ;LABEL TYPE IORI AC1,(SIXBIT /1/) MOVEM AC1,STDLB. ; LDB AC4,[POINT 12,ULBLK.+2,35] ;GET LOW ORDER CREA DATE LDB AC1,[POINT 3,ULBLK.+1,20] ;GET HIGH ORDER [EDIT#274] DPB AC1,[POINT 3,AC4,23] ;MERGE THE ORDERS [EDIT#274] PUSHJ PP,TODA1. ;CREATION DATE SETZ AC1, ; ROTC AC0,6 ; MOVEM AC0,STDLB.+7 ;DATE MOVEM AC1,STDLB.+6 ;DATE PUSHJ PP,OPNCA1 ;MOVE STD-LABEL AREA TO RECORD AREA JRST OPNBBF ;THIS ROUTINE FINDS THE NUMBER OF THE FIRST SECTOR OF THE LAST ;LOGICAL BLOCK OF THE SEQIO FILE OPNELO: SKIPE F.WSMU(I16) ; IF SMU-ING POPJ PP, ; WE'VE ALREADY BEEN HERE OPNEL1: HRRZ AC5,F.RPPN(I16) ; GET POINTER TO PPN SKIPE AC5 ; USE DEFAULT PPN IF NONE MOVE AC5,(AC5) ; GET THE PPN MOVEM AC5,ARGBK.##+.RBPPN ; MOVE AC5,[ULBLK.,,ARGBK.+.RBNAM]; GET FILE NAME BLT AC5,ARGBK.+.RBEXT ; AND EXTENSION HLLZS ARGBK.+.RBEXT ; ZERO DATE FIELD SETZM ARGBK.+.RBPRV ; AND PRIVILIGE FIELD SETZM ARGBK.+.RBSIZ ; AND SIZE FIELD MOVE AC0,ULKUP. ; GET A LOOKUP INST HRRI AC0,ARGBK. ; SETUP E FIELD XCT AC0 ; EXTENDED LOOKUP SKIPA AC5,ARGBK.+.RBEXT ; ERROR SO GET ERROR BITS JRST OPNEL2 ; NORMAL RETURN HRRM AC5,ULBLK.+1 ; SAVE BITS FOR OPNLER JRST OPNLER ; COMPLAIN OPNEL2: MOVE AC5,ARGBK.+.RBSIZ ; GET LAST BLOCK OF FILE ADDI AC5,177 ; DIVIDE WORDS WRITTEN BY IDIVI AC5,200 ; WRDS/BLK AND ROUND UP MOVE AC6,D.BPL(I16) ; GET NUMBER OF FIRST ADDI AC5,-1(AC6) ; SECTOR OF THE LAST IDIV AC5,AC6 ; LOGICAL BLOCK SKIPN AC5 ; IF FILE DOESN'T EXIST MOVEI AC5,1 ; ONE IS THE FIRST BLOCK MOVEM AC5,D.LBN(I16) ; SAVE IT FOR SEQIO POPJ PP, ; OPNLER: HRRZ AC2,ULBLK.+1 ; TRNE AC2,37 ;IS IT FILE-NOT-FOUND? JRST OLERR ;NO, OTHER TLNN FLG,IDXFIL ;DONT MAKE FILE IF ISAM FILE TLNE FLG,OPNOUT ; OR IF AN INPUT FILE TLNN FLG,RANFIL!OPNIO ;RANDOM OR IO OUTPUT FILE? JRST OLERR ;NO ;HERE TO CREATE A NULL FILE FOR USER PUSHJ PP,OPNEID ;SETUP FOR AN ENTER XCT UENTR. ;CREATE A NULL FILE JRST OEERR ;ERROR RETURN XCT UCLOS. JRST OPNLUP ;OK TRY THE LOOKUP AGAIN IFE TOPS20,< ; THIS ROUTINE OPENS A FILE VIA THE "FILOP." UUO OPNFOP: MOVE AC0,UOBLK. ;SET THE DATA MODE MOVEM AC0,FOP.IS IFN ISAM,< TLNN FLG,IDXFIL ; ISAM FILE? JRST OPNFPD ; NO TLO FLG1,FOPIDX ; ENTRY FOR ".IDX" FILE PUSHJ PP,OPNLIX ; GET VID TO LOOKUP BLOCK MOVE AC0,ICHAN(I12) ; CHANNEL FOR .IDX FILE JRST OPNFP2 OPNFPD: >;END IFN ISAM PUSHJ PP,OPNLID ; GET VID TO LOOKUP BLOCK TLNN FLG,OPNIO ; IF EXTENDED LOOKUP MUST BE DONE JRST OPNFP1 ; NO XCT UOPEN. ; DO IT BEFORE THE FILOP. UUO JRST OERRIF ; SO WE DONT GET PUSHJ PP,OPNELO ; ILLEGAL SEQUENCE OF UUO'S ERROR OPNFP1: LDB AC0,DTCN. ; GET CHANNEL NUMBER OPNFP2: HRLI AC0,5 ; MULTI ACCESS-UPDATE MOVSM AC0,FOP.BK ; SAVE IN FILOP BLOCK MOVE AC0,UOBLK.+1 ; GET DEVICE NAME MOVEM AC0,FOP.DN ; MOVEI AC0,ULBLK. ; GET ADR OF LOOKUP BLOCK MOVEM AC0,FOP.LB ; MOVE AC1,[7,,FOP.BK] ; SET UP FILOP'S AC FILOP. AC1, ; OPEN THE FILE SIMULTANEOUS-UPDATE POPJ PP, ; ERROR RETURN IFN ISAM, ; CLEAR FLAG JRST RET.2 ; EXIT ; FILOP ERROR OFERR: SETZM FS.IF ; IDA-FILE FLAG IFE ISAM, ; FILOP. FAILED IFN ISAM,< OFERRI: MOVE AC0,[E.MFOP+E.FIDX] ;MAKE AN ERROR NUMBER TLON FLG1,FOPIDX ; REMEMBER IT'S A FILOP ERROR MOVE AC0,[E.MFOP+E.FIDA] TLNN FLG,IDXFIL ; ISAM FILE? >;END IFN ISAM MOVE AC0,[E.MFOP] ; NO PUSHJ PP,ERCDF ; IGNORE ERROR? JRST RCHAN ; YES JRST LUPERR ; NO >; END IFE TOPS20 IFN TOPS20,< SEARCH MONSYM, MACSYM .REQUIRE SYS:MACREL EXTERN CP.BLK,CP.BK1,CP.BK2,CP.BK3,CP.BK4,CP.BK5,CP.BK6,CP.BK7,FID.PT E.MCPT==^D8000000 ; MONITOR COMPT. UUO ERROR ;HERE IF THIS IS A DEC-SYSTEM-20 TO OPEN FILE FOR SIMULTANEOUS UPDATING ;INIT THE CMPT. JSYS ARG BLOCK OCPT: TLNN FLG,IDXFIL ; ISAM FILE? JRST OCPTD ; NO PUSHJ PP,OPNLIX ; YES, GET VID TO LOOKUP BLOCK TLOA FLG1,FOPIDX ; AN IDX FILE OCPTD: ;ENTRY POINT FOR ISAM.IDA FILES PUSHJ PP,OPNLID ; NO, GET VID... SETZM CP.BK1 ; AC1 GTJFN BITS ;BUILD A SNARK FILE-DESCRIPTOR STRING - AC2 GTJFN BITS ;FIRST JUST MOVE THE DEVICE NAME MOVE AC5,FID.PT ; GET POINTER TO FILE-DESCRIPTOR MOVEM AC5,CP.BK2 ; INIT COMPT. ARG BLOCK MOVE AC0,[POINT 6,UOBLK.+1] ; POINTER TO DEVICE NAME MOVEI AC1,6 ; GET MAX OF SIX CHARS OCPT1: ILDB C,AC0 ; GET CHAR JUMPE C,OCPT2 ; DONE IF NULL ADDI C,40 ; CONVERT TO ASCII IDPB C,AC5 ; PUT CHAR IN STRING SOJG AC1,OCPT1 ; LOOP OCPT2: MOVEI C,":" ; DEVICE TERMINATOR IDPB C,AC5 ; TO STRING ;CONVERT PPN TO MOVEI C,"<" ; ORIGINATE DIRECTORY IDPB C,AC5 ; HRRZ AC1,F.RPPN(I16) ; GET ADR OF PPN JUMPN AC1,OCPT3 ; JUMP IF YOU GOT ONE GJINF ; GET CONNECT DIR # IN AC2 MOVE AC1,AC5 ; GET THE STRING POINTER DIRST ; STICK DIR # INTO STRING POPJ PP, ; IMPOSSIBLE! MOVEM AC1,AC5 ; GET STRING PTR BACK TO AC5 JRST OCPT4 ; OCPT3: MOVE AC1,(AC1) ; GET PPN FROM ADR MOVEM AC1,CP.BK1 ; PPN TO THE ARG-BLOCK MOVEM AC5,CP.BK2 ; SUPPLY STRING PTR MOVEI AC0,3 ; FUNCTION 3 MOVEM AC0,CP.BLK ; MOVE AC0,[3,,CP.BLK] ; SETUP FOR COMPT. COMPT. AC0, ; MOVE DIR # TO STRING POPJ PP, ; MOVE AC5,CP.BK2 ; RESTORE STRING PTR OCPT4: MOVEI C,">" ; TERMINATE DIRECTORY IDPB C,AC5 ; ;SETUP THE CP.BK? ARGUMENT BLOCK FOR COMPT. UUO HRLZI AC0,(1B17) ; SPECIFY THE SHORT FORM OF MOVEM AC0,CP.BK1 ; OPENF. JSYS MOVE AC0,FID.PT ; GET POINTER TO FILE DESCRIPTOR STRING MOVEM AC0,CP.BK2 ; FOR OPENF. ARGUMENT ;MOVE VALUE OF ID TO F-D STRING TLNE FLG,IDXFIL ; SKIP IF NOT ISAM FILE TLNE FLG1,FOPIDX ; SKIP IF ISAM .IDA FILE SKIPA AC4,F.WVID(I16) ; BYTE-PTR TO VALUE OF ID MOVE AC4,[POINT 6,DFILNM(I12)]; .IDA - SO VALUE-ID IS HERE MOVEI AC0,11 ; MAX OF 11 CHARS OCPT5: ILDB C,AC4 ; GET A CHAR TLNN AC4,600 ; IS VID IN EBCDIC? LDB C,PTR.96##(C) ; YES - CONVERT IT TLNN AC4,100 ; HOW BOUT SIXBIT? ADDI C,40 ; YES CAIE C," " ; SPACES ARE IGNORED IN FILENAME IDPB C,AC5 ; STUFF IT AWAY CAIE AC0,4 ; IS IT TIME FOR A "."? SOJN AC0,OCPT5 ; NO - LOOP TILL DONE JUMPE AC0,OCPT6 ; JUMP IF DONE MOVEI C,"." ; TERMINATE THE FILENAME IDPB C,AC5 ; SOJN OCPT5 ; BACK FOR THE EXTENSION OCPT6: SETZB C,AC0 ; A NULL IDPB C,AC5 ; TERMINATE THE STRING ;INIT AC2 OPENF BITS TLNE FLG,DDMASC ; DEVICE DATA MODE ASCII? TLO AC0,(7B5) ; YES TLNE FLG,DDMSIX ; SIXBIT? TLO AC0,(6B5) ; YES TLNE FLG,DDMBIN ; BINARY? TLO AC0,(44B5) ; YES TLNN FLG,DDMEBC ; EBCDIC? JRST OCPT10 ; NO TLO AC0,(10B5) ; ASSUME DEVICE IS A MAG-TAPE TLNN AC13,20 ; DEVICE A MTA? TLO AC0,(11B5) ; NO, ITSA DSK OCPT10: TLNE FLG,OPNIO!RANFIL!IDXFIL ; RANDOM, INDEXED OR IO FILES TLO AC0,(17B9) ; ARE DUMP MODE TLNE FLG,OPNIO!RANFIL!IDXFIL!OPNIN; OPEN FOR INPUT? TRO AC0,1B19 ; YES TLNE FLG,OPNOUT ; OPEN FOR OUTPUT? TRO AC0,1B20 ; YES TRO AC0,1B25 ; THAWED I.E. SIMULTANEOUS UPDATE MOVEM AC0,CP.BK3 ; INIT AC2 OPENF BITS ;INITIALIZE TO TOPS-10 OPEN MODE TLNE FLG,DDMASC ; DATA-MODE ASCII? TDZA AC0,AC0 ; YES MOVEI AC0,14 ; NOT ASCII TLNE FLG,RANFIL!IDXFIL!OPNIO ; THESE FILES ARE NOT BUFFERED MOVEI AC0,17 ; DUMP MODE MOVEM AC0,CP.BK4 ; OPEN MODE ;LOCATE THE BUFFER HEADERS AND EXTENDED LOOKUP BLOCK MOVEI AC0,D.IBH(I16) ; MOVEM AC0,CP.BK5 ; INPUT BUFFER HEADER MOVEI AC0,D.OBH(I16) ; MOVEM AC0,CP.BK6 ; OUTPUT BUFFER HEADER MOVEI AC0,ARGBK. ; MOVEM AC0,CP.BK7 ; ADR OF EXTENDED LOOKUP BLOCK ;SET UP EXTENDED LOOKUP BLOCK HRRZ AC1,F.RPPN(I16) ; GET ADR OF PPN SKIPE AC1 ; USE DEFAULT PPN IF ZERO MOVE AC1,(AC1) ; GET PPN MOVEM AC1,ARGBK.##+.RBPPN ; SETUP PPN MOVE AC1,[ULBLK.,,ARGBK.+.RBNAM]; COPY FILE-NAME.EXT BLT AC1,ARGBK.+.RBEXT ; FROM LOOKUP BLOCK HLLZS ARGBK.+.RBEXT ; CLEAR RIGHT HALF SETZM ARGBK.+.RBPRV ; AND PRIV SETZM ARGBK.+.RBSIZ ; AND SIZE TLNE FLG1,FOPIDX ; IF AN ISAM.IDX FILE GET CHAN # SKIPA AC1,ICHAN(I12) ; FROM HERE LDB AC1,DTCN. ; ELSE FROM HERE HRLI AC1,1 ; THE FUNCTION MOVSM AC1,CP.BLK ; ARG ,, FUNCTION MOVE AC1,[10,,CP.BLK] ; COUNT,,ADR FOR ARG-BLOCK COMPT. AC1, ; OPEN FILE FOR SIMULTANEOUS UPDATE POPJ PP, ; ERROR RETURN IFN ISAM, ; CLEAR FLAG JRST RET.2 ; NORMAL RETURN OCPER: SETZM FS.IF ; CLEAR .IDA FILE FLAG IFN ISAM,< OCPERI: MOVE AC0,[E.MCPT+E.FIDX] ; MAKE AN ERROR NUMBER TLZN FLG1,FOPIDX ; IDX OR IDA? MOVE AC0,[E.MCPT+E.FIDA] ; IDA! TLNN FLG,IDXFIL ; SKIP IF AN ISAM FILE >; END IFN ISAM MOVE AC0,[E.MCPT] ; PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RCHAN ; YES OCPERR: TTCALL 3,[ASCIZ /COMPT. UUO FAILED /] MOVEI AC0,.PRIIN ; CFIBF ; CLEAR TYPE AHEAD MOVEI AC0,.PRIOU ; DOBE ;WAIT FOR PREVIOUS OUTPUT TO FINISH HRROI AC1,[ASCIZ / ? JSYS ERROR: /] PSOUT MOVEI AC1,.PRIOU ; HRLOI AC2,.FHSLF ; THIS FORK ,, LAST ERROR SETZ AC3, ; ERSTR ; TYPE THE ERROR JFCL JFCL HRROI AC1,[ASCIZ / /] PSOUT ; APPEND CRLF MOVE AC2,[BYTE (5) 10,2,31,20,4] JRST MSOUT. ; FATAL ERROR MESSAGE >;END OF IFN TOPS20 ;READ A LABEL FROM A NON DIRECTORY DEVICE. ***OPNBBF*** OPNRLB: TLNN AC13,140610 ;SKIP IF DEVICE IS - CDR,LPT,TTY,PTR,OR PTP [RPGLIB EDIT #64] TLNN FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE PRESENT JRST OPNBBF ; OPNRL2: PUSHJ PP,READSY ;READ A LABEL INTO THE BUFFER AREA JRST OPNRL1 ;NORMAL RETURN JRST OPNFW4 ;TRY AGAIN RETURN OPNRL1: PUSHJ PP,BUFREC ;MOVE THE LABEL FROM THE BUFFER TO RECORD AREA ;DO BEFORE BEGINNING FILE USE PROCEDURE. PERFORM STANDARD ;LABEL CHECKS OR CREATE A LABEL. ***OPNABF*** OPNBBF: TLNE FLG,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT DUMP MODE JRST OPNBB1 ; TLNN FLG,OPNOUT ; SKIP IF OUTPUT [EDIT#301] JRST OPNBB1 ;;NOT OUTPUT,SKIP ENTER [EDIT#301] TLNE AC13,4 ;DIRECTORY DEVICE? [EDIT#315] JRST OPNBB2 ;YES, SKIP ENTER [EDIT#315] PUSHJ PP,OPNEID ;SET UP ID FOR ENTER [EDIT#301] XCT UENTR. ;DO AN ENTER [EDIT#301] JRST OEERR ;ERROR RETURN [EDIT#301] OPNBB2: XCT UOUT. ;DUMMY OUTPUT********************[EDIT#315] OPNBB1: MOVEI AC1,1 ;2 WORD CALL, PUSHJ PP,USEPRO ;TO GET THE USE PRO. ADDRESS TLNN AC13,140610 ;NO LABELS - NO CHECKS [RPGLIB EDIT #64] TLNN FLG1,STNDRD ;SKIP IF LABELS ARE STANDARD JRST OPNABF ;AFTER BEG FILE TLNE FLG,OPNIN ;SKIP IF NOT INPUT / IO JRST OPNCSL ;STANDARD LABEL CHECK PUSHJ PP,OPNCAL ;CREATE A LABEL ;DO AFTER BEGINNING FILE LABEL PROCEDURE ;AND WRITE OUT THE LABEL. ***OPNENR*** OPNABF: MOVEI AC1,2 ;TWO WORD CALL PUSHJ PP,USEPRO ;TO GET USE PRO. ADR. TLNN FLG,OPNOUT ;OUTPUT SKIPS JRST OPNDVC TLNE AC13,4 ;SKIP IF NOT DIR. DEV. JRST OPNENR TLNN AC13,140614 ;SKIP IF CDR,LPT,TTY,PTR,PTP,OR DTA,DSK. [RPGLIB EDIT #64] TLNN FLG1,NONSTD+STNDRD ;SKIP IF ANY LABELS JRST OPNDVC ;NO LABELS PUSHJ PP,RECBUF ;MOVE THE LABEL INTO THE BUFFER JUMPGE FLG,OPNAB1 ;JUMP IF DEVICE IS NOT ASCII PUSHJ PP,WRTCR ; PUSHJ PP,WRTLF ; OPNAB1: PUSHJ PP,WRTOUT ;WRITE THE LABEL IFN EBCLBL ,< TLNN FLG,DDMEBC ;EBCDIC? JRST OPNDVC ;NO XCT UCLOS. ;WRITE A TAPE MARK AFTER THE LABELS PUSHJ PP,WRTWAI ;WAIT FOR ERROR CHECKING XCT UOUT. ;DUMMY OUTPUT > JRST OPNDVC ;DO AN ENTER AND SAVE THE FLAG REGISTER. ***EXIT TO THE ACP*** OPNENR: PUSHJ PP,OPNEID ;SETUP UEBLK. (DUMP-MODE) SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE? JRST OPNEN1 ; YES - SKIP THE ENTER XCT UENTR. ;ENTER - DIRECTORY DEVICE********** JRST OEERR ;ERROR RETURN OPNEN1: TLNN FLG,RANFIL!OPNIO!IDXFIL ;DUMP MODE HAS NO DUMMY OUTPUTS XCT UOUT. ;DUMMY OUTPUT*****ENTER VOIDS PREVIOUS DUMMY OUTPUTS. OPNDVC: MOVE AC13,UOBLK.+1 CALLI AC13,4 ;THE FINAL DEVCHR TLNN FLG,OPNIO+OPNIN ;[330]IF NOT INPUT THEN IGNORE JRST OPNDV1 ;[330] TLC AC13,300000 ;[330]IF A DSK AND A CDR TLCN AC13,300000 ;[330]THEN ITS DEVICE 'NUL' TLZ AC13,20 ;[330]SO ITS NOT A MAGTAPE OPNDV1: MOVEM AC13,D.DC(I16) ;[330] MOVEM FLG,F.WFLG(I16) ;UPDATE THE FLAGS TLNE AC13,10 ;IS THIS A TTY FILE? HRRZM AC16,TTYOPN ;YES, REMEMBER THAT TLNE FLG1,STNDRD!NONSTD ;SKIP IF LABELS ARE OMITTED PUSHJ PP,ZROREC ;CLEAR THE RECORD AREA I.E.LABEL TLNN AC16,SLURP ;RESTORE THE REC-AREA IF A WRITE REEL CHANGE POPJ PP, ;RETURN TO CBL-PRG POP PP,AC2 ;FROM,,TO POP PP,AC1 ;LENGTH HRRZM AC2,.JBFF ;RESTORE FREE CORE MOVSS AC2 ;THE OTHER WAY ADDI AC1,(AC2) ;UNTIL BLT AC2,(AC1) ;SLURP POPJ PP, ; NOW EXIT TO CBL-PRG ; THE FOLLOWING TABLES ARE USED TO SETUP THE CONVERSION INSTRUCTION RCTBL: RCASC(AC2) ; ASCII TO ? RCEBC(AC2) ; EBCDIC TO ? RCSIX(AC2) ; SIXBIT TO ? RCASC: MOVE C,CHTAB(C) ; ASCII TO ASCII LDB C,PTR.79## ; EBCDIC MOVS C,CHTAB(C) ; SIXBIT RCEBC: LDB C,PTR.97## ; EBCDIC TO ASCII JFCL ; EBCDIC LDB C,PTR.96## ; SIXBIT RCSIX: ADDI C,40 ; SIXBIT TO ASCII LDB C,PTR.69## ; EBCDIC JFCL ; SIXBIT WCTBL: WCASC(AC1) ; ASCII TO ? RCEBC(AC1) ; EBCDIC TO ? RCSIX(AC1) ; SIXBIT TO ? WCASC: JFCL ; ASCII TO ASCII LDB C,PTR.79## ; EBCDIC MOVS C,CHTAB(C) ; SIXBIT ;STANDARD LABELS AND INPUT OR IO ;CHECK THE VALUE OF ID. ***OPNABF*** OPNCSL: PUSHJ PP,RECSLB ;MOVE RECORD AREA TO STD-LABEL AREA PUSHJ PP,OPNLID ;VALUE OF ID TO ULBLK. ;CHECK FOR LABEL TYPE 'HDR1' MOVE AC0,STDLB. ;LABEL TYPE TRZ AC0,7777 ; IFN EBCLBL ,< TLNE FLG,DDMEBC ;IF EBCDIC PUSHJ PP,OECLT ; LOOK FOR 'VOL1' IF FIRST FILE > CAMN AC0,[SIXBIT /HDR1/] ;SKIP INTO ERROR MESSAGE JRST OPNCID ;CHECK VALUE OF ID ;MISSING OR WRONG LABEL TYPE TTCALL 3,[ASCIZ/$ THE BEGINNING FILE LABEL IS MISSING/] OPNCL1: PUSHJ PP,SAVAC. MOVE AC2,[BYTE(5)10,2,31,20,4,14] PUSHJ PP,MSOUT. JRST OPNFW4 ;TRY AGAIN IFN EBCLBL ,< OECLT: LDB AC2,F.BPMT ;GET FILE POSITION SOJG AC2,RET.1 ; AND RETURN IF NOT FIRST FILE ON REEL CAME AC0,[SIXBIT /VOL1/] ;LABEL TYPE MUST BE 'VOL1' JRST OECL1 ; ELSE ERROR MESSAGE PUSHJ PP,READSY ;READ NEXT LABEL, SHLDB 'HDR1' JRST .+2 ;OK JRST OECL2 ;ERROR RETURN, MESSAGE & SECOND CHANCE PUSHJ PP,BUFREC ;MOVE LABEL INTO RECORD AREA PUSHJ PP,RECSLB ; THEN TO LABEL AREA MOVE AC0,STDLB. ;LABEL TYPE TO AC0 TRZ AC0,7777 ; AND CLEAR THE GARBAGE POPJ PP, ;TRY FOR 'HDR1' OECL1: TTCALL 3,[ASCIZ /LABEL "VOL1" IS MISSING/] POP PP,(PP) ; KEEP THE STACK RIGHT JRST OPNCL1 OECL2: POP PP,(PP) ; MAKE THE STACK RIGHT JRST OPNRL2 ; ERROR PATH > OPNCID: HRR AC0,STDLB. ; MOVE AC1,STDLB.+1 ; HLL AC0,STDLB.+2 ; ROTC AC0,30 ;JUSTIFY THE FILENAME CAME AC0,ULBLK. ;CHECK FILE NAMES JRST OPNIDE ;ID ERROR HLLZ AC0,ULBLK.+1 ; TRZ AC1,-1 ;CLEAR THE LABEL NUMBER CAMN AC0,AC1 ;CHECK EXTENSIONS JRST OPNCDW ;CHECK DATE WRITTEN ;ID ERROR. OPNIDE: PUSHJ PP,SAVAC. ; MOVE AC2,[BYTE (5)10,2,31,20,4,14] PUSHJ PP,MSOUT. ; TTCALL 3,[ASCIZ/$ THE VALUE OF ID DOES NOT MATCH THE LABEL ID/] JRST OPNFW4 ;CHECK DATE WRITTEN OPNCDW: SKIPN AC5,F.WVDW(I16) ;VALUE OF DATE WRITTEN JRST OPNCRN ;CHECK REEL NUMBER MOVE AC0,[POINT 6,STDLB.+6,29] MOVEI AC2,6 ;CHECK ONLY FIRST 6 CHARS. OPNCD1: ILDB AC1,AC0 ;ONE FROM THE LABEL AND ILDB AC6,AC5 ;ONE FROM THE FILE TABLE TLNE AC5,100 ;SKIP IF SIXBIT SUBI AC6,40 ;MAKE IT SIXBIT TLNN AC5,600 ; EBCDIC? LDB AC6,PTR.96##(AC6) ; YES CAME AC6,AC1 ;SKIP IF EQUAL JRST OPNCD2 ;WRONG DATE MESSAGE SOJN AC2,OPNCD1 ;LOOP 6 TIMES JRST OPNCRN ; OK SO CHECK THE REEL NUMBER ;WRONG DATE OPNCD2: MOVE AC2,[BYTE (5)10,31,20,2,4,14] PUSHJ PP,MSOUT. TTCALL 3,[ASCIZ /THE FILE TABLE DATE DIFFERS FROM THE FILE LABEL DATE/] JRST KILL ;CHECK THE REEL NUMBER IF THE DEVICE IS A MAGTAPE OPNCRN: TLNN AC13,20 ;MAGTAPE? JRST OPNABF ;NO HRL AC0,STDLB.+4 ;THE HLR AC0,STDLB.+5 ; REAL ROT AC0,-14 ; REEL ANDI AC0,7777 ; NUMBER LDB AC1,DTRN. ;AND WHAT IT OUGHT TO BE CAMN AC0,AC1 ;SKIP IF UNEQUAL JRST OPNCR1 ;MATCH LDB AC2,F.BPMT ; JUMPN AC2,OPNCR1 ;JUMP ITSA MULTI-FILE-REEL PUSHJ PP,SAVAC. ; TTCALL 3,[ASCIZ / $/] MOVE AC2,[BYTE(5)10,31,20,2,4,34,14] ;FODC.R# PUSHJ PP,MSOUT. ; TTCALL 3,[ASCIZ/ WAS MOUNTED, PLEASE MOUNT /] PUSHJ PP,MSDTRN TTCALL 3,[ASCIZ / THEN/] JRST OPNF04 ;TRY AGAIN OPNCR1: IFN EBCLBL ,< TLNE FLG,DDMEBC ;IF EBCDIC XCT MADVF. ; SKIP TO TAPE MARK > JRST OPNABF ;CREATE A STANDARD LABEL. ***@POPJ*** OPNCAL: PUSHJ PP,OPNEID ;LOAD FILENM.EXT INTO ENTER BLOCK PUSHJ PP,ZROSLA ;ZERO THE STD LABEL AREA IFN EBCLBL,< LDB AC0,F.BPMT ;GET FILE POSITION TLNE FLG,DDMEBC ;EBCDIC? SOJLE AC0,[ ;MAKE A 'VOL1' LABEL MOVE AC0,[SIXBIT /VOL1/] MOVEM AC0,STDLB. ;'VOL1' TO THE LABEL AREA PUSHJ PP,SLBREC ;MOVE TO RECORD AREA PUSHJ PP,RECBUF ; THEN TO THE BUFFER PUSHJ PP,WRTOUT ; AND WRITE IT SETZM STDLB. ;ZERO THE LABEL AREA JRST .+1] ;RETURN > MOVE AC0,UEBLK. ;FILENAME HLLZ AC1,UEBLK.+1 ;EXT ROTC AC0,14 ;12 PLACES TO THE LEFT - MARCH. TRO AC1,(SIXBIT /1/);FIRST LABEL MOVEM AC0,STDLB.+1 ;FILE HLLM AC1,STDLB.+2 ;DESCRIPTOR TLNE AC16,OPEN+CLOSEB HRLI AC1,(SIXBIT /HDR/) ;BEGINNING FILE LABEL TLNE AC16,CLOSEF HRLI AC1,(SIXBIT /EOF/) ;END OF FILE LABEL TLNE AC16,CLOSER HRLI AC1,(SIXBIT /EOV/) ;END OF VOLUME LABEL MOVEM AC1,STDLB. ; IFN EBCLBL,< TLNE FLG,DDMEBC ;EBCDIC? PUSHJ PP,JULIA0 ;JULIAN DATE & SKIP EXIT (YYDDD) > PUSHJ PP,TODAY. ;GET TODAY'S DATE (YYMMDD) SETZ AC1, ; ROTC AC0,6 ; MOVEM AC1,STDLB.+6 ;CREATION MOVEM AC0,STDLB.+7 ;DATE OPNCA1: SETZ AC2, LDB AC0,F.BPMT ;FILTAB FILE POSITION ON MAGTAPE IDIVI AC0,^D10 ; ADDM AC1,AC2 ; ROT AC2,6 ; JUMPN AC0,.-3 ;CONVERTED TO DECIMAL ADD AC2,[20202020] ;SIXBITIZED LDB AC1,DTRN. ;DEVTAB MAG-TAPE REEL NUMBER ROT AC2,14 ; ROTC AC1,-6 ; ADDI AC1,202000 ; MOVEM AC1,STDLB.+4 ;REEL NUMBER AND MOVEM AC2,STDLB.+5 ;FILE POSITION SETZ AC1, ; MOVE AC0,[SIXBIT /PDP10 /] MOVEM AC0,STDLB.+12 HRLZ AC0,.JBVER ROTC AC0,14 ROT AC1,3 ROTC AC0,3 ROT AC1,3 ROTC AC0,3 ADDI AC1,202020 HRLZM AC1,STDLB.+13 ;PDP10 VER JRST SLBREC ;MOVE STD-LABEL TO RECORD AREA AND EXIT ;SET MAGTAPE DENSITY & PARITY ;POSITION MAGTAPE VIA FILE TABLE FILE POSITION. ***OPNLO*** OPNMTA: TLNN FLG,DDMEBC ; RECORDING MODE EBCDIC? JRST OMTA10 ; NO TLNE FLG1,NONSTD!STNDRD; LABELS OMITTED? JRST OMTA98 ; NO - ERROR HRRZ AC1,F.WDNM(I16) ; GET THE SIXBIT MOVE AC1,(AC1) ; DEVICE NAME AND MTCHR. AC1, ; GET CHARACTERISTICS SETZ AC1, ; ERROR RET - ASSUME 9TRK TRNE AC1,1B31 ; 9 TRACKS? JRST OMTA10 ; NO - 7 TRK HRLZI AC3,3 ; LENGTH ,, ADDR MOVEI AC0,.TFMOD ; FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME MOVEI AC2,.TFM8B ; INDUSTRY-COMPATIBLE MODE TAPOP. AC3, ; DOIT JRST OMTA93 ; ERROR - COMPLAIN ;SET PARITY OMTA10: XCT UGETS. ; GET STATUS INTO AC2 LDB AC5,F.BPAR ; GET REQUESTED PARITY DPB AC5,[POINT 1,AC2,26]; SET PARITY XCT USETS. ; SET STATUS ;STANDARD-ASCII OR 1600 BPI WANTED? OMTA20: LDB AC5,F.BDNS ; GET DENSITY HRRZ AC6,D.RFLG(I16) ; GET STANDARD ASCII FLAG CAIGE AC5,4 ; SKIP IF 1600 BPI TRNE AC6,SASCII ; DOES HE WANT IT? JRST OMTA21 ; YES ;SET DENSITY XCT UGETS. ;GET STATUS DPB AC5,[POINT 3,AC2,28] XCT USETS. ;SET STATUS JRST OPNPMT ; ;TU16/43/45/70 REQUIRED - DO WE HAVE ONE? OMTA21: HRLZI AC3,2 ; LENGTH ,, ADDR MOVEI AC0,.TFKTP ; FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME TAPOP. AC3, ; GET CONTROLER TYPE JRST OMTA90 ; ERROR TRNN AC6,SASCII ; STD-ASCII REQUEST? JRST OMTA22 ; NO CAIE AC3,.TX01 ; TU70 CONTROLLER? CAIN AC3,.TM02 ; OR A TU16 OR TU45? JRST .+2 ; YES JRST OMTA91 ; ERROR - WRONG TYPE ;SET STANDARD ASCII MODE HRLZI AC3,3 ; LENGTH ,, ADDR MOVEI AC0,.TFMOD ; FUNCTION MOVEI AC2,.TFM7B ; STANDARD ASCII MODE TAPOP. AC3, ; CHANGE MODE JRST OMTA93 ; ERROR - COMPLAIN ;TU16/43/45/70 CAN ONLY DO 800 OR 1600 BPI JUMPE AC5,OPNPMT ; USE DEFAULT DENSITY CAIE AC5,3 ; 800 BPI? CAIN AC5,4 ; 1600? JRST OMTA30 ; YES SO SET IT JRST OMTA94 ; NO COMPLAIN OMTA22: CAIE AC3,.TC10C ; TU43 CONTROLLER? CAIN AC3,.TX01 ; TU70? JRST OMTA30 ; OK CAIE AC3,.TM02 ; TU16/45? JRST OMTA92 ; NO COMPLAIN ;SET DENSITY OMTA30: HRLZI AC3,3 ; LENGTH,,ADR MOVEI AC0,.TFSDN ; SET DENSITY FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME MOVE AC2,AC5 ; REQUESTED DENSITY TAPOP. AC3, ; SET IT JRST OMTA95 ; OOPS ;NOW GET/CHECK DENSITY HRLZI AC3,2 ; LEN,,ADR MOVEI AC0,.TFGDN ; GET DENSITY FUNCTION MOVE AC1,UOBLK.+1 ; DEVICE NAME TAPOP. AC3, ; GET DENSITY JRST OMTA95 ; OOPS CAME AC2,AC3 ; CHECK IT JRST OMTA95 ; ERROR - NOT WHAT 'E ASKED FOR JRST OPNPMT ; ;HERE IF TAPOP. ERROR RET OR NOT A TU16/45/70 DRIVE OMTA90: TRNN AC6,SASCII ; STD-ASCII MESSAGE? JRST OMTA92 ; NO 1600 BPI OMTA91: MOVE AC0,[E.FIDX+^D37]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / STANDARD ASCII RECORDING MODE REQUIRES A TU16, TU45 OR TU70/] JRST OMTA99 ; ;1600 BPI WANTS A TU16/43/45/70 OMTA92: MOVE AC0,[E.FIDX+^D38]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / DENSITY OF 1600 BPI REQUIRES A TU16, TU43, TU45 OR TU70/] JRST OMTA99 ; ;TAPOP. FAILED TO SET STANDARD ASCII MODE OMTA93: MOVE AC0,[E.FIDX+^D45]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / TAPOP. FAILED - UNABLE TO SET STANDARD-ASCII OR INDUSTRY-COMPATIBLE MODE/] JRST OMTA99 ;TU16/43/45/70 CAN DO ONLY 800/1600 BPI OMTA94: MOVE AC0,[E.FIDX+^D46]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ " TU16/43/45/70 CAN HAVE DENSITY OF ONLY 800 OR 1600 BPI"] JRST OMTA99 ;TAPOP. FAILED OR "SET" DOESN'T MATCH "GET" DENSITY OMTA95: MOVE AC0,[E.FIDX+^D47]; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE THE ERROR? JRST RCHAN ; YES TTCALL 3,[ASCIZ / CANNOT SET THE REQUESTED DENSITY/] JRST OMTA99 ;FOR NOW EBCDIC FILES MUST HAVE OMITTED LABELS OMTA98: TTCALL 3,[ASCIZ / EBCDIC MTA FILES MUST HAVE OMITTED LABELS /] OMTA99: MOVE AC2,[BYTE (5) 10,31,20,2] PUSHJ PP,MSOUT. ;DOESN'T RETURN OPNPMT: MOVEI AC3,2 ; 2 EOF'S PER FILE IF NOT EBCDIC TLNE FLG,DDMEBC ; DEVICE DATA MODE EBCDIC? MOVEI AC3,3 ; YES, 3 EOF/FILE. TLNN FLG1,NONSTD!STNDRD ; LABELS OMITTED? MOVEI AC3,1 ; YES, 1 EOF/FILE. HRLZI AC5,HUF ;"HEAD UNDER THIS FILE" FLAG LDB AC11,F.BPMT ;POINT 6,6(I16),17 ... FILE POSITION ON REEL JUMPE AC11,OPNF00 ;JUMP IF MULTI REEL FILE WAS OPNREW MOVE AC10,AC16 ;CURRENT FILE TABLE FIRST OPNHUF: TDNE AC5,D.HF(AC10) ;SKIP IF NOT "HUF" JRST OPNFND ;FOUND THE FILE HRRZ AC10,11(AC10) ;NEXT FILE TABLE THAT SHARES THIS REEL CAIE AC10,(I16) ;SKIP IF WE'VE MADE A COMPLETE LOOP JUMPN AC10,OPNHUF ;ZERO=REEL NOT SHARED ;FALL THRU IF REEL NEVER POSITIONED OPNREW: PUSHJ PP,OPNRWD ;REWIND SUBI AC11,1 ;SUB 1 FOR THIS REWIND IMUL AC11,AC3 ; SEE HOW MANY EOF'S TO PASS JUMPG AC11,OPNFWD JRST OPNFW1 OPNRWD: XCT MWAIT. XCT SOBOT. ;STATO BEG-OF-TAPE XCT MREW. ;ELSE REWIND POPJ PP, OPNFND: ANDCAM AC5,D.HF(AC10) ;CLEAR THE HUF FLAG TLNN AC16,100 ;REWIND REQ? JRST OPNREW ;YES LDB AC10,[POINT 6,6(AC10),17] ;FIGURE OUT WHERE TO GO SUB AC11,AC10 ;DIRECTION + MAGNITUDE IMUL AC11,AC3 ; SEE HOW MANY EOF'S TO PASS JUMPE AC11,OPNBOF ;GO TO THE BEG OF FILE JUMPG AC11,OPNFWD ;SPACE FORWARD OPNREV: XCT MWAIT. ;[336]MAKE SURE WE WAIT XCT MBSPF. ;[336]BACKSPACE A FILE XCT MWAIT. ;WAIT FOR COMPLETION XCT SZBOT. ;STATZ BOT JRST OPNRE1 ;PREMATURE BEG-OF-TAPE ERROR AOJL AC11,OPNREV ;LOOP TILL (AC11)=0 OPNBOF: XCT MBSPF. ;MOVE TO BEG OF CURRENT FILE XCT MWAIT. XCT SOBOT. ;SKIP, BIT=BOF XCT MADVF. ;MOVE TO OTHER SIDE OF EOF MARK JRST OPNFW1 OPNFWD: XCT MWAIT. ;AVOID POSITIONING ERRORS XCT SZEOT. ;STATZ EOT JRST OPNFW2 ;END OF TAPE ERROR XCT MADVF. ;ADVANCE A FILE SOJG AC11,OPNFWD OPNFW1: XCT MWAIT. ;[336]WAIT ON MTA ORM AC5,D.HF(I16) ;[336]NOTE CURRENT FILE OVER HEAD JRST OPNLO ;EXIT FROM OPNPMT OPNF00: TLNE AC16,100 ;REWIND REQ ? JRST OPNFW1 ;NO JRST OPNREW ;YES OPNRE1: TTCALL 3,[ASCIZ /$ UNEXPECTED BOT MARKER/] ; [EDIT#277] SKIPA OPNFW2: TTCALL 3,[ASCIZ /$ UNEXPECTED EOT MARKER/] ; [EDIT#277] PUSHJ PP,SAVAC. TTCALL 3,[ASCIZ /$ ENCOUNTERED WHILE POSITIONING /] MOVE AC2,[BYTE (5)10,31,20,14] ;FILE ON DEVICE. PUSHJ PP,MSOUT. OPNFW4: TLNN AC13,120 ;SKIP IF A REEL DEVICE JRST KILL ; TTCALL 3,[ASCIZ / WRONG REEL? /] OPNF04: PUSHJ PP,C.STOP ;TYPE CONTINUE TO RETRY PUSHJ PP,RSTAC. HRLZI AC5,HUF ;ANOTHER TAPE WAS MOUNTED ANDCAM AC5,D.HF(I16) ;CLEAR THE "HEAD-UNDER-FILE" FLAG JRST OPNBP4 ;TRY AGAIN ;PLACE VALUE OF ID IN LOOKUP/ENTER BLOCK OPNLID: SKIPA AC10,[POINT 6,ULBLK.] ;LOOKUP SETUP OPNEID: MOVE AC10,[POINT 6,UEBLK.] ;ENTER SETUP IFN ISAM,< TLNE FLG,IDXFIL ;ISAM ? SKIPA AC5,[POINT 6,DFILNM(I12)] > MOVE AC5,F.WVID(I16) ;BYTE POINTER TO VALUE OF ID MOVEI AC6,11 ;ID HAS 11 CHARACTERS MAX OPNEI1: ILDB C,AC5 ;PICK UP A CHAR TLNN AC5,600 ; IS VID EBCDIC? LDB C,PTR.96##(C) ; YES - CONVERT TO SIXBIT TLNE AC5,1100 ;SKIP IF SIXBIT SUBI C,40 ;CONVERT FROM ASCII IDPB C,AC10 ;STORE IN E BLOCK SOJN AC6,OPNEI1 ;LOOP 11 SETZM ULBLK.+3 ;P,,P SETZM UEBLK.+3 ;PROJ,,PROG HLLZS ULBLK.+1 ;ZERO RIGHT HALF OF EXTENSION WORD HLLZS UEBLK.+1 ; IN LOOKUP AND ENTER BLOCK SETZM UEBLK.+2 ;CLEAR PROTECTION AND DATE OPNPPN: LDB AC5,F.BCVR ;GET COMPILER NUMBER CAIGE AC5,3 ;VERSION 3 OR OLDER? POPJ PP, ;NOP HRRZ AC5,F.RPPN(I16) ;ADR OF PROJ,,PROG JUMPE AC5,RET.1 ;USE DEFAULT MOVE AC5,(AC5) ;PROJECT,,PROGRAMER MOVEM AC5,ULBLK.+3 MOVEM AC5,UEBLK.+3 POPJ PP, ;AND RETURN IFN ISAM,< OPNLIX: MOVEI AC10,OPNLID SKIPA OPNEIX: MOVEI AC10,OPNEID TLC FLG,IDXFIL PUSHJ PP,(AC10) TLC FLG,IDXFIL POPJ PP, > ;PERFORM A USE PROCEDURE ;CALLED WITH AN INDEX IN AC1, ***POPJ*** USEPRO: JUMPE AC1,USEPR0 ;JUMP IF ERROR USEPRO TLNN FLG1,NONSTD!STNDRD POPJ PP, ;EXIT, THERE ARE NO LABELS USEPR0: PUSHJ PP,SAVAC. ;SAVE THE ACS PUSHJ PP,USESUP ;GET USE-PRO ADDRESS INTO AC1 AND AC2 TLNE AC16,CLOSEB+CLOSER ;SKIP IF NOT A REEL PRO JRST USEPR1 ; LDB AC0,F.BPMT ;FILE POSITION ON MTA JUMPN AC0,USEPR2 ;JUMP IF MULTI FILE REEL TLNE AC16,CLOSEF ;SKIP IF AN OPEN USEPRO USEPR1: PUSHJ PP,USESWP ;SET FOR REEL PROCEDURE USEPR2: PUSHJ PP,USEXCT ;EXECUTE A PRO MOVE AC16,-16(PP) ;RESTORE AC16 TLNN AC16,CLOSEB+CLOSER ;EXIT IF A REEL PRO SKIPN -1(PP) ;OR AN ERROR PRO JRST RSTAC1 ;EXIT PUSHJ PP,USESUP ;SETUP TLNN AC16,CLOSEF ;SKIP IF A CLOSE TYPE USEPRO PUSHJ PP,USESWP ;SET FOR REEL PROCEDURE LDB AC0,F.BPMT ;FILE POSITION JUMPN AC0,RSTAC1 ;EXIT, NOT A MULTI-REEL-FILE PUSHJ PP,USEXCT ;ELSE PERFORM THE USE-PRO JRST RSTAC1 ;@POPJ USESUP: MOVE AC1,-2(PP) ;INDEX FOR THE USE TABLES MOVEM AC1,AC2 ; ADDI AC2,F.REUP(I16) ;ADR OF FILE USE PRO ADD AC1,USES. ;ADR OF GENERAL USE PRO MOVE FLG,-10(PP) ;RESTORE AC7 TLNN FLG,OPNOUT ;SKIP IF OUTPUT JRST USESU1 ;INPUT USE PRO TLNE FLG,OPNIN ;SKIP IF NOT INPUT ADDI AC1,5 ;INPUT/OUTPUT USE PRO ADDI AC1,5 ;OUTPUT USE PRO USESU1: MOVE AC1,(AC1) MOVE AC2,(AC2) SKIPN USES. ; SETZ AC1, ;FOR STAND ALONE SORTS POPJ PP, ; USESWP: SKIPN -2(PP) ;IF ERROR USEPRO POPJ PP, ; JUST RETURN HLRZ AC1,AC1 ;USE THE REEL ADDRESS HLRZ AC2,AC2 ;IN THE LEFT HALF POPJ PP, ; USEXCT: MOVE AC3,-2(PP) ;PP-2=AC1; USE TABLE INDEX TRNN AC1,-1 ;SKIP IF THERE IS A GENERAL USEPRO HRRZ AC1,AC2 ;GET SPECIFIC FILTAB USEPRO JUMPN AC1,USEXC1 ;GO PERFORM USEPRO JUMPN AC3,USEXC2 ;IF NO LABEL USEPRO RETURN AOSA -20(PP) ;IF NO ERROR USEPRO SKIP-EXIT USEXC1: PUSHJ PP,(AC1) ;XCT THE USEPRO USEXC2: POPJ PP, ; ;RECSLB.. MOVE RECORD AREA TO SIXBIT STD-LABEL AREA ;SLBREC.. MOVE SIXBIT STD-LABEL AREA TO RECORD AREA. ***POPJ*** RECSLB: TLOA AC0,400000 ; SLBREC: TLZ AC0,400000 ; MOVE AC2,STDLBP ; SET UP TO/FROM POINTERS LDB AC1,[POINT 2,FLG,14] ; GET CORE DATA MODE HLLZ AC1,RBPTBL(AC1) ; AND RECORD BYTE PTR SKIPL AC0 ; WHICH WAY? EXCH AC1,AC2 ; STD-LABEL TO RECORD AREA MOVEI AC0,^D80-2 ; TLNE FLG,DDMEBC ; EBCDIC ALWAYS HAS MOVEI AC0,^D80 ; 80. CHARS SLBRE1: ILDB C,AC1 ; TLNE AC1,1000 ; EBCDIC TO SIXBIT? LDB C,PTR.96## ; YES TLNE AC2,1000 ; SIXBIT TO EBCDIC? LDB C,PTR.69## ; YES TLNN FLG,CDMSIX!CDMEBC ; ADDI C,40 ; ASCII IDPB C,AC2 ; SOJG AC0,SLBRE1 ; POPJ PP, ;;;;; ;READ THE LABEL INTO THE RECORD AREA. ***POPJ*** BUFREC: PUSHJ PP,BUFRE0 ;SETUP MOVE AC10,D.RCNV(I16) ;SETUP AC10 BUFRE1: SOSGE D.IBC(I16) ; PUSHJ PP,READSY ;FILL THE BUFFER JRST BUFR01 ;NORMAL RETURN JRST CLSRL0 ;EOF - COMPLAIN BUFR01: ILDB C,D.IBB(I16) ;PICK UP A LABEL CHAR XCT AC10 ;CONVERT IF NECESSARY IDPB C,AC3 ;TO THE RECORD AREA SOJG AC0,BUFRE1 ;LOOP TILL LABEL IS IN THE RECORD AREA SETZM D.IBC(I16) ;THE BUFFER IS EMPTY POPJ PP, ;WRITE OUT THE LABEL. ***POPJ*** RECBUF: PUSHJ PP,BUFRE0 ;SETUP MOVE AC10,D.WCNV(I16) ;SETUP AC10 RECBU1: SOSGE D.OBC(I16) ; PUSHJ PP,WRTOUT ;WRITE OUT THE BUFFER ILDB C,AC3 ;PICK UP A LABEL CHAR XCT AC10 ;CONVERT IF NECESSARY IDPB C,D.OBB(I16) ;TO THE OUTPUT BUFFER SOJG AC0,RECBU1 ;LOOP TILL DONE POPJ PP, ;SET LABEL POINTER AND SIZE AND POPJ. BUFRE0: LDB AC3,[POINT 2,FLG,14] ; GET CORE DATA MODE HLLZ AC3,RBPTBL(AC3) ; AND THEN RECORD BYTE-PTR MOVEI AC0,^D80-2 ;STD-LABEL SIZE TLNE FLG,DDMEBC ; EBCDIC DEVICE? MOVEI AC0,^D80 ; LABEL SIZE TLNE FLG1,NONSTD ; HLRZ AC0,F.LNLS(I16) ;NON-STD-LABEL SIZE TLNN FLG,DDMBIN ;IS FILE BINARY? POPJ PP, ;NO HRLZI AC3,(POINT 36,(FLG)) ;MAKE ONE BYTE BE ONE WORD LDB AC10,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC10,RBPTBL(AC10) ; GET CHARS PER WORD ADDI AC0,-1(AC10) ; - IDIV AC0,AC10 ; TO WORD COUNT POPJ PP, ;ZERO THE STANDARD LABEL AREA. ***POPJ*** ZROSLA: SETZM STDLB. ; MOVEI AC1,STDLB.+1 ;TO HRLI AC1,STDLB. ;FROM,TO BLT AC1,STDLB.+15 ;ZERO 16 WORD STD LABEL AREA POPJ PP, ;MOVE SPACES TO THE RECORD AREA. ***POPJ*** ZROREC: LDB AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE MOVE AC2,SPCTBL(AC2) ; GET A WORD OF SPACES MOVEM AC2,(FLG) ; TO THE RECORD AREA SETZ AC2, ; INIT AC2 TLNE FLG1,STNDRD ; STANDARD LABELS? MOVEI AC2,^D80 ; YES TLNE FLG1,NONSTD ; NON-STANDARD LABELS? HLRZ AC2,F.LNLS(I16) ; YES LDB AC1,F.BMRS ;MAX REC SIZ CAMGE AC1,AC2 ; USE THE LARGER SIZE MOVE AC1,AC2 ; LABEL LARGER. LDB AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC2,RBPTBL(AC2) ; GET CRARS PER WORD ADDI AC1,-1(AC2) ;CONVERT TO IDIV AC1,AC2 ; WORDS HRLI AC2,(FLG) ;THE FROM ADR HRRI AC2,1(FLG) ;THE TO ADR ADDI AC1,-1(FLG) ;THE UNTIL ADR BLT AC2,(AC1) ;ZRAPP! POPJ PP, ; SPCTBL: ASCII / / ; ASCII SPACES BYTE (9) 100,100,100,100 ; EBCDIC SIXBIT / / ; SIXBIT SPCTB1: 40 ; ONE ASCII SPACE RIGHT JUSTIFIED 100 ; EBCDIC 0 ; SIXBIT ;SAVE THE ACS ON THE PUSH DOWN STACK. ***"POPJ"*** SAVAC.: POP PP,TEMP. ;POP OFF THE RETURN PUSH PP,AC16 ;SAVE AC16 - AC0 MOVEI AC16,15 ; PUSH PP,(I16) ; SOJGE AC16,.-1 ; MOVE AC16,-16(PP) ; JRST @TEMP. ;LAST ENTRY IS AC0 ;RESTORE THE ACS. ***"POPJ"*** ;RSTAC1 MUST -NOT- BE CALLED VIA PUSHJ RSTAC1: HRRZI AC16,RET.1 MOVEM AC16,TEMP. SKIPA ;RSTAC. MUST BE CALLED VIA PUSHJ RSTAC.: POP PP,TEMP. ;RESTORE AC0 - AC16 HRLZI AC16,-16 ; POP PP,(I16) ; AOBJN AC16,.-1 ; POP PP,AC16 ; JRST @TEMP. ; ;FREE THE IO CHANNEL. ***POPJ*** IFN ISAM,< FRECH1: SKIPA AC2,ICHAN(I12) ;IDX-DEV'S CHAN > FRECHN: LDB AC2,DTCN. ;CHANNEL NUMBER FRECH2: MOVNS AC2 ;SHIFT TO THE RIGHT HRLZI AC0,400000 ;MASK BIT LSH AC0,(AC2) ;POSITION THE MASK ORM AC0,OPNCH. ;MAKES THE CHANNEL AVAILABLE POPJ PP, ; ;DISTRIBUTE THE CHANNEL NUMBER THROUGH THE UUO TABLE. ***POPJ*** SETCN.: LDB AC5,DTCN. ; CHANNEL NUMBER SETC1.: HRLZI AC10,ULEN.##-1 ; GET TABLE LENGTH MOVE AC6,[POINT 4,UFRST.(AC10),12] DPB AC5,AC6 ; INSERT THE CHAN NUMBER AOBJN AC10,.-1 ; LOOP TILL THE LAST LOC POPJ PP, ;RETURN A FREE CHANNEL NUMBER IN AC5 GCHAN: SKIPN AC5,OPNCH. ;ANY CHANNELS AVAILABLE? SKIPA AC2,[BYTE (5)10,2,4,5] ;FCBO,TMOF. SKIPA AC6,OPNCBP ;YES, SKIP + GET BYTE POINTER JRST MSOUT. ;ERROR MESSAGE + KILL HRRI AC5,1 ;[342]START WITH 1 MOVEI AC2,17 ;[342]UPPER LIMIT GCHAN2: ILDB AC11,AC6 ;[342]GET FIRST CHAN FLAG SOJE AC11,GCHAN1 ;[342]JUMP IF IT WAS A ONE CAIG AC2,(AC5) ;[342]IF TRIED ALL 17 JRST GCHAN0 ;[342]THEN HAVE TO USE 0 AOJA AC5,GCHAN2 ;[342]AC5 (RIGHT) HAS CHAN NUMBER GCHAN1: DPB AC11,AC6 ;[342]NOTE THAT CHAN UNAVAILABLE POPJ PP, GCHAN0: SETZB AC5,AC11 ;[342]USE CHANNEL 0 MOVE AC6,OPNCBP ;[342]MARK CHAN 0 IN USE JRST GCHAN1 ;[342]AND EXIT ;INCREMENT THE REEL NUMBER BY ONE. ***POPJ*** INCRN.: LDB AC2,DTRN. ;SIXBIT ADD ONE TO CURRENT REEL NUMBER MOVE AC0,AC2 ;SO THE REEL NUMBER MAY BE RESTORED TRNE AC2,10 TRNN AC2,1 ;SKIP IF INC. WILL CAUSE A CARRY OUT AOJA AC2,INCRN1 ;INCREMENT THE REEL NUMBER TRNE AC2,1000 TRNN AC2,100 SKIPA ;[327] JRST INCRN2 ;99 IS MAX ADDI AC2,100 ;[327] ADD 100 TRZ AC2,11 ;THE INCREMENT INCRN1: DPB AC2,DTRN. ;SAVE AS CURRENT REEL NUMBER POPJ PP, INCRN2: MOVE AC2,[BYTE (5)10,31,20,2,4,14] PUSHJ PP,MSOUT. TTCALL 3,[ASCIZ /99 IS THE MAXIMUM ACCEPTABLE REEL NUMBER/] JRST KILL ;OPEN FAILED - GIVE FATAL MESSAGE OR IGNORE IT OERRDF: MOVE AC0,[E.MOPE+E.FIDA];ERROR NUMBER SETZM FS.IF ;IDA FILE JRST OERRI1 ; ;OPEN FAILED OERRIF: MOVE AC0,[E.MOPE+E.FIDX];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MOPE] ;NO OERRI1: PUSHJ PP,IGCVR ;IGNORE? JRST RCHAN ;YES - NO MESSAGE BUT FILE IS NOT OPEN MOVE AC2,[BYTE (5)25,4,20,13,23,15] JRST MSOUT. ;DEVICE IS NOT A DEVICE OR NOT AVAILABLE ;RENAME OF "IDX" FILE FAILED ORERRI: MOVE AC0,[E.MREN+E.FIDX];MAKE AN ERROR NUMBER JRST OEERR1 ; ;RENAME FAILED ORERR: SETZM FS.IF ;IDA FILE MOVE AC0,[E.MREN+E.FIDA];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MREN] ;NO, ERROR NUMBER JRST OEERR1 ; ;ENTER OF "IDX" FILE FAILED OEERRI: MOVE AC0,[E.MENT+E.FIDX];ERROR NUMBER JRST OEERR1 ; ;ENTER FAILED OEERR: SETZM FS.IF ;IDA FILE MOVE AC0,[E.MENT+E.FIDA];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MENT] ;NO, ERROR NUMBER OEERR1: PUSHJ PP,ERCDE ;IGNORE? JRST RCHAN ;YES JRST ENRERR ;GIVE ERROR MESSAGE ;LOOKUP OF "IDX" FILE FAILED OLERRI: MOVE AC0,[E.MLOO+E.FIDX];ERROR NUMBER JRST OLERR1 ; ;LOOKUP FAILED OLERR: SETZM FS.IF ;IDA FILE MOVE AC0,[E.MLOO+E.FIDA];ERROR NUMBER TLNN FLG,IDXFIL ;IDX FILE? MOVE AC0,[E.MLOO] ;NO, ERROR NUMBER OLERR1: PUSHJ PP,ERCDL ;IGNORE? JRST RCHAN ;YES JRST LUPERR ;GIVE ERROR MESSAGE ;GET THE LOOKUP/ENTER/RENAME/FILOP ERROR CODE INTO AC0 ERCDL: SKIPA AC1,ULBLK.+1 ;GET ERROR CODE FROM LOOKUP BLOCK ERCDE: MOVE AC1,UEBLK.+1 ; OR ENTER BLOCK ERCDF: ANDI AC1,37 ;GET ONLY THE ERROR BITS CAIL AC1,10 ;DON'T CONVERT TO ADDI AC0,2 ; DECIMAL CAIL AC1,20 ; GET RID ADDI AC0,2 ; OF 8, 9 CAIL AC1,30 ; 18, 19 ADDI AC0,2 ; 28 AND 29 ADD AC0,AC1 ;ADD IN THE ERROR CODE CAIE AC1,6 ;HARDWARE ERROR? JRST IGCVR ;NO MOVEI AC1,^D30 ;YES MOVEM AC1,FS.FS ;LOAD FILE-STATUS JRST IGCVR ;FINISH UP ;RELEASE THE IO CHANNEL AND NOTE THAT IT'S FREE RCHAN: IFN ISAM< TLNN FLG,IDXFIL ;INDEXD FILE? JRST RCHAN1 ;NO HRRZ AC5,ICHAN(I12) ;GET THE CHANNEL NUMBER PUSHJ PP,SETC1. ;SET UP THE RELEASE UUO XCT URELE. ;RELEASE IT PUSHJ PP,FRECH1 ; AND FREE THE CHAN PUSHJ PP,SETCN. ;SET UP FOR THE "IDA" FILE > RCHAN1: XCT URELE. ;RELEASE IT JRST FRECHN ;FREE THE CHAN AND RET TO CBL-PRG ;CALL VIA JRST ;AC0 HAS ERROR NUMBER FOR IGCV - AC2 HAS ERROR MESSAGE FOR MSOUT. OXITER: TLNE FLG,IDXFIL ;ISAM FILE? ADD AC0,[E.FIDX] ;YES PUSHJ PP,IGCV ;IGNORE ERROR? JRST MSOUT. ;NO POPJ PP, ;YES, BACK TO MAIN LINE ;CALL VIA PUSHJ -- AC0 HAS ERROR NUMBER OXITP: TLNE FLG,IDXFIL ;ISAM FILE? ADD AC0,[E.FIDX] ;YES PUSHJ PP,IGCVR ;IGNORE ERROR ? POP PP,(PP) ;YES, POP OFF RETURN POPJ PP, ; RETURN SUBTTL WRITE OUT THE BUFFER ;ALL BUFFERED OUTPUTS ARE DONE HERE. ***POPJ*** WRTOUT: AOS D.OE(I16) ;BUMP OUTPUT COUNT XCT UOUT. ;DO THE OUTPUT POPJ PP, ;NORMAL RETURN WRTWAI:;**SAVE ACS** PUSHJ PP,SETCN. ; SETUP THE CHANNEL FIELD XCT UWAIT. ;FOR ALL THE ERRORS XCT UGETS. ; TRNE AC2,740000 ;ERRORS? JRST WRTERR ;THERE ARE ERRORS. WRTFIN: MOVE AC13,D.DC(I16) ; GET DEVICE CHARACTERISTICS TLNE AC13,20 ;MTA? TRNN AC2,2000 ;EOT? JRST WRTXIT ;NOT A MAGTAPE EOT TLNE AC16,READ+CLOSEF+CLOSER ;CLOSE OR READ? JRST WRTXIT ;YES TYPE 'F' OR 'R' LABEL OR READ LDB AC0,F.BPMT ;COULD BE WRITE, OPEN, OR CLOSE 'B' JUMPN AC0,WRTMFR ;JUMP IF MFR TLO AC16,MTAEOT ;EOT FLAG JRST WRTXIT ; WRTMFR: MOVE AC0,[E.MOUT] ;OUTPUT ERROR PUSHJ PP,IGMDR ;IGNORE ERROR? JRST WRTXIT ;YES TTCALL 3,[ASCIZ/ENCOUNTERED AN "EOT" ON A MULTI FILE REEL WHILE PROCESSING/] MOVE AC2,[BYTE(5)10,31,20,36] JRST MSOUT. ;/FILE ON DEVICE/ KILL ;READ EOF GETS A SKIP EXIT WRTRSX: TLO FLG,ATEND ;SET READ AN "EOF" WRTRS1: AOS (PP) ;SKIP EXIT VIA WRITE EXIT WRTXIT: XCT UGETS. ;GET STATUS TLNE AC13,20 ;MAGTAPE? TRZA AC2,762000 ;MAGTAPE. TRZ AC2,760000 ;OTHER. XCT USETS. ;SET STATUS POPJ PP, ;RETURN WRTERR: TLNE AC13,20 ;MTA? TRNN AC2,400000 ;WRITE-LOCKED? JRST WRTER1 ;NO PUSHJ PP,SAVAC. ;IT'S A WRITE-LOCKED MAGTAPE TTCALL 3,[ASCIZ /$ /] MOVE AC2,[BYTE(5)22,27,10,31,20,4,14] PUSHJ PP,MSOUT. ;"CANNOT DO OUTPUT TO TTCALL 3,[ASCIZ/IS THE DEVICE WRITE ENABLED?/] PUSHJ PP,C.STOP ;"TYPE CONTINUE TO PROCEDE" PUSHJ PP,RSTAC. ;RESTORE THE ACS TRZ AC2,760000 ;TURN OFF THE ERROR BITS XCT USETS. ;SET STATUS JRST WRTOUT ;TRY AGAIN WRTER1: MOVE AC0,[E.MOUT] ;OUTPUT ERROR PUSHJ PP,IGMDR ;IGNORE ERROR? JRST WRTXIT ;YES MOVE AC2,[BYTE(5)36,31,20,10,4,14] PUSHJ PP,MSOUT. ;"OUTPUT ERROR ON " PUSHJ PP,IOERMS ;THE ERROR JRST KILL ; IOERMS: XCT UGETS. ;GET STATUS AC2************* IOERM1: PUSHJ PP,ERCODE ;OUTPUT ERROR STATUS TRNE AC2,400000 TTCALL 3,[ASCIZ/ IMPROPER MODE/] TRNE AC2,200000 TTCALL 3,[ASCIZ/ DEVICE ERROR/] TRNE AC2,100000 TTCALL 3,[ASCIZ/ DATA ERROR/] TRNN AC2,40000 POPJ PP, TLNE AC13,200000 ;DSK? TTCALL 3,[ASCIZ / QUOTA EXCEEDED, FILE STRUCTURE OR RIB FULL/] TLNE AC13,100 ;DTA? TTCALL 3,[ASCIZ / BLOCK NUMBER TOO LARGE OR DEC-TAPE IS FULL/] TLNN AC13,200100 ;ONLY ONE MESSAGE TTCALL 3,[ASCIZ/ BLOCK TOO LARGE/] POPJ PP, ;OUTPUT CONTENTS OF AC2 BITS 18-35 (ERROR STATUS) ERCODE: MOVEI C,"(" ; TTCALL 1,C ;OUTPUT ( MOVEI AC1,6 ;SIX OCTAL NUMBERS MOVE AC0,[POINT 3,2,17] ERCOD1: ILDB C,AC0 ;GET NUMBER ADDI C,"0" ;ASCIZE IT TTCALL 1,C ;OUTPUT IT SOJG AC1,ERCOD1 ;LOOP MOVEI C,")" ; TTCALL 1,C ;OUTPUT ) POPJ PP, SUBTTL READ INTO THE BUFFER ;ALL BUFFERED INPUTS ARE DONE HERE. ***POPJ*** READIN: AOS D.IE(I16) ;BUMP INPUT COUNT XCT UIN. ;*********************** POPJ PP, ;NORMAL RETURN ;SKIP RETURN IF OPEN/CLOSE/READ EOF READCK: ;**BOMB** PUSHJ PP,SETCN. ; SETUP THE CHANNEL FIELD XCT UGETS. ; GET THE STATUS MOVE AC13,D.DC(I16) ; AND DEVICE CHARACTERISTICS TLNN AC13,20 ; MTA ? JRST READC1 ; NO TRNE AC2,2000 ;SKIP IF NOT AN "EOT" TLO AC16,MTAEOT ;"EOT" FLAG FOR READEF+N READC1: TRNN AC2,760000 ;SKIP IF ANY ERRORS IN THE CURRENT BUFFER JRST WRTXIT ;CLEAR THE ERRORS AND POPJ TRNN AC2,20000 ;SKIP IF AN EOF JRST REAERR ;REAL ERRORS! TLNN AC16,OPEN+CLOSEB+CLOSER+CLOSEF ;SKIP IF OPEN OR CLOSE JRST WRTRSX ;JUMP, IT'S READ OR WRITE "EOF" JRST WRTRS1 ;EXIT BUT DONT SET ATEND REAERR: MOVE AC0,[E.MINP] ;INPUT ERROR PUSHJ PP,IGMDR ;IGNORE ERROR? JRST WRTXIT ;YES MOVE AC2,[BYTE (5) 35,31,20,10,4,14] PUSHJ PP,MSOUT. PUSHJ PP,IOERMS ;THE ERROR JRST KILL ; ;READ IN SYNCHRONOUS MODE READSY: PUSHJ PP,CLSYNC ;SINGLE BUFFERS PUSHJ PP,READIN ;GET A BUFFER JRST .+2 ;NORMAL RET AOS (PP) ;EOF RETURN JRST CLSYNC ;BACK TO MULTI BUFFERS SUBTTL TODAY. 8JAN ;CALLED BY PUSHJ PP,TODAY. ;EXIT WITH DATE IN AC0 YYMMDD ; TIME IN AC1 HHMMSS AC0=0 ;YYMMDD AC1=1 ;HHMMSS AC4=4 ;TEMP AC5=AC4+1 ;TEMP AC6=AC5+1 ;TEMP PP=17 ; INTERN TODAY.,TODA1.,TODA2. ENTRY MCSTIM ;CMCS (LCM) USES THIS ROUTINE TODAY.: CALLI AC4,14 ;DATE UUO ((Y-64)*12+(M-1))*31+D-1 TODA1.: IDIVI AC4,^D31 ;PICK OFF THE DAY ADDI AC5,1 ;MAKE IT RIGHT PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS DPB AC5,DAY ;XXXXDD IDIVI AC4,^D12 ;PICK OFF THE MONTH ADDI AC5,1 ;MAKE IT RIGHT PUSHJ PP,TODA4. ;RETURNS TWO SIXBIT NUMBERS DPB AC5,MONTH ;XXMMDD MOVEI AC5,^D64 ;GET THE BASE YEAR ADD AC5,AC4 ;PLUS YEARS SINCE THEN CAIL AC5,^D100 ;CK FOR YEAR 2000+ [EDIT#274] SUBI AC5,^D100 ;IF SO, CONVERT TO 00+ [EDIT#274] PUSHJ PP,TODA4. ;SIXBIT DPB AC5,YEAR ;YYMMDD-DATE FINISHED CALLI AC4,23 ;TIME UUO GETS TIME IN MILLISECONDS IDIVI AC4,^D1000 ;CONVERT TO SECONDS MCSTIM: PUSHJ PP,TODA3. ;PICK OFF SECONDS IN SIXBIT DPB AC5,SECOND ;XXXXSS TODA2.: PUSHJ PP,TODA3. ;PICK OFF MINUTES IN SIXBIT DPB AC5,MINUTE ;XXMMSS MOVE AC5,AC4 ;WHAT'S LEFT IS HOURS PUSHJ PP,TODA4. ;TO SIXBIT DPB AC5,HOUR ;HHMMSS-TIME FINISHED POPJ PP, ;RETURN TODA3.: IDIVI AC4,^D60 ;DIVIDE BY 60 FOR TIME TODA4.: IDIVI AC5,^D10 ;DIVIDE OUT A DECIMAL NUMBER LSH AC5,6 ;MAKE ROOM FOR THE REMIANDER ADDI AC5,2020(AC6) ;CONVERT TO SIXBIT POPJ PP, ;RETURN YEAR: POINT 12,AC0,11 MONTH: POINT 12,AC0,23 DAY: POINT 12,AC0,35 HOUR: POINT 12,AC1,11 MINUTE: POINT 12,AC1,23 SECOND: POINT 12,AC1,35 IFN EBCLBL,< ;PUSHJ PP,JULIAN ;RETURNS WITH DATE IN AC0 ;AS SIXBIT YYDDD JULIA0: AOS (PP) ;TAKE A SKIP EXIT JULIAN: SETZ AC0, ; CALLI AC4,14 ;GET DATE IDIVI AC4,^D31 ;PICK OFF DAY-1 ADDI AC5,1 ;DAY OF THE MONTH MOVE AC1,AC5 ;SAVE THE DAY IDIVI AC4,^D12 ;PICK OFF MONTH - 1 ADDI AC4,^D64 ;GET YEAR IN AC4 EXCH AC4,AC5 ;SWAP WITH MONTH INDEX PUSHJ PP,TODA4. ;STORE THE SIXBIT YEAR DPB AC5,YEAR ; IN AC0 ADD AC1,DAYTAB(AC4) ;ADD PREVIOUS DAYS TO DAY OF MONTH CAIG AC4,2 ;PAST FEBRUARY? JRST JULIA1 ;YES IDIVI AC4,4 ;CHECK FOR LEAP YEAR CAIG AC5,0 ;LEAP YEAR? ADDI AC1,1 ;YES JULIA1: MOVE AC4,AC1 ; IDIVI AC4,^D10 ;DIVIDE OUT THE MOVE AC1,AC5 ; UINTS AND IDIVI AC4,^D10 ; THE TENS LSH AC4,6 ;SHIFT OVER THE HUNDREDS ADD AC5,AC4 ;ADD IN THE TENS LSH AC5,6 ;MAKE ROOM FOR THE UNITS ADDI AC5,202020(AC1) ;ADDEM IN AND SIXBITIZE LSH AC5,6 ;GET THEM NEXT TO THE YEAR POSITION ADD AC0,AC5 ; YYDDD POPJ PP, DAYTAB: EXP ^D0 ;JAN EXP ^D31 ;FEB EXP ^D59 ;MAR EXP ^D90 ;APR EXP ^D120 ;MAY EXP ^D151 ;JUN EXP ^D181 ;JUL EXP ^D212 ;AUG EXP ^D243 ;SEP EXP ^D273 ;OCT EXP ^D304 ;NOV EXP ^D334 ;DEC > SUBTTL ERROR MESSAGES 5-JAN-70 ;MOVE AC2,[BYTE (5),1,2,3,4] ;CALLING ;JRST MSOUT. ;SEQUENCE MSOUT.: PUSHJ PP,DSPL1. ;OUTPUT BUFFER AND "CRLF" MOVE AC0,[POINT 5,AC2] ;POINT AT INDEX FROM AC0 ILDB AC1,AC0 ;PLACE IT IN AC1 XCT MSAGE(AC1) ;EXECUTE THE TABLE ITEM JRST .-2 ;GO AGAIN ;MSDEV OUTPUTS THE SIXBIT DEVICE NAME MSDEV.: SKIPN .JBAPR ;SKIP IF NOT RESET UUO SKIPA AC1,AC13 ;ELSE MAKE SURE U GET THE RIGHT DEV HRRZ AC1,D.ICD(I16) ;GET THE CURRENT DEVICE MOVE AC6,(AC1) ; [407] GET DEVICE NAME DEVNAM AC6, ; [407] GET PHYSICAL NAME JRST MSDEVA ; [407] NO SUCH DEVICE- DO REGULAR PRINTOUT CAMN AC6,(AC1) ; [407] IS PHYSICAL = LOGICAL? JRST MSDEVA ; [407] YES- NO REASON TO SAY IT TWICE MOVE AC4,(AC1) ; [407] DEVICE NAME DEVTYP AC4, ; [407] GET DEVICE TYPE JRST MSDEVA ; [407] CANT TLNE AC4,20 ; [407] IF SPOOLED FORGET IT JRST MSDEVA TTCALL 3,[ASCIZ/ LOGICAL DEVICE /] ; [407] MOVE AC3,(AC1) ; [407] LOGICAL DEVICE PUSHJ PP,MSDEV1 ; [407] TYPE IT TTCALL 3,[ASCIZ/; PHYSICAL DEVICE /] ; [407] MOVE AC3,AC6 ; [407] PHYSICAL DEVICE JRST MSDEV1 ; [407] TYPE AND RETURN MSDEVA: TTCALL 3,[ASCIZ/ DEVICE /] MOVE AC3,(AC1) ;DEVICE NAME MSDEV1: MOVEI AC4,6 ;6 CHARS SKIPA AC1,[POINT 6,AC3] ;POINT AT IT MSFIL1: PUSHJ PP,OUT6B. ;ASCIZE IT AND PLACE IN BUFFER MSFIL2: ILDB C,AC1 ;PICKUP THE NEXT CHAR CAIE C,0 ;TERMINATE ON A SPACE SOJGE AC4,MSFIL1 ; OR SATISFIED CHAR COUNT JRST OUTBF. ;EXIT ;MSFIL OUTPUTS THE SIXBIT FILE NAME MSFIL.: MOVEI AC4,^D30 ;30 CHARS TTCALL 3,[ASCIZ / FILE /] MOVE AC1,[POINT 6,(I16)] ;POINT AT A FILE NAME PUSHJ PP,MSFIL2 ;OUTPUT FILE NAME ;OUTPUT THE VALUE-OF-ID AS [ FILE EXT ] MSVID: IFN ISAM< TLNE FLG,IDXFIL ;[323]IS THIS AN ISAM FILE? SKIPE FS.IF ;[323]YES,IS ERROR IN DATA FILE? JRST MSVID2 ;[323]"NO" TO EITHER QUESTION MOVE AC1,[POINT 6,DFILNM(I12)] ;[323]WANT DATA FILENAME TLNE I16,777777 ;[323]UNLESS IN RESET JRST MSVID3 ;[323]CONTINUE > MSVID2: SKIPN AC1,F.WVID(I16) ;[323]BP TO VALUE OF ID POPJ PP, ;EXIT IF NO ID MSVID3: MOVEI AC4,11 ;9 CHARACTERS MSVID4: TTCALL 3,[ASCIZ/ [/] ;[323] MSVID1: ILDB C,AC1 TLNN AC1,100 ;SKIP IF ASCII [EDIT#304] ADDI C,40 ;CONVERT SIXBIT TO ASCII [EDIT#304] TLNN AC1,600 ; EBCDIC? LDB AC1,PTR.97##(AC1) ; YES PUSHJ PP,OUTCH. ;OUTPUT TO BUFFER [EDIT#304] SOJG AC4,MSVID1 ;LOOP 9 TIMES PUSHJ PP,OUTBF. ;DUMP THE BUFFER TTCALL 3,[ASCIZ/]/] ; POPJ PP, ;EXIT ;OUTPUT THE SIXBIT REEL NUMBER MSDTRN: LDB AC3,DTRN. ;FROM THE DEVICE TABLE JRST MSSLR1 ; MSSLRN: HRL AC3,STDLB.+4 ;THE HLR AC3,STDLB.+5 ; STANDARD ROT AC3,-14 ; LABEL ANDI AC3,7777 ; REEL NUMBER MSSLR1: TTCALL 3,[ASCIZ/ REEL /] ROT AC3,-14 JRST MSDEV1 ;MSSLR1+3 [277] IG 22-OCT-73 ;ROUTINE TO PRECEDE MESSAGES TO TTY WITH "$" [EDIT#277] $SIGN: TTCALL 3,[ASCIZ/ $ /] ; [EDIT#277] POPJ PP, ; [EDIT#277] ;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES [371] PUTDEC: JUMPGE AC0,PUTDC1 ;IF NEGATIVE, [371] TTCALL 3,[ASCIZ "-"] ; TYPE SIGNED AND [371] MOVMS AC0 ; GET MAGNITUDE [371] PUTDC1: IDIVI AC0,^D10 ; DIVIDE BY RADIX TO [371] HRLM AC1,(PP) ; SAVE RADIX DIGIT [371] SKIPE AC0 ; DONE ? [371] PUSHJ PP,PUTDC1 ; NO-- LOOP [371] HLRZ C,(PP) ; GET SAVED DIGIT [371] ADDI C,"0" ; CONVERT TO ASCII [371] TTCALL 1,C ; TYPE DIGIT [371] POPJ PP, ; [371] ;THE FOLLOWING 40 LOC TABLE IS "XCT"ED FROM MSOUT. MSAGE: JRST KILL ;0 TTCALL 3,[ASCIZ/ SHARES BUFFER AREA WITH /] ;1 TTCALL 3,[ASCIZ/ CANNOT BE OPENED/] ;2 TTCALL 3,[ASCIZ/, ALREADY OPEN/] ;3 TTCALL 3,[ASCIZ/ /] ;4 TTCALL 3,[ASCIZ/ TOO MANY OPEN FILES/] ;5 TTCALL 3,[ASCIZ/ IS NOT OPEN/] ;6 TTCALL 3,[ASCIZ/ FOR INPUT/] ;7 PUSHJ PP,MSFIL. ;30 CHARACTER FILENAME ;10 TTCALL 3,[ASCIZ/ FOR OUTPUT/] ;11 TTCALL 3,[ASCIZ/ IS AT END/] ;12 TTCALL 3,[ASCIZ/ IS NOT A DEVICE/] ;13 POPJ PP, ;RETURN ;14 TTCALL 3,[ASCIZ/ IS NOT AVAILABLE TO THIS JOB/];15 TTCALL 3,[ASCIZ/ IS ASSIGNED TO ANOTHER FILE/] ;16 TTCALL 3,[ASCIZ . CANNOT DO INPUT/OUTPUT.] ;17 PUSHJ PP,MSDEV. ;6 CHARACTER DEVICE NAME;20 TTCALL 3,[ASCIZ/ CANNOT DO INPUT/] ;21 TTCALL 3,[ASCIZ/ CANNOT DO OUTPUT/] ;22 TTCALL 3,[ASCIZ/ OR /] ;23 PUSHJ PP,C.STOP ;24 TTCALL 3,[ASCIZ/INIT TOOK THE ERROR RETURN/] ;25 TTCALL 3,[ASCIZ/DIRECTORY DEVICES MUST HAVE STANDARD LABELS/] TTCALL 3,[ASCIZ/ TO/] ;27 PUSHJ PP,MSDTRN ;DEVICE TABLE REEL NUMBER;30 TTCALL 3,[ASCIZ/ ON/] ;31 TTCALL 3,[ASCIZ/LABELS MAY NOT BE OMITTED FROM DTA OR DSK FILES/] TTCALL 3,[ASCIZ/ BECAUSE IT IS NOT OPEN/] ;33 PUSHJ PP,MSSLRN ;STANDARD LABEL REEL NUMBER;34 TTCALL 3,[ASCIZ/ INPUT ERROR/] ;35 TTCALL 3,[ASCIZ/ OUTPUT ERROR/] ;36 TTCALL 3,[ASCIZ/ CANNOT BE CLOSED/] ;37 ;LOOKUP OR ENTER ERROR MESSAGES. ***KILL OR OPNENR*** LUPERR: TDZA ;LOOKUP ERROR ENRERR: SETO ;ENTER ERROR PUSHJ PP,SAVAC. LDB AC1,F.BOUP ;GET THE OEUP FLAG HRRZ AC2,UEBLK.+1 ;GET THE ERROR CODE TRZ AC2,777740 ; CLEAR THE REST CAIN AC2,3 ;IF ERROR IS FILE BEING MODIFIED JUMPN AC1,ENRAGN ;YES, IF FLAG ON SEE IF USE PRO ENRER2: TLNN AC16,OPEN ;OPEN OR CLOSE UUO SKIPA AC2,[BYTE (5)10,37,31,20,4,14] ;CLOSE! MOVE AC2,[BYTE (5)10,2,31,20,4,14] ;ENRER2+3 [277] IG 22-OCT-73 MOVE AC13,D.ICD(I16) ;DEVICE NAME [EDIT#277] CALLI AC13,4 ;DEVCHR UUO [EDIT#277] TLNE AC13,120 ;A REEL DEVICE? [EDIT#277] PUSHJ PP,$SIGN ;YES, OUTPUT "$" [EDIT#277] PUSHJ PP,MSOUT. ; CANNOT BE OPENED ON MOVEI AC2,[ASCIZ/ LOOKUP /] SKIPE (PP) ;SKIP IF LOOKUP UUO MOVEI AC2,[ASCIZ/ ENTER /] SKIPE PRGFLG ;RENAME FAILURE? MOVEI AC2,[ASCIZ / RENAME /] TLNE FLG1,FOPERR ;FILOP FAILURE? MOVEI AC2,[ASCIZ/ FILOP /] TTCALL 3,(AC2) ; LOOKUP, ENTER, RENAME OR FILOP TTCALL 3,[ASCIZ/FAILED, /] HRRZ AC2,ULBLK.+1 SKIPE (PP) ;SKIP IF LOOKUP UUO HRRZ AC2,UEBLK.+1 TRZ AC2,777740 ;SAVE ONLY THE ERROR BITS PUSHJ PP,ERCODE ;OUTPUT THE ERROR CODE CAIL AC2,LEMLEN ;A LEGAL ERROR CODE? HRRI AC2,LEMLEN ;NO, GIVE CATCH-ALL JUMPN AC2,ENRER1 ; SKIPE (PP) ;SKIP IF LOOPUP HRRI AC2,LEMLEN+1 ;ILL-FIL-NAME NOT FIL-NOT-FND ENRER1: TTCALL 3,@LEMESS(AC2) ;TYPE A MESSAGE SKIPN (PP) ;KILL IF ENTER TLNN AC13,120 ;A REEL DEVICE? JRST KILL ;NO JUMPN AC2,KILL ;KILL IF NOT UNFOUND FILE TTCALL 3,[ASCIZ/ WRONG REEL? /] PUSHJ PP,C.STOP ;WAIT FOR CONTINUE PUSHJ PP,RSTAC. ;RESTORE THE ACS TLNN AC16,-1 ;SKIP IF NOT CALLED W/ A PUSHJ POPJ PP, ;EXIT TO RRDMP JUMPE AC0,OPNLUP ;TRY JRST OPNENR ;AGAIN. ;PERFORM USE PROCEDURE AND RETRY ENTER UUO ;LOOP TILL ENTER WINS OR USER GIVES UP IN USE-PRO. ENRAGN: MOVEI AC1,0 ;PERFORM ERROR USE PRO SKIPN FS.UPD ;SKIP IF ALREADY DONE PUSHJ PP,USEPRO ; ERROR USE PRO JRST .+2 ;NORMAL RETURN JRST ENRER2 ;NO USE PRO - GIVE ERROR MESS. AND KILL SETZM FS.UPD ;CLEAR THE USE-PRO-DONE FLAG PUSHJ PP,RSTAC. ;RESTORE ACS IFN ISAM,< TLNE FLG1,EIX ;IF INDEX FOR ISAM FILE JRST OPNI00 ; EXIT HERE > JRST OPNENR ;TRY AGAIN ;LOOKUP/ENTER ERROR MESSAGES LEMESS: [ASCIZ / FILE NOT FOUND/] [ASCIZ / UFD DOES NOT EXIST/] [ASCIZ / PROTECTION FAILURE OR DTA DIRECTORY FULL/] [ASCIZ / FILE BEING MODIFIED/] [ASCIZ / RENAME FILE ALREADY EXIST/] [ASCIZ / ILLEGAL SEQUENCE OF UUOS/] [ASCIZ . DEVICE OR UFD/RIB DATA ERROR.] [ASCIZ / NOT A SAVED FILE/] [ASCIZ / NOT ENOUGH CORE/] [ASCIZ / DEVICE NOT AVAILABLE/] [ASCIZ / NO SUCH DEVICE/] [ASCIZ / GETSEG REQUIRES TWO RELOCATION REGISTERS/] [ASCIZ / QUOTA EXCEEDED OR NO ROOM ON FILE STRUCTURE/] [ASCIZ / WRITE LOCKED FILE STRUCTURE/] [ASCIZ / NOT ENOUGH MONITOR TABLE SPACE/] [ASCIZ / PARTIAL ALLOCATION ONLY/] [ASCIZ / ALLOCATED BLOCK NOT FREE/] LELAST: [ASCIZ / LOOKUP, ENTER OR RENAME ERROR/] LEMLEN==LELAST-LEMESS [ASCIZ / ILLEGAL FILENAME/] SUBTTL CLOSE-UUO PURGE.: TLZ AC16,(Z 17,) TLO AC16,(Z 1,) ;MAKE PURGE BE A CLOSE UUO SETOM PRGFLG ;REMEMBER TO RENAME TO ZERO ;A C.CLOS UUO LOOKS LIKE: ;001040,,ADR WHERE ADR = FILE TABLE ADDRESS ;BIT9 =0 CLOSE FILE ;BIT9 =1 CLOSE REEL ;BIT10 =1 LOCK, LOCKED FILES MAY NOT BE REOPENED ;BIT11 =1 DON'T REWIND ;BIT12 =1 ALWAYS 1 (VS. 0 = OPEN) ;CALL+1: POPJ RETURN ;EXIT IF OPTIONAL FILE IS NOT PRESENT, ERROR MESSAGE IF IT'S NOT ;OPEN OR IF IT'S A "CLOSE REEL" AND A MULTI-FILE REEL. ;WRITE OUT ANY ACTIVE DATA REMAINING IN THE BUFFER FROM RANDOM ;OR IO FILES. C.CLOS: IFE %%RPG,< SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS? PUSHJ PP,SU.CL ; YES > MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR BLT AC0,FS.IF ; STATUS WORDS. SETOM FS.IF ;IDX FILE MOVE FLG,F.WFLG(I16) ;PICK UP THE FLAGS HLLZ FLG1,D.F1(I16) ;MORE FLAGS TLNN FLG,NOTPRS ;SKIP IF FILE IS NOT PRESENT JRST CLOS01 ; BUT IT IS SETZM PRGFLG ;INCASE IT WAS CLOSE WITH DELETE TLZ FLG,OPNIN!OPNOUT!ATEND!NOTPRS!CONNEC MOVEM FLG,F.WFLG(I16) ;REINIT THE FLGS POPJ PP, ;EXIT CLOS01: MOVE AC0,[E.VCLO+^D20];ERROR NUMBER TLNN FLG,OPNIN+OPNOUT SKIPA AC2,[BYTE(5)10,31,20,37,33] SKIPA AC13,D.DC(I16) ;PICK UP DEVICE CHARACTERISTICS JRST OXITER ;FILE WAS NOT OPEN. TLNN AC13,4 ;A DIRECTORY DEVICE? SETZM PRGFLG ;NO - SO WE CAN'T PURGE TLNE AC13,10 ;A TTY FILE? SETZM TTYOPN ;YES, NOTE THAT IT'S CLOSED LDB AC5,F.BPMT ;FILE POSITION ON TAPE TLNE AC16,400 ;SKIP IF NOT CLOSE REEL TLOA AC16,CLOSER ;% CLOSE REEL TLOA AC16,CLOSEF ;% CLOSE FILE JUMPN AC5,CLOSF5 ;CLOSE "REEL" A MULTI-FILE-REEL - AN ERROR CLOS02: TLNE AC16,CLOSER ; TLNE AC13,20 ;CLOSE REEL AND NOT MTA? JRST CLOS00 ;NO MOVEI AC0,^D33 ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST CLOS00 ;YES TTCALL 3,[ASCIZ /$ CLOSE REEL IS LEGAL ONLY FOR MAG-TAPE /] MOVE AC2,[BYTE(5) 10,31,20,37,4,14] JRST MSOUT. ;NON-FATAL CONTINUE WITH A POPJ CLOS00: PUSHJ PP,SETCN. ;DISTRIBUTE THE CHAN NUMBER HLRZ AC12,D.BL(I16) ;BUFFER LOCATION IFN ISAM,< TLNE FLG,IDXFIL ;INDEXED FILE? JRST CLSISM ;YES > TLNN FLG,RANFIL+OPNIO;SKIP IF RANDOM OR IO JRST CLOSE1 ; TLNE FLG,DDMASC!RANFIL ;SKIP IF IO-FILE JRST CLOSE0 ; TLC FLG,OPNIN!OPNOUT!ATEND ; TLCE FLG,OPNIN!OPNOUT!ATEND ;SKIP IF IO-FILE AND ATEND TLNN FLG,OPNIN ;SKIP IF OPEN FOR INPUT PUSHJ PP,CLSZBF ;IO-FILE AND ATEND OR OUTPUT FILE CLOSE0: SKIPE R.DATA(I12) ;SKIP IF NO ACTIVE DATA IN BUFFER PUSHJ PP,RANOUT ;WRITE IT OUT HLLZS UOUT. ;CLEAR IOWD POINTER JRST CLOSE3 ; ;PAD THE LAST LOGICAL BLOCK IF NECESSARY. CLOSE1: TLNE FLG,OPNOUT ;SKIP IF NOT AN OUTPUT FILE SKIPG AC5,D.BCL(I16) ;SKIP IF BUFFER/BLOCK IS NOT 0 JRST CLOSE3 ; TLNE FLG,DDMBIN ;IF BINARY MODE, JRST CLOSE3 ; WE DON'T PAD CAME AC5,D.BPL(I16) ;SKIP IF = BUF/LOGBLK JRST CLOSE2 ;PAD THE LOGICAL BLOCK HRRZ AC1,D.OBH(I16) ;ADR OF CURRENT BUF+1 HRRZ AC3,D.OBB(I16) ;ADR OF BYTE PTR SKIPL D.OBB(I16) ;440S00,,LOC MEANS BUF EMPTY CAIN AC1,-1(AC3) ;SKIP IF DATA IN BUFFER JRST CLOSE3 ; CLOSE2: SKIPE D.OBC(I16) ; SKIP IF BUFFER IS FULL IBP D.OBB(I16) ;FAKE OUT DSKSER PUSHJ PP,WRTBUF ;PAD THE LOGBLK SOJG AC5,.-2 ;LOOP TILL LOGBLK IS FULL ;READ A LABEL, DO BEFORE ENDING FILE/REEL USE PROCEEDURE, ;AND CHECK FOR "EOF/V" LABEL TYPE. CLOSE3: TLNN FLG,OPNOUT!ATEND JRST CLOSE8 ;SKIP LABEL PROCESSING, READ AND NOT ATEND TLNE FLG,OPNIN ;IF INPUT, PUSHJ PP,CLSRL ;READ A LABEL LDB AC5,F.BPMT ;[341]SEE IF FILE POSITIONED JUMPN AC5,CLOSE4 ;[341]IF THERE IS, SKIP NEXT TLNN FLG,OPNIN ;[341]OPEN FOR INPUT? JRST CLOSE4 ;[341]NO TLNE FLG1,NONSTD!STNDRD ;[341] IF LABELLED XCT MADVF. ;[341]SKIP OVER EOF AFTER LABEL REC. CLOSE4: MOVEI AC1,3 ; PUSHJ PP,USEPRO ;BEFORE ENDING FILE/REEL TLNN FLG,OPNIN ;SKIP IF INPUT JRST CLOSE6 ;JUMP IF OUTPUT TLNE FLG1,STNDRD ;SKIP IF NOT STD LABELS TLNN AC16,CLOSER ;SKIP IF CLOSE REEL JRST CLOSE7 ; PUSHJ PP,CLSEOV ;CHECK FOR EOV JRST CLOSE7 ; TTCALL 3,[ASCIZ /STANDARD END-OF-REEL LABELS MUST HAVE "EOV" AS THE FIRST THREE CHARACTERS/] MOVE AC2,[BYTE (5)10,31,20,37] JRST MSOUT. ;TYPE IT OUT ;CREATE A LABEL,DO AFTER ENDING FILE/REEL USE PROCEEDURE, ;WRITE OUT THE LABEL AND LOCK THE FILE. CLOSE6: PUSHJ PP,CLSCAL ;CREATE STD MTA ENDING LABEL CLOSE7: MOVEI AC1,4 ; PUSHJ PP,USEPRO ;AFTER ENDING FILE/REEL TLNE FLG,OPNOUT ;SKIP IF NOT OUTPUT PUSHJ PP,CLSWEL ;WRITE ENDING LABEL MAYBE CLOSE8: TLNE AC16,400 ;SKIP IF CLOSE FILE JRST CLOSR1 ;CLOSE REEL TLNN AC16,200 ;LOCK THE FILE? JRST CLOSF1 ;NO HRLZI AC0,LOCK ;SET THE LOCK FLAG ORM AC0,D.LF(I16) ;SAVE IT XCT MREWU. ;REWIND AND UNLOAD************** JRST CLOSF2 ;REWIND OR POSITION THE MTA, RESET THE FLAGS, RELEASE THE ;DEVICE AND EXIT. ***POPJ***ACP*** CLOSF1: TLNE AC16,100 ;REWIND REQUEST? JRST CLOSF3 ;NO PUSHJ PP,OPNRWD ;REWIND UUO CLOSF2: HRLZI AC0,HUF ;"HUF" FLAG ANDCAM AC0,D.HF(I16) ;CLEAR IT JRST CLOSF4 ; CLOSF3: LDB AC5,F.BPMT ;GET FILE POSITION JUMPE AC5,CLOSF4 ;DONT POSITION IF NONE IS SPECIFIED TLNN FLG,OPNOUT ;OPEN FOR OUTPUT? JRST CLOSF9 ;NO TLNE FLG1,NONSTD!STNDRD ;LABELED FILE? XCT MBSPF. ;YES, BACK INTO THE LABEL CLOSF9: TLNE FLG,OPNOUT!ATEND ;SKIP IF INPUT AND NOT "AT-END" XCT MBSPF. ;BACK SPACE INTO THE FILE TLNE FLG,OPNOUT!ATEND;[336]IF OUTPUT OR AT END JRST CLOSF4 ;[336]WE ARE DONE SKIPL D.IBH(I16) ;[336]IF HAVE DONE ANY READS XCT MBSPR. ;[336]BACKSPACE 1 RECORD CLOSF4: ;[336] IFN ISAM,< TLNN FLG,IDXFIL ;INDEX FILE? JRST CLOSF7 ;NO PUSHJ PP,CLSIDX ;YES, CLOSE & RELEAS THE INDEX-FILE PUSHJ PP,FRECH1 ;MAKE CHAN AVAILABLE MOVE AC1,CORE0(I12) ;UNTIL,,FROM SETZM (AC1) ;ZERO FIRST WORD HLRZ AC2,AC1 ;UNTIL HRL AC1,AC1 ;FROM,,FROM ADDI AC1,1 ;FROM,,TO BLT AC1,(AC2) ;ZERO CLOSF7:> SKIPN PRGFLG ;PURGE? JRST CLOSF8 ;NO TLNN FLG,OPNIN!RANFIL!IDXFIL ;SUPERSEDING? JRST CLOS75 ;COULD BE - GO SEE CLOS71: PUSHJ PP,OPNEID ; SETZM UEBLK. ;ZERO THE FILE-NAME XCT URNAM. ;DELET IT ******************* PUSHJ PP,ORERRI ;ERROR RET CLOS72: SETZM PRGFLG ;CLEAR THE FLG CLOSF8: SETZM D.DC(I16) ;DEVICE CHARACTERISTICS TLZ FLG,OPNIN+OPNOUT+ATEND+NOTPRS+CONNEC MOVEM FLG,F.WFLG(I16) ;REINITIALIZE THE FLAGS TLZ FLG1,F1CLR ; CLEAR SOME FLAGS HLLM FLG1,D.F1(I16) ;REINIT MORE FLAGS XCT URELE. ;RELEASE THE DEVICE************** JRST FRECHN ;EXIT TO THE ***"ACP"*** CLOSF5: MOVE AC0,[E.FIDX+^D21];ERROR NUMBER TLNN FLG,IDXFIL ;SKIP IF AN ISAM FILE MOVEI AC0,^D21 ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST CLOS02 ;CONTINUE MOVE AC2,[BYTE(5)10,31,20,37,14] PUSHJ PP,MSOUT. TTCALL 3,[ASCIZ/ THE CLOSE "REEL" OPTION MAY NOT BE USED WITH A MULTI-FILE-TAPE./] JRST KILL CLOS75: LDB AC1,DTCN. ;GET THE CHANNEL NUMBER TLNE AC13,4 ; DIRECTORY DEVICE ? [373] TLNE AC13,200000 ; DSK? IF NO IT IS DTA DO RENAME [373] RESDV. AC1, ;RESET THIS CHANNEL IE DELETE JRST CLOS71 ;FAILED SO RENAME TO ZERO JRST CLOS72 ;RETURN ;CLOSE REEL, REWIND AND UNLOAD, RELEASE THE DEVICE, GENERATE ;AN OPEN UUO AND GO DOIT. ***OPNDEV*** CLOSR1: TLZ AC16,777675 ;CLEAR ALL BUT REWIND&SLURP FLAGS TLO AC16,OPEN!CLOSEB!1000 ;OPEN WITH A REWIND + FLAG THE REEL CHANGE TLNN FLG,RRUNER ;RERUN ON END OF REEL? JRST CLOSR2 ;NO IFE %%RPG,< SETZM D.OE(I16) ;CLEAR THE NUMBER OF INS + OUTS SO SETZM D.IE(I16) ; RERUN DOESNT ROCK MAGTAPE PUSHJ PP,RRDMP ;YES PUSHJ PP,RSAREN ;RESTORE .JBSA, .JBREN PUSHJ PP,SETCN. ;CHAN NUMBERS DISTURBED BY RRDMP CODE XCT UCLOS. ;ELSE RELEASE TRYS TO DUMP "DUMMY BUFFER" CAUSED BY DUMMY OUT ; WHICH CAUSES REQUEST FOR OPR1 INTERVENTION!!? > ; END OF IFE %%RPG CLOSR2: TLZN AC16,100 ;SKIP IF NO REWIND XCT MREWU. ;REWIND AND UNLOAD PUSHJ PP,INCRN. ;INCREMENT THE DEVTAB REEL NUMBER PUSHJ PP,FRECHN ;NOTE THE CHAN IS FREE MOVE AC0,D.ICD(I16) ;GET THE NEXT DEVICE AOBJN AC0,.+2 ;JUMP IF THERE IS ONE PUSHJ PP,DEVIOW ;RESET DEVICE IOWD MOVEM AC0,D.ICD(I16) ;SAVE AS CURRENT IF THERE IS TLNN FLG,OPNIN ;SKIP IF INPUT JRST CLOSR3 ;JUMP IF OUTPUT TTCALL 3,[ASCIZ/ $ MOUNT/] PUSHJ PP,MSDTRN ;"REEL N" TTCALL 3,[ASCIZ/ OF/] MOVE AC2,[BYTE (5)10,31,20,24,14] PUSHJ PP,MSOUT. ;"FILE ON DEV" STOP0 JRST CLOSR4 ;OPEN THE NEXT REEL CLOSR3: TTCALL 3,[ASCIZ/ $ MOUNT SCRATCH TAPE ON/] PUSHJ PP,MSDEV. ;DEVICE PUSHJ PP,C.STOP ;TYPE CONT TO PRO CLOSR4: XCT URELE. ;RELEASE THE DEVICE JRST OPNDEV ;OPEN THE NEXT REEL ;READ A LABEL INTO THE RECORD AREA OR ZERO IT. ***@POPJ*** CLSRL: TLNN FLG,ATEND ;SKIP IF AT END POPJ PP, ; TLNE AC13,20 ;SKIP IF NOT A MAGTAPE TLNN FLG1,NONSTD+STNDRD ;SKIP IF NOT OMITTED LABELS POPJ PP, ;ZERO THE RECORD AREA XCT UCLOS. ;CLEAR THE EOF PUSHJ PP,READSY ;READ A LABEL JRST BUFREC ;NORMAL RETURN CLSRL0: MOVEI AC0,^D32 ;ERROR NUMBER PUSHJ PP,IGCV ;IGNORE ERROR? JRST CLSRL2 ;NO TLNE AC16,READ ;YES READ UUO? POPJ PP, ;YES, JUST RETURN TLNN AC16,OPEN ;OPEN UUO? JRST CLSRL1 ;NO MUST BE CLOSE XCT URELE. ;RELEASE DEVICE POP PP,(PP) ;DUMP RET TO BUFREC JRST FRECHN ;RELEASE THE CHANNEL ; AND BACK TO CBL-PRG CLSRL1: POP PP,(PP) ;POP OFF RET TO CLSRLB TLO AC16,100 ;REWIND CAUSE WE'RE LOST JRST CLOSE8 ;FINISH UP CLSRL2: TTCALL 3,[ASCIZ/ READ AN "EOF" INSTEAD OF A LABEL/] ; MOVE AC2,[BYTE(5)30,10,31,20,37] ;CLOSE TLNE AC16,OPEN ;OPEN UUO? MOVE AC2,[BYTE(5) 30,10,31,20,2] ;YES TLNE AC16,READ ;READ? MOVE AC2,[BYTE (5)35,31,20,10,4] ;YES JRST MSOUT. ;GO COMPLAIN ;CHECK FOR "EOV" AS FIRST THREE LABEL CRARACTERS CLSEOV: TLNE FLG,CDMASC ;SKIP IF NOT ASCII RECORD AREA JRST CLSEO1 ;ASCII TEST HLRZ C,(FLG) ;FIRST 3 CHARS CAIN C,(SIXBIT /EOV/) POPJ PP, ;OK EXIT JRST RET.2 ;ERROR SKIP RET CLSEO1: MOVE C,(FLG) ;FIRST WORD TRZ C,77777 ;CLEAR EXTRANEOUS BITS CAMN C,[ASCIZ /EOV/] POPJ PP, ;OK EXIT JRST RET.2 ;ERROR SKIP EXIT IFN ISAM,< ;CLOSE & RELEASE THE INDEX FILE CLSIDX: HRRZ AC1,D.IBL(I16) ; [377] GET ISAM SAVE AREA JUMPE AC1,CLSID3 ; [377] NONE GO ON HRLI AC1,ISCLR1(I12) ; [377] SAVE SHARE BUFFER AREA MOVEI AC2,ISMCLR(AC1) ; [377] IN ISAM FILE SAVE AREA BLT AC1,(AC2) ; [377] CLSID3: ; [377] NEW LABEL PUSHJ PP,SETIC ;SET THE CHANNEL NUMBER SKIPE PRGFLG ;DELETE THE FILE JRST CLSID2 ;YES SO GO DO IT TLNE FLG,OPNOUT ;OPEN FOR OPTPUT? JFCL; PUSHJ PP,WSTBK ;WRITE THE STATISTICS BLOCK XCT ICLOS ; XCT IWAIT ;WAIT FOR ERRORS XCT IGETS ;GET STATUS TRNE AC2,760000 ;SKIP IF ANY ERRORS PUSHJ PP,WIBK2 ;CATCH ANY ERRORS NOW JRST CLSID1 ; CLSID2: PUSHJ PP,OPNEIX ; SETZM UEBLK. ;ZERO THE FILENAME XCT IRNAM ;DELET JRST CLSID4 ;ERROR RET CLSID1: XCT IRELE ; POPJ PP, CLSID4: PUSHJ PP,ORERRI ;TRY FOR A USE PROCEDURE POP PP,(PP) ;POP OFF CALL FROM CLOSF4+7 JRST CLOS72 ;CLEAN UP AND EXIT ;WRITE OUT ALL ACTIVE ISAM DATA STILL IN CORE CLSISM: PUSHJ PP,SETIC ;SET INDEX FILE CHAANNEL NUMBER SKIPE LIVE(I12) ;IF ANY ACTIVE DATA PUSHJ PP,WWDBK ; OUTPUT IT MOVE AC13,D.DC(I16) ;RESTORE AC13 ALIAS LVL JRST CLOSE4 > ;CREATE A LABEL OR ZERO IT. ***@POPJ*** CLSCAL: TLNE AC13,20 ;SKIP IF DEVICE IS NOT A MTA TLNN FLG1,STNDRD ;SKIP IF STANDARD LABELS POPJ PP, ;CLEAR RECORD AREA JRST OPNCAL ;CREATE A LABEL FOR A MTA W/ STD LABELS ;WRITE AN ENDING LABEL AND DO FINAL ERROR CHECKS. ***@POPJ*** CLSWEL: SKIPN PRGFLG ;DON'T OUTPUT IF DELETE IS NEXT XCT UCLOS. ;DUMP ALL THE BUFFERS PUSHJ PP,WRTWAI ;WAIT FOR ERROR CHECKING TLNE AC13,20 ;SKIP NOT A MAGTAPE TLNN FLG1,NONSTD+STNDRD ;SKIP IF LABELS ARE NOT OMITTED POPJ PP, ; XCT UOUT. ;DUMMY OUTPUT PUSHJ PP,RECBUF ;MOVE RECORD TO THE BUFFER AREA PUSHJ PP,WRTOUT ;OUTPUT IT XCT UCLOS. ;LEOT JRST WRTWAI ;WAIT FOR ERROR CHECKING ;TO KEEP OUR MTA BUFFERS STRAIGHT. ***POPJ*** CLSYNC: XCT UGETS. ;SET OR CLEAR TRC AC2,40 ; THE SYNCHRONOUS XCT USETS. ; MODE STATUS BIT POPJ PP, ; FOR MAGTAPE ;ZERO THE UNUSED AREA OF THE DUMP MODE BUFFER CLSZBF: TLNN FLG,DDMEBC ; SKIP IF AN EBCDIC FILE JRST CLSZB2 ; JUMP ITS NOT HLRZ AC1,R.BPNR(I12) ; PAD THE LAST RECORD WORD CAIN AC1,441100 ; DID REC END ON A WORD BOUNDRY? JRST CLSZB2 ; YES MOVE AC1,R.BPNR(I12) ; GET BYTE-PTR SETZ AC2, ; THE PAD CHAR JRST CLSZB1 ; IDPB AC2,AC1 ; CLSZB1: TLNE AC1,770000 ; DONE? JRST .-2 ; LOOP AOS R.BPNR(I12) ; RESTORE BYTE-PTR CLSZB2: HRRZ AC1,R.BPNR(I12) ;LOC SUB AC1,R.IOWD(I12) ;LOC - LOC-1 ; HLRO AC2,R.IOWD(I12) ;-LEN ; MOVN AC2,AC2 ;LEN HLRZ AC2,AC1 ;LENGTH SUBI AC2,(AC1) ;LENGTH TO CLEAR JUMPE AC2,RET.1 ; EXIT IF NOTHING TO ZERO HRR AC1,R.BPNR(I12) ;LOC HRL AC1,AC1 ;FROM HRRI AC1,1(AC1) ;TO SETZM -1(AC1) ;THE ZERO ADDI AC2,-1(AC1) ;UNTIL CAIL AC2,(AC1) ;JUST EXIT IF BUFFER IS FULL BLT AC1,(AC2) ;DOIT POPJ PP, SUBTTL WRITE-UUO ;A WRITE. UUO LOOKS LIKE: ;002140,,ADR WHERE ADR = FILE TABLE ADDRESS ;CALL+1: 0-11 RECORD SIZE IN CHARACTERS ; 12-35 UNDEFINED ;CALL+2: NORMAL POPJ RETURN ;CALL+3: "INVALID-KEY" RETURN ;A WADV. UUO LOOKS LIKE: ;002200,,ADR WHERE ADR = FILE TABLE ADDRESS ;CALL+1: 0-11 RECORD SIZE IN CHARACTERS ;BIT12 =1 USE 18-35 AS AN ADDRESS ;BIT13 =0 WRITE AFTER ADVANCING ;BIT13 =1 WRITE BEFORE ADVANCING ;BIT14-17 ADVANCE VIA THIS LPT CHANNEL ;BIT18-35 NUMBER OF TIMES TO ADVANCE ;CALL+2: NORMAL POPJ RETURN ;SETUP AND INITIAL CHECKS. ***WRTREC***RANDOM*** WRPW.: TLO AC16,WADV ; WRITE ADVANCE VERB SETOM NOCR. ;REPORT-WRITER ENTRY JRST WRITE1 ; WADV.: TLOA AC16,WADV ;WRITE ADVANCE WRITE.: TLO AC16,WRITE ;WRITE SETZM NOCR. ;CLEAR NO CARRIAGE RET FLAG WRITE1: MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR BLT AC0,FS.IF ; STATUS WORDS. IFE %%RPG,< SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS? PUSHJ PP,SU.WR ; YES > SKIPGE NOCR. ;[QAR] IF THIS IS A REPORT WRITER CALL JRST WRITE2 ;[QAR] AC15 IS ALREADY SETUP HRRZ AC15,(PP) ;OPERAND OR RETURN ADR (UOCAL.) MOVE AC15,(AC15) ; WRITE2: PUSHJ PP,WRTSUP ;SETUP LDB AC3,WOPRS. ;RECORD SIZE FROM AC15 TLNN FLG,OPNOUT ;SKIP IF OPEN FOR OUTPUT JRST ERROPN ;ERROR MESSAGE IFN ISAM,< TLNE FLG,IDXFIL ; JRST IWRITE ;WRITE AN INDEX-FILE > TLNE FLG,RANFIL+OPNIO ;SKIP IF NOT RANDOM OR I/O JRST RANDOM ;RANDOM AND IO EXIT HERE JUMPL FLG,WRTREC ;ASCII TLNE FLG,DDMBIN ;IF BINARY, JRST WRTR20 ; USE THIS ROUTINE TLNE FLG,DDMEBC ;EBCDIC? JRST WER ;YES - USE EBCDIC ROUTINE ;CHECK AND WRITE OUT VARIABLE LENGTH RECORD SIZE PUSHJ PP,WRTABP ;ADJUST THE BYTE-POINTER MOVE AC4,D.RP(I16) ;GET RECORD SEQUENCE NUMBER TLNE AC13,20 ;MTA? HRLM AC4,(AC1) ;YES - STORE IN THE HEADER WORD HRRM AC3,(AC1) ;MOVE RECSIZE TO THE BUFFER AOS D.OBB(I16) ;SO REC-SIZE IS NOT OVERWRITTEN MOVN AC4,D.BPW(I16) ;MAKE BYTE COUNT ADDB AC4,D.OBC(I16) ; RIGHT JUMPN AC4,WRTREC ;JUMP IF BUFFER IS NOT FULL TLNN FLG,CONNEC ;SKIP IF CONVERSION IS NECESSARY SOS D.OBB(I16) ;BACKUP THE BYTE-POINTER PUSHJ PP,WRTBUF ;ADVANCE BUFFERS PUSHJ PP,WRTABP ;ADJUST BYTE-POINTER ;MOVE RECORD TO THE BUFFER, OUTPUT IF NECESSARY. WRTREC: TLNN FLG,CONNEC ;SKIP IF CONVERSION IS NECESSARY JUMPGE FLG,WRTRB ;NOT-ASCII, GO BLT RECORD MOVE AC10,D.WCNV(I16) ;SETUP AC10 TLNE AC16,WADV ;SKIP IF WRITE. PUSHJ PP,WRTADV ;SEE IF NOW IS THE TIME TO ADVANCE JUMPE AC3,WRTZRE ;TRYING TO WRITE A NULL REC? WRTRE1: ILDB C,AC6 ;CHAR FROM THE RECORD AREA XCT AC10 ;CONVERT IF NECESSARY IDPB C,D.OBB(I16) ;CHAR TO THE BUFFER SOSG D.OBC(I16) ;SKIP IF YOU CAN PUSHJ PP,WRTBUF ;BUFFER FULL, WRITE IT OUT SOJG AC3,WRTRE1 ;LOOP TILL A COMPLETE RECORD IS PASSED JUMPGE FLG,WRTRE4 ;JUMP IF NOT ASCII SKIPN NOCR. ;CR WANTED? PUSHJ PP,WRTCR ;YES WRTRE2: JUMPL AC16,WRTRE3 ;JUMP IF "WRITE ADVANCING" PUSHJ PP,WRTLF ;WRITE ASCII REC LF JRST WRTRE6 ; WRTRE3: PUSHJ PP,WRTADV ;WADV. JRST WRTRE6 ; ;ZERO FILL THE LAST PARTIAL WORD IF NECESSARY WRTRE4: SKIPN AC2,D.OBC(I16) ;SKIP IF BUFFER IS NOT FULL JRST WRTRE6 ;JUMP FULL WRTRE5: MOVE AC1,D.OBB(I16) ;OUTPUT BYTE POINTER TLNN AC1,760000 ;SKIP IF ZERO FILL IS NECESSARY JRST WRTRE7 ; IBP D.OBB(I16) ;FILL IN A ZERO SOSLE D.OBC(I16) ;ADJ THE BYTE COUNT JRST WRTRE5 ;LOOP WRTRE6: SKIPG D.OBC(I16) ;BUFFER FULL? PUSHJ PP,WRTBUF ;YES ;STANDARD EXIT FOR READ AND WRITE. ***POPJ*** ;MAY GENERATE A CLOSE UUO IF A MTA "EOT" AND A MULTI REEL FILE. WRTRE7: LDB AC2,F.BBKF ;BLOCKING-FACTOR JUMPE AC2,WRTR10 ;DON'T PAD IF BLK-FTR IS ZERO TLNN FLG,OPNIO+RANFIL ;SKIP IF AN IO/RANDOM FILE SOSE D.RCL(I16) ;DECREMENT THE RECORD/LOGICAL-BLOCK COUNT JRST WRTR10 ; MOVEM AC2,D.RCL(I16) ;RECORDS/LOGIC BLOCK SETZM D.IBC(I16) ;BE SURE THE NEXT READ GETS NEXT BUFFER SKIPLE AC2,D.BCL(I16) ;BUFFERS/LOGICAL BLOCK WRTRE9: SOJGE AC2,WRTR14 ;PASS A BUFFER AND RETURN HERE MOVE AC2,D.BPL(I16) ;RESTORE MOVEM AC2,D.BCL(I16) ; BUFFERS PER LOGICAL BLOCK WRTR10: SOSG D.RRD(I16) ;SKIP IF IT'S NOT RERUN DUMP TIME TLNN FLG,RRUNRC ;SKIP IF WE ARE RERUNNING JRST WRTR15 ; HRRZ AC2,F.RRRC(I16) ;RESTORE NUMBER OF RECORDS MOVEM AC2,D.RRD(I16) ; TO A RERUN DUMP JRST WRTR16 ; WRTR15: SKIPL REDMP. ;SKIP IF A FORCED DUMP JRST WRTR11 ;NEITHER WRTR16: IFE %%RPG,< PUSHJ PP,RRDMP ;DUMP PUSHJ PP,RSAREN ;RESTORE .JBSA, .JBREN > WRTR11: TLNN FLG,RANFIL ;DONT MESS WITH OLD KEY (D.RP) IF RANFIL AOS D.RP(I16) ;BUMP THE RECORD COUNT TLNN AC16,READ ;SKIP IF READ AOS (PP) ; TLNN AC16,MTAEOT ;SKIP IF "EOT" POPJ PP, ;EXIT TO THE ***"ACP"*** HRLI AC16,1440 ;CLOSE REEL WITH REWIND SKIPA AC1,FILES. ;THE FIRST FILE-TABLE WRTR12: HRRZ AC1,F.RNFT(AC1) ;NEXT FILE-TABLE ADR JUMPE AC1,C.CLOS ;NO MORE, EXIT TO THE ***ACP*** CAIN AC1,(I16) ;IS IT THE CURRENT FILE-TABLE? JRST WRTR12 ;YES, LOOP HRRZ AC2,F.RREC(AC1) ;RECORD-AREA ADR CAIE AC2,(FLG) ;SKIP IF "SAME RECORD-AREA" JRST WRTR12 ;ELSE LOOP ;SAVE THE SHARED RECORD-AREA WHILE CHANGING REELS HLRZ AC1,F.LNLS(I16) ;NONSTD LABEL SIZE IN CHARS LDB AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC2,RBPTBL(AC2) ; GET CHARS PER WORD IDIV AC1,AC2 ;CONVERT TO WORDS/LABEL SKIPN AC1+1 ; SUBI AC1,1 ;ROUND DOWN HLLZ FLG1,D.F1(I16) ;FLAGS TLNN FLG1,NONSTD ;SKIP IF NONSTD LABELS MOVEI AC1,15 ;STD LABEL SIZE IN WORDS (-1) HRR AC2,.JBFF ;"TO" ADR HRL AC2,FLG ;"FROM,,TO" ADRS MOVE AC0,AC1 ;SETUP AC10 FOR GETSPC PUSHJ PP,GETSPC ;GET SOME SPACE JRST WCORER ;NO CORE AVAILABLE PUSH PP,AC1 ;SAVE LENGTH POPED @ OPNDV1 PUSH PP,AC2 ;SAVE "FROM,,TO" HRRZ AC0,HLOVL. ;GET START OF OVERLAY AREA CAMGE AC0,.JBFF ;BLT INTO OVL AREA? JUMPN AC0,WOVLER ;ERROR IF IT DOES MOVE AC1,.JBFF ;"UNTIL" BLT AC2,(AC1) ;SLURP! WRTR13: HRLI AC16,1442 ;CLOSE REEL WITH REWIND AND SLURP FLAG SET JRST C.CLOS ;DOIT! WOVLER: HRRZM AC2,.JBFF ;GET JOBFF OUT OF OVL-AREA POP PP,(PP) ;MAKE THE STACK RIGHT SO POP PP,(PP) ;WE CAN RETURN TO CBL-PRG JRST WOVLR2 WOVLR1: EXCH AC5,.JBFF ;MOVE JOBFF SUBM AC5,.JBFF ;BACK OUT OF OVL-AREA WOVLR2: MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS MOVEI AC0,^D35 ;ERROR-NUMBER PUSHJ PP,OXITP ;RETURNS TO CBL-PRG IF IGNORING ERRORS WOVLRX: TTCALL 3,[ASCIZ /NOT ENOUGH FREE CORE BETWEEN JOBFF AND OVERLAY AREA/] WOVLRY: MOVE AC2,[BYTE (5)10,31,20,21,4] TLNN AC16,READ ;GET THE RIGHT MESSAGE MOVE AC2,[BYTE (5)10,31,20,22,4] TLNE AC16,OPEN ;OPEN VERB? MOVE AC2,[BYTE (5) 10,31,20,2] JRST MSOUT. ;MESSAGE AND KILL WCORER: MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS HRRZM AC2,.JBFF ;BACK OUT OF OVERLAY AREA MOVEI AC0,^D8 ;ERROR NUMBER PUSHJ PP,OXITP ;RETURNS FOR FATAL MESS PUSHJ PP,GETSP9 ;GIVE MESSAGE JRST WOVLRY ;AND KILL ;PAD THE LOGICAL BLOCK IF NECESSARY. WRTR14: TLNN AC16,READ ;SKIP IF READ JRST WRTR17 ;A WRITE PUSHJ PP,READBF ;INPUT A BUF AND SKIP EXIT SETZM D.IBC(I16) ;REMEMBER THAT IT'S EMPTY JRST WRTR18 ;[343] WRTR17: TLNN FLG,DDMBIN ;IF BINNARY LET NXT WRITE/CLOSE OUTPUT IT [343] PUSHJ PP,WRTBUF ;OUTPUT A BUF [343] WRTR18: TLZE FLG,ATEND ;EOF? [343] JRST WRTR10 ;GIVE HIM THE REC AND LET NXT READ GET EOF JRST WRTRE9 ;RETURN ;WRITE OUT A BINARY RECORD WRTR20: SKIPG D.OBC(I16) ;IF BUFFER IS FULL, PUSHJ PP,WRTBUF ; WRITE IT OUT MOVE AC11,AC3 ;GET RECORD SIZE IN BYTES LDB AC12,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC12,RBPTBL(AC12) ; GET CHARS PER WORD ADDI AC11,-1(AC12) ;CONVERT SIZE TO WORDS AND IDIVI AC11,(AC12) ; ROUND UP HRL AC5,FLG ;MOVING FROM RECORD AREA WRTR21: HRR AC5,D.OBB(I16) ;MOVING TO BUFFER ADDI AC5,1 ; PLUS ONE WORD MOVE AC4,AC11 ;IF NOT CAMLE AC4,D.OBC(I16) ; ENOUGH WORDS IN BUFFER, MOVE AC4,D.OBC(I16) ; WE WILL DO A PARTIAL MOVE NOW ADDM AC4,D.OBB(I16) ;BUMP BUFFER WORD ADDRESS MOVN AC12,AC4 ;DECREMENT ADDM AC12,D.OBC(I16) ; BUFFER COUNT ADD AC11,AC12 ; AND NUMBER RECORDS WORDS LEFT MOVS AC12,AC5 ;REMEMBER NEXT 'FROM', ADD AC12,AC4 ; IT MAY BE NEEDED ADDI AC4,(AC5) ;COMPUTE FINAL DESTINATION ADDRESS, PLUS 1 BLT AC5,-1(AC4) ;BLAT!! JUMPLE AC11,WRTR22 ;IF NO MORE TO DO, QUIT MOVSI AC5,(AC12) ;NEW 'FROM' ADDRESS PUSHJ PP,WRTBUF ;WRITE OUT THE BUFFER JRST WRTR21 ;LOOP FOR NEXT PIECE OF RECORD WRTR22: MOVE AC2,D.RCL(I16) ;IF THIS IS THE LAST RECORD [343] CAIN AC2,1 ; IN THIS LOGICAL BLOCK [343] SETZM D.OBC(I16) ; NOTE THAT THE BUFFER IS FULL [343] JRST WRTRE7 ;GO HOME ; HERE TO WRITE OUT AN EBCDIC FILE WER: MOVE AC10,D.WCNV(I16) ; GET CONVERSION INSTRUCTION LDB AC3,WOPRS. ; GET RECORD SIZE SKIPL D.F1(I16) ; VARIABLE LENGTH RECORDS? JRST WEF1 ; NO - FIXED LENGTH ;WILL THE RECORD FIT IN THE CURRENT LOGICAL BLOCK? LDB AC1,F.BBKF ; ONLY BLOCKED FILES HAVE A BDW JUMPE AC1,WEV3 ; JUMP IF UNBLOCKED FILE MOVE AC1,D.FCPL(I16) ; GET NUMBER OF FREE BYTES LEFT CAIGE AC1,4(AC3) ; WILL IT FIT? PUSHJ PP,WELB ; NO - WRITE LAST BUFFER CAME AC1,D.TCPL(I16) ; IS THIS FIRST RECORD IN LOG-BLK? TDZA C,C ; NO SETO C, ; YES SUBI AC1,4(AC3) ; UPDATE THE CHAR-COUNT MOVEM AC1,D.FCPL(I16) ; FREE CHARS PER LOG-BLOCK ;UPDATE THE BLOCK-DESCRIPTOR-WORD (BDW) TLNN AC13,20 ; SKIP IF A MTA JRST WEV2 ; JUMP IF NOT HRRZ AC1,D.OBH(I16) ; POINTS TO CURRENT BUFFER HRLZI AC2,4(AC3) ; GET THE RECORD SIZE + RDW JUMPE C,WEV1 ; JUMP IF NOT FIRST RECORD HRLZI AC2,4+4(AC3) ; REC-SIZE +4 FOR RDW +4 FOR BDW MOVNI AC0,4 ; UPDATE THE BYTE-COUNT ADDM AC0,D.OBC(I16) ; YES - DOIT AOSA AC5,D.OBB(I16) ; UPDATE THE BYTE POINTER WEV1: MOVE AC5,D.OBB(I16) ; DO WE HAVE 8 OR 9 BIT BYTES? TLNN AC5,000100 ; IF 8 BIT BYTES LSH AC2,2 ; MOVE BDW OVER 2 BITS ADDM AC2,2(AC1) ; ADD THIS RECORD SIZE TO BDW JRST WEV3 ; WEV2: JUMPE C,WEV3 ; JUMP IF NOT FIRST REC IN BLOCK HRRZ C,D.TCPL(I16) ; GET TOTAL CHARS PER LOG-BLK HRRZI C,4(C) ; PLUS 4 FOR BDW PUSHJ PP,WEDW ; MAKE A BDW ;POINT AC5 AT RECORD-DESCRIPTOR-WORD (RDW) ; PUT THE RDW INTO THE BUFFER WEV3: MOVEI C,4(AC3) ; GET REC-SIZE TO C PUSHJ PP,WEDW ; GO MAKE A RDW MOVE AC5,D.OBB(I16) ; GET BYTE POINTER ;NOW MOVE THE RECORD TO THE BUFFER WEV4: SOSGE D.OBC(I16) ; BUFFER FULL? PUSHJ PP,WEBF ; YES ILDB C,AC6 ; GET CHAR FROM RECORD AREA XCT AC10 ; CONVERT IF NECESSARY IDPB C,AC5 ; PUT IN BUFFER SOJG AC3,WEV4 ; LOOP TIL DONE MOVEM AC5,D.OBB(I16) ; RESTORE BYTE POINTER JRST WRTR10 ; DONE ; MOVE FIXED LENGTH RECORD TO BUFFER WEF1: ILDB C,AC6 ; GET CHAR FROM RECORD AREA XCT AC10 ; CONVERT IF NECESSARY IDPB C,D.OBB(I16) ; PUT IN BUFFER SOSG D.OBC(I16) ; BUFFER FULL? PUSHJ PP,WRTBUF ; YES SOJG AC3,WEF1 ; LOOP TIL DONE JRST WRTRE7 ; DONE ; THE CURRENT RECORD WONT FIT SO FINISH OFF THIS LOGICAL BLOCK WELB: PUSHJ PP,WRTOUT ; DUMP THE BUFFER SOSLE D.BCL(I16) ; ANY EMPTY BUFFERS TO GO OUT? JRST WELB ; YES MOVE AC1,D.BPL(I16) ; GET BUFFERS PER LOG-BLOCK MOVEM AC1,D.BCL(I16) ; BUFFERS PER CURRENT LOG-BLOCK MOVE AC1,D.TCPL(I16) ; TOTAL CHARS PER LOG-BLOCK MOVEM AC1,D.FCPL(I16) ; FREE CHARS PER LOG-BLOCK POPJ PP, ; ; WRITE OUT THE CURRENT BUFFER WEBF: MOVEM AC5,D.OBB(I16) ; RESTORE THE BYTE-PTR WEBF1: PUSHJ PP,WRTOUT ; WRITE IT MOVE AC5,D.OBB(I16) ; GET BYTE-PTR SOS D.BCL(I16) ; DECREMENT BUFFERS PER CURRENT LOG-BLOCK SOS D.OBC(I16) ; DECREMENT CHAR-COUNT POPJ PP, ; ;WRITE A DESCRIPTOR WORD, BDW OR RDW WEDW: LDB AC2,[POINT 6,D.OBB(I16),11] ; GET THE BYTE SIZE MOVN AC1,AC2 ; AC1 SHIFT RIGHT - AC2 .. LEFT ROT C,(AC1) ; GET THE HI ORDER BITS PUSHJ PP,WECH ; STOW IT ROT C,(AC2) ; GET LO ORDER BITS PUSHJ PP,WECH ; STOW IT SETZ C, ; GET A NULL PUSHJ PP,WECH ; STOW IT JRST WECH ; AND RETURN ;WRITE AN EBCDIC CHARACTER WECH: SOSGE D.OBC(I16) ; BUFFER FULL? PUSHJ PP,WEBF1 ; DUMP IT IDPB C,D.OBB(I16) ; DUMP THE CHAR POPJ PP, ; RETURN ;WRITE AND READ SETUP. ***POPJ*** WRTSUP: MOVE AC13,D.DC(I16) ;DEVICE CHARACTERISTICS MOVE FLG,F.WFLG(I16) ;FLAGS,,RECORD LOCATION PUSHJ PP,SETCN. ;SET THE IO CHANNEL NUMBER LDB AC3,F.BMRS ;FILE TABLE MAX REC SIZE LDB AC6,[POINT 2,FLG,14] ; GET CORE DATA MODE MOVE AC6,RBPTB1(AC6) ; GET BYTE-POINTER TO RECORD AREA HRR AC6,FLG ; RECORD ADR POPJ PP, ; ;LEFT HALF IS BYTE-PTR TO RECORD AREA ;RIGHT HALF IS CHARS PER WORD RBPTBL: POINT 7,5(FLG) ; ASCII POINT 9,4(FLG) ; EBCDIC POINT 6,6(FLG) ; SIXBIT ;LEFT IS BYTE-PTR TO RECORD AREA ;RIGHT IS BYTES PER WORD IN SYM-KEY RBPTB1: POINT 7, 6 ; ASCII SIXBIT POINT 9, 4 ; EBCDIC EBCDIC POINT 6, 5 ; SIXBIT ASCII ;SETUP THE CONVERSION INST IN AC10 WRTXCT: JUMPL FLG,WRTXC1 ;JUMP IF ASCII DEV SKIPA AC10,[MOVS C,CHTAB(C)] ;ASCII TO SIXBIT WRTXC1: MOVE AC10,[ADDI C,40] ;SIXBIT TO ASCII TLNN FLG,CONNEC ; HRLZI AC10,(JFCL) ;ASCII TO ASCII POPJ PP, ; ;ADVANCING IS DONE HERE. ***POPJ*** WRTADV: TLCE AC15,20 ;WRTADV OPERAND POPJ PP, ;DON'T ADV THIS TIME TLNE AC15,10 ; POSITIONING? JRST WAD1 ; YES HRRZ AC4,AC15 ; GET CHAR CNT TLNE AC15,40 ; IS THIS REALLY AN ADR? HRRZ AC4,(AC15) ; YES - GET COUNT FROM HERE JUMPE AC4,RET.1 ; IF CNT = 0 JUST RETURN LDB C,WOPCN ; GET CHANNEL NUMBER JRST WAD2 ; WAD1: MOVEI AC4,1 ; ASSUME ONE CHAR TO OUTPUT HRRZ C,(AC15) ; GET POSITIONING CHAR CAIL C,"1" ; IS CHAR "1" CAILE C,"8" ; THRU "8" JRST .+3 ; NO TRZ C,777770 ; CONVERT TO BINARY JRST WAD2 ; CAIN C,"+" ; POPJ PP, ; "+" = NO POSITIONING CAIN C,"0" ; MOVEI AC4,2 ; "0" = TWO "LF" CAIN C,"-" ; MOVEI AC4,3 ; "-" = THREE "LF" SKIPA C,[12] ; GET A "LF" WAD2: MOVE C,WADTBL(C) ; GET CHAR FROM TABLE TLNE FLG,RANFIL+OPNIO; SKIP IF NOT A RANDOM FILE JRST WAD3 ; PUSHJ PP,WRTCH ; SOJG AC4,.-1 ; POPJ PP, ; WAD3: IDPB C,AC5 ;AC5 BYTE-PTR. TO RANDOM BUFFER AREA SOJG AC4,.-1 ; POPJ PP, ; ; CHAR CHANNEL NUMBER WADTBL: EXP 12 ; 8 EXP 14 ; 1 EXP 20 ; 2 EXP 21 ; 3 EXP 22 ; 4 EXP 23 ; 5 EXP 24 ; 6 EXP 13 ; 7 WRTLF: SKIPA C,[ 12 ] ;"LF" WRTCR: MOVEI C,15 ;"CR" WRTCH: IDPB C,D.OBB(I16) ;TO THE BUFFER SOSLE D.OBC(I16) ;SKIP IF FULL POPJ PP, ;OR RETURN WRTBUF: PUSHJ PP,WRTOUT SOS D.BCL(I16) ;BUFFER PER LOGICAL BLOCK POPJ PP, ;SEE IF ZERO LEN RECORD IS LEGAL WRTZRE: SKIPE NOCR. ; JRST WRTRE2 ;A WAY TO GET ONLY PAPER-ADVANCING-CHARS MOVEI AC0,^D23 ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST WRTRE6 ;YES TTCALL 3,[ASCIZ /ZERO LENGTH RECORDS ARE ILLEGAL /] MOVE AC2,[BYTE (5)10,31,20,22,4] JRST KILL ;BLT RECORD AREA TO THE BUFFER/S WRTRB: HRLZ AC5,FLG ;RECORD AREA I.E. "FROM" WRTRB1: MOVE AC11,AC3 ;SETUP FOR THE "UNTIL" SUB AC3,D.OBC(I16) ;REC-SIZE MINUS BYTE-COUNT JUMPGE AC3,WRTRB2 ;JUMP, USE ALL OF CURRENT BUFFER MOVN AC3,AC11 ;SO WE CAN ADJ THE BYTE-COUNT JRST WRTRB3 ;PROCEED WRTRB2: MOVE AC11,D.OBC(I16) ;BYTE-COUNT SETZM D.OBC(I16) ;ZERO THE BYTE COUNT WRTRB3: IDIVI AC11,6 ;CONVERT TO WORDS MOVE AC2,AC12 ;SAVE FOR ZERO FILL JUMPE AC12,WRTRB4 ;CHECK THE REMAINDER ADDI AC11,1 ;ADJ IF THERE WAS ONE SUBI AC12,6 ;NEGATE TRAILING NULL BYTES WRTRB4: SKIPE D.OBC(I16) ;SKIP IF BUFFER IS FULL ADD AC12,AC3 ;ADD IN THE REC-SIZE ADDM AC12,D.OBC(I16) ;SUBTRACT FROM THE BYTE-COUNT HRR AC5,D.OBB(I16) ;"TO" ADDRESS HRRZ AC4,AC5 ; ADDI AC4,-1(AC11) ;"UNTIL" ADDRESS HLRZ AC12,AC5 ;SAVE ORIGIN ADDM AC12,AC11 ;NEXT ORIGIN BLT AC5,(AC4) ;SHAZAM! HRL AC5,AC11 ;NEXT "FROM" ADR HRLI AC4,600 ;NO MORE BYTES THIS WORD MOVEM AC4,D.OBB(I16) ; SKIPLE D.OBC(I16) ;XIT IF U CAN JRST WRTRB5 ;EXIT PUSHJ PP,WRTBUF ;ADVANCE TO NEXT BUFFER JUMPLE AC3,WRTRB5 ;EXIT IF DONE PUSHJ PP,WRTABP ;ADJ THE BYTE-PTR JRST WRTRB1 ;LOOP TILL ALL IS BLT'ED WRTRB5: JUMPE AC2,WRTRE7 ;EXIT IF NO NO FILL REQUIRED IMULI AC2,-6 ;ZERO FILL THE LAST WORD SETO AC0, ;-- LSH AC0,(AC2) ;-- ANDCAM AC0,(AC4) ;DOIT JRST WRTRE7 ;EXIT ;ADJUST THE BYTE-POINTER TO POINT TO NON-EX BYTE LEFT OF NEXT WORD WRTABP: SKIPGE AC1,D.OBB(I16) ; POPJ PP, ; TLZ AC1,770000 ; ADD AC1,[POINT ,1] ; MOVEM AC1,D.OBB(I16) ; POPJ PP, ; ERROPN: AOS (PP) ;REWRITE-WRITE-DELETE MOVEI AC0,^D22 ;THE "OUTPUT" MESSAGE CAIA ERROP1: MOVEI AC0,^D34 ;THE "INPUT" MESS SETOM FS.IF ;IDX FILE TLNE FLG,IDXFIL ;ISAM FILE? ADD AC0,[E.FIDX] ;YES PUSHJ PP,IGCVR ;IGNORE ERROR? POPJ PP, ;YES, TAKE A NORMAL EXIT MOVE AC2,[BYTE (5)10,31,20,6,14] PUSHJ PP,MSOUT. ;"FILE IS NOT OPEN" HRLZI AC2,(BYTE (5)7) ;"FOR INPUT" TLNN AC16,READ ;SKIP IF ATTEMPT TO READ HRLZI AC2,(BYTE (5)11);"FOR OUTPUT" PUSHJ PP,MSOUT. ERRMR0: SKIPA AC3,AC0 ;ISAM FILE ERRMR1: MOVE AC2,AC0 ;IO OR RANDOM FILE CAIA ERRMR2: EXCH AC3,AC4 ;SEQUENTIAL FILE PUSH PP,AC0 ;SAVE MAX-REC-SIZE MOVEI AC0,^D6 ;THE ERROR NUMBER TLNE FLG,IDXFIL ;ISAM FILE? ADD AC0,[E.FIDA] ;YES PUSHJ PP,IGCVR ;IGNORE ERROR? JRST ERRMRX ;YES TLNE FLG,IDXFIL!OPNIO!RANFIL ;NO JRST ERRMRS ;SKIP - JUST DESTROYED OLD REC-SIZ TRNE AC3,770000 ;TRUBLE IF THESE BITS ARE ON TTCALL 3,[ASCIZ/NOT A LEGAL SIXBIT FILE OR INCORRECT BLOCK FACTOR... ASCII? /] ERRMRS: TTCALL 3,[ASCIZ /THE MAXIMUM RECORD SIZE MAY NOT BE EXCEEDED/] ERRMR: TLNE AC16,READ ;SKIP IF OUTPUT FILE SKIPA AC2,[BYTE (5)10,31,20,21,4] MOVE AC2,[BYTE (5)10,31,20,22,4] JRST MSOUT. ;CANNOT DO OUTPUT (OR INPUT) ERRMRX: POP PP,AC0 ;RESTORE MAX-REC-SIZE POPJ PP, SUBTTL READ-UUO ;A READ UUO LOOKS LIKE: ;002100,,ADR WHERE ADR = FILE TABLE ADDRESS ;CALL+1: NORMAL RETURN ;CALL+2: "AT-END" OR "INVALID-KEY" RETURN READ.: IFE %%RPG,< SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS? PUSHJ PP,SU.RD ; YES > FAKER.: TLO AC16,READ ; ENTRY POINT FOR FAKE READ HLRZ AC12,D.BL(I16) MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR BLT AC0,FS.IF ; STATUS WORDS. PUSHJ PP,WRTSUP ;SETUP TLNN FLG,NOTPRS ;SKIP IF OPTIONAL AND NOT PRESENT JRST READ1 ; TLOE FLG,ATEND ;SET "AT END" PATH TAKEN JRST REAAEE ;FATAL THE SECOND TIME MOVEM FLG,F.WFLG(I16) ;SAVE FLG JRST RET.2 ;SKIP EXIT READ1: TLNN FLG,OPNIN ;SKIP IF OPEN FOR INPUT JRST ERROP1 ; TLNE FLG,ATEND ;SKIP IF NOT "AT END" JRST REAAEE ;"FILENM IS AT END" STOPR. MOVE AC10,D.RCNV(I16);SETUP AC10 IFN ISAM,< TLNE FLG,IDXFIL ;INDEX FILE? JRST IREAD ;YES > TLNE FLG,RANFIL+OPNIO ;SKIP IF NOT RANDOM OR I/O JRST RANDOM ;RANDOM AND IO EXIT HERE TLNE FLG,DDMEBC ;EBCDIC? JRST RER ; USE EBCDIC ROUTINE JUMPL FLG,READ4 ;JUMP IT'S ASCII TLNE FLG,DDMBIN ;IF BINARY, JRST READ10 ; USE THIS ROUTINE ;PICKUP REC-SIZE (FIRST WORD) AND CHECK AGAINST MAX-REC-SIZE. MOVE AC4,D.IBC(I16) ;INPUT BYTE COUNT CAILE AC4,1 ;SKIP IF THE BUFFER IS EMPTY JRST READ3 ; READ2: PUSHJ PP,READBF ; FILL IT. TLNE FLG,CONNEC ;SKIP IF WE'RE BLT'ING THE RECORD AOS D.IBC(I16) ;SO THE BYTE COUNT WILL BE RIGHT READ21: LDB AC3,F.BMRS ;RESTORE AC3 TLNE FLG,ATEND ;CHECK FOR END-OF-FILE JRST READEF ;TAKE A SKIP EXIT TO THE "ACP" READ3: PUSHJ PP,REAABP ;ADJUST THE BYTE-POINTER AOS D.IBB(I16) ;DONT OVERWRITE REC-SIZE TLNN AC13,20 ;MTA? JRST READ31 ;NO HLRZ AC4,(AC1) ;GET RECORD SEQUENCE NUMBER JUMPE AC4,READ31 ;JUMP IF NO RSN HRRZ AC0,D.RP(I16) ;GET RECORD COUNT CAME AC4,AC0 ;OK? JRST REALR ;NO - LOST OR GAINED A RECORD READ31: HRRZ AC4,(AC1) ;INCASE ITSA ASCII DATA WRD & NOT 6BIT CHR-CNT CAMGE AC3,AC4 ;SKIP IF MAX RECORD SIZE IS NOT EXCEEDED PUSHJ PP,ERRMR2 ;ERROR MESSAGE MOVEM AC4,RELEN. ;[332]FOR STAND ALONE SORT HRRZ AC3,(AC1) ;MOVE IT INTO AC3 ;ANDI AC3,7777 ; MOVN AC4,D.BPW(I16) ;CPW ADDB AC4,D.IBC(I16) ;SUB FROM THE BYTE COUNT JUMPE AC3,READ32 ;ZERO LENGTH RECORD TLNE FLG,CONNEC ;SKIP IF CONVERSION IS NOT NECESSARY JRST READ4 ;OAKAY JUMPN AC4,REABR ;GO BLT PUSHJ PP,READBF ;ADVANCE THE BUFFER FIRST PUSHJ PP,REAABP ;ADJ THE BYTE-PTR TLNN FLG,ATEND ;CHECK FOR EOF JRST REABR ;THEN GO BLT JRST REAAE1 ;ERROR MESSAGE ;HERE TO READ AHEAD TO FIND NEXT NON-0-LENGTH RECORD ;IF NOT FOUND TAKE THE ATEND PATH READ32: LDB AC4,F.BBKF ;SKIP THE FOLLOWING TEST IF JUMPE AC4,READ34 ; BLOCKING-FACTOR IS ZERO SOSE D.RCL(I16) ; OR IF THERE ARE MORE RECORDS IN JRST READ34 ; THIS LOGICAL-BLOCK MOVEM AC4,D.RCL(I16) ;RESTORE # OF RECORDS IN CURRENT LOGICAL-BLOCK SKIPLE AC4,D.BCL(I16) ;IGNORE ANY TRAILING BUFFERS IN THIS READ33: PUSHJ PP,READBF ; LOGICAL-BLOCK SETZM D.IBC(I16) ;DECLARE HIS BUFFER EMPTY TLZN FLG,ATEND ;LET THE NEXT RECORD GET THE "EOF" SOJG AC4,READ33 ;PASS ALL OF THIS LOGICAL-BLOCK MOVE AC4,D.BPL(I16) ;RESTORE THE POINTERS MOVEM AC4,D.BCL(I16) ; BUFFERS PER CURRENT LOGICAL-BLOCK READ34: MOVE AC4,D.IBC(I16) ;IF THE CAILE AC4,1 ; BUFFER JRST READ35 ; IS EMPTY PUSHJ PP,READBF ; FILL IT. TLNE FLG,CONNEC ;MAKE THE BYTE-COUNT RIGHT IF AOS D.IBC(I16) ; RECORD IS TO BE BLT'ED TLNE FLG,ATEND ;EOF MEANS TAKE JRST READEF ; ATEND PATH READ35: PUSHJ PP,REAABP ;ADJUST THE BYTE-POINTER HRRZ AC3,(AC1) ;GET THE RECORD SIZE JUMPN AC3,READ21 ;EXIT HERE IF N0N-0-LENGTH RECORD AOS D.IBB(I16) ;ACCOUNT FOR THE MOVN AC4,D.BPW(I16) ; HEADER ADDM AC4,D.IBC(I16) ; WORD JRST READ32 ;LOOP TIL EOF OR N0N-0-LENGTH RECORD ;PASS LEADING "EOL" CHARACTERS. READ4: PUSHJ PP,READCH ;GET CHAR TLNE FLG,ATEND ;SKIP IF NOT "EOF" JRST READEF ;"AT-END" BUT DONT INC REC COUNT XCT AC10 ;CONVERT IF NECESSARY JUMPL C,READ4 ;JUMP IF EOL CHAR MOVE AC5,AC3 ;SAVE ACTUAL RECORD SIZE FOR ZERO FILL MOVEM AC5,RELEN. ;[332]INITIAL RELEASE SIZE ;LOAD THE RECORD AREA FROM THE BUFFER. READ5: IDPB C,AC6 ; SOJE AC3,READ51 ;DECREMENT REC SIZE PUSHJ PP,READCH ; TLNE FLG,ATEND ;SKIP IF NOT "EOF" JRST REAAE1 ;MESS AND KILL XCT AC10 ;CONVERT IF NECESSARY JUMPGE C,READ5 ;JUMP IF NON EOL CHAR READ5A: EXCH AC5,RELEN. ;[332]CORRECT RELEASE SIZE SUBI AC5,(AC3) ;[332] EXCH AC5,RELEN. ;[332] READ52: MOVEI C,40 ;ASCII SPACE TLNN FLG,CDMASC ; SETZ C, ;SIXBIT SPACE IDPB C,AC6 ;TRAILING SPACES SOJG AC3,.-1 ;FILL OUT THE RECORD WITH SPACES JRST READ8 ; READ51: LDB AC3,F.BMRS ;GET MAX RECORD SIZE SUB AC3,AC5 ;NUMBER OF ZEROS TO FILL JUMPG AC3,READ52 ;DOIT ;RECORD IS FULL. PASS CHAR TILL AN "EOL" CHAR IS ENCOUNTERED. READ6: JUMPGE FLG,READ8 ;JUMP SIXBIT HAS NO "EOL" READ7: PUSHJ PP,READCH ; XCT AC10 ;CONVERT IF NECESSARY TLZN FLG,ATEND ; JUMPGE C,READ7 ;JUMP IF NON-EOL CHAR READ8: PUSHJ PP,WRTRE7 ;UPDATE DEVTAB, RERUN DUMP, ETC JFCL ; MOVE AC1,RELEN. ;[332]CONVERT RELEN. TO WRDS MOVEI AC3,6 ;[332]FOR SIXBIT TLNE FLG,CDMASC ; [406] UNLESS INTERNAL RECORD IS ASCII. MOVEI AC3,5 ;[322]USE 5 CHARS/WD ADDI AC1,-1(AC3) ;[322]FOR ROUNDING IDIVI AC1,(AC3) ;[332] MOVEM AC1,RELEN. ;[332]PUT IT AWAY MOVEM FLG,F.WFLG(I16) ; POPJ PP, ;EXIT TO THE ***"ACP"*** ;READ A BINARY RECORD READ10: SKIPLE AC4,D.IBC(I16) ;IF BUFFER NOT EMPTY JRST READ11 ; DON'T NEED ANOTHER PUSHJ PP,READBF ;GET ANOTHER BUFFER FULL TLNE FLG,ATEND ;IF NO MORE, JRST READEF ; WE ARE AT END READ11: LDB AC11,F.BMRS ;GET RECORD SIZE IN BYTES MOVEI AC12,6 ;ASSUME DATA RECORD IS SIXBIT TLNE FLG,CDMASC ;IS IT ACTUALLY ASCII? MOVEI AC12,5 ;YES--5 BYTES PER WORD ADDI AC11,-1(AC12) ;CONVERT TO IDIVI AC11,(AC12) ; WORDS AND ROUND UP HRR AC5,FLG ;DESTINATION IS RECORD AREA READ12: MOVE AC4,D.IBB(I16) ;MOVING FROM BUFFER WORD HRLI AC5,1(AC4) ; PLUS 1 MOVE AC4,AC11 ;IF SIZE IS CAMLE AC4,D.IBC(I16) ; MORE THAN THAT LEFT IN BUFFER, MOVE AC4,D.IBC(I16) ; USE ALL WORDS IN BUFFER ADDM AC4,D.IBB(I16) ;BUMP BUFFER WORD ADDRESS MOVN AC12,AC4 ;DECREMENT ADDM AC12,D.IBC(I16) ; BUFFER COUNT ADD AC11,AC12 ; AND WORDS LEFT IN RECORD ADDI AC4,(AC5) ;COMPUTE FINAL DESTINATION PLUS 1 BLT AC5,-1(AC4) ;BLAT!! JUMPLE AC11,READ8 ;IF ENTIRE RECORD MOVED, WE'RE DONE MOVEI AC5,(AC4) ;NEW DESTINATION ADDRESS PUSHJ PP,READBF ;GET ANOTHER BUFFER FULL TLZN FLG,ATEND ;IF NOT AT END, JRST READ12 ; LOOP SETZM D.IBC(I16) ;FORCE READ NEXT TIME READ13: SETZM (AC5) ;FILL SOJLE AC11,READ8 ; REST OF RECORD AOJA AC5,READ13 ; WITH ZEROES ;READ AN EBCDIC RECORD RER: MOVE AC4,AC3 ; GET REC-SIZE FOR FIXED LEN-RECS HLLZ FLG1,D.F1(I16) ; GET THE VLREBC FLAG LDB AC1,F.BBKF ; GET THE BLOCKING FACTOR JUMPL FLG1,RER1 ; JUMP IF VARIABLE LEN-RECS JUMPE AC1,RER7 ; JUMP IF UNBLOCKED FIXED-LEN-RECS SOS AC1,D.RCL(I16) ; ANY MORE FIXED-LEN-RECS IN THIS BLOCK? JUMPGE AC1,RER7 ; JUMP IF THERE ARE JRST RER2 ; GET NEXT LOGICAL BLOCK RER1: JUMPE AC1,RER3 ; JUMP IF UNBLOCKED - NO BDW SKIPLE AC1,D.FCPL(I16) ; ANY RECORDS IN THIS LOG-BLOCK? JRST RER3 ; COULD BE, GO SEE ;PASS OVER CURRENT LOGICAL BLOCK AND GET NEXT RER2: SKIPLE AC1,D.BCL(I16) ; ANY BUFFERS LEFT FOR THIS LOG-BLOCK? PUSHJ PP,READBF ; PASS OVER THE EMTPY BUFFERS SOJG AC1,.-1 ; GET THEM ALL MOVE AC1,D.BPL(I16) ; BUFFERS PER LOG-BLOCK MOVEM AC1,D.BCL(I16) ; BUFFERS PER CURRENT LOG-BLOCK PUSHJ PP,READBF ; NOW GET THE NEXT RECORD TLNE FLG,ATEND ; END-OF-FILE? JRST READEF ; YES LDB AC1,F.BBKF ; GET BLOCKING FACTOR SUBI AC1,1 ; DECREMENT IT FOR THE CURRENT RECORD MOVEM AC1,D.RCL(I16) ; SAVE AS RECORDS/LOG-BLOCK MOVE AC5,D.IBB(I16) ; SET BYTE-PTR TO AC5 JUMPGE FLG1,RER7 ; FIXED RECS HAVE NO BDW OR RDW ;NOW GET THE BLOCK-DESCRIPTOR-WORD PUSHJ PP,REDW ; GET A BDW JRST READEF ; EOF RETURN SUBI AC4,4 ; IS LOGIGAL-BLOCK EMPTY? JUMPLE AC4,RERE1 ; YES - ERROR MOVEM AC4,D.FCPL(I16) ; AND SAVE IT AWAY ;NOW GET THE RECORD DESCRIPTOR WORD RER3: PUSHJ PP,REDW ; GET A RDW JRST READEF ; EOF RETURN SUBI AC4,4 ; SUBTRACT OUT 4 FOR RDW ;NOW SEE IF WE GOT A LEGAL RECORD LDB AC1,F.BBKF ; IF BLOCKING-FACTOR IS 0, JUMPN AC1,RER5 ; JUMP IF A BLOCKED FILE ;FILE IS UNBLOCKED JUMPG AC4,RER6 ; GET RECORD IF SIZE GT 0 PUSHJ PP,READBF ; NO RECORD - MUST BE EOF TLNN FLG,ATEND ; IS IT? JRST RERE2 ; NO! - SO ERROR JRST READEF ; YES - TAKE ATEND PATH ;FILE IS BLOCKED RER5: JUMPLE AC4,RER2 ; IF LOG-BLOCK IS EMPTY GET NEXT ONE MOVNI AC0,4(AC4) ; SUBTRACT RDW FROM ADDB AC0,D.FCPL(I16) ; "FREE CHARS PER LOGICAL-BLOCK" JUMPL AC0,RERE3 ; ERROR IF REC GT SIZE OF LOG-BLOCK RER6: CAMLE AC4,AC3 ; WILL IT FIT IN RECORD AREA? PUSHJ PP,ERRMR2 ; NO - COMPLAIN ;MOVE THE RECORD INTO THE RECORD AREA RER7: SETZ AC0, ; ZERO THE NULL CHAR COUNT ;[V10] MOVE AC5,D.IBB(I16) ; SET UP AC5 RER71: SOSL D.IBC(I16) ; ANY CHARS AVAILABLE? JRST RER74 ; YES PUSHJ PP,READBF ; NO - GET ANOTHER BUFFER TLNN FLG,ATEND ; END-OF-FILE? JRST RER73 ; NO JUMPGE FLG1,READEF ; YEP - ITSA EOF JRST RERE4 ; VAR-LEN-REC, COULD BE AN ERROR RER73: ;[V10] MOVE AC5,D.IBB(I16) ; GET BYTE-PTR TO AC5 SOS D.IBC(I16) ; DECREMENT THE BYTE-COUNT RER74: ;[V10] ILDB C,AC5 ; GET CHAR ILDB C,D.IBB(I16) ;[V10] GET CHAR JUMPN C,RER75 ; EXIT IF NON-NULL ADDI AC0,1 ; COUNT THE NULLS ;[V10] SOJG AC4,RER74 ; LOOP FOR A RECORD SOJG AC4,RER71 ;[V10] LOOP FOR A RECORD ;GOT A NULL RECORD LDB AC4,F.BMRS ; RESTORE RECORD SIZE ;[V10] MOVEM AC5,D.IBB(I16) ; AND BYTE-PTR AOS D.RP(I16) ; COUNT THE RECORD JRST RER ; AND TRY FOR THE NEXT ONE ;GOT A NON-NULL CHAR SO RESTORE THE NULLS IF ANY RER75: JUMPE AC0,RER82 ; EXIT HERE IF NO NULLS AT ALL SETZ C, ; MAKE A NULL XCT AC10 ; CONVERT IT IDPB C,AC6 ; RESTORE IT SOJG AC0,.-1 ; LOOP ;[V10] LDB C,AC5 ; REGET THE LAST CHAR LDB C,D.IBB(I16) ;[V10] REGET THE LAST CHAR. JRST RER82 ; OFF TO MAIN LOOP RER8: SOSL D.IBC(I16) ; ANY CHARS LEFT? JRST RER81 ; YES PUSHJ PP,READBF ; NO - GET ANOTHER BUFFER TLNE FLG,ATEND ; END-OF-FILE? JRST RERE4 ; YEP - COULD BE AN ERROR ;[V10] MOVE AC5,D.IBB(I16) ; GET BYTE-PTR TO AC5 SOS D.IBC(I16) ; DECREMENT THE BYTE-COUNT RER81: ;[V10] ILDB C,AC5 ; GET CHAR ILDB C,D.IBB(I16) ;[V10] GET CHAR. RER82: XCT AC10 ; CONVERT IDPB C,AC6 ; PUT CHAR SOJG AC4,RER8 ; LOOP ;[V10] MOVEM AC5,D.IBB(I16) ; SAVE THE BYTE-POINTER JRST WRTR10 ; GO HOME ;GET A CHARACTER RECH: ;[V10] SOSGE D.IBC(I16) ; BUFFER EMPTY? ;[V10] PUSHJ PP,READBF ; YES - FILL IT SOSL D.IBC(I16) ; BUFFER EMPTY? JRST RECH1 ; NO. PUSHJ PP,READBF ; YES, GO FILL IT SOS D.IBC(I16) ; KEEP THE CHAR COUNT RIGHT. RECH1: ILDB C,D.IBB(I16) ; GET CHAR TLNN FLG,ATEND ; EOF? JRST RET.2 ; NO - SKIP RETURN SETZ C, ; YES - RETURN A NULL POPJ PP, ; ;READ A DISCRIPTOR WORD, BDW OR RDW REDW: MOVE AC4,D.IBC(I16) ; IF BYTE-COUNT LE 3 AND CAILE AC4,3 ; THIS LAST BUFFER OF LOGICAL BLOCK JRST REDW1 ; THEN THE BYTE-CNT MAY REALLY LDB AC4,F.BBKF ; BE A ZERO. THE MONITOR FORCES THE SKIPN D.BCL(I16) ; BYTE-CNT FOR BINNARY MODE TO BE JUMPN AC4,REDWX ; AN INTEGRAL NUMBER OF WORDS REDW1: PUSHJ PP,RECH ; GET A CHAR POPJ PP, ; END-OF-FILE RETURN MOVE AC4,C ; INTO AC4 LDB AC2,[POINT 6,D.IBB(I16),11] ; GET BYTE SIZE LSH AC4,(AC2) ; MAKE ROOM FOR NEXT BYTE PUSHJ PP,RECH ; GET CHAR JUMPE AC4,RET.1 ; EOF RETURN IOR AC4,C ; THE ?DW IS NOW IN AC4 PUSHJ PP,RECH ; SKIP OVER THE NEXT TWO CHARS JUMPN AC4,RERE0 ; COMPLAIN IF EOF AND DATA SKIPE C ; IF NON-ZERO PUSHJ PP,RERE6 ; ERROR PUSHJ PP,RECH ; SKIP LAST CHAR JUMPN AC4,RERE0 ; COMPLAIN IF EOF AND DATA SKIPE C ; IF NON-ZERO PUSHJ PP,RERE6 ; ERROR JRST RET.2 ; NORMAL EXIT ;HERE WHEN BYTE-CNT WAS WRONG, SHLD HAVE BEEN 0 REDWX: SETZB AC4,D.IBC(I16) ; ?DW IS 0 AND BUFFER IS EMPTY! JRST RET.2 ; ;HERE IF GOT SOME DATA AND EOF INSTEAD OF ?DW RERE0: MOVEI AC0,^D39 ; YES GIVE AN ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? POPJ PP, ; YES - EOF RETURN TTCALL 3,[ASCIZ "GOT AN EOF IN MIDDLE OF BLOCK/RECORD DESCRIPTOR WORD"] JRST ERRMR ; ERROR MESS AND KILL ;ERROR BDW = 4 OR LESS RERE1: MOVEI AC0,^D40 ; GIVE AN ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RER2 ; YES - GET NEXT LOG-BLOCK TTCALL 3,[ASCIZ /BLOCK DESCRIPTOR WORD BYTE COUNT IS LESS THAN FIVE/] JRST ERRMR ; ERROR MESSAGE AND KILL ;ERROR - RDW LE 0 AND WE GOT ANOTHER BUFFER OF WHAT? RERE2: MOVEI AC0,^D41 ; GIVE AN ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST READEF ; YES - TAKE END-OF-FILE RETURN TTCALL 3,[ASCIZ /ERROR - GOT ANOTHER BUFFER INSTEAD OF "EOF"/] JRST ERRMR ; ERROR MESSAGE AND KILL ;ERROR - RDW PUTS END OF RECORD BEYOND D.FCPL RERE3: MOVEI AC0,^D42 ; GIVE AN ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RER6 ; YES - GIVE HIM "RECORD" ANYHOW TTCALL 3,[ASCIZ /ERROR RECORD EXTENDS BEYOND THE END OF THE LOGICAL BLOCK/] JRST ERRMR ; ERROR MESSAGE AND KILL ;GOT AN EOF IN MIDDLE OF A RECORD RERE4: CAMN AC3,AC4 ; ANY NON-NULL CHARACTERS SEEN? JRST READEF ; NO - GIVE ATEND RETURN JRST REAAE1 ; YEP - ERROR ;BUFFER REC SIZE DIFFERS FROM THE ONE HE'S TRYING TO WRITE RERE5: MOVEI AC1,4(AC3) ; IN CASE HE IGNORES THE ERROR MOVEI AC0,^D43 ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? JRST RNER32 ; YEP TTCALL 3,[ASCIZ /IT IS ILLEGAL TO CHANGE THE RECORD SIZE OF AN EBCDIC IO RECORD/] JRST ERRMR ; ;ONE OF THE TWO LOW ORDER B/RDW BYTES IS NON-ZERO (SPANNED RECORDS?) RERE6: MOVEI AC0,^D44 ; ERROR NUMBER PUSHJ PP,IGCVR ; IGNORE ERROR? POPJ PP, ; YES TTCALL 3,[ASCIZ "THE TWO LOW ORDER BYTES OF A BLOCK/RECORD WORD MUST BE ZERO"] JRST ERRMR ; NO, COMPLAIN ;READ AN "EOF". TAKE "AT-END" PATH. ***POPJ*** READEF: MOVEI AC0,^D10 ; READ INVALID KEY MOVEM AC0,FS.FS ; LOAD FILE-STATUS MOVEM FLG,F.WFLG(I16) ;SAVE THE FLAG REGISTER LDB AC5,F.BPMT ;FILE TABLE - FILE POSITION JUMPN AC5,RET.2 ;SKIP EXIT TO THE ***"ACP"*** HLLZ FLG1,D.F1(I16) ;FLAGS TLNE AC13,20 ;SKIP IF NOT A MTA,ETC. TLNN FLG1,STNDRD ;SKIP IF STANDARD LABELS JRST RET.2 ;SKIP EXIT TO THE ***"ACP"*** PUSHJ PP,CLSRL ;READ IN THE LABEL XCT MBSPR. ;BACK OVER THE LABEL PUSHJ PP,CLSEOV ;CHECK FOR "EOV" JRST READE1 ;OK JRST RET.2 ;SKIP EXIT TO ***ACP*** READE1: HRLI AC16,440 ;CLOSE REEL UUO PUSHJ PP,C.CLOS ;A READ GENERATED CLOSE UUO HRLI AC16,2100 ;READ UUO TLZ FLG,ATEND ;TURN OFF THE EOF FLAG MOVEM FLG,F.WFLG(I16) ; ALSO IN THE FILE TABLE JRST READ. ;TRY AGAIN ;READ A CHARACTER. IGNORE ASCII NULLS. ***POPJ*** READCH: SOSG D.IBC(I16) ;DECREMENT THE BYTE COUNT PUSHJ PP,READBF ;INPUT IF YOU MUST TLNE FLG,ATEND ;SKIP IF AT END ("EOF") ;IS THIS NECES??? POPJ PP, ; ILDB C,D.IBB(I16) ;RETURN WITH A CHAR IN C SKIPN C ;SKIP IF NOT A NULL CHAR JUMPL FLG,READCH ;IGNORE IT IF IT IS A ASCII NULL POPJ PP, ; READBF: PUSHJ PP,READIN ;GET A BUFFER JFCL SOS D.BCL(I16) ;DECREMENT BUF/LOGBU POPJ PP, ; ;BLT BUFFER/S TO THE RECORD AREA REABR: HRR AC5,FLG ;RECORD AREA I.E. "TO" MOVE AC0,AC3 ;SAVE ACTUAL RECORD SIZE REABR1: MOVE AC11,AC3 ;SETUP FOR THE "UNTIL" SUB AC3,D.IBC(I16) ;REC-SIZE MINUS BYTE-COUNT JUMPGE AC3,REABR2 ;JUMP, USE ALL OF CURRENT BUFFER MOVN AC3,AC11 ;SO WE CAN ADJ THE BYTE-COUNT JRST REABR3 ; REABR2: MOVE AC11,D.IBC(I16) ;BYTE-COUNT SETZM D.IBC(I16) ;NOTE THE BUFFER IS EMPTY REABR3: IDIVI AC11,6 ;CONVERT TO WORDS JUMPE AC12,REABR4 ;CHECK THE REMAINDER ADDI AC11,1 ;ADJ WRDCNT IF THERE WAS ONE SUBI AC12,6 ;NEGATE TRAILING NULL BYTES REABR4: SKIPE D.IBC(I16) ;SKIP IF THE BUFFER IS EMPTY ADD AC12,AC3 ;ADD IN THE REC-SIZE ADDM AC12,D.IBC(I16) ;SUBTRACT FROM THE BYTE-COUNT HRL AC5,D.IBB(I16) ;"FROM" HRRZ AC4,AC5 ; ADDI AC4,-1(AC11) ;"UNTIL" BLT AC5,(AC4) ;SLURP P P !! HRRI AC5,1(AC4) ;NEW "TO" ADDM AC11,D.IBB(I16) ;RESTORE THE BYTE-POINTER SKIPLE D.IBC(I16) ;READ8 IF YOU CAN JRST REABR5 ;EXIT JUMPLE AC3,REABR5 ;EXIT IF ALL WAS BLT'ED PUSHJ PP,READBF ;ADVANCE TO NEXT BUFFER PUSHJ PP,REAABP ;ADJ BYTE-PTR TLNN FLG,ATEND ;SKIP IF "EOF" WAS SEEN JRST REABR1 ;LOOP REABR5: ADDI AC0,5 ;ACTUAL SIZE LDB AC2,F.BMRS ;MAX SIZE ADDI AC2,5 ;ROUND UP CAMN AC0,AC2 ;IF THE SAME JRST READ8 ; EXIT IDIVI AC0,6 ;CONVERT TO IDIVI AC2,6 ; WORDS SUB AC2,AC0 ;NUMBER OF WORDS TO ZERO FILL JUMPE AC2,READ8 ;EXIT IF NONE REABR6: SETZM 1(AC4) SOJLE AC2,READ8 AOJA AC4,REABR6 REAAE1: MOVEI AC0,^D25 ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? POPJ PP, ;YES TTCALL 3,[ASCIZ/ENCOUNTERED AN "EOF" IN THE MIDDLE OF A RECORD/] JRST REAAE0 ;AT END ERROR REAAEE: SETOM FS.IF ;IDX FILE MOVEI AC0,^D24 ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST RET.2 ;YES TTCALL 3,[ASCIZ /THE "AT END" PATH HAS BEEN TAKEN/] REAAE0: MOVE AC2,[BYTE (5)10,31,20,21] PUSHJ PP,MSOUT. ;KILL ;HERE IF RECORD SEQUENCE NUMBER FOUND IN LEFT SIDE OF MTA SIXBIT ;HEADER-WORD IS NOT EQUAL TO RECORD COUNT IN FILE TABLE ;NOTE. COUNT STARTS AT ZERO REALR: MOVEI AC0,^D26 ;ERROR NUMBER PUSHJ PP,IGCVR ;IGNORE ERROR? JRST READ31 ;YES TRY TO RETURN WHAT YOU GOT TTCALL 3,[ASCIZ /RECORD-SEQUENCE-NUMBER /] HRLO AC12,AC4 ;RSN PUSHJ PP,PPOUT2 ;TYPE IT TTCALL 3,[ASCIZ / SHOULD BE /] HRLO AC12,D.RP(I16) ;RECORD COUNT PUSHJ PP,PPOUT2 ;TYPE IT JRST REAAE0 ;FINISH UP MESSAGE ;ADJUST BYTE-POINTER TO NON-EX BYTE LEFT OF NEXT WORD REAABP: SKIPGE AC1,D.IBB(I16) ; POPJ PP, ; TLZ AC1,770000 ; ADD AC1,[POINT ,1] ; MOVEM AC1,D.IBB(I16) ; POPJ PP, ; ;SETUP AC10 WITH CONVERSION INST. ***POPJ*** REAXCT: TLNE FLG,DDMBIN ;IF BINARY, JRST REAXC2 ; NO CONVERSION JUMPL FLG,REAXC1 ;JUMP IF DEV IS ASCII MOVE AC10,[ADDI C,40] ;ASCII TO SIXBIT TLNE FLG,CDMSIX ;SKIP IF CORE-DATA-MODE IS NOT SIXBIT REAXC2: MOVSI AC10,(JFCL) ;6BIT T0 6BIT (LABELS) POPJ PP, ; REAXC1: MOVE AC10,[MOVE C,CHTAB(C)] ;ASCII TO ASCII TLNE FLG,CDMSIX ; TLO AC10,4000 ;SIXBIT TO ASCII (MOVE TO MOVS) POPJ PP, SUBTTL RANDOM/IO-STUFF ;RANDOM AND IO READ AND WRITE ENTER HERE FROM READ. OR WRITE. ; DUMP MODE POINTERS ;(I12)R.IOWD DUMP MODE IOWD ;(I12)R.TERM TERMINATOR ;(I12)R.BPNR BYTE-POINTER TO NEXT RECORD ;(I12)R.BPLR BYTE-POINTER TO LAST RECORD ;(I12)R.BPFR BYTE POINTER TO FIRST RECORD ;(I12)+5 NOT USED ;(I12)R.DATA -1 IF ACTIVE DATA IN BUFFER ;(I12)R.WRIT -1 IF LAST UUO WAS A WRITE ;(I12)R.FLMT AOBJ PTR TO FILE LIMITS ;CHECK THE FILE-LIMITS, READ IN THE LOGICAL BLOCK, AND ;POINT AT THE RECORD. ***WRTRE7*** RANDOM: SETZ AC4, ; ASSUME ACTUAL KEY IS ZERO HLLZ FLG1,D.F1(I16) ;GET FLAGS HLRZ I12,D.BL(I16) ;POINTER TO DUMP MODE POINTERS TLNN FLG,RANFIL ;SKIP IF NOT SEQIO JRST SEQIO ; PUSHJ PP,FLIMIT ;CHECK ACTUAL KEY VS. FILE LIMITS LDB AC2,F.BBKF ;BLOCKING FACTOR SKIPN AC1,AC4 ;ZERO MEANS GET NEXT RECORD AOSA AC1,D.RP(I16) ;ZERO! SO LAST KEY PLUS ONE MOVEM AC1,D.RP(I16) ;SAVE IT HERE TOO MOVEM AC1,FS.RN ;SAVE FOR ERROR-STATUS SOSN AC1 ; [EDIT#300] TDZA AC2,AC2 ; IDIV AC1,AC2 ; IMUL AC1,D.BPL(I16) ;BUFFER PER BLOCK ADDI AC1,1 ;PHYS. BLOCK NUMBER FOR USETI MOVEM AC1,FS.BN ;SAVE IT FOR ERROR-STATUS JUMPE AC4,SEQIO ;IF ACT-KEY = 0, READ SEQUENTIALLY CAME AC1,D.CBN(I16) ;SKIP IF RECORD IS IN CORE PUSHJ PP,RANIN ;OTHERWISE GET IT SKIPA AC5,R.BPFR(I12) ;BYTE POINTER TO THE FIRST RECORD JRST RANXI8 ;EOF [EDIT#273] JUMPL FLG,RANWRT ;JUMP IF ASCII TLNE FLG,DDMBIN ;IF BINARY, JRST RANDO7 ; GO TO SPECIAL ROUTINE LDB AC0,F.BBKF ;HOW MANY RECORDS ARE LEFT SUBI AC0,1(AC2) ; IN THIS LOGICAL BLOCK. MOVEM AC0,D.RCL(I16) ;SAVE FOR RANSHF TLNE FLG,DDMEBC ; IF EBCDIC FILE JRST RNER ; GO HERE JUMPE AC2,RANDO2 ;JUMP IF WE'RE DONE LDB AC0,F.BMRS ;MAX-REC-SIZ RANDO1: HRRZ AC10,@AC5 ;RECORD SIZE IN CHARS ;ANDI AC10,7777 ; CAMGE AC0,AC10 ;IS CHAR-CNT TOO LARGE? ASCII FILE? JRST RANDO2 ;COMPLAIN IDIVI AC10,6 ;RECORD SKIPE AC11 ;SIZE ADDI AC10,1 ;IN ADDI AC5,1(AC10) ;WORDS SOJG AC2,RANDO1 ;JUMP TILL NXTREC=CURREC MOVEM AC5,R.BPNR(I12) ;SAVE AS CURRENT RECORD ;HERE TO CHECK THAT NEW RECORD SIZE LE THAN MAX RANDO2: HRRZ AC2,@AC5 ;RECORD SIZE IN CHARACTERS LDB AC0,F.BMRS ;MAX RECORD SIZE CAMLE AC2,AC0 ;LE THAN MAX? PUSHJ PP,ERRMR1 ;NO - GO COMPLAIN JUMPN AC2,RANWR0 ;ONWARD IF NOT A ZERO LENGTH RECORD TLNN AC16,READ ;READ? JRST RANWR0 ;WRITE! MOVE AC1,F.RACK(I16) ;GET THE MOVE AC1,(AC1) ; ACTUAL KEY TLNE FLG,RANFIL ;A RANDOM FILE? JUMPN AC1,RANDO3 ;YES - NEXT RECORD? SKIPN NRSAV. ; IF WE ALREADY HAVE START OF NULL STRING SKIPN AC1,D.LBN(I16) ; OR IF NOT AN IO FILE JRST RNDO21 ; JUMP CAMLE AC1,D.CBN(I16) ; IS THIS THE LAST BLOCK OF FILE? JRST RNDO21 ; NO MOVE AC1,[-5,,NRSAV.-1]; SAVE POINTERS TO LAST REAL RECORD PUSH AC1,R.BPNR(I12) ; PUSH AC1,FS.RN ; PUSH AC1,D.RP(I16) ; PUSH AC1,D.RCL(I16) ; RNDO21: MOVE AC0,R.BPNR(I12) ;HERE TO GET NEXT NON-0-RECORD MOVEM AC0,R.BPLR(I12) ; BUT FIRST UPDATE AOS R.BPNR(I12) ; THE POINTERS AOS D.RP(I16) ;COUNT 0LEN RECORDS AOS FS.RN ;BUMP THE RECORD NUMBER AOJA AC5,SQIO2 ;FIND THE NEXT ONE RANDO3: SOS D.RP(I16) ;DONT COUNT THIS ONE TLNN FLG,RANFIL ;SEQIO? TLO FLG,ATEND ;SET "EOF" FLAG AOS D.RCL(I16) ;DONT COUNT "EOF" AS A RECORD MOVE AC0,R.BPNR(I12) ;UPDATE POINTERS IN CASE HE WANTS TO MOVEM AC0,R.BPLR(I12) ; WRITE AFTER "EOF" JRST RANXI3 ;RETURN ;FILE IS BINARY. ;STEP DOWN TO CORRECT RECORD AND MOVE TO/FROM RECORD AREA. RANDO7: LDB AC10,F.BMRS ;GET MAXIMUM RECORD SIZE LDB AC11,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC11,RBPTBL(AC11) ; GET CHARS PER WORD ADDI AC10,-1(AC11) ; * IDIVI AC10,(AC11) ; * MOVE AC11,AC10 ;SAVE IT IMULI AC11,(AC2) ;MULTIPLY BY # RECORDS FROM TOP ADD AC5,AC11 ;ADD TO RECORD BYTE POINTER MOVEM AC5,R.BPNR(I12) ;SAVE AS CURRENT RECORD HRL AC5,FLG ;GET RECORD ADDRESS TLNN AC16,READ ;IS IT READ? JRST RANDO9 ;NO MOVSS AC5 ;YES--MOVING TO RECORD SETZM R.WRIT(I12) ;REMEMBER IT WAS A READ JRST RAND10 RANDO9: SETOM R.DATA(I12) ;FORCE WRITE LATER SETOM R.WRIT(I12) ;REMEMBER IT WAS A WRITE RAND10: ADDI AC10,(AC5) ;FINAL DESTINATION PLUS 1 BLT AC5,-1(AC10) ;BLAT!! JRST RANXIT ;SEQUENTIAL IO READ AND WRITE ARE PROCESSED HERE SEQIO: SKIPE R.BPLR(I12) ;SKIP IF FIRST INPUT JRST SQIO1 ;ITS NOT MOVE AC5,R.BPFR(I12) ;FIRST RECORD MOVEM AC5,R.BPLR(I12) ;LAST RECORD MOVEI AC1,1 ;FIRST BLOCK JRST SQIO11 ;READ IT IN SQIO1: SKIPN R.WRIT(I12) ;SKIP IF WRITE WAS LAST TLNN AC16,WRITE+WADV ;SKIP IF WRITE AFTER READ SQIO2: SKIPA AC1,D.RCL(I16) ;NUMBER OF REC TO FILL CURRENT LOGBLK JRST SQIO20 ; JUMPGE FLG1,SQIO4 ; JUMP IF NOT VAR-LEN EDCDIC RECORDS MOVE AC1,D.FCPL(I16) ; SEE IF ANOTHER REC IN THIS BLOCK CAIG AC1,4 ; COULD THERE BE A RDW? JRST SQIO10 ; NO - GET NEXT BLOCK MOVE AC5,R.BPNR(I12) ; YES - SEE IF THERE IS A RECORD PUSHJ PP,RNDW ; GET THE RDW INTO AC1 CAILE AC1,4 ; IS THERE AT LEAST ONE CHAR? JRST SQIO30 ; YES - GOT A RECORD HRRZ AC1,D.LBN(I16) ; NO - SEE IF THIS IS LAST BLOCK CAMLE AC1,D.CBN(I16) ; OF THE FILE, IF SO JRST SQIO10 ; GET THE NEXT BLOCK TLO FLG,ATEND ; REMEMBER WE'RE AT END-OF-FILE TLNN AC16,READ ; IS THIS A READ VERB? JRST SQIO3 ; NO MOVE AC0,R.BPNR(I12) ; UPDATE LAST-REC PTR MOVEM AC0,R.BPLR(I12) ; SO APPEND WILL WORK SOS D.RP(I16) ; NOT A RECORD SO DONT COUNT IT JRST RANXI0 ; TAKE INVALID KEY RETURN SQIO3: TLZ FLG,ATEND ; NO ATEND FOR WRITE MOVE AC1,D.FCPL(I16) ; IF WRITE SEE IF RECORD WILL FIT CAIGE AC1,4(AC3) ; IN THIS BLOCK, IF NOT JRST SQIO10 ; GET NEXT BLOCK JRST SQIO30 ; HERE IF IT FITS SQIO4: JUMPN AC1,SQIO30 ;JUMP IF RECORD IS IN CORE SKIPN NRSAV. ; NON-ZERO MEANS THIS IS LAST BLOCK JRST SQIO10 ; NOT THE LAST BLOCK OF FILE MOVE AC0,[-5,,NRSAV.+3]; IT IS SO BACK UP TO POP AC0,D.RCL(I16) ; THE RECORD POSITION AOS D.RCL(I16) ; POP AC0,D.RP(I16) ; JUST AFTER THE LAST POP AC0,FS.RN ; REAL RECORD SO APPEND POP AC0,R.BPLR(I12) ; WILL FIND THE RIGHT RECORD SLOT SETZM NRSAV. ; ZERO NULL-REC-IN-LAST-BLOCK FLAG SETZM R.WRIT(I12) ; ZERO THE WRITE FLAG TLO FLG,ATEND ; SET ATEND FLAG JRST RANXI0 ; AND GIVE ATEND RETURN ;HERE TO GET THE NEXT LOGICAL BLOCK SQIO10: HRRZ AC1,D.BPL(I16) ;BUFFERS PER LOGBLK ADD AC1,D.CBN(I16) ;USETI OPERAND (CURRENT PHYS BLOCK) SQIO11: PUSHJ PP,RANIN ;WRITE LAST BLOCK IF NECESSARY,THEN INPUT JRST SQIO30 ;NOW THE RECORD IS IN CORE TLNN AC16,READ ;SKIP IF NOT WRITE AFTER EOF JRST SQIO30 ;WRITE MOVE AC0,R.BPFR(I12) ;BP TO FIRST REC MOVEM AC0,R.BPLR(I12) ; = BP TO LAST REC JRST RANXI0 ; [EDIT#273] ;HERE ON WRITE AFTER READ SQIO20: JUMPGE FLG1,SQIO21 ; JUMP IF FIXED LEN RECORDS MOVE AC0,D.FCPL(I16) ; REWRITING OR APPENDING? MOVEI AC0,4(AC3) ; IF APPENDING DO NOTHING CAME AC0,D.TCPL(I16) ; IF REWRITING ADDM AC1,D.FCPL(I16) ; THIS ADD NEGATES LATER SUBTRACT SQIO21: SOS D.RP(I16) ;THIS REC HAS BEEN COUNTED SOS FS.RN ;BEEN COUNTED BY PREVIOUS READ MOVE AC5,R.BPLR(I12) ;BP TO LAST RECORD MOVEM AC5,R.BPNR(I12) ;BP TO NEXT RECORD TLNE FLG,ATEND ; [322]IF ATEND THEN SOS D.RCL(I16) ; [322]DECREMENT REC/LOGBLK CNT JRST SQIO32 ; ;HERE WHEN RECORD IS IN CORE SQIO30: TLNN FLG,ATEND ;APPENDING? JRST SQIO31 ; NOT APPENDING TLNN FLG,DDMEBC ; NO REC-CNT IF EBCDIC APPEND MOVEM AC3,@R.BPNR(I12);GIVE A REC-CNT SQIO31: SOS D.RCL(I16) ;DECREMENT REC/LOGBLK COUNT MOVE AC5,R.BPNR(I12) ;CURRENT/NEXT RECORD SQIO32: JUMPL FLG,RANWRT ;JUMP IF ASCII TLNE FLG,DDMBIN ;JUMP IF JRST RANBIN ; IT IS A BINARY FILE TLNE FLG,DDMEBC ; IF EBCDIC FILE JRST RNES ; GO HERE JRST RANDO2 ;GO CHECK THE RECORD SIZE ;ENTRY POINT FOR RANDOM EBCDIC FILES ;LOGICAL BLOCK IS IN CORE SO SETUP THE BYTE-POINTER RNER: LDB AC10,F.BMRS ; GET MAX-REC-SIZE IMUL AC10,AC2 ; GET NUMBER OF CHARS BEFORE THE DESIRED RECORD IDIVI AC10,4 ; TURN IT INTO WORDS ADD AC5,AC10 ; ADD THIS OFFSET TO BYTE-PTR HLL AC5,RNTBL(AC11) ; GET BYTE-POSITION IN WORD ;ENTRY POINT FOR SEQIO EBCDIC FILES RNES: TLNN AC16,READ ; READ SKIPS JRST RNER30 ; WRITE JUMPS MOVE AC10,D.RCNV(I16); SETUP THE CONVERSION INST SETZB AC0,R.WRIT(I12) ; READ WAS LAST JUMPL FLG1,RNER10 ; BRANCH IF VAR-LEN RECORDS ;READ - FIXED-LEN RECORDS SEE IF ALL CHARS ARE NULL RNER01: ILDB C,AC5 ; GET A CHAR JUMPN C,RNER06 ; EXIT HERE IF NOT NULL ADDI AC0,1 ; COUNT THE NULLS SOJG AC3,RNER01 ; LOOP ;GOT A NULL RECORD SEE WHAT TO DO WITH IT SKIPN NRSAV. ; IF WE ALREADY GOT START OF NULL STRING SKIPN AC3,D.LBN(I16) ; OR IF NOT AN IO FILE JRST RNER02 ; BRANCH CAMLE AC3,D.CBN(I16) ; IF THIS IS NOT THE LAST BLOCK, JRST RNER02 ; DONT PUSH MOVE AC0,[-5,,NRSAV.-1]; SAVE POINTERS TO LAST REAL RECORD PUSH AC0,R.BPNR(I12) ; PUSH AC0,FS.RN ; PUSH AC0,D.RP(I16) ; PUSH AC0,D.RCL(I16) ; RNER02: LDB AC3,F.BMRS ; RESTORE RECORD SIZE TLNE FLG,RANFIL ; RANDOM OR SEQIO FILE? JRST RNER03 ; RANDOM! EXCH AC5,R.BPNR(I12) ; NULL RECORD - GET NEXT MOVEM AC5,R.BPLR(I12) ; UPDATE BYTE-PTRS AOS D.RP(I16) ; COUNT THIS RECORD AOS FS.RN ; HERE TOO JRST SQIO2 ; GET NEXT RECORD RNER03: JUMPN AC4,RNER05 ; JUMP IF ACT-KEY NON-ZERO MOVEM AC5,R.BPNR(I12) ; SAVE AS PTR TO NEXT REC JRST RANDOM ; ACT-KEY = 0 SO GET NEXT RECORD RNER05: AOS (PP) ; GIVE HIM AN INVALID KEY RETURN MOVEI AC1,^D23 ; READ INVALID KEY MOVEM AC1,FS.FS ; LOAD FILE-STATUS JRST RNER40 ; EXIT ;RESTORE THE NULL CHARS IF ANY RNER06: SETZM NRSAV. ; ZERO WHEN REAL REC IS FOUND JUMPE AC0,RNER21 ; JUMP IF NO NULLS SETZ C, ; MAKE A NULL XCT AC10 ; CONVERT IT IDPB C,AC6 ; STORE IT SOJG AC0,.-1 ; LOOP LDB C,AC5 ; REGET LAST CHAR JRST RNER21 ; ;READ - VAR-LEN RECORDS SO CHECK THE SIZE RNER10: PUSHJ PP,RNDW ; GET RDW INTO AC1 AND AC0 CAIGE AC3,-4(AC1) ; WILL IT FIT INTO RECORD AREA PUSHJ PP,ERRMR1 ; NO - COMPLAIN MOVEI AC3,-4(AC1) ; USE ACTUAL NOT MAX SIZE ADDB AC0,D.FCPL(I16) ; UPDATE FREE CHARS PER LOGICAL BLOCK JUMPL AC0,RERE3 ; COMPLAIN IF REC TOO BIG ;READ - MOVE RECORD FROM BUFFER TO RECORD AREA RNER20: ILDB C,AC5 ; GET CHAR RNER21: XCT AC10 ; CONVERT IDPB C,AC6 ; PUT CHAR SOJG AC3,RNER20 ; LOOP JRST RNER40 ; EXIT ;WRITE - MOVE RECORD AREA TO BUFFER RNER30: MOVE AC10,D.WCNV(I16); SETUP THE CONVERSION INST JUMPGE FLG1,RNER33 ; JUMP IF FIXED LEN RECORDS PUSHJ PP,RNDW ; GET RDW INTO AC1 JUMPN AC1,RNER31 ; IT WILL BE 0 IF WE ARE APPENDING HRLZI AC1,4(AC3) ; SO MAKE A RDW MOVNI AC0,4(AC3) ; NEGATE THE COUNT SUBI AC5,1 ; BACK UP THE BYTE-PTR ONE WRD ROT AC1,11 ; HI-BITS FIRST IDPB AC1,AC5 ; ROT AC1,11 ; LO-BITS NEXT IDPB AC1,AC5 ; SETZ AC1, ; THEN SOME NULLS IDPB AC1,AC5 ; IDPB AC1,AC5 ; JRST RNER32 ; RNER31: CAIE AC1,4(AC3) ; SIZES MUST MATCH JRST RERE5 ; THEY DONT SO ERROR RNER32: ADDM AC0,D.FCPL(I16) ; UPDATE NUMBER OF FREE CHARS LEFT RNER33: ILDB C,AC6 ; GET CHAR XCT AC10 ; CONVERT IDPB C,AC5 ; PUT CHAR SOJG AC3,RNER33 ; LOOP SETOM R.DATA(I12) ; NOTE ACTIVE DATA IN BUFFER SETOM R.WRIT(I12) ; AND WRITE WAS LAST ;FINISH UP AND EXIT RNER40: EXCH AC5,R.BPNR(I12) ; UPDATE NEXT-RECORD AND MOVEM AC5,R.BPLR(I12) ; LAST-RECORD POINTERS TLNN FLG,RANFIL ; RANDOM FILE? JRST RANXI0 ; NO - SEQIO FILE! TLNN AC16,READ ; READ OR ? JRST RANXI2 ; WRITE JRST RANXI1 ; READ ;RETURNS RECORD DESCRIPTOR WORD IN AC1 AND AC0 (NEGATED) RNDW: MOVE AC0,AC5 ; GET BYTE-POINTER ILDB AC1,AC0 ; GET HI-BITS ILDB AC0,AC0 ; AND LO-BITS LSH AC1,11 ; LINE EM UP IOR AC1,AC0 ; MERGE EM MOVN AC0,AC1 ; NEGATE EM AOJA AC5,RET.1 ; INC BYTE-PTR AND EXIT ; RNTBL IS USED TO FIND NTH RECORD IN LOGICAL BLOCK. ; DIVIDE REC-SIZE BY CHARS PER WORD - REMAINDER IS INDEX ; TABLE YIELDS BYTE-PTR TO FIRST CHAR OF NEXT RECORD RNTBL: POINT 9, POINT 9,,8 POINT 9,,17 POINT 9,,26 ;MOVE THE RANDOM/IO RECORD AREA TO THE BUFFER AREA. ***RANXIT*** RANWR0: ADDI AC5,1 ;POINT AT DATA NOT RECSIZ RANWRT: TLNN AC16,WRITE+WADV ;IF IT'S WRITE, JRST RANREA ;IT'S READ TLNE FLG,DDMSIX ;SIXBIT STUFF IN THE BUFFER? PUSHJ PP,RANSHF ;YES - MAKE SURE NEW RECORD FITS TLNN FLG,CONNEC ;SKIP IF CONVERSION IS NECESSARY JUMPGE FLG,RANRB ;SIXBIT, GO BLT THE DATA MOVE AC10,D.WCNV(I16) ;SETUP AC10 TLNE AC16,WADV ;IF IT'S WADV, PUSHJ PP,WRTADV ;GO ADVANCE RANWR1: ILDB C,AC6 ;PICK UP A CHARACTER XCT AC10 ;CONVERT IF NECESSARY IDPB C,AC5 ;DEPOSIT THE CHAR. SOJG AC3,RANWR1 ;LOOP TILL A COMPLETE RECORD IS PROCESSED JUMPGE FLG,RANWR2 ;JUMP,SIXBIT HAS NO "CRLF" PUSHJ PP,RANCR ;ALL ASCII RECORDS GET "CR" TLNE AC16,WADV ;IF IT'S WRITE ADVANCE, PUSHJ PP,WRTADV ;TRY TO TLNE AC16,WRITE ;IF IT'S WRITE, PUSHJ PP,RANLF ;GIVE HIM A "LF" RANWR2: SETOM R.DATA(I12) ;THERE IS ACTIVE DATA IN THE BUFFER SETOM R.WRIT(I12) ;THE LAST COBOL UUO WAS A WRITE JRST RANXIT ;TAKE A STANDARD EXIT ;MOVE THE RANDOM/IO BUFFER AREA TO THE RECORD AREA. ***RANXIT*** RANREA: MOVE AC1,AC3 ;SAVE MAX RECORD SIZE IN CHARS TLNE FLG,DDMSIX ;IF A SIXBIT FILE HRRZ AC3,-1(AC5) ; USE THE ACTUAL SIZE TLNN FLG,CONNEC ;SKIP IF CONVERSION IS NECESSARY JUMPGE FLG,RANBR ;SIXBIT, GO BLT THE DATA MOVE AC0,AC3 ;SAVE ACTUAL RECORD SIZE MOVE AC10,D.RCNV(I16) ;SETUP AC10 RANRE0: ILDB C,AC5 ;PICK UP A CHARACTER XCT AC10 ;CONVERT IF NECESSARY JUMPG C,RANRE1 ;IF NOT NULL , CONTINUE [EDIT#300] SOJG AC3,RANRE0 ;IF MORE CHARS. THEN LOOP [EDIT#300] JUMPE AC4,RANDOM ;JUMP IF SEQ [EDIT#300] MOVEI AC1,^D23 ; READ INVALID KEY MOVEM AC1,FS.FS ; LOAD FILE-STATUS AOS (PP) ;SET UP SKIP RETURN [EDIT#300] JRST RANRE2 ;GO SET FLAGS [EDIT#300] RANRE1: IDPB C,AC6 ;DEPOSIT INTO RECORD AREA SOJE AC3,RANRE3 ;EXIT AFTER PROCESSING THE RECORD ILDB C,AC5 ;GET NEXT CHAR XCT AC10 ;CONVERT IF NECESSARY JUMPGE C,RANRE1 ;LOOP IF NOT AN EOL CHAR RANRE3: JUMPL C,RANRE4 ;ASCII AND NEEDS FILL JUMPL FLG,RANRE2 ;ASCII NO FILL REQUIRED SUB AC1,AC0 ;SIXBIT - HOW MUCH FILL? JUMPE AC1,RANRE2 ;JUMP IF NONE MOVE AC3,AC1 ; RANRE4: MOVEI C,40 ;ASCII SPACE TLNN FLG,CDMASC ;ASCII? MOVEI C,0 ;NO, SIXBIT SPACE IDPB C,AC6 ;FILL OUT RECORD SOJG AC3,.-1 ;WITH SPACES RANRE2: SETZM R.WRIT(I12) ;THE LAST COBOL UUO WAS A READ ;SETUP FLAG WORDS AND EXIT. ***WRTRE7*** RANXIT: MOVE AC0,R.BPNR(I12) ;CURRENT RECORD MOVEM AC0,R.BPLR(I12) ;LAST RECORD HRRI AC0,-1(AC5) ;ADR OF NEXT RECORD MOVEM AC0,R.BPNR(I12) ;BP TO NEXT RECORD RANXI0: TLNE FLG,RANFIL ;IF A RANDOM FILE [EDIT#273] JRST RANXI1 ; ZERO ATEND FLAG [EDIT#273] TLNN AC16,READ ;SKIP IF A READ JRST RANXI2 ;WRITE HAS NO ATEND SKIP EXIT TLNN FLG,ATEND ;SKIP IF ATEND RANXI1: TLZE FLG,ATEND ;ZERO THE ATEND FLAG JRST RANXI4 ;HERE ON ATEND RANXI2: MOVEM FLG,F.WFLG(I16) ;SAVE FLAGS HLLM FLG1,D.F1(I16) ;SAVE MORE FLAGS HLLZS UOUT. ;ZERO THE RIGHT HALF HLLZS UIN. ; IOWD POINTER IFE %%RPG,< SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE ? PUSHJ PP,LRDEQX## ; YES > TLNN FLG,OPNIO ; IF THIS IS AN IO FILE JRST WRTRE7 ; ITS NOT MOVE AC0,D.CBN(I16) ; UPDATE THE LAST BLOCK NUMBER CAMLE AC0,D.LBN(I16) ; IF CURRENT BN IS GT LAST BN MOVEM AC0,D.LBN(I16) ; SAVE IT AS LBN JRST WRTRE7 ;EXIT TO USER RANXI4: TLNE FLG,RANFIL ;RANDOM FILE? SOS D.RCL(16) ;YES - DONT COUNT THIS RECORD RANXI3: AOS (PP) ;SKIP EXIT SKIPN AC1,FS.FS ; NO CHANGE IF NON ZERO MOVEI AC1,^D10 ; READ INVALID KEY MOVEM AC1,FS.FS ; LOAD FILE-STATUS JRST RANXI2 ; RANXI8: MOVE AC0,R.BPNR(I12) ;KEEP THE RECORD POINTERS [EDIT#273] MOVEM AC0,R.BPLR(I12) ; UP TO DATE [EDIT#273] JRST RANXI1 ; [EDIT#273] ;SIXBIT: BLT THE RECORD TO/FROM THE BUFFER AREA. RANBR: EXCH AC5,AC6 ;GO THE OTHER WAY RANRB: HRL AC5,AC6 ;FROM,,TO HRRZM AC5,TEMP. ; TLNE AC16,READ ;SKIP IF NOT READ HLRZM AC5,TEMP. ;BUFFER ORIGIN MOVEI AC4,6 ;SIX PER WORD RANBR1: IDIV AC3,AC4 ;CONVERT TO WORDS JUMPE AC4,.+2 ;SKIP IF NO REMAINDER ADDI AC3,1 ;ELSE ACCOUNT FOR IT MOVE AC0,AC3 ;SAVE ACT SIZE FOR ZERO FILL ADDM AC3,TEMP. ;NEXT RECORD ADDI AC3,-1(AC5) ;UNTIL BLT AC5,(AC3) ;ZRAPPP! MOVE AC5,TEMP. ; ADDI AC5,1 ;POINT TO NEXT RECORD TLNN AC16,READ ;SKIP IF IT'S A READ JRST RANBR2 ;NOP, A WRITE TLNE FLG,DDMBIN ;NO FILL IF DEVICE DATA MODE JRST RANRE2 ; IS BINARY ADDI AC1,5 ;GET MAX SIZE IDIVI AC1,6 ; IN WORDS SUB AC1,AC0 ;WHAT'S THE DIFFERENCE? JUMPLE AC1,RANRE2 ; DONE IF THE SAME SETZM 1(AC3) ;ZERO THE FIRST WORD HRLI AC2,1(AC3) ;FROM HRRI AC2,2(AC3) ;FROM , TO ADDI AC1,(AC3) ;UNTIL CAIL AC1,(AC2) ;DONE IF ONLY ONE WORD BLT AC2,(AC1) ;FILL IN THE ZEROS JRST RANRE2 ; RANBR2: JUMPE AC4,RANWR2 ;EXIT HERE IF NO FILL REQUIRED HRREI AC1,-6 ;ASSUME RECORD IS SIXBIT TLNN FLG,CDMSIX ; IF NOT SIXBIT HRREI AC1,-7 ; ITS ASCII IMUL AC4,AC1 ;ZERO FILL THE LAST DATA WORD SETO AC0, ;-- LSH AC0,(AC4) ;-- ANDCAM AC0,(AC3) ;DOIT JRST RANWR2 ;BINARY: BLT THE RECORD TO/FROM THE BUFFER AREA. RANBIN: HRL AC5,FLG ;FROM RECORD TO BUFFER HRRZM AC5,TEMP. ;SAVE BUFFER LOC TLNE AC16,READ ;IF READ, MOVSS AC5 ; REVERSE THE DIRECTION OF BLT LDB AC4,[POINT 2,FLG,14] ; GET CORE DATA MODE HRRZ AC4,RBPTBL(AC4) ; GET CHARS PER WORD JRST RANBR1 ;ALL RANDOM/IO INPUTS ARE EXECUTED FROM HERE. OUTPUTS ARE ;EXECUTED ONLY WHEN THERE IS ACTIVE DATA IN THE BUFFER AND ;AND AN INPUT IS ABOUT TO OVERWRITE IT. THE LAST ACTIVE DATA ;IS CAUGHT BY THE CLOSE UUO. ***POPJ*** RANIN: SKIPGE R.DATA(I12) ;SKIP IF THERES NOTHING TO OUTPUT PUSHJ PP,RANOUT ; MOVEM AC1,D.CBN(I16) ;SAVE CURRENT PHYS BLOCK NUMBER MOVEM AC1,FS.BN ;SAVE BLOCK-NUMBER TLNE FLG,RANFIL ;SKIP THE USETI IF SEQIO XCT USETI. ;***************** HRRM AC12,UIN. ;DUMP MODE IOWD LDB AC5,F.BBKF ;BLOCKING FACTOR TLNN AC16,READ ;SKIP IF READ UUO CAIE AC5,1 ;DONT INPUT IF BLOCKING-FACTOR = 1 RANIN0: TLNN FLG,OPNIN!RANFIL ;DONT INPUT IF NOT OPEN FOR INPUT JRST RANIN5 ; NORMAL RET HLRO AC0,R.IOWD(I12) ;;-LEN HRRZ AC10,R.IOWD(I12) ;;LOC -1 SUB AC10,AC0 ;;LAST WORD OF BUFFER AREA SETOM (AC10) ;;MARK IT HRRZM AC10,TEMP. ;;SAVIT SO WE CAN DISMISS PHONY EOF'S AOS D.IE(I16) ;COUNT INPUT EXECUTED XCT UIN. ;******************** JRST RANIN1 ;NORNAL RETURN MOVEM AC2,TEMP.1 ;SAVE AC2 ; XCT UGETS. ;ERROR RETURN ; MOVE AC1,AC2 ; PUSHJ PP,READCK ; RANIN1: SKIPA AC10,R.BPFR(I12);BYTE POINTER TO FIRST RECORD JRST RANIN3 ;EOF WAS SEEN ;READI1 SKIP EXIT MOVEM AC10,R.BPNR(I12);POINTER TO CURRENT RECORD MOVEM AC5,D.RCL(I16) ;REMAINING RECORDS IN CURRENT BLOCK JUMPGE FLG1,RET.1 ; VAR-LEN RECS DROP THROUGH HRRZ AC10,R.BPFR(I12); GET POINTER TO BDW MOVS AC0,-1(AC10) ; GET BDW SUBI AC0,4 ; -4 FOR BDW ITSELF MOVEM AC0,D.FCPL(I16) ; SAVE AS FREE CPL POPJ PP, ;HERE ON END-OF-FILE RANIN3: MOVE AC2,TEMP.1 ;RESTORE AC2 SKIPE @TEMP. ;EOF AND SOME DATA? JRST RANIN4 ;NO TLZ FLG,ATEND ;YES, SO TURN OFF THE EOF JRST RANIN1 ; AND MAKE BELEIVE IT DIDN'T HAPPEN RANIN4: PUSHJ PP,ZDMBUF ;ZERO THE DUMP MODE BUFFER TLNN AC16,READ ;READ UUO? TLZA FLG,ATEND ; WRITE UUO SO CLEAR "ATEND" AOSA (PP) ; READ GETS A SKIP EXIT JRST RANIN5 ; TAKE NORMAL RETURN TLNE FLG,RANFIL ; SKIP IF SEQUENTIAL FILE SKIPN AC4 ; IF ACTUAL-KEY IS 0 FILE IS SEQ SKIPA AC10,[^D10] ; AT END "NO NEXT RECORD" MOVEI AC10,^D23 ; "RECORD NOT FOUND" MOVEM AC10,FS.FS ;LOAD FILE-STATUS ;IF VAR LEN RECS MAKE A BLOCK DESCRIPTOR WORD RANIN5: JUMPGE FLG1,RANIN1 ; JUMP IF FIXED LEN RECS HRRZ AC10,R.BPFR(I12); GET POINTER TO BDW HRRZ AC0,D.TCPL(I16) ; GET BLOCK SIZE ADDI AC0,4 ; PLUS 4 FOR BDW MOVSM AC0,-1(AC10) ; SAVE AS BDW JRST RANIN1 ;TAKE NORMAL RETURN ;ALL RANDOM/IO OUTPUTS ARE EXECUTED FROM HERE. ***@POPJ*** RANOUT: SETZM R.DATA(I12) ;NOTE DATA WENT OUT EXCH AC1,D.CBN(I16) ;NEXT BLOCK,,CURRENT BLOCK MOVEM AC1,FS.BN ;SAVE FOR ERROR STATUS XCT USETO. ;****************** MOVE AC1,D.CBN(I16) ;NEXT BLOCK BECOMES CURRENT BLOCK HRRM AC12,UOUT. ;DUMP MODE IOWD JRST WRTOUT ;DO IT ;CHECK ACTUAL KEY AGAINST THE FILE-LIMIT-CLAUSES AND TAKE ;THE INVALID-KEY RETURN IF NOT LEGAL. ***POPJ*** FLIMIT: MOVE AC1,R.FLMT(I12) ;PICK UP THE IOWD "FLC" HRRZ AC4,F.RACK(I16) MOVE AC4,(AC4) ;ACTUAL KEY JUMPE AC4,RET.1 ;OK IF 0, HE WANTS TO READ SEQ FROM HERE CAIA FLIMI1: ADDI AC1,2 ;ACCOUNT FOR TWO LIMIT WORDS CAMLE AC4,2(AC1) ;SKIP IF ACTKEY LE LARGER LIMIT JRST .+3 CAML AC4,1(AC1) ;SKIP IF ACTKEY L THE SMALLER LIMIT POPJ PP, ;OK EXIT AOBJN AC1,FLIMI1 ; TLNN AC16,READ!WRITE!WADV ;SKIP IF NOT A SEEK UUO POPJ PP, ;SEEK, RETURN TO ***ACP*** POP PP,(PP) ;POP OFF RETURN ADR TLNN AC16,READ ;INVALID-KEY EXITSKIP IF READ AOS (PP) ;SKIP OVER THE OPERAND MOVEI AC1,^D24 ;BOUNDRY VIOLATION MOVEM AC1,FS.FS ;LOAD FILE-STATUS JRST RET.2 ; AND TAKE A SKIP EXIT ***ACP*** ;ZERO THE DUMP MODE BUFFER AREA ZDMBUF: HLRO AC4,R.IOWD(I12) ;-LEN HRR AC1,R.IOWD(I12) ;LOC-1 HRLI AC1,1(AC1) ;FROM HRRI AC1,2(AC1) ;TO SETZM -1(AC1) ;THE ZERO MOVN AC4,AC4 ;LEN ADDI AC4,-1(AC1) ;UNTIL BLT AC1,(AC4) ;DOIT POPJ PP, RANLF: SKIPA C,[12] ; RANCR: MOVEI C,15 ; IDPB C,AC5 ; POPJ PP, ; ;HERE BEFORE WRITING A NEW RECORD ;MAKE THE OLD RECORD SIZE CONFORM TO NEW SIZE RANSHF: CAMN AC2,AC3 ;ACTUAL-SIZE VS NEW-SIZE POPJ PP, ;SKIP THIS MESS MOVE AC4,D.RCL(I16) ;IF NO RECORDS FOLLOWING JUMPE AC4,RANS09 ; DONE MOVEI AC0,5(AC3) ;NEW SIZE IDIVI AC0,6 ; IN WORDS MOVEI AC1,5(AC2) ;ACTUAL SIZE IDIVI AC1,6 ; IN WORDS SUB AC0,AC1 ;NS - AS JUMPE AC0,RANS09 ;SAME SIZE SO EXIT ;FIND THE LAST DATA WORD IN THIS LOGICAL BLOCK MOVE AC10,AC1 ;SIZE OF THIS RECORD MOVEI AC2,-1(AC5) ;ADR OF THIS RECORD'S HEADER WORD RANS01: ADDI AC2,1(AC10) ;ADR OF NEXT HEADER WORD HRRZ AC10,@AC2 ;SIZE OF NEXT RECORD IN CHARACTERS ADDI AC10,5 ; -- IDIVI AC10,6 ; IN WORDS SOJG AC4,RANS01 ;LOOP IF ANY MORE ADDI AC2,(AC10) ;ADR OF LAST DATA WORD HRRO AC10,AC5 ;ADR OF THE FIRST RECORD WORD ADD AC10,AC1 ;ADR OF NEXT RECORD'S HEADER WORD JUMPG AC0,RANS03 ;IF POSITIVE MAKE A LARGER HOLE ;NEGATIVE SO MAKE A SMALLER HOLE HRLS AC10 ;ADR OF NEXT RECORD HEADER WORD ADD AC10,AC0 ; PLUS THE DIFFERENCE ADD AC2,AC0 ;THE BLT UNTIL POINTER BLT AC10,(AC2) ;MOVE IT SETZM 1(AC2) ;TERMINATE DATA JRST RANS09 ;POSITIVE SO MAKE A LARGER HOLE RANS03: HRRZ AC4,AC2 ;ADR OF LAST DATA WORD SUBI AC4,-1(AC10) ;NUMBER OF WORDS TO MOVE HRR AC10,AC2 ;START WITH THE LAST DATA WORD HRLI AC0,(POP AC10,(AC10)) HRLZI AC1,(SOJG AC4,AC0) HRLZI AC2,(POPJ PP,) PUSHJ PP,AC0 ;POP-POP-POP RANS09: HRRZM AC3,-1(AC5) ;GIVE IT A HEADER WORD HRRZ AC2,AC3 ;RESTORE AC2 POPJ PP, ;FORCE WRITE FOR SIMULTANEOUS UPDATE FORCW.:: MOVE AC0,[FS.ZRO,,FS.FS] ; CLEAR FILE STATUS BLOCK BLT AC0,FS.IF ; FOR POSSIBLE ERROR ACTION PUSHJ PP,SETCN. ; SET UP CHANNEL NUMBER MOVE FLG,F.WFLG(I16) ; JUST IN CASE OF ERRORS MOVE AC1,D.CBN(I16) ; GET THE BLOCK NUMBER HLRZ AC12,D.BL(I16) PUSHJ PP,RANOUT ; GO WRITE IT OUT SOS (PP) ; NORMAL RETURN SOS D.OE(I16) ; DON'T COUNT THIS OUTPUT HLLZS UOUT. ; CLEAR IOWRD PTR SETZM R.DATA(I12) ; SET NO ACTIVE DATA FLAG JRST RET.2 ; RETURN ;FORCE READ FOR SIMULTANEOUS UPDATE FORCR.:: MOVE AC0,[FS.ZRO,,FS.FS] ; CLEAR FILE STATUS BLOCK BLT AC0,FS.IF ; MOVE FLG,F.WFLG(I16) ; GET FLG REGISTER IFN ISAM, MOVE AC1,D.CBN(I16) ; GET BLOCK NUMBER MOVEM AC1,FS.BN ; SAVE FOR ERROR ACTION PUSHJ PP,SETCN. ; SET UP CHANNEL HLRZ AC12,D.BL(I16) HRRM AC12,UIN. ; SET IOWRD PTR XCT USETI. ; THIS IS THE BLOCK XCT UIN. ; TO READ JRST FORCRX ; NORMAL RETURN PUSHJ PP,READCK ; ERROR RETURN (EOF?) JRST FORCRX ; SHOULD NOT GET HERE TLNN FLG,ATEND ; EOF GETS NORMAL RETURN AOS (PP) ; ERROR GETS SKIP RET FORCRX: HLLZS UIN. ; CLEAR THE IOWRD PTR POPJ PP, IFN ISAM,< ;ZERO THE ISAM BLOCK NUMBERS TO CAUSE FRESH INPUTS FORCRY: HLRZ I12,D.BL(I16) ;ZERO POINTERS HRRI AC1,USOBJ(I12) HRLI AC1,(AC1) ADDI AC1,1 SETZM -1(AC1) BLT AC1,USOBJ+13(I12) PUSHJ PP,VNDE1 ; READ FRESH COPY OF STATISTICS BLOCK JFCL ; NO NEW LEVELS EXIT POPJ PP, > SUBTTL ISAM-CODE IFN ISAM,< ;INDEX-SEQ READ IREAD: TLZ FLG1,-1 ;INITIALIZE FLG1 PUSHJ PP,SETIC ;SET THE CHANNEL HRR AC0,F.WBSK(I16) HRRM AC0,GDPSK(I12) AOS RWRSTA(I12) ;# OF READ/WRITE/REWRITES PUSHJ PP,LVTST ;SYMKEY = LOW-VALUES ? JRST SREAD ;YES, SEQUENTIAL READ PUSHJ PP,@GETSET(I12) ;ADJKEY OR GD67 OR FPORFP PUSHJ PP,IBS ;LOCATE THE RECORD IFE %%RPG,< SKIPN SU.FRF > JRST MOVBR ;JUMP IF NOT FAKE READ TO MOVE RECORD IREADF: MOVE AC1,USOBJ(I12) ; FAKE READ - DONT TOUCH REC-AREA MOVEM AC1,FS.BN ; JUST RETURN THE BLOCK NUMBER TO RETAIN POPJ PP, RRDIVK: SKIPE BRISK(I12) ;SKIP IF SLOW MODE JRST RRDIV4 ;JUMP IF FAST MODE TLON FLG1,RIVK ;SET INVALID-KEY, FIRST TIME? JRST IBSTO1 ;YES ;MAKE CNTRY POINT AT THE RECORD PRECEEDING THE 'NOT-FOUND' RECORD RRDIV4: HRRZI AC0,-1(AC4) ;ADR OF THE RECORD HEADER WORD HRRZ AC2,DRTAB ; RRDIV3: SKIPL AC3,(AC2) ;ADR OF FIRST REC-HEADER WORD IN THIS BLOCK CAIN AC0,(AC3) ;CURRENT RECORD? SKIPA AC3,-1(AC2) ;YES, GET ADR OF PREVIOUS REC-HDR AOJA AC2,RRDIV3 ;NO, TRY AGAIN ADDI AC3,1 ;FIRST WORD AFTER HEADER CAME AC2,DRTAB ;FIRST RECORD OF THE FILE? JRST RRDIV2 ;NO SETOM NNTRY(I12) ;NOTE CNTRY POINTS TO NEXT ENTRY MOVE AC0,IOWRD(I12) ; ADDI AC0,2 ; HRRM AC0,CNTRY(I12) ;POINT AT FIRST RECORD IN BLOCK JRST RRDIV1 RRDIV2: HRRZM AC3,CNTRY(I12) ;POINT AT FIRST REC BEFORE 'NOT -FOUND' REC SETZM NNTRY(I12) ;CLEAR NNTRY SO CNTRY POINTS TO CURRENT ENTRY [EDIT#275] RRDIV1: POP PP,AC0 ; TLNN AC16,READ ;READ? AOS (PP) ;NO, RERITE OR DELET MOVEI AC0,^D23 ; READ IVK FILE STATUS RRDIV0: MOVEM AC0,FS.FS ; SAVE FILE STATUS IFE %%RPG,< SKIPE F.WSMU(I16) PUSHJ PP,LRDEQX## ;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE > JRST RET.2 ;INVALID-KEY RETURN ;SEQUENTIAL READ SREAD: TLO FLG1,SEQ ;FLAG SREAD SKIPE CNTRY(I12) ;IS THIS THE FIRST READ EVER? JRST SREAD1 ;NO PUSHJ PP,@GETSET(I12) ;SET UP SEARCH FOR LOW-VALUES PUSHJ PP,IBS ;FIND FIRST DATA RECORD JRST SREAD2 ;TRY FOR THE NEXT DATA REC IN THIS BLOCK SREAD1: SETZ LVL, ;WE ARE AT LEVEL 0! HRRZ AC4,CNTRY(I12) ;CURRENT ENTRY SKIPE NNTRY(I12) ;CNTRY ALREADY POINTING AT NEXT ENTRY? JRST SREAD2 ;YES LDB AC1,RSBP(I12) ; IDIV AC1,D.BPW(I16) ; JUMPE AC2,.+2 ; ADDI AC1,1 ; ADDI AC4,1(AC1) ;NEXT ENTRY SREAD2: SKIPE -1(AC4) ;NULL REC = LAST REC CAMLE AC4,LRW(I12) ;WAS THAT THE LAST REC? PUSHJ PP,UPDOWN ;YES, GET THE NEXT HRRM AC4,CNTRY(I12) ;SAVE AS CURRENT ENTRY SETZM NNTRY(I12) ;NOTE CNTRY POINTS AT CURRENT ENTRY PUSHJ PP,SETLRW ;SET UP LRW INCASE A 'DELET' OCCURED IFE %%RPG,< SKIPN SU.FRF > JRST MOVBR ;JUMP IF NOT FAKE READ TO MOVE RECORD ; HERE IF FAKE READ TO GET BLOCK NUMBER IFE %%RPG,< MOVE AC2,F.WBRK(I16) ; GET RELATIVE REC-KEY BYTE-PTR ADD AC2,CNTRY(I12) ; FILL IN THE ADR MOVEM AC2,SU.RBP ; SAVE IT FOR RETAIN JRST IREADF ; GET THE BLOCK NUMBER AND EXIT > ;LOOK UP AND DOWN THROUGH THE INDEX FOR THE NEXT REC UPDOWN: ADDI LVL,1 ;UP AN INDEX LEVEL CAMLE LVL,MXLVL(I12) ;ANY MORE LEVELS? JRST UPDOW1 ;NO, INVALID KEY EXIT MOVE AC4,@CNTRY0(I12) ;GET THE LAST ENTRY SKIPN @NNTRY0(I12) ;CNTRY ALREADY AT NEXT ENTRY? ADD AC4,IESIZ(I12) ;NO, THE CURRENT ENTRY HRRZ AC2,@IOWRD0(I12) ; ADD AC2,IBLEN(I12) ; HRRZI AC2,3(AC2) ;UPPER LIMIT SKIPE (AC4) ;IF NULL, REST OF BLOCK IS EMPTY CAIG AC2,(AC4) ;ANY MORE ENTRIES AT THIS LEVEL? PUSHJ PP,UPDOWN ;NO, UP ANOTHER LEVEL HRRM AC4,@CNTRY0(I12) ;CURRENT ENTRY SAVED SETZM @NNTRY0(I12) ;CNTRY POINTS AT CURRENT ENTRY SOJL LVL,RET.1 ;DOWN AN INDEX LEVEL PUSHJ PP,GETBLK ;GET NEXT BLOCK MOVE AC4,@IOWRD0(I12) ADDI AC4,2 ; SKIPE LVL ; ADDI AC4,1 ;CURRENT ENTRY OR REC POPJ PP, UPDOW1: POP PP,AC0 ;POPOFF THE RETURNS SOJG LVL,.-1 ; MOVEI AC0,^D10 ; NO NEXT LOGICAL RECORD FOUND MOVEM AC0,FS.FS ; SAVE FILE STATUS JRST RET.2 ;INVALID KEY RETURN ;HERE FROM GETBLK VERSION NUMBER DISCREPANCY WHEN SREADING UDVERR: TLNN FLG1,VERR ;IF WE'VE BEEN HERE BEFORE OR SKIPN CNTRY(I12) ; THIS IS THE FIRST READ EVER JRST UDVER1 ; LEAVE THE STACK ALONE. JUMPE LVL,UDVER1 ; SAME THING IF A DATA BLOCK POP PP,(PP) ;MAKE THE STACK RIGHT SOJG LVL,.-1 ; ;MOVE THE CURRENT KEY TO THE SYMBOLIC KEY UDVER1: LDB AC1,KY.TYP ; GET KEY TYPE CAIGE AC1,3 ; DISPLAY? JUMPN AC1,.+3 ; JUMP IF NUMERIC DISPLAY CAIGE AC1,7 ; SKIP IF COMP-3 JRST UDVER2 ; DISPLAY, FIXED, OR FLOATING POINT ;CONVERT BINNARY TO DISPLAY KEY PUSHJ PP,SAVAC. ;SAVE THE ACS MOVE AC0,2(AC4) ;THE KEY LDB AC2,KY.MOD ; GET KEY MODE HLRZ AC10,PDTBL(AC2) ; GET CONVERSION ROUTINE LDB AC2,KY.TYP ; GET KEY TYPE CAIL AC2,7 ; IF COMP-3 HRRZI AC10,PC3. ; USE THIS ROUTINE MOVE AC15,F.WBSK(I16);BYTE POINTER TO SYM-KEY TLZ AC15,7777 ;MAKE A PARAMETER WORD FOR PD6/7. LDB AC1,KY.SIZ ; GET KEY SIZE TSO AC15,AC1 ;INCLUDE THE KEY SIZE HRRZI AC16,AC15 ;AC0 IS SOURCE,,AC15 IS PARAMETER WRD PUSHJ PP,(AC10) ;CALL PD6. OR PD7. PUSHJ PP,RSTAC. ;RESTORE ACS JRST UDVER3 ;--DONE-- ;JUST MOVE THE KEY UDVER2: HRLI AC1,2(AC4) ;MOVE CURRENT KEY TO SYMBOLIC-KEY HRR AC1,F.WBSK(I16) ;FROM,,TO MOVE AC2,IESIZ(I12) ; SUBI AC2,2 ;LEN ADDI AC2,-1(AC1) ;UNTIL BLT AC1,(AC2) ;MOVIT UDVER3: PUSHJ PP,VNDE ;IF TOP INDEX BLOCK WAS SPLIT - TRY AGAIN [EDIT#307] JFCL ; TLOE FLG1,VERR ; JRST LV2SK3 ;NO - GIVE ERROR MESSAGE AND QUIT [EDIT#307] MOVE LVL,MXLVL(I12) ;OK - TAKE IT FROM THE TOP [EDIT#307] PUSHJ PP,@GETSET(I12) ; PUSHJ PP,IBSTO1 ; ;SET LOW-VALUES TO SYMKEY LV2SK.:: MOVE AC1,F.WBSK(I16) ;SK BYTE-POINTER HLRZ AC12,D.BL(I16) LDB AC3,KY.TYP ; GET KEY TYPE CAIL AC3,7 ; COMP-3? JRST LV2SK1 ; YES CAIGE AC3,3 ;DISPLAY ? JRST LV2SK2 ;YES ;FIXED OR FLOATING POINT MOVSI AC0,400000 ;ASSUME IT IS A COMP ITEM CAILE AC3,4 ;FIXED POINT ? ADDI AC0,1 ;NO, COMP-1 MOVEM AC0,(AC1) ;TO SYMKEY TLNN AC3,1 ;TWO WORDS ? MOVEM AC0,1(AC1) ; POPJ PP, ;NO, EXIT ;COMP-3 LV2SK1: LDB AC3,KY.SGN ; GET SIGN BIT SKIPE AC3 ; SKIP IF UNSIGNED SKIPA AC2,[9B13+15B17+9B31+9B35] ; LOW-VALUES ;DISPLAY LV2SK2: SETZ AC2, ; LOW VALUES FOR DISPLAY LDB AC0,KY.SIZ ; GET KEY SIZE IDPB AC2,AC1 ;DEPOSIT SOME LV'S SOJG AC0,.-1 TLNN AC2,-1 ; SKIP IF SIGNED COMP-3 POPJ PP, ; MOVSS AC2 ; GET THE LSAT BYTE DPB AC2,AC1 ; "9-" POPJ PP, ;ERROR MESSAGE OR IGNORE THE ERROR LV2SK3: PUSHJ PP,GBVER ;IGNORE ERROR? JRST LV2SK. ;YES - RESTORE SYM-KEY ;HERE TO DELETE A RECORD DELET.: IFE %%RPG,< SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS? PUSHJ PP,SU.DL ; YES > TLO AC16,DELET ; JRST RERIT1 ; ;HERE TO REWRITE AN EXISTING RECORD RERIT.: IFE %%RPG,< SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS? PUSHJ PP,SU.RW ; YES > TLO AC16,RERIT ; RERIT1: MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR BLT AC0,FS.IF ; STATUS WORDS. HRRZ AC15,(PP) ;(UOCAL.) MOVE AC15,(AC15) ; PUSHJ PP,WRTSUP ; TLNN FLG,OPNOUT ;FILE OPEN FOR OUTPUT? JRST ERROPN ;NO PUSHJ PP,LVTST ;LOW-VALUES IN SYMBOLIC KEY? JRST LVERR ;YES, ITS ILLEGAL AOS RWRSTA(I12) TLZ FLG1,-1 ;INITIALIZE THE FLAG REG PUSHJ PP,SETIC ;SET THE INDEX CHANNEL PUSHJ PP,@GETSET(I12) ;ADJKEY OR GD67 OR FPORFP PUSHJ PP,IBS ;FIND THE RECORD PUSHJ PP,SETLRW ;FIND THE LAST RECORD WORD PUSHJ PP,SHFREC ;MAKE SURE THE NEW REC WILL FIT TLNE AC16,DELET ;DELET ? JRST DEL01 ;YES PUSHJ PP,MOVRB ;MOVE THE RECORD RERIT2: PUSHJ PP,WDBK ;WRITE THE DATA BLOCK IFE %%RPG,< SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE? PUSHJ PP,LRDEQX## ; YES > JRST RET.2 DEL01: HRRZ AC2,LRW(I12) ; SETZM 1(AC2) ;TERMINATE THE DATA BLOCK HRRZ AC3,IOWRD(I12) CAMN AC2,AC3 ;IS DATA BLOCK EMPTY ? PUSHJ PP,DEL10 ;YES, GO UPDATE THE INDEX SKIPE OLDBK ;ANYTHING TO DE-ALLOCATE? PUSHJ PP,DALC ;YES JRST RERIT2 ;IF NOT FIRST ENTRY IN THE INDEX BLOCK ; JUST DELET THE ENTRY & EXIT DEL10: MOVE AC1,USOBJ(I12) ;ADR OF EMPTY BLOCK MOVEM AC1,OLDBK ;SAVE FOR DE-ALLOCATION DEL11: ADDI LVL,1 ;UP A LVL HRRZ AC1,@CNTRY0(I12) HRRZ AC0,@IOWRD0(I12) ; ADDI AC0,3 CAME AC0,AC1 ;FIRST ENTRY THIS BLK ? JRST DEL40 ;NO, DELET ENTRY & EXIT HLL AC1,DBPRK(I12) ;BYTE POINTER TO DATA RECORD KEY [EDIT#276] PUSHJ PP,LVTSTI ;TEST FOR LOW-VALUES JRST DEL13 ;LOW-VALUES! SUBI AC1,2 ;FIRST WORD OF CURRENT ENTRY SETZM (AC1) ;BLOCK IS EMPTY; CLEAR THE BLOCK NUMBER ADD AC1,IESIZ(I12) SKIPN (AC1) ;IS IB EMPTY ? JRST DEL11 ;YES, UP A LEVEL & DELET ITS ENTRY HRRZ AC1,@CNTRY0(I12) PUSHJ PP,DEL40 ;NO, DELET THIS ENTRY MOVE AC3,@CNTRY0(I12) ;SETUP AC3 FOR DEL50 AOJA LVL,DEL50 ;FIX NEXT LEVEL'S KEY DEL13: SETZM OLDBK ;SAVE THIS EMPTY BLOCK HRRZ AC1,@CNTRY0(I12) SETZM 1(AC1) ;MAKE VERSION NUMBER BE SAME AS DATA'S ADD AC1,IESIZ(I12) SKIPN (AC1) ;IS IB EMPTY ? JRST WIBK ;YES, EXIT ;KEY = LOW-VALUES SO JUST UPDATE BLOCK / VERSION NUMBERS HRRZ AC1,@CNTRY0(I12) MOVE AC2,AC1 ;FIRST ENTRY ADD AC1,IESIZ(I12) ;SECOND ENTRY MOVE AC0,(AC1) MOVEM AC0,(AC2) ;BLOCK NUMBER MOVE AC0,1(AC1) MOVEM AC0,1(AC2) ;VERSION NUMBER ;DELET AN INDEX ENTRY DEL40: HRR AC2,AC1 ADD AC1,IESIZ(I12) HRL AC2,AC1 ;FROM,,TO HLRO AC6,@IOWRD0(I12) MOVNS AC6 ADD AC6,@IOWRD0(I12) ;LAST WORD OF LAST ENTRY DEL41: CAIG AC1,(AC6) ;STILL IN ACTIVE DATA? SKIPN (AC1) ;YES, NULL ENTRY? JRST DEL42 ;DONE ADD AC1,IESIZ(I12) ; JRST DEL41 DEL42: SUB AC1,IESIZ(I12) ; BLT AC2,-1(AC1) ; SETZM (AC1) ;TERMINATE THE ENTRIES SETOM @NNTRY0(I12) ;NOTE CNRTY POINTS AT NEXT ENTRY JRST WIBK ;WRITE THE NEW INFO ;OK NEXT LEVEL, UPDATE THE KEY DEL50: CAMLE LVL,MXLVL(I12) ;ANY MORE LEVELS? POPJ PP, ;NO - EXIT HRRZ AC5,@CNTRY0(I12) ;ENTRY'S FATHER HRLI AC1,2(AC3) ;FROM,,0 HRRI AC1,2(AC5) ;FROM,,TO ADD AC5,IESIZ(I12) ;UNTIL+1 BLT AC1,-1(AC5) ;MOVE THE KEY PUSHJ PP,WIBK ; AND WRITE IT OUT ;SEE IF THIS IS FIRST ENTRY IN INDEX BLOCK MOVE AC3,@CNTRY0(I12) ;CURRENT ENTRY HRRZ AC0,@IOWRD0(I12) ;BEGINNING OF BLOCK CAIE AC0,-3(AC3) ;IF NOT THE FIRST ENTRY POPJ PP, ; EXIT AOJA LVL,DEL50 ; ELSE UPDATE NEXT LEVEL'S KEY ;HERE FROM WRITE. IWRITE: TLZ FLG1,-1 ;INITIALIZE [EDIT#307] PUSHJ PP,LVTST ;LOW VALUES IN SYM-KEY? JRST LVERR ;ILLEGAL! AOS RWRSTA(I12) ;BUMP # OF WRITE STATEMENTS PUSHJ PP,SETIC ;SET CHAN FOR INDEX FILE PUSHJ PP,@GETSET(I12) ; PUSHJ PP,IBS ;FIND WHERE TO INSERT HRRZ AC6,D.RCL(I16) ;# OF EMPTY RECS THIS BLK JUMPG AC6,IWRI02 ;IS CURRENT BUFFER FULL? JRST SPLTBK ;YES, MAKE SOME ROOM IWRI01: PUSHJ PP,WABK ;WRITE THE AUXBUF IWRI02: HRRZ AC1,DBF(I12) ;GET BLOCKING FACTOR CAIE AC1,1 ;DON'T NEED A HOLE IF BF = 1 PUSHJ PP,SHFHOL ;MAKE A HOLE PUSHJ PP,SRHW ;SET THE RECORD HEADER WORD PUSHJ PP,MOVRB ;INSERT THE RECORD PUSHJ PP,WDBK ;MARK DATA BLOCK ACTIVE TLNN FLG1,BVN ;WAS DATA BLOCK SPLIT? JRST IWRIX ;NO SKIPE LIVE(I12) ;ANYTHING TO BE OUTPUT? PUSHJ PP,WWDBK ;YES - WWRITE OUT THE DATA ;MAKE AN INDEX ENTRY & UPDATE THE INDEX FILE IWRI04: MOVE AC1,IAKBP(I12) ; MOVE AC0,NEWBK1 ; MOVEM AC0,-2(AC1) ;BLOCK NUMBER MOVE AC2,IOWRD(I12) ; HLRZ AC0,1(AC2) ; TRZ AC0,-100 ;CLEAR FILE FORMAT INFO MOVEM AC0,-1(AC1) ;VERSION NUMBER MOVE AC3,AUXBUF ; ADD AC3,DBPRK(I12) ;DATA BYTE-POINTER TO RECORD KEY [EDIT#276] ADDI AC3,1 ; MOVE AC2,AC3 ; HRLZI AC1,7777 ;MASK ANDCAM AC1,AC2 ;CLEAR BYTE SIZE AND AC1,GDPSK(I12) ;GET KEY SIZE & SIGN IOR AC2,AC1 ;MERGE PUSH PP,GDPSK(I12) ;SAVE IT [EDIT#276] PUSH PP,F.WBSK(I16) ;SAVE IT [EDIT#276] MOVEM AC3,F.WBSK(I16) ;FIRST KEY OF AUXBUF VS SYMKEY [EDIT#276] MOVEM AC2,GDPSK(I12) ; [EDIT#276] TLO FLG1,NOTEST ;SKIP THE CONVERSION AT ADJKEY [EDIT#276] PUSHJ PP,@GETSET(I12) ;PLACE FIRST KEY OF AUXBUF IN IAKBP TLZ FLG1,NOTEST ;RESTORE THE FLAG [EDIT#276] POP PP,F.WBSK(I16) ;RESTORE SYMKEK POINTER [EDIT#276] POP PP,GDPSK(I12) ;RESTORE [EDIT#276] PUSHJ PP,UDIF ;UPDATE THE INDEX FILE PUSHJ PP,WIBK ;WRITE THE INDEX BLOCK IWRIX: SKIPE OLDBK ;ANY BLOCKS TO DEALLOCATE PUSHJ PP,DALC ;YES, DOIT IFE %%RPG,< SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE? PUSHJ PP,LRDEQX## ; YES > JRST RET.2 IWIVK: SKIPE BRISK(I12) ;SKIP IF SLOW MODE JRST IWIVK2 ; TLON FLG1,WIVK ;HAVE WE BEEN HERE BEFOR? JRST IBSTO1 ;NO, TRY AGAIN IWIVK2: SUB AC4,DBPRK(I12) ;POINT AT BEGINNING OF THIS ENTRY [EDIT#276] HRRZM AC4,CNTRY(I12) ;SAVE IN CASE SEQ READ IS NEXT IWIVK1: POP PP,(PP) ; MOVEI AC0,^D22 ;RECORD ALREADY EXISTS MOVEM AC0,FS.FS ;LOAD FILE-STATUS IFE %%RPG,< SKIPE F.WSMU(I16) PUSHJ PP,LRDEQX## ;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE > JRST RET.3 ;UPDATE THE INDEX FILE UDIF: ADDI LVL,1 ;UP A LEVEL CAMLE LVL,MXLVL(I12) ;ANY MORE LEVELS? JRST UDIF10 ;NO, MAKE A NEW LEVEL ;UPDATE CURRENT ENTRY BLOCK & VERSION NUMBERS HRRO AC2,@CNTRY0(I12) MOVE AC3,NEWBK2 ; MOVEM AC3,(AC2) ;NEW BLOCK NUMBER MOVE AC1,1(AC2) ;THE VERSION NUMBER ADDI AC1,1 ;BUMP IT CAIN LVL,1 ;A DATA BLOCK VERSION NUMBER? TRZ AC1,-100 ;CLEAR THE FILE FORMAT INFO MOVEM AC1,1(AC2) ;PUT IT BACK ;MUST INDEX BLOCK BE SPLIT? MOVE AC1,IBLEN(I12) ; ADD AC1,@IOWRD0(I12) ADDI AC1,3 ;SKIP OVER THE HEADER SUB AC1,IESIZ(I12) ;POINT AT LAST ENTRY SKIPE (AC1) ;MUST IDXBLK BE SPLIT? JRST UDIF20 ;YES ;MAKE A HOLE FOR NEW ENTRY UDIF30: MOVE AC1,IESIZ(I12) ;DISPLACEMENT HRRO AC2,@CNTRY0(I12) ADD AC2,AC1 ; SKIPN (AC2) ; JRST UDIF31 ;NO HOLE NEEDED, JUST APPEND UDIF33: ADD AC2,AC1 ; SKIPE (AC2) ;IS THIS LAST ENTRY? JRST UDIF33 ;NO HRRZ AC0,AC2 ; SUBI AC2,1 ;-1 ,, LEN SUB AC0,@CNTRY0(I12) ;LEN PUSHJ PP,SHFR00 ;MAKE HOLE UDIF31: TLNE FLG1,WSTB ;MUST STATISTICS BLOCK BE WRITTEN? UDIF34: PUSHJ PP,WSTBK ;YES MOVE AC0,IAKBP(I12) ; ADDI AC0,-2 ; HRL AC0,AC0 ;FROM,,FROM HRR AC0,@CNTRY0(I12) ;FROM,,TO MOVE AC1,IESIZ(I12) ; ADD AC0,AC1 ; ADD AC1,AC0 ;UNTIL HRRM AC0,@CNTRY0(I12) ;UPDATE CNTRY FOR SREAD BLT AC0,-1(AC1) ;INSERT THE ENTRY POPJ PP, ;EXIT TO IWRITE ;BUMP THE VERSION NUMBER UDIF20: MOVE AC2,AUXBUF HRRZ AC3,@IOWRD0(I12) ADDI AC3,2 MOVE AC0,-1(AC3) ; MOVEM AC0,(AC2) ;HEADER WORD - BLOCK SIZE EXPRESSED AS 6BIT BYTES AOS AC3,(AC3) ;IN THE CURRENT IDXBLK MOVEM AC3,1(AC2) ; AND IN AUXBUF ;DECIDE WHERE TO SPLIT THE INDEX BLOCK MOVE AC3,EPIB(I12) ;NUMBER OF INDEX ENTRIES LSH AC3,-1 ;HALVE IT IMUL AC3,IESIZ(I12) ; ADDI AC3,3 ; ADD AC3,@IOWRD0(I12) ;FIRST ENTRY OF 2ND HALF TLZ AC3,-1 ;CLEAR LEFT HALF THEN COMPARE CAMG AC3,@CNTRY0(I12) ;NEW ENTRY IN FIRST HALF? JRST UDIF21 ;YES ;NEW ENTRY IS IN FIRST HALF OF CURRENT IDXBLK ;MOVE SECOND HALF TO AUXBUF HLRZ AC2,@IOWRD0(I12) MOVNI AC2,(AC2) ; ADD AC2,@IOWRD0(I12) HRRZM AC2,TEMP. ;UNTIL - FOR ZEROING IDXBLK SUBI AC2,-1(AC3) ; OF 2ND HALF ADDI AC2,2 ;SKIP OVER HEADER ADD AC2,AUXBUF ;UNTIL HRL AC1,AC3 ;FROM HRR AC1,AUXBUF ;TO ADDI AC1,2 ;SKIP OVER HEADER BLT AC1,-1(AC2) ; ;INSERT NEW ENTRY IN CURRENT IDXBLK SETZM (AC3) ;SET LOOP CATCHER FOR UDIF33 ADD AC3,IESIZ(I12) ;INCLUDE THE NEW ENTRY MOVEM AC2,TEMP.1 MOVEM AC3,TEMP.2 PUSHJ PP,UDIF30 MOVE AC2,TEMP.1 MOVE AC3,TEMP.2 JRST UDIF25 ;FINISH UP UDIF21: TLO FLG1,IIAB ;INSERTION IS IN AUXBUF ADD AC3,IESIZ(I12) ;PUT ONE MORE ENTRY IN 1ST HALF CAMLE AC3,@CNTRY0(I12) ;NEW ENTRY FIRST IN AUXBUF? JRST UDIF22 ;YES ;MOVE FIRST PART OF 2ND HALF TO AUXBUF HRL AC2,AC3 ;FROM HRR AC2,AUXBUF ;TO ADDI AC2,2 ;SKIP OVER HEADER & VERSION NUMBER HRRZ AC1,@CNTRY0(I12) SUBI AC1,(AC3) ;LEN ADD AC1,IESIZ(I12) ;INCLUDE THE CURRENT ENTRY HRRZM AC1,TEMP. ;LEN OF 1ST PART ADDI AC1,(AC2) ;UNTIL BLT AC2,-1(AC1) ;MOVE FIRST PART JRST UDIF23 ;NEW ENTRY IS FIRST IN AUXBUF UDIF22: SETZM TEMP. ;LEN OF FIRST PART IS ZERO HRRZ AC1,AUXBUF ;TO ADDI AC1,2 ;SKIP OVER THE HEADER WORD ;INSERT THE NEW ENTRY UDIF23: HRRZM AC1,TEMP.2 ;AUXBUF CNTRY, SAVE FOR MAUXI HRR AC0,IAKBP(I12) ; ADDI AC0,-2 ; HRL AC0,AC0 ; HRR AC0,AC1 ;FROM,,TO ADD AC1,IESIZ(I12) ;UNTIL BLT AC0,-1(AC1) ;INSERT ;MOVE REST OF 2ND HALF TO AUXBUF HRR AC0,TEMP. ;LEN OF FIRST PART ADD AC0,AC3 ;FROM HRL AC0,AC0 ;FROM,,FROM HRR AC0,AC1 ;TO MOVE AC2,@IOWRD0(I12) MOVE AC5,IESIZ(I12) ; IMUL AC5,EPIB(I12) ; ADDI AC2,2(AC5) ;LAST WORD OF LAST ENTRY HRRZM AC2,TEMP.1 ;'LEW', SAVE FOR MAUXI SUB AC2,TEMP. ; ADDM AC2,TEMP. ;UNTIL, FOR CLEARING CURRENT IDXBLK SUBI AC2,(AC3) ;LEN-1 ADDI AC2,1(AC1) ;UNTIL BLT AC0,-1(AC2) ;REST TO AUXBUF HRRZM AC2,LRWA ; SOS LRWA ;LAST ACTIVE WORD IN AUXBUF, SAVE FOR MAUXI ;ZERO 2ND HALF OF CURRENT IDXBLK UDIF25: SETZM (AC3) ; HRL AC0,AC3 ; HRRI AC0,1(AC3) ;FROM,,TO HRRZ AC1,TEMP. ; BLT AC0,(AC1) ; ;ZERO 2ND HALF OF AUXBUF SETZM (AC2) ; HRL AC2,AC2 ; HRRI AC2,1(AC2) ;FROM,,TO MOVE AC1,AUXIOW ; HLRZ AC0,AC1 ; SUB AC1,AC0 ;UNTIL - END OF AUXBUF BLT AC2,(AC1) ; ;MAKE A NEW ENTRY PUSHJ PP,ALC2IB ;GRAB TWO BLOCKS MOVE AC0,NEWBK1 ; MOVEM AC0,AUXBNO ; MOVE AC1,IAKBP(I12) ; MOVEM AC0,-2(AC1) ;BLOCK NUMBER MOVE AC2,@IOWRD0(I12) MOVE AC0,2(AC2) ; MOVEM AC0,-1(AC1) ;VERSION NUMBER MOVE AC3,AUXBUF ;MOVE KEY TO HOLDING AREA HRLI AC3,4(AC3) ; HRRI AC3,(AC1) ;FROM,,TO MOVE AC2,IESIZ(I12) ; ADDI AC2,-2(AC3) ; BLT AC3,-1(AC2) ; ;WRITE OUT THE SPLIT BLOCKS MOVE AC1,NEWBK2 ; MOVEM AC1,@USOBJ0(I12) ;NEW BLOCK NUMBER FOR CURRENT IDXBLK PUSHJ PP,WIBK ;CURRENT PUSHJ PP,WABK ;AUXBLK CAMN LVL,MXLVL(I12) ;IS THIS THE TOP INDEX LEVEL? PUSHJ PP,SAVTIE ;YES, SO SAVE TOP INDEX ENTRY FOR NEW TOP-LVL TLZE FLG1,IIAB ;WAS INSERTION IN AUXBUF? PUSHJ PP,MAUXI ;MOVE AUXBUF TO IDXBUF JRST UDIF ;UPDATE THE NEXT LEVEL ;CREATE ANOTHER LEVEL OF INDEX UDIF10: CAILE LVL,12 ;MORE LEVELS AVAILABLE? JRST UDIER ;NO AOS MXLVL(I12) ;INCREASE MXLVL BY ONE MOVEI AC11,@IOWRD0(I12) SKIPN KEYCV. ;SORT IN PROGRESS? PUSHJ PP,UDIF11 ;NO, TRY FOR MORE CORE MOVE AC3,-1(AC11) ;YES, IOWRD OF OLD TOP INDEX BLOCK MOVE AC5,1(AC3) ;FIRST HEADER WORD OF OLD TOP LEVEL ADD AC5,[XWD 1,0] ;BUMP THE LEVEL BY ONE MOVE AC1,(AC11) ;IOWRD OF NEW TOP INDEX BLOCK MOVEM AC5,1(AC1) ;SAVE AS FIRST HEADER WORD SETZM 2(AC1) ;VERSION NUMBER OF TOP LEVEL IS ZERO ;MAKE AN ENTRY POINTING AT OLD TOP-LEVEL HRL AC5,IESAVE ; HRRI AC5,3(AC1) ;TO HRRZM AC5,@CNTRY0(I12) ;FIRST ENTRY = CURRENT ENTRY HRRZ AC2,AC5 ADD AC2,IESIZ(I12) ;UNTIL BLT AC5,-1(AC2) ;DOIT PUSHJ PP,ALC1IB ;GET THE NEXT FREE BLOCK MOVE AC1,NEWBK2 ; MOVEM AC1,TOPIBN(I12) ;TOP INDEX BLOCK NUMBER MOVEM AC1,@USOBJ0(I12) ; ALSO CURRENT TTCALL 3,[ASCIZ / $ /] MOVE AC2,[BYTE (5)10,31,20,14] PUSHJ PP,MSOUT. TTCALL 3,[ASCIZ / SHOULD BE REORGANIZED, THE TOP INDEX BLOCK WAS JUST SPLIT. /] JRST UDIF34 UDIER: SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDX+E.BIDX+^D2] ;THE ERROR NUMBER PUSHJ PP,IGCVR1 ;FATAL MESSAGE OR IGNORE ERROR? JRST RET.2 ;NO MESSAGE JUST RETURN TO CBL-PRGM TTCALL 3,[ASCIZ /NO MORE INDEX LEVELS AVAILABLE TO/] MOVE AC2,[BYTE (5)10,31,20] PUSHJ PP,MSOUT. ;KILL UDIF11: CAIN LVL,12 ;IF HIGHEST POSSIBLE LEVEL SKIPL @IOWRD0(I12) ; AND SPACE IS STILL AVAILABLE JRST .+2 JRST UDIF12 ; USE THE ALLOCATED AREA ;ZERO FREE CORE HRRZ AC1,.JBFF ;SET UP TO ZERO THE FIRST FREE WORD CAMG AC1,.JBREL ;[320];DON'T ZERO IT IF OUT-OF-BOUNDS SETZM (AC1) ;ZERO INITIAL WORD HRL AC0,AC1 ;MAKE A BLT HRRI AC0,1(AC1) ; POINTER CAML AC1,.JBREL ;[320];EXIT JRST UDIF13 ;[320]; HERE IF DONE HRRZ AC1,.JBREL ;MAKE A BLT TERMINATOR BLT AC0,(AC1) ;PROPAGATE THE ZERO UDIF13: HLRO AC1,-1(AC11) ;[320]; MOVN AC0,AC1 ;LENGTH FOR GETSPC HRL AC1,.JBFF ;DWOI PUSHJ PP,GETSPC ;GET SOME SPACE JRST UDIF12 ;NO MORE CORE HRRZ AC0,HLOVL. ;[346] GET START OF OVERLAY AREA CAMGE AC0,.JBFF ;[346] BUFFER EXTEND INTO OVL AREA? JUMPN AC0,UDIF15 ;ERROR IF IN OVERLAY AREA MOVE AC0,(AC11) ;IOWD FOR ALLOCATED AREA CAIGE LVL,12 ;SKIP IF IF CAN'T BE MOVEM AC0,1(AC11) ;SAVE FOR NEXT TOP BLK SPLIT MOVSS AC1 ;-LEN,,LOC SUBI AC1,1 ;MAKE IT AN IOWD MOVEM AC1,(AC11) ;SAVE AS CURRENT IOWRD UDIF12: SKIPE (AC11) ;ANY CORE ALLOCATED? POPJ PP, ;YES, PHEW! MOVEI AC0,^D30 ;RERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDX+E.BIDX+^D3] ;ERROR NUMBER PUSHJ PP,IGCVR2 ;FATAL MESSAGE OR IGNORE ERROR? JRST RET.2 ;IGNORE SO RETURN TO MAIN LINE CODE UDIF14: TTCALL 3,[ASCIZ /INSUFICIENT CORE WHILE ATTEMPTING TO SPLIT THE TOP INDEX BLOCK OF /] MOVE AC2,[BYTE(5)10,31,20] PUSHJ PP,MSOUT. ;KILL UDIF15: HLRZM AC1,.JBFF ;GET OUT OF OVERLAY AREA MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDX+E.BIDX+^D36] ;ERROR NUMBER PUSHJ PP,IGCVR2 ;IGNORE? JRST RET.2 ;YEP XCT WOVLRX ;GIVE ERROR MESSAGE JRST UDIF14 ; AND KILL ;ALOCATE TWO INDEX BLOCKS ALC2IB: MOVE AC1,FMTSCT(I12) ; MOVEM AC1,NEWBK1 ; MOVE AC0,ISPB(I12) ;NUMBER OF SECTORS PER INDEX BLOCK ADDM AC0,FMTSCT(I12) ;UPDATE FIRST EMPTY SECTOR AVAILABLE ALC1IB: MOVE AC1,FMTSCT(I12) ; MOVEM AC1,NEWBK2 ; MOVE AC0,ISPB(I12) ; ADDM AC0,FMTSCT(I12) ; TLO FLG1,WSTB ;REMEMBER TO WRITE THE STATISTICS BLOCK POPJ PP, ;DECIDE WHERE TO SPLIT THE BLOCK SPLTBK: TLO FLG1,BVN ;NOTE THE BLOCK WAS SPLIT PUSHJ PP,SETLRW ;BUMP THE VERSION NUMBERS HRRZ AC4,CNTRY(I12) ; SUBI AC4,1 ;ONE FOR HEADER WORD HRRZ AC5,DBF(I12) ;DATA BLOCKING FACTOR LSH AC5,-1 ;2ND HALF GE 1ST HALF MOVE AC11,DRTAB ; ADD AC11,AC5 ;BEG OF 2ND HALF MOVE AC10,(AC11) ; CAIG AC4,(AC10) ;NEWREC IN 2ND HALF? JRST SPLT01 ;NO ;MAKE HEADER WORD FOR NEWREC TLO FLG1,IIAB ;NOTE INSERTION IS IN AUX BUFFER ADDI AC11,1 ;MAKE 1ST HALF GE 2ND HALF LDB AC2,WOPRS. ;NEWREC SIZE MOVEM AC2,AC6 ;FIRST PART OF HEADER WORD JUMPGE FLG,SPLT03 ;ASCII? ADDI AC2,2 ; ADDI AC6,2 ; LSH AC6,1 ;MAKE ROOM FOR BIT35 TRO AC6,1 ;MAKE IT LOOK LIKE A SEQUENCE NUMBER SPLT03: MOVE AC3,IOWRD(I12) ;GET VERSION NUMBER HLL AC6,1(AC3) ;HEADER WORD = VERSION # ,, RECSIZ ;HOW MANY WORDS IN NEWREC? IDIV AC2,D.BPW(I16) ; JUMPE AC3,.+2 ; ADDI AC2,1 ; ADDI AC2,1 ;PLUS ONE FOR HEADER WORD ;MOVE 1ST PART OF 2ND HALF TO AUXBUF HRL AC0,(AC11) ; HRR AC0,AUXBUF ;FROM ,, TO HRRZI AC1,-1(AC4) ; HRRZ AC3,(AC11) ;ADR OF FIRST REC-HDR TO GO IN AUXBUF SUB AC1,AC3 ;LENGTH OF FIRST PART HRRZM AC1,TEMP. ;LEN OF PART BEFORE NEW-REC CAIGE AC1,0 ;IS NEW-REC FIRST IN AUXBUF? SETZM TEMP. ;YES ADD AC1,AUXBUF ;UNTIL SKIPE TEMP. ;DONT DO BLT IF FIRST RECORD [EDIT#271] BLT AC0,(AC1) ;FIRST PART MOVEM AC6,1(AC1) ;NEWREC HEADER WORD ;MAKE ROOM FOR NEWREC & MOVE THE REST TO AUXBUF HRL AC0,(AC11) ; HRR AC0,AUXBUF ; SKIPE AC6,TEMP. ;LEN OF FIRST PART ADDI AC6,1 ; HRL AC6,AC6 ; ADD AC0,AC6 ;SKIP OVER FIRST PART HLL AC3,CNTRY(I12) ;BYTE-POINTER POSITION & SIZE HLLM AC3,TEMP.2 ;SAVE FOR MOVRBA HRRM AC0,TEMP.2 ;WHERE TO MAKE INSERTION IN AUXBUF AOS TEMP.2 ; ADD AC0,AC2 ;MAKE ROOM FOR NEWREC HRRZ AC2,LRW(I12) ; HLRZ AC1,AC0 ; SUBM AC2,AC1 ; ADD AC1,AC0 ;UNTIL BLT AC0,(AC1) ;MOVIT JRST SPLT02 ;MOVE 2ND HALF OF CURRENT BLOCK TO AUXBUF SPLT01: HRL AC0,(AC11) ; HRR AC0,AUXBUF ;FROM,,TO HRRZ AC1,LRW(I12) ; SUB AC1,(AC11) ;LEN ADD AC1,AC0 ;UNTIL BLT AC0,(AC1) ; SPLT02: HRRZM AC1,LRWA ;LAST-REC-WRD FOR AUXBUF ;ZERO THE REST OF AUXBUF HLRZ AC2,IOWRD(I12) ; MOVE AC0,AUXBUF ; SUBI AC0,1(AC2) ; HRLI AC1,1(AC1) ; HRRI AC1,2(AC1) ;FROM ,,TO HRRZ AC2,AC0 ;UNTIL CAIGE AC2,(AC1) ;IF UNTIL LESS THAN TO JRST SPLT04 ; SKIP THE BLT SETZM -1(AC1) ;ZERO THE FIRST WORD EXCH AC0,AC1 ; BLT AC0,(AC1) ; ;ZERO 2ND HALF OF CURRENT BLOCK SPLT04: HRRZ AC2,(AC11) ;FIRST FREE DATA WRD LOC SUBI AC2,1 ;LRW HRRZI AC0,2(AC2) ; CAMLE AC0,LRW(I12) ;CHECK BLT POINTERS JRST SPLT05 ;FROM GE UNTIL HRLI AC0,1(AC2) ; SETZM 1(AC2) ; EXCH AC2,LRW(I12) ; BLT AC0,(AC2) ; SPLT05: MOVE AC1,@AUXBUF ;GET THE VERSION NUMBER HLLM AC1,(AC10) ; SO BLOCKING FACTOR OF 1 WILL WORK PUSHJ PP,ALC2BK ;GET TWO BLKNO MOVE AC1,NEWBK2 ; EXCH AC1,USOBJ(I12) ;GIVE NEW BLKNO TO CURRENT BUFFER MOVEM AC1,OLDBK ;MARK OLD ONE FOR DE-ALLOCATION MOVE AC0,NEWBK1 ; HRRZM AC0,AUXBNO ;GIVE 2ND NEW BLKNO TO AUXBUF TLZN FLG1,IIAB ;INSERTION IN AUX BLOCK? JRST IWRI01 ;NO PUSHJ PP,WWDBK ;WRITE A DATA BLOCK PUSHJ PP,MOVRBA ;INSERT PUSHJ PP,WABK ;WRITE AUXBUF PUSHJ PP,MAUXD ;MOVE AUXBUF TO DATABUF HRRZM AC1,LRW(I12) ; JRST IWRI04 ; ;ROUTINE MOVES CONTENTS OF AUXBUF TO DATA OR INDEX BUFFER ;UPDATES CNTRY AND USOBJ SO SEQ-READS WILL WORK MAUXD: MOVE AC0,LRW(I12) ; HRRZM AC0,TEMP.1 ;LAST RECORD WORD MAUXI: MOVE AC0,TEMP.2 ; SUB AC0,AUXIOW ; ADD AC0,@IOWRD0(I12) ; HRRM AC0,@CNTRY0(I12) ;CURRENTRY MOVE AC0,AUXBNO ; MOVEM AC0,@USOBJ0(I12) ;USETO OBJECT MOVE AC1,LRWA ; SUB AC1,AUXIOW ;LENGTH ADD AC1,@IOWRD0(I12) ;UNTIL MOVE AC0,@IOWRD0(I12) ADDI AC0,1 ; HRL AC0,AUXBUF ;FROM,,TO HRRZ AC3,TEMP.1 ; CAIL AC3,(AC1) ;ANY REMNANTS LEFT? HRRZM AC3,AC1 ;YES, COVER THEM UP WITH ZEROES BLT AC0,(AC1) ;DOIT! POPJ PP, ;SAVE TOP INDEX ENTRY FOR THE NEW TOP INDEX BLOCK SAVTIE: MOVE AC2,@IOWRD0(I12) ; ADDI AC2,1 ; HRLI AC2,4(AC2) ; HRR AC2,IESAVE ;FROM,,TO MOVE AC3,NEWBK2 ; MOVEM AC3,(AC2) ;BLOCK NUMBER FOR THIS LEVEL MOVE AC3,@IOWRD0(I12) MOVE AC3,2(AC3) ; MOVEM AC3,1(AC2) ;VERSION OF CURRENT IDX BLOCK HRR AC3,IESIZ(I12) ; ADD AC3,-1(AC2) ;UNTIL ADDI AC2,2 ;WHERE THE KEY WILL GO BLT AC2,(AC3) ;MOVIT POPJ PP, ;MAKE TWO COPIES OF SYMKEY ;ADJUST ONE TO MATCH IDXKEY, &ONE TO RECKEY ADJKEY: MOVE AC0,F.WBSK(I16) ;SYMBOLIC KEY BP MOVE AC1,DAKBP(I12) ;DATA ADJUSTED KEY POINTER HRRM AC1,DKWCNT(I12) ;DATA KEY WRD CNT MOVE AC2,IAKBP(I12) ;INDEX ADJUSTED KEY POINTER HRRM AC2,IKWCNT(I12) ;-CNT,,FRST-WRD MOVE AC10,D.WCNV(I16); GET CONVERSION INST. TLNE FLG1,NOTEST ; IF NOTEST - NO CONVERSION MOVSI AC10,(JFCL) ; LDB AC4,KY.SIZ ; GET KEY SIZE ADJKE1: ILDB C,AC0 ;SYMKEY XCT AC10 ; CONVERT IF NECESSARY IDPB C,AC1 ;RECKEY IDPB C,AC2 ;IDXKEY SOJG AC4,ADJKE1 ; POPJ PP, ;CONVERT NUMERIC DISPLAY OR COMP-3 TO ONE/TWO WRD INTEGER GD67: MOVEI AC0,ACSAV0 ; BLT AC0,ACSAV0+16 ; MOVE AC16,[Z AC2,GDPSK] ;PARAMETER ADD AC16,I12 ;INDEX IT PUSHJ PP,@GDX.I(I12) ;CALL GD6. OR GD7. OR GD9. OR GC3. MOVEM AC2,@IAKBP(I12) MOVEM AC2,@DAKBP(I12) MOVEM AC3,@IAKBP1(I12) MOVEM AC3,@DAKBP1(I12) HRLZI AC0,ACSAV0 BLT AC0,AC16 POPJ PP, ;GET SET FOR ONE/TWO WRD INTEGER FPORFP: MOVE AC1,F.WBSK(I16) ;SYM-KEY MOVE AC0,(AC1) ; MOVEM AC0,@IAKBP(I12) MOVEM AC0,@DAKBP(I12) MOVE AC0,1(AC1) MOVEM AC0,@IAKBP1(I12) MOVEM AC0,@DAKBP1(I12) POPJ PP, ;DO THE BINARY SEARCH AGAIN, THERE WAS A VERSION NUMBER DISCREPANCY ;ROUTINE CAUSES GETBLK TO REREAD INDEX/DATA BLOCKS FROM DSK IBSTOP: POP PP,AC1 ;CLEAR RETURN TO IBS+1 IBSTO1: MOVN AC1,MXLVL(I12) ;NUMBER OF IOWD'S TO ZERO MOVEI AC2,USOBJ(I12) ;ADR OF FIRST IOWD HRL AC2,AC1 ;FOR AOBJN SETZM (AC2) ; AOBJN AC2,.-1 ; ;BINARY SEARCH ROUTINE FOR THE INDEX BLOCKS IBS: PUSHJ PP,GETOP ;GET THE TOP LEVEL INDEX BLOCK JRST .+2 IBS0: PUSHJ PP,GETBLK ;GET THE BLOCK INTO CORE MOVE AC5,SINC(I12) ;THE SEARCH INCREMENT HRRZ AC4,@IOWRD0(I12) ; SUB AC4,IESIZ(I12) ;INITIALIZE AT ZEROTH ENTRY ADDI AC4,3 ;ADR OF FIRST WRD OF FRST ENTRY MOVE AC6,IBLEN(I12) ;TABLE LEN ADD AC6,AC4 ;TABLE LIMIT IBSGE: LSH AC5,-1 ;HALF THE INC CAMGE AC5,IESIZ(I12) ;BEGINNING OF TABLE? JRST IBS100 ;YES, DONE ADD AC4,AC5 ;CURRENT ENTRY PLUS INC IBS2: MOVE AC10,AC4 ; ADD AC10,IESIZ(I12) ; CAMG AC10,AC6 ;END OF TABLE? [EDIT#311] SKIPN (AC10) ;NULL ENTRY? [EDIT#311] JRST IBSLT ;YES, GO OTHER WAY JRST @ICMP(I12) ;DO THE COMPARISON ;RETURNS ARE IBSGE OR IBSLT IBSLT: LSH AC5,-1 ;HALF THE INC CAMGE AC5,IESIZ(I12) ;BEG OF TABLE? JRST IBS10 ;YES, DONE SUB AC4,AC5 ;CURRENT ENTRY MINUS INC JRST IBS2 ; IBS100: MOVE AC4,AC10 ;AC10 HAS ENTRY FROM GE IBS10: MOVEM AC4,@CNTRY0(I12) ;ADR OF CURRENT ENTRY SETZM @NNTRY0(I12) ;SO 'SREAD' WILL WORK IF IT'S NEXT SOJG LVL,IBS0 ;GO AGAIN DOWN A LEVEL JRST DSRCH ;LEVEL ZERO, EXIT SEARCH ROUTINE ;INDEX DISPLAY NON-NUMERIC COMPARE ICDNN: MOVE AC1,IKWCNT(I12) ;-CNT ,, ADR OF IAK MOVEI AC2,2(AC10) ;INDEX ENTRY ICDNN1: MOVE AC0,(AC2) ;INDEX ENTRY CAME AC0,(AC1) ;SYM-KEY = IDX-KEY JRST ICDNN2 ;NOT EQUAL ADDI AC2,1 ;NEXT AOBJN AC1,ICDNN1 ;LOOP IF YOU CAN JRST IBSGE ;EQUAL RETURN ICDNN2: MOVE AC3,(AC1) ;SYM-KEY TLC AC0,1B18 ; TLC AC3,1B18 ; CAMG AC0,AC3 ; JRST IBSGE ;SYM-KEY GT IDX-KEY JRST IBSLT ;SYM-KEY LT IDX-KEY ;INDEX COMPARE ONE WORD SIGNED IC1S: MOVE AC0,@IAKBP(I12) ;SYM-KEY CAMGE AC0,2(AC10) ; JRST IBSLT ;SYM-KEY LT IDX-KEY JRST IBSGE ;SYM-KEY EQ OR GT IDX-KEY ;TWO WORD SIGNED IC2S: MOVE AC0,@IAKBP(I12) ;SYM-KEY CAMGE AC0,2(AC10) ; JRST IBSLT ;SYM-KEY LT IDX-KEY CAME AC0,2(AC10) ; JRST IBSGE ;SYM-KEY GT IDX-KEY MOVE AC0,@IAKBP1(I12) ;NEXT WRD CAMGE AC0,3(AC10) ; JRST IBSLT ;SK LT IK JRST IBSGE ;SK EQ OR GT IK ;ONE WORD UNSIGNED IC1U: MOVM AC0,@IAKBP(I12) ;SK MOVM AC1,2(AC10) ;IK CAMGE AC0,AC1 ; JRST IBSLT ;SK LT IK JRST IBSGE ;SK EQ OR GT IK ;TWO WORD UNSIGNED IC2U: MOVM AC0,@IAKBP(I12) ;SK MOVM AC1,2(AC10) ;IK CAMGE AC0,AC1 ; JRST IBSLT ;SK LT IK CAME AC0,AC1 ; JRST IBSGE ;SK GT IK MOVM AC0,@IAKBP1(I12) ; MOVM AC1,3(AC10) ; CAMGE AC0,AC1 ; JRST IBSLT ;SK LT IK JRST IBSGE ;SK EQ OR GT IK ;SEACH FOR A DATA FILE KEY DSRCH: MOVE AC0,(AC4) ;GET THE BLOCK NUMBER JUMPN AC0,DSRCH1 ;IS IT ZERO ? TLNN AC16,WRITE ;YES, TAKE INVALID KEY EXIT JRST RRDIV1 JRST IWIVK1 ;NO DSRCH1: PUSHJ PP,GETBLK ; PUSHJ PP,SETLRW ;SETUP LRW, POINTER TO LAST FREE RECWRD LDB AC6,F.BBKF ;NUMBER OF RECS THIS BLK HRRZ AC4,IOWRD(I12) ; ADDI AC4,2 ;FIRST WORD, FIRST REC LDB AC1,RSBP(I12) ;RECSIZ IN CHARS IDIV AC1,D.BPW(I16) ; JUMPE AC2,.+2 ; ADDI AC1,1 ; JUMPE AC1,DSNUL ;EXIT HERE IF DATA BLOCK IS EMPTY MOVEI AC5,1(AC1) ;RECSIZ IN WRDS PLUS ONE ADDI AC5,-1(AC4) ;5 POINTS AT NEXT RECSIZ WRD TLNE FLG1,SEQ ;A SEQUENTIAL READ? POPJ PP, ;YES, EXIT HERE DSLOOP: ADD AC4,DBPRK(I12) ;FIRST KEY,FIRST REC [EDIT#276] MOVE AC10,AC4 ; JRST @DCMP(I12) ; RETURNS TO DSGT, DSEQ OR DSLT DSGT: HRRZI AC4,1(AC5) ;FIRST WRD NEXT REC SOJE AC6,DSGT03 ;EXIT IF NO ROOM FOR MORE RECORDS LDB AC1,RSBP(I12) ;RECSIZ IN CHARS IDIV AC1,D.BPW(I16) ; JUMPE AC2,.+2 ; ADDI AC1,1 ; IN WORDS MOVEI AC5,1(AC1) ;RECSIZ INWORDS PLUS ONE ADDI AC5,-1(AC4) ;5 POINTS AT NEXT RECSIZ WORD SKIPE -1(AC4) ;SKIP IF APPENDING TO THE RECS IN THIS BLK JRST DSLOOP ; DSGT01: HRRZI AC4,(AC5) TLNN AC16,WRITE ;LAST REC & NOT FOUND JRST RRDIVK ;READ, RERIT, DELET INVALID-KEY JRST DSXIT1 ;THIS WILL BE THE LAST RECORD IN THIS BLOCK DSGT03: AOJA AC5,DSGT01 ;CNTRY MUST POINT AT RECORD NOT HEADER DSEQ: TLNE AC16,WRITE ; JRST IWIVK ;WRITE INVALID-KEY DSXIT: SUB AC4,DBPRK(I12) ;DATA BYTE-POINTER TO RECORD KEY [EDIT#276] DSXIT1: MOVEM AC4,CNTRY(I12) ; SETZM NNTRY(I12) ;SO SREAD WILL GET "NEXT" RECORD POPJ PP, DSLT: TLNE AC16,WRITE ; JRST DSXIT ;NORMAL IWRITE EXIT SUB AC4,DBPRK(I12) ;DATA BYTE-POINTER TO RECORD KEY [EDIT#276] JRST RRDIVK ;READ, RERIT, DELETE INVALID-KEY ;NO RECORDS IN THIS DATA BLOCK DSNUL: TLNE AC16,WRITE ; JRST DSXIT1 JRST RRDIVK ;CALL IS: JRST @DCMP(I12) ;RETURNS: DSGT OR DSEQ OR DSLT ;CONVERT NUMERIC DISPLAY TO 1 OR 2 WRD INTEGER DGD67: MOVE AC0,[XWD AC4, ACSAV0+4] ; BLT AC0,ACSAV0+16 ;SAVE ACS HRRM AC10,GDPRK(I12) ;POINT AT CURRENT DATA KEY MOVE AC16,[Z AC2,GDPRK] ;PARAMETER ADD AC16,I12 ;INDEX IT PUSHJ PP,@GDX.D(I12) ;CONVERT, GD6. OR GD7. MOVE AC0,[XWD ACSAV0+4, AC4] ; BLT AC0,AC16 ; MOVEI AC10,2 ;POINT AT CONVERTED DATA JRST @DCMP1(I12) ;OFF TO COMPARISION ROUTINE ;DATA DISPLAY NON-NUMERIC COMPARE DCDNN: MOVE AC1,DKWCNT(I12) ;-CNT ,, DAKBP MOVE AC0,FWMASK(I12) ;FIRST WRD MASK JUMPE AC0,DCDNN2 ;JUMP ONLY ONE WRD AND AC0,(AC10) ;REC-KEY JRST .+2 DCDNN1: MOVE AC0,(AC10) ;REC-KEY CAME AC0,(AC1) ; JRST DCDNN3 ;NOT EQ ADDI AC10,1 ;NEXT AOBJN AC1,DCDNN1 ; DCDNN2: MOVE AC0,LWMASK(I12) ;LAST WRD MASK AND AC0,(AC10) ; CAMN AC0,(AC1) ; JRST DSEQ ;SYM-KEY EQ REC-KEY DCDNN3: MOVE AC3,(AC1) ; TLC AC0,1B18 ; TLC AC3,1B18 ; CAMG AC0,AC3 ; JRST DSGT ;SYM-KEY GT REC-KEY JRST DSLT ;SYN-KEY LT REC-KEY ;DATA, ONE WRD SIGNED DC1S: MOVE AC0,@DAKBP(I12) ; CAMGE AC0,(AC10) ; JRST DSLT ;SK LT RK CAME AC0,(AC10) ; JRST DSGT ;SK GT RK JRST DSEQ ;SK EQ RK ;DATA, TWO WRD SIGNED DC2S: MOVE AC0,@DAKBP(I12) ; CAMGE AC0,(AC10) ; JRST DSLT ;SK LT RK CAME AC0,(AC10) ; JRST DSGT ;SK GT RK MOVE AC0,@DAKBP1(I12); CAMGE AC0,1(AC10) ; JRST DSLT ;SK LT RK CAME AC0,1(AC10) ; JRST DSGT ;SK GT RK JRST DSEQ ;SK EQ RK ;DATA, ONE WRD UNSIGNED DC1U: MOVM AC0,@DAKBP(I12) ; MOVM AC1,(AC10) ; CAMGE AC0,AC1 ; JRST DSLT ;SK LT RK CAME AC0,AC1 ; JRST DSGT ;SK GT RK JRST DSEQ ;SK EQ RK ;DATA, TWO WRD UNSIGNED DC2U: MOVM AC0,@DAKBP(I12) ; MOVM AC1,(AC10) ; CAMGE AC0,AC1 ; JRST DSLT ;SK LT RK CAME AC0,AC1 ; JRST DSGT ;SK GT RK MOVM AC0,@DAKBP1(I12); MOVM AC1,1(AC10) ; CAMGE AC0,AC1 ; JRST DSLT ;SK LT RK CAME AC0,AC1 ; JRST DSGT ;SK GT RK JRST DSEQ ;SK EQ RK ;GET A BLOCK, MAYBE THE TOP-BLOCK & CHECK VERSION NOS GETOP: MOVE LVL,MXLVL(I12) ;NOTE ITS TOP LVL SKIPA AC1,TOPIBN(I12) ;THE BLOCK NO. GETBLK: MOVE AC1,(AC4) ;NEXT BLKNO MOVE AC2,@IOWRD0(I12) ;CURRENT IOWRD MOVEM AC2,CMDLST ;SET THE IOWD CAMN AC1,@USOBJ0(I12) ;IN CORE? JRST GETB0A ;YES GETB0E: JUMPE LVL,GETB0C ;JUMP IF DATA FILE XCT ISETI ;INDEX FILE XCT IIN ;[IN CH,CMDLST] GETB1E: SKIPA AC2,2(AC2) ;GET NEW VERSION NO. JRST GBIER ;INPUT ERROR GETB0D: MOVEM AC1,@USOBJ0(I12) ;BLKNO TO USOBJ(I12) SKIPE LVL ;DATA BLOCK ALWAYS HAS VERSION NO. CAME AC1,TOPIBN(I12) ;TOPBLOCK HAS NO VERSION NO. CAMN AC2,1(AC4) ;SAME VERNO? POPJ PP, ;YES JRST GETB0B ;VERSION ERROR ;IGNORE THIS INDEX FILE INPUT ERROR? GBIER: MOVE AC0,[E.MINP+E.FIDX+E.BIDX] ;NOTE IT WAS AN INPUT ERROR PUSHJ PP,IGMI ;IGNORE THIS ERROR? JRST IINER ;NO, GIVE AN ERROR MESSAGE PUSHJ PP,CLRIS ;YES, CLEAR THE INDEX FILE STATUS BITS JRST GETB1E ; AND IGNORE THE ERROR. GETB0A: TLNE FLG1,RIVK!VERR ;FORCE INPUT? JRST GETB0E ;YEP JUMPE LVL,GETB0F ;LEVEL 0 IS A DATA FILE MOVE AC2,2(AC2) ; CAME AC1,TOPIBN(I12) ;TOP-BLOCK HAS NO VERNO CAMN AC2,1(AC4) ; POPJ PP, GETB0B: MOVEI AC1,@USOBJ0(I12);GET ADR OF THIS LEVEL'S BLOCK # MOVE AC1,1(AC1) ;GET BLOCK # OF PRECEDING LEVEL MOVEM AC1,FS.BN ;SAVE THE OFFENDING BLOCK NUMBER TLNE FLG1,SEQ ;SEQ READ? JRST UDVERR ;SPECIAL CASE TLON FLG1,VERR ;FIRST OR SECOND ERROR? JRST IBSTOP ;FIRST, SO TRY AGAIN PUSHJ PP,VNDE ;IF TOP BLOCK WAS SPLIT TRY AGAIN [EDIT#307] JRST GBVER ;NO - SO ERROR MESSAGE AND QUIT [EDIT#307] JRST IBSTOP ;YES - TRY ONE MORE TIME [EDIT#307] ;IGNORE THIS ERROR? GBVER: SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDA+E.BDAT+^D4] ;ERROR NUMBER CAIE LVL,0 ;SKIP IF DATA BLOCK MOVE AC0,[E.FIDX+E.BIDX+^D4] ;ERROR NUMBER PUSHJ PP,IGCV ;IGNORE ERROR? JRST GETB0G ;NO -- GIVE A ERROR MESSAGE POPJ PP, ;YES -- TAKE A NORMAL EXIT GETB0G: TTCALL 3,[ASCIZ /VERSION NUMBER DISCREPANCY /] JRST IINER2 ; GETB0C: SKIPN LIVE(I12) ;MUST BLOCK BE OUTPUT? JRST GETB1C ;NO PUSHJ PP,WWDBK ;YES--DOIT JRST GETBLK ; GETB1C: XCT USETI. HRRI AC0,CMDLST HRRM AC0,UIN. XCT UIN. GETB0F: SKIPA AC2,1(AC2) JRST GBDER HLLZS UIN. HLRZS AC2 ;VERSION NO TO RIGHT HALF TRZ AC2,-100 ;CLEAR OUT THE FILE FORMAT INFO JRST GETB0D ;IGNORE DATA FILE IO ERROR? GBDER: MOVE AC0,[E.MINP+E.FIDA+E.BDAT] ;ERROR NUMBER PUSHJ PP,IGMD ;IGNORE THE ERROR? JRST UINER ;NO, GIVE ERROR MESSAGE PUSHJ PP,CLRDS ;CLEAR DATA FILE STATUS BITS JRST GETB0F ;YES, TAKE A NORMAL RETURN ;[307] GETB0F+6 20-DEC-73 ;HERE ON "VERSION NUMBER DISCREPANCY ERROR" [EDIT#307] ; SEE IF THERE ARE MORE INDEX LEVELS THAN THE READER KNOWS ABOUT [EDIT#307] ; I.E. WHEN A WRITER SPLITS THE TOP BLOCK AND CREATES A NEW [EDIT#307] ; INDEX LEVEL. [EDIT#307] ; IF SO GET ANOTHER BUFFER TO ACCOMMODATE THE NEW INDEX LEVEL(S) [EDIT#307] ; AND TRY AGAIN. [EDIT#307] ; POPJ IF OPNOUT OR NO NEW INDEX LEVEL OR SORT IN PROGRESS [EDIT#307] ; OR NO MORE CORE. [EDIT#307] ; ELSE TAKE A SKIP EXIT -- TRY AGAIN. [EDIT#307] VNDE: TLZE FLG1,TRYAGN ;BEEN HERE BEFORE ? [EDIT#307] POPJ PP, ;YES - CAN'T HELP [EDIT#307] TLO FLG1,TRYAGN ;REMEMBER YOU'VE BEEN HERE [EDIT#307] ; ENTRY POINT TO READ FRESH COPY OF STS BLOCK VNDE1: PUSHJ PP,RSTBK ;NO - GET FRESH COPY OF STATISTICS BLOCK [EDIT#307] MOVN AC5,MXLVL(I12) ;SEE IF SOMEONE HAS CREATED [EDIT#307] SUB AC5,OMXLVL(I12) ; A NEW INDEX LEVEL [EDIT#307] JUMPE AC5,RET.1 ; EXIT HERE IF NOT [EDIT#307] HRRZ AC1,ISPB(I12) ;BUILD AN IOWRD IN AC6 [EDIT#307] IMULI AC1,200 ; AND GET THE LENGTH IN AC1 [EDIT#307] MOVN AC6,AC1 ; -- [EDIT#307] HRLZS AC6 ; -- [EDIT#307] HRR AC6,.JBFF ; -- [EDIT#307] SUBI AC6,1 ; --. [EDIT#307] MOVEI AC4,IOWRD+1(I12);GET LOCATION OF THE FIRST [EDIT#307] SUB AC4,OMXLVL(I12) ; UNUSED IOWRD POINTER [EDIT#307] HRL AC4,AC5 ;# OF NEW IOWRD'S REQUIRED [EDIT#307] VNDE10: SKIPE (AC4) ;IF IOWRD ALREADY EXIST [EDIT#307] JRST VNDE20 ; TRY TO LOOP [EDIT#307] SKIPE KEYCV. ;IF SORT IN PROGRESS [EDIT#307] POPJ PP, ; QUIT -- CAN'T HANDLE THAT [EDIT#307] HRRZ AC0,AC1 ;LENGTH OF THE BUFFER AREA [EDIT#307] PUSHJ PP,GETSPC ;GET SOME SPACE [EDIT#307] POPJ PP, ; NONE LEFT [EDIT#307] HRRZ AC0,HLOVL. ;SEE IF WE'RE WIPING OUT CAMGE AC0,.JBFF ; THE OVL-AREA JUMPN AC0,VNDERR ;COMPLAIN IF WE ARE MOVEM AC6,(AC4) ;MAKE A NEW IOWRD [EDIT#307] ADD AC6,AC1 ; AND SET UP FOR NEXT ONE [EDIT#307] VNDE20: AOBJN AC4,VNDE10 ;LOOP IF MORE LEVELS [EDIT#307] ;[V10] MOVN AC0,MXLVL(I12) ;UPDATE OMXLVL [EDIT#307] ;[V10] MOVEM AC0,OMXLVL(I12) ; AND THEN [EDIT#307] JRST RET.2 ;TAKE SKIP EXIT + TRY AGAIN [EDIT#307] VNDERR: EXCH AC1,.JBFF ;FIRST GET OUT SUBM AC1,.JBFF ; OF OVL-AREA MOVEI AC0,^D30 ;PERMANENT ERROR MOVEM AC0,FS.FS ;LOAD FILE-STATUS SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDX+^D35];IDX-FLAG TOO PUSHJ PP,OXITP ;DONT RET IF IGNORING ERRORS XCT WOVLRX ;GIVE MESSAGE JRST GETB0G ;FINISH UP ;MARK THIS BLOCK SO IT WILL BE OUTPUT WDBK: SETOM LIVE(I12) ;MARK IT SKIPE BRISK(I12) ;SKIP IS SLOW BUT SAFE POPJ PP, ;WRITE A DATA BLOCK WWDBK: MOVE AC1,USOBJ(I12) ; MOVE AC0,IOWRD(I12) ; WWDBK1: MOVEI AC2,CMDLST ; HRRM AC2,UOUT. ; MOVEM AC0,CMDLST ; SETZM LIVE(I12) ;CLEAR THE LIVE FLAG AOS IOUUOS(I12) ; XCT USETO. ; XCT UOUT. ; JRST .+2 ; PUSHJ PP,WDBER ;OUTPUT ERROR HLLZS UOUT. ; POPJ PP, ;DATA FILE IO ERROR WDBER: MOVE AC0,[E.MOUT+E.FIDA+E.BDAT];ERROR NUMBER PUSHJ PP,IGMD ;IGNORE THIS ERROR? JRST UOUTER ;NO -- GIVE A ERROR MESSAGE JRST CLRDS ;YES, CLEAR STATUS BITS ;WRITE AN INDEX BLOCK WIBK: MOVE AC1,@USOBJ0(I12) MOVE AC0,@IOWRD0(I12) WIBK1: MOVEM AC0,CMDLST ; AOS IOUUOS(I12) ; XCT ISETO ; XCT IOUT ; POPJ PP, ; WIBK2: CAMN AC0,IOWRD+13(I12);SAT BLOCK? MOVE AC0,[E.BSAT] ;YES CAMN AC0,IOWRD+14(I12);STATISTICS BLOCK? MOVE AC0,[E.BSTS] ;YES CAIG AC0,0 ;NONE OF THE ABOVE? MOVE AC0,[E.BIDX] ;MUST BE INDEX BLOCK ADD AC0,[E.MOUT+E.FIDX];OUTPUT ERROR PUSHJ PP,IGMI ;IGNORE ERROR? JRST IOUTER ;NO JRST CLRIS ;CLEAR STATUS BITS AND RETURN ;WRITE A SAT BLOCK WSBK: MOVE AC1,USOBJ+13(I12) MOVE AC0,IOWRD+13(I12) JRST WIBK1 ; ;WRITE AUXILARY BLOCK WABK: MOVE AC1,AUXBNO MOVE AC0,AUXIOW HLL AC0,IOWRD(I12) JUMPE LVL,WWDBK1 HLL AC0,IOWRD+1(I12) JRST WIBK1 ;WRITE STATISTICS BLOCK WSTBK: MOVEI AC1,1 MOVE AC0,IOWRD+14(I12) JRST WIBK1 ;READ A STATISTICS BLOCK RSTBK: MOVEI AC1,1 ;[EDIT#307] MOVE AC2,IOWRD+14(I12) ;[EDIT#307] MOVEM AC2,CMDLST ;[EDIT#307] XCT ISETI ;[EDIT#307] XCT IIN ;[EDIT#307] POPJ PP, ;[EDIT#307] MOVE AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER PUSHJ PP,IGMI4 ;IGNORE THE ERROR? JRST RSTBK1 ;NO PUSHJ PP,CLRIS ;CLEAR STATUS BITS TLNN AC16,READ ;IF NOT IREAD OR SREAD JRST RET.2 ; SKIP EXIT ELSE POPJ PP, RSTBK1: TTCALL 3,[ASCIZ /CANNOT READ STATISTICS BLOCK/] ;[EDIT#307] JRST IINER ;[EDIT#307] ;READ A SAT BLOCK RSBK: MOVEM AC1,USOBJ+13(I12) MOVE AC2,IOWRD+13(I12) MOVEM AC2,CMDLST AOS IOUUOS(I12) XCT ISETI XCT IIN POPJ PP, MOVE AC0,[E.MINP+E.FIDX+E.BSAT] ;ERROR NUMBER PUSHJ PP,IGMI2 ;IGNORE ERROR? JRST RSBK1 ;NO PUSHJ PP,CLRIS ;CLEAR STATUS BITS JRST RET.2 ;TAKE A NORMAL EXIT RSBK1: TTCALL 3,[ASCIZ /CANNOT READ SAT BLOCK/] JRST IINER ;ROUTINE TO CLEAR INDEX FILE ERROR STATUS BITS CLRIS: PUSH PP,AC2 ;SAVE AC2 XCT IGETS ;GET STATUS TO AC2 TRZ AC2,760000 ;TURN EM OFF XCT ISETS ; AND RESET THEM CLRIS1: POP PP,AC2 ; POPJ PP, ; ;ROUTINE TO CLEAR DATA FILE ERROR STATUS BITS CLRDS: PUSH PP,AC2 ;SAVE AC2 XCT UGETS. ;GET STATUS TO AC2 TRZ AC2,760000 ;TURN EM OFF XCT USETS. ; AND RESET THEM JRST CLRIS1 ;MOVE BUFFER TO RECORD (READ) MOVBR: LDB AC0,F.BMRS ;MAX-REC-SIZ MOVE AC6,RECBP(I12) ;REC BYTE-POINTER ;[V10] MOVE AC4,CNTRY(I12) ;POINTE TO DATA HRRZ AC4, CNTRY(I12) ;[V10] POINTER TO DATA. HRRZ AC3,-1(AC4) TLNN FLG,DDMASC ;ASCII ? JRST MOVBR1 ;NO LSH AC3,-1 ; SUBI AC3,2 ; MOVBR1: ANDI AC3,7777 CAMGE AC0,AC3 PUSHJ PP,ERRMR0 ;THE RECORD SIZE IS TOO BIG! TLNN FLG,CONNEC!DDMASC!DDMBIN JRST BLTBR ; EBCDIC OR SIXBIT, BLTIT LDB AC10,[POINT 2,FLG,2] ; GET DEVICE DATA MODE HLL AC4,RBPTB1(AC10) ; GET BYTE PTR MOVE AC10,D.RCNV(I16) ; SET AC10 SUBI AC0,(AC3) ;[335]KEEP TRACK OF NEEDED BLANK FILL MOVB0A: ILDB C,AC4 XCT AC10 JUMPLE C,MOVB0A ;IGNOR LEADING EOLS & NULLS MOVB0B: IDPB C,AC6 ;[335] SOJE AC3,RET.1 SOJE AC3,MOVB0C ;[335]DONT RETURN TILL CHECK FILL ILDB C,AC4 XCT AC10 JUMPGE C,MOVB0B ;MOVE THE RECORD MOVB0C: LDB C,[POINT 2,FLG,14]; GET CORE DATA MODE MOVE C,SPCTB1(C) ; GET A SPACE CHAR ADD AC3,AC0 ;[335]#LEFT+ MAX - THIS REC SKIPE AC3 ;[335]COULD BE NOTHING LEFT TO DO IDPB C,AC6 SOJG AC3,.-1 ;FILL WITH SPACES IFE %%RPG,< SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE? PUSHJ PP,LRDEQX## ; YES > POPJ PP, ;BLT BUFFER TO RECORD BLTBR: CAIN AC0,(AC3) ;[335]IF RECS = JRST BLTB1 ;[335]NO NEED FOR FILL IDIV AC0,D.BPW(I16) ; CONVERT TO WORDS SKIPE AC1 ; ROUND UP? ADDI AC0,1 ; YES MOVEI AC1,1(AC6) ;[335] BLT TO HRLI AC1,(AC6) ;[335]BLT FROM LDB AC2,[POINT 2,FLG,14] ; GET CORE DATA MODE MOVE AC2,SPCTBL(AC2) ; AND A WORD OF SPACES MOVEM AC2,(AC6) ; START BLANK ADDI AC0,-1(AC6) ;[335]BLT LIMIT MOVE AC2,AC0 ;[335] BLT AC1,(AC2) ;[335]ZAP BLTB1: HRRZ AC1,-1(AC4) ;RECSIZ ;ANDI AC1,7777 IDIV AC1,D.BPW(I16) ; IN WORDS ;[V10] JUMPE AC2,.+2 ;[V10] ADDI AC1,1 ;[V10] HRLI AC0,(AC4) ;FROM ;[V10] HRR AC0,AC6 ;TO ;[V10] ADDI AC1,-1(AC6) ;UNTIL ;[V10] BLT AC0,(AC1) ;ZRAPPP! ;[V10] BLT ONLY THE FULL WORDS OF DATA AND THEN MOVE THE REST ;[V10] CHARACTER BY CHARACTER. HRRI AC0, (AC6) ;[V10] TO LOCATION. ADDI AC6, (AC1) ;[V10] UPDATE THE BYTE POINTER. JUMPE AC1, BLTB4 ;[V10] IF THERE IS NOTHING TO ;[V10] BLT, GO ON. HRLI AC0, (AC4) ;[V10] FROM LOCATION. BLT AC0, -1(AC6) ;[V10] DO IT TO IT. BLTB4: JUMPE AC2, BLTB8 ;[V10] IF THERE IS NOTHING LEFT ;[V10] OVER, GO ON. ADDI AC4, (AC1) ;[V10] CONSTRUCT THE SENDING HLL AC4, AC6 ;[V10] BYTE POINTER. BLTB6: ILDB C, AC4 ;[V10] TRANSFER THE REST OF THE IDPB C, AC6 ;[V10] CHARACTERS. SOJG AC2, BLTB6 ;[V10] BLTB8: ;[V10] IFE %%RPG,< SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE? PUSHJ PP,LRDEQX## ; YES > POPJ PP, ;MOVE RECORD TO AUXBUF (WRITE) ;BUT FIRST CLEAR BIT-35 IF DEVICE DATA MODE IS ASCII ;SO THE KEY COMPARISION ROUTINES WILL WORK MOVRBA: TLNN FLG,DDMASC ;IS DATA FILE IS ASCII? JRST MOVRB0 ;NO LDB AC0,WOPRS. ;GET RECORD SIZE ADDI AC0,2+4 ;PLUS 2 FOR CRLF AND 4 TO ROUND UP IDIVI AC0,5 ;CONVERT TO WORDS MOVN AC1,AC0 ;MAKE A HRLS AC1 ; AOBJN HRR AC1,TEMP.2 ; POINTER SETZM (AC1) ;CLEAR BIT 35 AOBJN AC1,.-1 ;LOOP MOVRB0: SKIPA AC5,TEMP.2 ;POINTER TO AUXBUF ;MOVE RECORD TO BUFFER MOVRB: MOVE AC5,CNTRY(I12) ;POINTER TO BUFFER LDB AC0,F.BMRS ;MAX-REC-SIZ MOVE AC6,RECBP(I12) ;REC BYTE-POINTER LDB AC3,WOPRS. ; CAMGE AC0,AC3 ;IS RECORD LEGAL SIZE? PUSHJ PP,ERRMR0 ;NO -- TOO BIG TLNN FLG,CONNEC!DDMASC!DDMBIN JRST BLTRB ; EBCDIC OR SIXBIT - BLTIT LDB AC10,[POINT 2,FLG,2] ; GET DEVICE DATA MODE HLL AC5,RBPTB1(AC10) ; GET BYTE PTR MOVE AC10,D.WCNV(I16);SET AC10 MOVR0A: ILDB C,AC6 ; XCT AC10 ; IDPB C,AC5 ; SOJG AC3,MOVR0A ; JUMPGE FLG,RET.1 ;IF NOT ASCII EXIT PUSHJ PP,RANCR ; JRST RANLF ; AND EXIT BLTRB: MOVE AC1,AC3 ;DONT DESTRY 4 IDIV AC1,D.BPW(I16) ; GET BYTES PER WORD JUMPE AC2,.+2 ; ADDI AC1,1 ; HRLI AC0,(AC6) ;FROM HRRI AC0,(AC5) ;TO ADDI AC1,-1(AC5) ;UNTIL BLT AC0,(AC1) ; POPJ PP, ;IWRITE - SO MAKE HOLE FOR REC TO FIT IN SHFHOL: SETZ AC3, ;FAKE AN OLD SIZE OF ZERO LDB AC1,WOPRS. ;NEW-SIZ JUMPGE FLG,.+2 ;ASCII REC? ADDI AC1,2 ;YES, ACCOUNT FOR MOVE AC4,CNTRY(I12) ;POINT AT CURRENT REC JRST SHFR10 ; ;SHUFFLE RECORDS SO NEXT RECORD WILL JUST FIT SHFREC: MOVE AC4,CNTRY(I12) ;CURRENT REC LDB AC1,RSBP(I12) ;OLD RECSIZ IN CHARS LDB AC3,WOPRS. ;NEW RECSIZ IN CHARS JUMPGE FLG,SHFR03 ; ADDI AC3,2 ;ASCII AND WRITE OR RERIT, ADD 2 FOR SHFR03: TLNE AC16,DELET ;DELET? JRST SHFR04 ;YES CAMN AC3,AC1 ;SAME SIZE ? POPJ PP, ;YES SHFR04: IDIV AC1,D.BPW(I16) ; JUMPE AC2,.+2 ; ADDI AC1,1 ; ADDI AC1,1 ; EXCH AC1,AC3 ;AC3 = OLD SIZ IN WRDS SHFR10: TLNE AC16,DELET ;DELETING? JRST SHFR20 ;YES TLNN AC16,WADV!WRITE ;IWRITE GETS A COMPLETE NEW HEADER WRD DPB AC1,RSBP(I12) ;UPDATE RECSIZ IDIV AC1,D.BPW(I16) ; JUMPE AC2,.+2 ; ADDI AC1,1 ; ADDI AC1,1 ;AC1 = NEW SIZ IN WRDS SUB AC1,AC3 ;AC1 = DIFF SHFR11: ADDM AC1,LRW(I12) ;UPDATE LRW HRRO AC2,LRW(I12) ; SKIPLE D.RCL(I16) ;LAST REC THIS BLOCK? SETZM 1(AC2) ;NO, MAKE ZERO NEXT REC SIZ JUMPL AC1,SHFR01 ;BLTIT - MAKE A SMALLER HOLE SUB AC2,AC1 ;FROM HRRZ AC0,AC2 ; SUBI AC0,-1(AC4) ;LEN + OLD-REC-SIZ SUB AC0,AC3 ;LEN JUMPE AC0,RET.1 ;ZERO = OLD-REC IS LAST-REC ADDI AC0,1 ;MOVE THE HEADER WRD ALSO ;AC0=LEN, AC1=DISPLACEMENT, AC2=-1,,FROM SHFR00: MOVE AC4,AC1 ;POPIT - MAKE LARGER ADD AC4,[POP AC2,(AC2)] MOVE AC5,[SOJG AC0,AC4] HRLI AC6,(POPJ PP,) JRST AC4 ;SHRINK THE OLD RECORD SIZE SHFR01: ADDI AC3,-1(AC4) ;FROM HRL AC3,AC3 ;FROM,AC3 ;FROM,,FROM ADD AC3,AC1 ;FROM,,TO MOVE AC1,LRW(I12) ;UNTIL BLT AC3,(AC1) ; POPJ PP, ;SETUP TO DELETE A REC SHFR20: MOVNI AC1,(AC3) ;RECSIZ + HEADER ADDM AC1,LRW(I12) ;UPDATE LRW SETOM NNTRY(I12) ;NOTE: CNTRY POINTS AT NEXT ENTRY PUSHJ PP,SHFR01 ;MOVIT HRRZ AC2,LRW(I12) SETZM 1(AC2) ;ZERO RECSIZ MEANS END OF DATA POPJ PP, ;SET POINTER TO LAST FREE RECORD WORD SETLRW: LDB AC6,F.BBKF ;NUMBER OF RECS PER BLOCK HRRZ AC4,IOWRD(I12) ; ADDI AC4,1 ;POINT AT REC-CNT HRRZ AC5,D.BPW(I16) ;BYTES PER WORD MOVE AC11,DRTAB ;WHERE TO STORE REC-ORIGN SUBI AC11,1 ;SET UP FOR PUSH HLRZ AC0,(AC4) ;VERSION NUMBER ADDI AC0,1 ; BUMP IT SETLR1: LDB AC1,RSBP1(I12) ;RECSIZ IN CHARS JUMPE AC1,SETLR2 ;ZERO RECSIZ IMPLIES LAST REC ADDI AC1,-1(AC5) ;CONVERT TO WORDS AND IDIV AC1,AC5 ; ROUND UP HRL AC3,AC1 ;RECNT IN WORDS HRR AC3,AC4 ;LOC OF REC-ORIGN PUSH AC11,AC3 ;PUSH IT IN THE DR-TABLE TLNE FLG1,BVN ;SPLITTING? DPB AC0,[POINT 6,(AC4),17] ;VERSION NUMBER IS SIX BITS WIDE ADDI AC4,1(AC1) ;PLUS ONE FOR RECSIZ SOJG AC6,SETLR1 ;MORE RECORDS? SETLR2: MOVEM AC6,D.RCL(I16) ;NO, ROOM FOR RECS HRROM AC4,AC3 ;TERMINATOR (-1,,LRW+1) PUSH AC11,AC3 ; SUBI AC4,1 ; MOVEM AC4,LRW(I12) ;SAVIT POPJ PP, ;SET THE INDEX CHANNEL NUMBER SETIC: HLRZ I12,D.BL(I16) ;INDEX TABLE MOVE LVL,MXLVL(I12) ;SET LVL TO TOP-LEVEL MOVE AC5,ICHAN(I12) ; MOVEI AC10,LASTIC ; MOVE AC1,[POINT 4,FRSTIC,12] DPB AC5,AC1 ; CAIE AC10,(AC1) ; AOJA AC1,.-2 ; POPJ PP, ; ;ALLOCATE DATA BLOCKS HERE ;BLOCK NUMBER IS RETURNED IN NEWBK1 & NEWBK2 ALC2BK: TLZ FLG1,TRYAGN ;INIT THIS FLAG [EDIT#307] TLO FLG1,BLK2 ;REMEMBER TO GRAB 2 BLOCKS MOVE AC2,IOWRD+13(I12) ; ADD AC2,[XWD 2,2] ; HRRZM AC2,TEMP. ;FIRST WORD OF SAT BITS SKIPE USOBJ+13(I12) ;IS THERE A SAT BLK INCORE? JRST ALC05 ;YES ALC01: TLZE FLG1,WSB ;SHLD SAT BLK BE WRITTEN? PUSHJ PP,WSBK ;YES MOVE AC1,SBLOC(I12) ;LOC OF FIRST SAT BLK ALC02: PUSHJ PP,RSBK ;GET A SAT BLK ;NOW FIND A WORD WITH SOME EMPTY BLOCKS IN IT ADD AC2,[XWD 2,2] ;FIRST WORD OF SAT BITS HRRZM AC2,TEMP. ;FIRST-WRD SAVE FOR LATER ALC05: HRROI AC0,-1 ;WHAT WERE NOT LOOKING FOR CAMN AC0,(AC2) ;ANY FREE BLOCKS? AOBJN AC2,.-1 ;NO, LOOP IF MORE WORDS JUMPL AC2,ALC07 ;JUMP IF FOUND [EDIT#271] ;THAT BLOCK WAS FULL, TRY NEXT ONE TLNN FLG1,TRYAGN ;HAVE WE LOOKED FROM THE BEGINNING? JRST ALC20 ;NO, SO DOIT MOVE AC0,SBTOT(I12) ;# OF SAT BLOCKS [EDIT#271] SUBI AC0,1 ;ADJUST COUNT [EDIT#271] IMUL AC0,ISPB(I12) ;TIMES # SECTORS / SAT [EDIT#271] ADD AC0,SBLOC(I12) ;PLUS FIRST BLOCK # [EDIT#271] CAMG AC0,USOBJ+13(I12) ;IS THERE A NEXT ONE? JRST ALC20 ;NO, TRY AGAIN, SEE IF ANY WERE DELETED TLZE FLG1,WSB ;WRITE OUT THE SAT-BLK? [EDIT#310] PUSHJ PP,WSBK ;YES MOVE AC1,ISPB(I12) ;SECTORS / SAT [EDIT#271] ADDB AC1,USOBJ+13(I12) ;NEW USETI/O POINTER [EDIT#271] JRST ALC02 ;YES, TRY NEXT SAT BLOCK ;FOUND A BLK - FLAG IT IN USE ALC07: SETCM AC0,(AC2) ;SO JFFO WILL WORK JFFO AC0,ALC08 ;FIND THE BIT JRST ALC05 ;TRY NEXT WORD ALC08: MOVSI AC0,400000 ; MOVNS AC1 ; LSH AC0,(AC1) ; ORM AC0,(AC2) ;FLAG IT IN USE ;OK - WHATS THE BLOCK NUMBER? HRRZ AC0,AC2 ; SUB AC0,TEMP. ; IMULI AC0,^D36 ; SUBI AC0,-1(AC1) ; MOVE AC1,USOBJ+13(I12) SUB AC1,SBLOC(I12) ; PUSH PP,AC2 ;NEED TO SAVE AC2 [EDIT#271] IDIV AC1,ISPB(I12) ;/ NUMBER OF SECTORS PER SAT [EDIT#271] POP PP,AC2 ;... [EDIT#271] IMUL AC1,BPSB(I12) ; ADD AC0,AC1 ;AC0 HAS THE LOGICAL BLKNO MOVE AC1,D.BPL(I16) ;BUFFERS PER LOGICAL BLOCK SUBI AC0,1 ;MINUS ONE IMUL AC0,AC1 ;TIMES LOGICAL-BLOCK NUMBER ADDI AC0,1 ; IS USETO OBJECT TLO FLG1,WSB ;REMEMBER TO WRITE THE SAT BLOCK HRRZM AC0,NEWBK1 ;SAV THE FIRST BLKNO TLZN FLG1,BLK2 ;A TWO BLOCK REQ? JRST WSBK ;ALLOCATE! WRITE OUT THE SAT BLOCK HRRZM AC0,NEWBK2 ; JRST ALC07 ;GO FOR NEXT ONE ;START AT BEGINNING AND SEE IF ANY WERE DELETED ALC20: TLON FLG1,TRYAGN ;FIRST RETRY? JRST ALC01 ;YES, TRY AGAIN SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDX+E.BSAT+^D5] ;ERROR NUMBER PUSHJ PP,IGCVR1 ;IGNORE ERROR? JRST RET.2 ;YES, RETURN TO CBL-PRGM. TTCALL 3,[ASCIZ /ALLOCATION FAILURE, ALL BLOCKS ARE IN-USE/] JRST IOUTE1 ;& KILL ;DE-ALLOCATE BLOCK NUMBER FOUND IN OLDBK DALC: MOVE AC1,OLDBK ; IDIV AC1,D.BPL(I16) ;CONVERT PHYSICAL TO LOGICAL BLKNO SKIPE AC2 ;REMAINDER? ADDI AC1,1 ;YEP IDIV AC1,BPSB(I12) ;FIND WHICH RELATIVE SATBLK IT'S IN IMUL AC1,ISPB(I12) ;TIMES SECTORS / SAT [EDIT#271] ADD AC1,SBLOC(I12) ;ABSOLUTE MOVEM AC2,AC3 ;SAVE RELATIVE BIT POSITION IN SATBLK CAME AC1,USOBJ+13(I12) ;IS IT IN CORE? PUSHJ PP,RSBK ;NO,GO GET IT MOVEM AC1,USOBJ+13(I12) ;MAKE THIS BLK CURRENT IDIVI AC3,^D36 ;RELATIVE WORD POSITION ADD AC3,IOWRD+13(I12) ;ABSOLUTE WORD POSITION -2 MOVN AC4,AC4 ;ROTATE TO THE RIGHT MOVEI AC0,1 ;THE MASK ROT AC0,(AC4) ; SKIPN AC4 ;IF REMAINDER = 0 SUBI AC3,1 ; BACKUP A WORD ANDCAM AC0,2(AC3) ;MARK IT FREE TLZ FLG1,WSB SETZM OLDBK ; JRST WSBK ;SETUP RECORD HEADER WORD SRHW: MOVE AC4,CNTRY(I12) MOVE AC1,IOWRD(I12) MOVE AC1,1(AC1) MOVEM AC1,-1(AC4) ;SET VERSION NUMBER & BIT35 LDB AC1,WOPRS. JUMPGE FLG,SRHW1 ;ASCII? ADDI AC1,2 ;ADD 2 FOR CR + LF MOVEI AC0,1 ;ASCII FLAG, BIT 35 ORM AC0,-1(AC4) ; SRHW1: DPB AC1,RSBP(I12) ;THE RECORD SIZE IN CHARS POPJ PP, ;LOW-VALUE TEST ;POPJ IF SYMKEY = LOW-VALUES, SKIP EXIT IF NOT LVTST: HLRZ I12,D.BL(I16) ;SETUP I12 MOVE AC1,F.WBSK(I16) ;SK BYTE-POINTER LDB AC3,KY.TYP ; GET KEY TYPE CAIGE AC3,3 ;DISPLAY ? JRST LVTS02 ;YES CAIL AC3,7 ; COMP-3? JRST LVC3 ; YES LVTS01: CAIG AC3,6 ; COMP-3 IS SAME AS FIXED-POINT CAIG AC3,4 ;FIXED POINT ? SKIPA AC2,[1B0] ;YES, LOW-VALUE MOVE AC2,[1B0+1] ;FLOATING PT. LOW-VALUE CAME AC2,(AC1) ;LOW-VALUE ? JRST RET.2 ;NO TRNE AC3,1 ;TWO WORDS ? POPJ PP, ;NO, EXIT CAME AC2,1(AC1) ;LV ? JRST RET.2 ;NO POPJ PP, ;LV. LVTS02: LDB AC2,KY.SIZ ; GET KEY SIZE LVTS03: ILDB AC0,AC1 JUMPN AC0,RET.2 ;NOT LV SOJG AC2,LVTS03 POPJ PP, ;LOW-VALUE ;ENTRY FOR INDEX-KEY LOW-VALUE TEST LVTSTI: ADDI AC1,2 ;SKIP OVER THE TWO WORD HEADER LDB AC3,KY.TYP ; GET KEY TYPE JUMPE AC3,LVTS02 ;DISPLAY EXITS HERE JRST LVTS01 ;NUMERIC DISPLAY IS NUMERIC IN THE INDEX ; LV TEST FOR COMP-3 LVC3: LDB AC3,KY.SIZ ; GET KEY SIZE MOVEI AC2,2(AC3) ; ROUND UP AND GET NUMBER LSH AC2,-1 ; OF NINE BIT BYTES LDB AC0,KY.SGN ; SKIP IF A SIGNED KEY JUMPE AC0,LVC310 ; JUMP IF NOT SIGNED ; HERE IF A SIGNED COMP3 ; LOW-VALUES = A SRTING OF 9'S FOLLOWED BY A SIGN SOJE AC2,LVC302 ; JUMP IF ONLY ONE BYTE ILDB AC0,AC1 ; GET FIRST TWO DIGITS TLNN AC3,1 ; IF ONLY ONE DIGIT IN THIS BYTE DPB AC0,[POINT 4,AC0,31]; DUPLICATE IT JRST .+2 ; SKIP INTO MAIN LOOP LVC301: ILDB AC0,AC1 ; GET NEXT TWO DIGITS CAIE AC0,9B31+9B35 ; LOW-VALUES? JRST RET.2 ; NO EXIT SOJG AC2,LVC301 ; LOOP LVC302: ILDB AC0,AC1 ; GET THE LAST BYTE CAIE AC0,9B31+15B35 ; 9 AND MINUS SIGN? CAIN AC0,9B31+13B35 ; THERE ARE TWO MINUS SIGNS POPJ PP, ; LOW-VALUE RETURN JRST RET.2 ; NOT LV RET ; HERE IF A UNSIGNED COMP3 ; LOW-VALUES = A SRTING OF 0'S FOLLOWED BY A SIGN LVC310: SOJE AC2,LVC312 ; JUMP IF ONLY ONE BYTE TLNN AC3,1 ; IF ONLY ONE DIGIT IN THIS BYTE JRST LVC311 ; SKIP INTO MAIN LOOP ILDB AC0,AC1 ; GET FIRST TWO DIGITS TRZA AC0,360 ; ZERO LEADING DIGIT LVC311: ILDB AC0,AC1 ; GET NEXT TWO DIGITS JUMPN AC0,RET.2 ; JUMP IF NOT LV SOJG AC2,LVC311 ; LOOP LVC312: ILDB AC0,AC1 ; GET THE LAST BYTE TRZ AC0,17 ; FORGET ABOUT THE SIGN JUMPN AC0,RET.2 ; JUMP IF NOT LV POPJ PP, ; LOW-VALUE RETURN ;INDEX FILE INPUT ERROR IINER: XCT IGETS ;GET STATUS TO AC2 TRNE AC2,20000 ;EOF? TTCALL 3,[ASCIZ /FOUND AN EOF INSTEAD OF INDEX BLOCK/] IINER1: MOVE LVL,D.DC(I16) ;DEV CHARACTERISTICS PUSHJ PP,IOERM1 ;NO, CHECK THE OTHERS IINER2: MOVE AC2,[BYTE (5)10,31,20,21,4] PUSHJ PP,MSOUT. ;FILE CANNOT DO INPUT & KILL ;DATA FILE INPUT ERROR UINER: XCT UGETS. ;ERROR BITS TRNE AC2,20000 ;EOF? TTCALL 3,[ASCIZ /FOUND AN EOF INSTEAD OF DATA BLOCK/] JRST IINER1 ;MESSAGE AND KILL LVSKER: TLNE AC16,RERIT TTCALL 3,[ASCIZ /REWRITE, /] TLNE AC16,DELET TTCALL 3,[ASCIZ /DELETE, /] TLNE AC16,WRITE TTCALL 3,[ASCIZ /WRITE, /] TTCALL 3,[ASCIZ /SYMBOLIC-KEY MUST NOT EQUAL LOW-VALUES/] HRLZI AC2,(BYTE (5) 10,31,20) PUSHJ PP,MSOUT. ;KILL & DON'T RETURN ;SEE IF THIS MESSAGE SHOULD BE IGNORED LVERR: SETOM FS.IF ;IDX FILE MOVE AC0,[E.FIDX+^D1] ;LOW-VALUES ILLEGAL PUSHJ PP,IGCV ;FATAL ERROR OR IGNORE ERROR? JRST LVSKER ;FATAL! JRST RET.2 ;DONT PROCESS THIS VERB ;JUST RETURN TO CBL-PRGM ;INDEX FILE OUTPUT ERROR IOUTER: XCT IWAIT XCT IGETS TRNN AC2,740000 POPJ PP, ;NO ERRORS SO EXIT MOVE LVL,D.DC(I16) ;DEV-CHAR PUSHJ PP,IOERM1 IOUTE1: MOVE AC2,[BYTE (5) 10,31,20,22,4] PUSHJ PP,MSOUT. ;& KILL ;DATA FILE OUTPUT ERROR UOUTER: XCT UWAIT. MOVE LVL,D.DC(I16) ;DEVICE CHARACTERISTICS PUSHJ PP,IOERMS MOVE AC2,[BYTE (5) 10,36,31,20,4] JRST MSOUT. ;MESSAGE AND KILL > SUBTTL ERROR RECOVERY ;REVERSE EXIT PROCEDURE FOR IGMD IGMDR: PUSHJ PP,IGMD ;MAKE ERROR NUMBER AND TEST AOS (PP) ;SKIP EXIT TO FATAL MESSAGE POPJ PP, ;RETURN ;REVERSE EXIT PROCEDURE FOR IGMI IGMIR: PUSHJ PP,IGMI ;MAKE ERROR NUMBER AND TEST AOS (PP) ;SKIP EXIT TO FATAL MESSAGE POPJ PP, ;RETURN ;INCLUDE MONITOR ERROR STATUS IN AC0 IGMI4: POP PP,-1(PP) ;POP OFF A RETURN IGMI3: POP PP,-1(PP) ;POP OFF A RETURN IGMI2: POP PP,-1(PP) ;POP OFF A RETURN IGMI1: POP PP,-1(PP) ;POP OFF A RETURN IGMI: PUSHJ PP,SAVAC. ;SAVE ACS XCT IGETS ;GET THE INDEX FILE ERROR STATUS BITS SETOM FS.IF ;SET IDX-FILE FLAG JRST IGMD1 ; IGMD: PUSHJ PP,SAVAC. ;SAVE ACS XCT UGETS. ;GET DATA FILE STATUS BITS SETZM FS.IF ;IDA FILE IGMD1: TLNE FLG,IDXFIL ;SKIP IF NOT ISAM FILE MOVEM AC1,FS.BN ;SAVE THE CURRENT BLOCK NUMBER SETZ AC1, ;INIT AC1 TO ZERO TRNE AC2,400000 ;IMPROPER MODE? MOVEI AC1,^D18 TRNE AC2,200000 ;DEVICE ERROR MOVEI AC1,^D19 TRNE AC2,100000 ;DATA ERROR MOVEI AC1,^D20 TRNE AC2,040000 ;QUOTA EXCEEDED, FILE STR, OR RIB FULL MOVEI AC1,^D21 TRNE AC2,020000 ;EOF MOVEI AC1,^D22 ADD AC0,AC1 MOVEI AC3,^D34 ;ASSUME DSK FULL TRNE AC2,040000 ;IS IT? JRST IGMD2 ;YES SKIPN AC3,FS.FS ;NO CHANGE IF NON ZERO MOVEI AC3,^D30 ;PERMANENT ERROR IGMD2: MOVEM AC3,FS.FS ;LOAD FILE-STATUS JRST IGCV2 ;AVOID CLEARING FS.BN ;REVERSE THE EXIT PROCEDURE FOR IGCV ;POPJ TO IGNORE THE ERROR ;SKIP EXIT TO GET A FATAL MESSAGE IGCVR2: POP PP,-1(PP) ;POP OFF A RETURN IGCVR1: POP PP,-1(PP) ;POP OFF ANOTHER IGCVR: PUSHJ PP,IGCV ;FLAG THE VERB AND TEST FOR IGNORE... AOS (PP) ;NO -- SKIP EXIT TO FATAL MESS POPJ PP, ;YES - EXIT ;FLAG THE COBOL VERB IGCV: PUSHJ PP,SAVAC. ;SAVE ACS IGCV2: TLNE AC16,OPEN ADD AC0,[EXP E.VOPE] TLNE AC16,CLOSEF!CLOSER!CLOSEB ADD AC0,[EXP E.VCLO] TLNE AC16,WADV!WRITE ADD AC0,[EXP E.VWRI] TLNE AC16,RERIT ADD AC0,[EXP E.VREW] TLNE AC16,DELET ADD AC0,[EXP E.VDEL] TLNE AC16,READ ADD AC0,[EXP E.VREA] ;FALL THROUGH TO IGTST ;BUT FIRST INCLUDE FILE TYPE IN ERROR STATUS TLNE FLG,SEQFIL ;SEQUENTIAL? ADD AC0,[E.FSEQ] ;YES TLNE FLG,RANFIL ;RANDOM? ADD AC0,[E.FRAN] ;YES MOVEM AC0,FS.EN ;SAVE THE ERROR-NUMBER ;AND THEN SETUP SEQ/IO FILE FS.BN AND FS.RN IGBNRN: TLNE AC16,OPEN ;OPEN? JRST IGSS ;YES TLNE FLG,OPNIO ;IO-FILE? TLNN FLG,SEQFIL ;SEQ-FILE? JRST IGBNR1 ;NOT SEQ-IO FILE. MOVE AC3,D.IE(I16) ;NUMBER OF INPUTS EXECUTED IMUL AC3,D.BPL(I16) ;TIMES BUFFERS/BLOCK SUB AC3,D.BPL(I16) ;MINUS BUFFERS/BLOCK ADDI AC3,1 ;PLUS ONE SKIPG AC3 ;UNLESS ITS NEGATIVE SETZM AC3 ;WHICH MEANS NONE WERE DONE MOVEM AC3,FS.BN ;SAVE THE BLOCK-NUMBER MOVE AC3,D.RP(I16) ;RECORDS PROCESSED SO FAR ADDI AC3,1 ;BRING IT UP TO DATE MOVEM AC3,FS.RN ;AND SAVE IT AWAY JRST IGSS ; ;SETUP SEQUENTIAL FILE BLOCK AND RECORD NUMBERS IGBNR1: TLNN FLG,SEQFIL ;SEQ FILE? JRST IGSS ;NO SKIPN AC3,D.IE(I16) ;GET NUMBER OF INPUTS MOVE AC3,D.OE(I16) ; OR OUTPUTS EXECUTED. MOVEM AC3,FS.BN ;AND SAVE IT. MOVE AC3,D.RP(I16) ;GET THE RECORD NUMBER ADDI AC3,1 ;UPDATE THE COUNT MOVEM AC3,FS.RN ;AND SAVE IT. ;HERE TO SETUP THE STATUS WORDS IGSS: SKIPN AC1,F.WPFS(I16) ;GET FILE-STATUS POINTER JRST IGTST ;DONE IF NO POINTER MOVE AC0,FS.FS ;GET FILE-STATUS PUSHJ PP,IGCNVT ;MOVE IT TO DATA-ITEM SKIPN AC1,F.WPEN(I16) ;GET ERROR-NUMBER POINTER JRST IGTST ;DONE IF NO POINTER MOVE AC0,FS.EN ;GET ERROR-NUMBER PUSHJ PP,IGCNVT ;MOVE IT TO DATA-ITEM SKIPN AC1,F.WPAC(I16) ;GET ACTION-CODE POINTER JRST IGTST ;DONE IF NO POINTER SETZM (AC1) ;ZERO THE ACTION CODE MOVE AC2,F.WPID(I16) ;GET VALUE-OF-ID POINTER JUMPE AC2,IGTST ;DONE IF NO POINTER IFN ISAM,< HLRZ I12,D.BL(I16) ;RESTORE I12 HRRI AC1,DFILNM(I12) ;ADR OF IDA-FILE NAME HRLI AC1,440600 ;NOW ITS AN INPUT BYTE-PTR MOVE FLG,-7(PP) ;RESTORE FLG TLNE FLG,IDXFIL ;AN ISAM FILE? SKIPE FS.IF ;YES - IDX OR IDA? > MOVE AC1,F.WVID(I16) ;GET THE REAL VID POINTER LDB AC3,[POINT 2,AC1,11] ;GET INPUT BYTE SIZE LDB AC4,[POINT 2,AC2,11] ;GET DESTINATION BYTE SIZE TLZ AC2,007700 ;ZERO BYTE FIELD PUSH PP,I16 ;SAVE I16 MOVEI AC16,1 ;SETUP PARAMETER WORD PUSHJ PP,@IGTAB2-1(AC3) ;MOVE IT TO DATA-ITEM POP PP,I16 ;RESTORE AC16 SKIPN AC1,F.WPBN(I16) ;GET BLOCK-NUMBER POINTER JRST IGTST ;DONE IF NO POINTER MOVE AC0,FS.BN ;GET BLOCK-NUMBER MOVEM AC0,(AC1) ;MOVE IT TO DATA-ITEM SKIPN AC1,F.WPRN(I16) ;GET RECORD-NUMBER POINTER JRST IGTST ;DONE IF NO POINTER MOVE AC0,FS.RN ;GET RECORD-NUMBER MOVEM AC0,(AC1) ;MOVE IT TO DATA-ITEM SKIPN AC2,F.WPFN(I16) ;GET POINTER TO FILE-NAME JRST IGTST ;DONE IF NONE MOVE AC1,I16 ;GET FILE-TBL FILE-NAME POINTER HRLI AC1,440600 ;MAKE IT A BYTE POINTER LDB AC4,[POINT 2,AC2,11] ;GET BYTE SIZE TLZ AC2,007700 ;ZERO BYTE FIELD PUSH PP,I16 ;SAVE I16 MOVEI AC16,1 ;SETUP PARAMETER WORD PUSHJ PP,@IGTAB4-1(AC4) ;MOVE IT TO DATA-ITEM POP PP,I16 ;RESTORE I16 HRRZM I16,@F.WPFT(I16) ;SET FILE-TABLE PTR TO DATA-ITEM ;CALL = PUSHJ PP,IG???? ;AC0 = THE ERROR NUMBER ;RETURN ;POPJ IF THERE IS NO ERROR USE PROCEDURE ; OR IF THE ACTION CODE POINTER, F.WPAC IS ZERO ; OR IF THE ACTION CODE IS ZERO ; GIVE ERROR MESSAGE AND KILL ;SKIP EXIT IF (F.WPAC) IS NON-ZERO TO IGNORE THE ERROR IGTST: SKIPE FS.IGE ;ANY ERRORS IGNORED YET? JRST IGTST2 ;YES - IGNORE ALL FOR DURATION OF THIS VERB MOVEI AC1,0 ;CALL THE ERROR USE PROCEDURE PUSHJ PP,USEPRO ;DO IT JRST IGTST1 ;THERE IS ONE JRST RSTAC1 ;THERE IS NONE IGTST1: SETOM FS.UPD ;REMEMBER ERROR USE-PRO WAS DONE SKIPE AC1,F.WPAC(I16) ;IS THERE AN F.WPAC POINTER? SKIPN AC1,(AC1) ;YES, IGNORE THE ERROR? JRST RSTAC1 ;NO -- MESSAGE AND KILL SETOM FS.IGE ;YES -- FOR THE DURATION OF THIS VERB AOS FS.IEC ; COUNT IGNORED ERRORS IGTST2: PUSHJ PP,RSTAC. ;RESTORE ACS JRST RET.2 ;SKIP EXIT ;HERE TO MOVE DECIMAL NUMBER TO DISPLAY FIELD ;AC0 HAS THE NUMBER IGCNVT: PUSH PP,I16 ;SAVE THE FILE-TABLE POINTER LDB AC3,[POINT 2,AC1,11] ;PICKUP THE BYTE SIZE TLZ AC1,007700 ;ZERO THE SIZE FIELD MOVEI AC16,1 ;SETUP PARAMETER WORD PUSHJ PP,@IGTAB1-1(AC3) ;CONVERT AND MOVE IT POP PP,I16 ;RESTORE I16 POPJ PP, ;RETURN IGTAB1: PD9. ;DECIMAL TO EBCDIC PD6. ;DECIMAL TO SIXBIT PD7. ;DECIMAL TO ASCII IGTAB2: @ IGTAB3-1(AC4) ;EBCDIC TO SOMETHING @ IGTAB4-1(AC4) ;SIXBIT TO SOMETHING @ IGTAB5-1(AC4) ;ASCII TO SOMETHING IGTAB3: MOVE. ;EBCDIC TO EBCDIB C.D9D6 ;EBCDIC TO SIXBIT C.D9D7 ;EBCDIC TO ASCII IGTAB4: C.D6D9 ;SIXBIT TO EBCDIC MOVE. ;SIXBIT TO SIXBIT C.D6D7 ;SIXBIT TO ASCII IGTAB5: C.D7D9 ;ASCII TO EBCDIC C.D7D6 ;ASCII TO SIXBIT MOVE. ;ASCII TO ASCII IFE %%RPG,< SUBTTL RERUN-DUMP-CODE ;SCAN FOR AN OPEN RANDOM IO FILE RRDMP: PUSHJ PP,SAVAC. ;SAVE AC'S MOVE AC15,REDMP. ;SAVE THE "FORCE-DUMP" FLAG SETZB AC0,REDMP. ;CLEAR THE "FORCE-DUMP" FLAG SKIPN AC1,RRFLG. ; FLG IS SET IF RERUN CLAUSE WAS USED SKIPN OPNCH. ; ANY CHANNELS AVAILABLE? JUMPE AC1,RRERR5 ; IF NOT - ERROR SKIPN KEYCV. ; ARE WE SORTING? JRST RRDMP7 ; NO PUSHJ PP,RRERR0 ; COMPLAIN TTCALL 3,[ASCIZ / SORT IN PROGRESS. /] JRST RRXIT ; AND EXIT RRDMP7: SKIPN OVRFN. ;IF OVERLAY FILE IS OPEN JRST RRDMP6 ; PUSHJ PP,RRERR0 ; ABORT -- CHANNEL 1 IS IN USE TTCALL 3,[ASCIZ/ OVERLAY/] JRST RRDMP9 ; RRDMP6: CALLI AC0,51 ;SYSPHY UUO ;XIT IF LEVEL C JRST RSTAC1 ;EXIT HRRZ AC16,FILES. ;POINT TO FIRST FILE TABLE SKIPA RRDMP1: HRRZ AC16,F.RNFT(I16);POINTER TO NEXT FILE-TABLE JUMPE AC16,RRDMP2 ; MOVE AC13,D.DC(I16) ;DEVCHR TO 13 MOVE FLG,F.WFLG(I16) ;FLAGS TO FLG TLC FLG,OPNIN!OPNOUT TLCE FLG,OPNIN!OPNOUT JRST RRDMP5 ; RRDMP0: PUSHJ PP,RRERR0 ;"DUMP ABORTED" TTCALL 3,[ASCIZ / IO/] JRST RRDMP9 ;EXIT, NO DUMP ;SCAN FOR OPEN OUTPUT FILES RRDMP2: HRRZ AC16,FILES. ;FIRST FILE-TABLE SKIPA RRDMP3: HRRZ AC16,F.RNFT(I16);NEXT FILE-TABLE JUMPE AC16,RRDIT ;GO DUMP IT MOVE FLG,F.WFLG(I16) ;FLAGS TLNN FLG,OPNIN!OPNOUT ;SKIP IF FILE IS OPEN JRST RRDMP4 ;ELSE CONT MOVE AC1,F.WDNM(I16) ;DEVICE POINTER MOVE AC1,(AC1) ;6BIT DEVICE NAME MOVEM AC1,D.RD(I16) ;SAVE IT FOR RERUN RRDMP4: TLNN FLG,OPNOUT ;SKIP IF OPEN FOR OUTPUT JRST RRDMP3 ;LOOP MOVE AC13,D.DC(I16) ;DEVCHR TLC AC13,300000 ;[321];IF IT'S A DSK AND A CARD READER TLCE AC13,300000 ;[321]; IT'S THE NULL DEVICE - SO SKIP TLNN AC13,200020 ;SKIP IF DSK OR MTA JRST RRDMP3 ; PUSHJ PP,SETCN. ;SET CHAN NUMBER TLNN FLG,OPNIO!RANFIL ;SKIP IF DSK DUMP MODE JRST RRBUF ;DSK/MTA BUFFERED MODE ;DSK DUMP MODE PUSHJ PP,RRCLE ;CLOSE, LOOKUP, ENTER SEQUENCE MOVE AC1,D.CBN(I16) ;NEXT BLOCK XCT USETI. ; JRST RRDMP3 ;CONT LOOP RRDMP5: TLNN FLG,OPNIN!OPNOUT JRST RRDMP1 ;THIS FILE IS NOT OPEN = CONT TLC AC13,300000 ;[321]; TLCN AC13,300000 ;[321];NULL DEVICE JRST RRDMP1 ;[321];YES -- GO ON SKIPE F.WSMU(I16) ; ENQ'ING? JRST [PUSHJ PP,RRERR0; "DUMP ABORTED" TTCALL 3,[ASCIZ/ SIMULTANEOUS UPDATE/] JRST RRDMP9] ; "FILE IS OPEN" TLNE FLG,IDXFIL ;ISAM FILE? JRST RRDMP8 ;YES TLNN AC13,140700 ;CDR, CDP, PTP, PTR, DTA? JRST RRDMP1 ;NO, CONT SCAN RRDMP8: PUSHJ PP,RRERR0 ;DUMP ABORTED TLNE FLG,IDXFIL ;INDEX-SEQ-ACCESS MODE? TTCALL 3,[ASCIZ / ISAM/] TLNE AC13,100000 ;CARDS? TTCALL 3,[ASCIZ / CARD/] TLNE AC13,40000 ;LINE-PRINTER? TTCALL 3,[ASCIZ / LPT/] TLNE AC13,600 ;PAPER TAPE? TTCALL 3,[ASCIZ / PAPER-TAPE/] TLNE AC13,100 ; TTCALL 3,[ASCIZ / DEC-TAPE/] RRDMP9: TTCALL 3,[ASCIZ / FILE IS OPEN. /] JRST RRXIT ;EXIT NO DUMP ;CLOSE LOOKUP ENTER ROUTINE RRCLE: XCT UCLOS. ;CLOSE, ENSURES FILES CURRENT STATE IS PRESERVED PUSHJ PP,WRTWAI ;CHECK FOR ERRORS RRCLE1: PUSHJ PP,OPNLID ;SET UP LOOKUP BLOCK XCT ULKUP. ;LOOKUP JRST LOOKER ;ERROR TLNE AC13,100 ;SKIP IF NOT DTA POPJ PP, ; RRCLE2: PUSHJ PP,OPNEID ;ENTER BLK XCT UENTR. ;ENTER JRST ENTRER ;ERROR POPJ PP, ; LOOKER: PUSHJ PP,LUPERR ;ERROR MESSAGE JRST RRCLE1 ;TRY AGAIN ENTRER: PUSHJ PP,ENRERR ; JRST RRCLE2 ; ;BUFFERED MODE RRBUF: PUSH PP,D.OBC(I16) ;OUTPUT PUSH PP,D.OBB(I16) ;BUFFER PUSH PP,D.OBH(I16) ;HEADER HRR AC1,D.OBH(I16) ;CURRENT BUFFER'S ADR ADDI AC1,1 ;MAKE BYTPTR INDICATE EMPTY BUFFER HRRM AC1,D.OBB(I16) ;HDR BYTE-POINTER PUSHJ PP,RRCLE ;CLOSE, LOOKUP, ENTER TLNE AC13,20 ;MTA? JRST RRBUF5 ;YES POP PP,D.OBH(I16) ;OUTPUT POP PP,D.OBB(I16) ;BUFFER POP PP,D.OBC(I16) ;HEADER MOVE AC1,D.OE(I16) ;NUMBER OF OUTPUTS AOJA AC1,RRBUF2 ;DSK RRBUF2: XCT USETO. ; JRST RRDMP3 ; ;MAG-TAPE, IF CLOSE GENERATED AN EOF BACK OVER IT RRBUF5: XCT UOUT. ;DUMMY OUTPUT, ??? IT WORKS XCT MBSPR. ;BACKUP ONE RECORD (EOF) XCT MWAIT. ;WAIT FOR TAPE MOTION TO STOP XCT UGETS. ;GET STATUS INTO AC2 TRNN AC2,24000 ;SKIP IF EOF OR BOT XCT MADVR. ;NOT AN EOF, SPACE OVER IT ;NOW MOVE WHAT WAS THE CURRENT BUFFER TO THE CURRENT CURRENT BUFFER HRR AC2,D.OBH(I16) ;TO - 1 HRL AC2,(PP) ;FROM - 1 HLRZ AC1,(AC2) ;BUF SIZE, MAY CHANGE FROM FILE TO FILE ADDI AC1,(AC2) ;UNTIL AOBJP AC2,.+1 ;FROM,,TO BLT AC2,(AC1) ;MOVIT ;UPDATE THE HEADER POP PP,AC1 ;FRST HDR WRD POP PP,AC2 ;BYTE-PTR SUBI AC2,(AC1) ;#OF WRDS IN BFR HRRZ AC1,D.OBH(I16) ;CRNT BFRS ADR ADD AC2,AC1 ;NEW BYTE-PTR MOVEM AC2,D.OBB(I16) ;SAVIT POP PP,D.OBC(I16) ;OLD BYTE-CNT JRST RRDMP3 ;NEXT RC==1 ;RERUN IO CHANNEL ;DUMP THE LOWSEG RRDIT: MOVEI AC5,RC ; GET DEFAULT CHANNEL SKIPN RRFLG. ; USE IT IF RERUN CLAUSE WAS USED PUSHJ PP,GCHAN ; ELSE GET ON FROM THE POOL MOVEI AC3,(SIXBIT /DSK/) HRLZM AC3,UOBLK.+1 ;DEVICE NAME MOVEI AC3,17 ;DUMP MODE HRRZM AC3,UOBLK. ; SETZM UOBLK.+2 ;ELSE LAST BUF-HDR IS OVER-WRITTEN MOVE AC6,[OPEN UOBLK.] DPB AC5,[POINT 4,AC6,12] XCT AC6 JRST RRERR ;ERROR HRROI AC3,3 ;JBTPRG CALLI AC3,41 ;PROGRAM NAME TO AC3 JRST RRERR3 ;ERROR RET ;HRLZI AC3,(SIXBIT /PKC/) MOVEM AC3,UEBLK. ;LOW-SEG NAME HRLZI AC3,(SIXBIT /CKP/) HLLZM AC3,UEBLK.+1 ;EXTENSION SETZM UEBLK.+2 SETZM UEBLK.+3 MOVE AC6,[ENTER UEBLK.] DPB AC5,[POINT 4,AC6,12] XCT AC6 JRST RRERR1 ;ERROR PUSH PP,.JBFF ; SAVE .JBFF MOVS AC1,HLOVL. ; IF THERE IS AN OVERLAY AREA GET ADDI AC1,1 ; ADR OF FIRST FREE LOC FOLLOWING IT CAIE AC1,1 ; SKIP IF NO LINK TYPE OVERLAY HRRZM AC1,.JBFF ; USE THIS AREA FOR JOBDATA STORAGE HRRZ AC0,.JBFF ; ADDI AC0,.JBDA ; CAMGE AC0,.JBREL ;SKIP IF NEXT BLT VIOLATES MEMORY JRST RRDIT3 ; CALLI AC0,11 ;EXPAND CORE JRST RRERR4 ;ERROR RET RRDIT3: MOVE AC0,FILES. ; HRL AC0,.JBFF ;FRST FREE MOVEM AC0,TEMP. ;FIRST FILE TABLE MOVEM PP,TEMP.1 ;PP POINTER HRLI AC10,TEMP. ;POINTER TO FILES. AND PP HRR AC10,.JBREL ;LENGTH FOR IOWD HRRZ AC1,.JBFF ; MOVEM AC10,(AC1) ;INTO FIRST FREE LOC HRROI AC1,-1(AC1) ;IOWD SETZ AC2, ;TERMINATOR MOVE AC6,[OUT AC1] ;FIRST RECORD ;TEMP.,,(.JBREL) DPB AC5,[POINT 4,AC6,12] XCT AC6 SKIPA JRST RRERR2 ;OUTPUT ERROR HRRZ AC1,.JBFF ;SAVE JOBDATA AREA MOVEI AC3,.JBDA(AC1) ;UNTIL BLT AC1,(AC3) ; STARTING AT .JBFF MOVNI AC1,-140(AC10) ;IOWD FOR SECOND RECORD HRL AC1,AC1 ;ALL OF LOW-SEG HRRI AC1,.JBDA-1 ; BUT JOB-DATA AREA MOVE AC6,[OUT AC1] ;SECOND RECORD DPB AC5,[POINT 4,AC6,12] XCT AC6 SKIPA JRST RRERR2 ;OUTPUT ERROR POP PP,.JBFF ; RESTORE THE STACK AND JOBFF MOVE AC6,[CLOSE ] DPB AC5,[POINT 4,AC6,12] XCT AC6 TTCALL 3,[ASCIZ /DUMP COMPLETED. /] RRXIT: AOSN AC15 ;SKIP IF NOT FORCED CALLI 1,12 ;EXIT IF IT WAS FORCED JRST RSTAC1 ;RESTORE ACS AND POPJ RRERR0: TTCALL 3,[ASCIZ /DUMP ABORTED /] POPJ PP, ; ;OPEN FAILED RRERR: PUSHJ PP,RRERR0 ; TTCALL 3,[ASCIZ /OPEN FAILED. /] JRST RRXIT ; ;ENTER FAILED RRERR1: PUSHJ PP,RRERR0 ; TTCALL 3,[ASCIZ /ENTER FAILED,/] HRRZ AC2,UEBLK.+1 ;THE ERROR BITS TRZ AC2,777740 ; NOTHING ELSE CAIL AC2,LEMLEN ;LEGAL MESSAGE? HRRI AC2,LEMLEN ;NO CAIN AC2,0 ; HRRI AC2,LEMLEN+1 ;ILL-FIL-MAME TTCALL 3,@LEMESS(AC2) ;COMPLAIN JRST RRERRX ;ERROR EXIT ;OUTPUT FAILED RRERR2: POP PP,.JBFF ; RESTORE THE STACK AND JOBFF PUSHJ PP,RRERR0 ; TTCALL 3,[ASCIZ /OUTPUT ERROR, /] GETSTS RC,AC2 ;ERROR STATUS PUSHJ PP,IOERM1 ;COMPLAIN RRERRX: TTCALL 3,[ASCIZ / /] CLOSE RC,40 ;CLOSE, BUT DONT SUPERCEDE JRST RSTAC1 ;EXIT ;CAINT FIND THE PROGRAM NAME RRERR3: PUSHJ PP,RRERR0 ; TTCALL 3,[ASCIZ /CANNOT FIND PROGRAM NAME/] JRST RRERRX ; ;CORE UUO FAILED RRERR4: POP PP,.JBFF ; RESTORE THE STACK AND JOBFF PUSHJ PP,RRERR0 TTCALL 3,[ASCIZ /CORE UUO FAILED/] JRST RRERRX ; ;NO IO CHANNELS FOR THE DUMP FILE RRERR5: PUSHJ PP,RRERR0 TTCALL 3,[ASCIZ /NO CHANNELS AVAILABLE/] JRST RRERRX > ; END OF IFE %%RPG (STARTED AT RRDMP) ;POINTERS AND THINGS PAT: BLOCK 10 ;PATCH AREA WOPRS.: POINT 12,AC15,11 ;RECORD SIZE IN CHARS WOPCN: POINT 3,AC15,17 ;LPT CHANNEL NUMBER STDLBP: POINT 6,STDLB. ;STANDARD LABEL POINTER DOPFS.: POINT 10,(I16),17 ;DISPLAY OPERAND FIELD-SIZE OPNCBP: POINT 1,OPNCH.,0 ;[342]POINTER TO CHAN. STATUS ;CONSTANTS FOR ISAM IFN ISAM,< KY.TP: POINT 18,1+KEYDES(AC1),17 ; KEY TYPE KY.MD: POINT 2,1+KEYDES(AC1),19 ; MODE OF FILE KY.TYP: POINT 18,KEYDES(I12),17 ; KEY TYPE KY.MOD: POINT 2,KEYDES(I12),19 ; MODE OF FILE KY.SGN: POINT 1,KEYDES(I12),20 ; ONE IF SIGNED KY.SIZ: POINT 12,KEYDES(I12),35 ; KEY SIZE > ;DEVICE TABLE CONSTANTS D.LBN=-32 ; LAST BLOCK OF SEQIO FILE D.FCPL=-31 ; FREE CRARS PER LOG-BLOCK D.TCPL=-30 ; TOTAL CHARS PER LOG-BLOCK D.WCNV=-27 ; THE WRITE CONVERSION INSTRUCTION D.RCNV=-26 ; THE READ CONVERSION INSTRUCTION D.BPW=-25 ;BYTES PER WORD D.RD=-24 ;RERUN DEVICE NAME IN SIXBIT D.F1=-23 ;0-17 FLG1 D.IBL=-23 ; [377] 18-35 ISAM SAVE AREA FOR SHARED BUFFER D.IE=-22 ;# OF INPUTS EXECUTED D.OE=-21 ;# OF OUTPUTS EXECUTED D.LRS=-20 ;18-35 LABEL RECORD SIZE D.BL=-20 ;0-17 BUFFER LOCATION D.RFLG=-17 ; 18-35 FLAGS, SASCII=1 D.HF=-17 ;BIT-17 HUF FLAG D.LF=-17 ;BIT-16 LOCK FLAG D.CN=-17 ;12-15 IO CHANNEL NUMBER D.RN=-17 ;0-11 MAGTAPE REEL NUMBER D.CBN=-16 ;CURRENT PHYSCIAL BLOCK NUMBER D.BPL=-15 ;# OF BUFFERS PER LOGICAL BLOCK D.BCL=-14 ;# OF BUFFERS TO FILL CURRENT LOGICAL BLOCK D.RCL=-13 ;# OF RECORDS TO FILL CURRENT LOGICAL BLOCK D.ICD=-12 ;IOWD FOR CURRENT DEVICE D.OBH=-11 ;OUTPUT BUFFER HEADER D.OBB=-10 ;OUTPUT BUFFER BYTE POINTER D.OBC=-7 ;OUTPUT BUFFER BYTE COUNT D.IBH=-6 ;INPUT BUFFER HEADER D.IBB=-5 ;INPUT BUFFER BYTE POINTER D.IBC=-4 ;INPUT BUFFER BYTE COUNT D.RRD=-3 ;# OF RECORDS TO A RERUN DUMP D.RP=-2 ;# OF RECORDS PROCESSED D.DC=-1 ;DEVICE CHARACTERISTICS D.OPT=-1 ;-1 IF A "NOT-PRESENT" OPTIONAL ISAM FILE DTCN.: POINT 4,D.CN(I16),15 ; CHANNEL NUMBER DTIBS.: POINT 6,D.IBB(I16),11 ; INPUT HEADER BYTE SIZE DTOBS.: POINT 6,D.OBB(I16),11 ; OUTPUT HEADER BYTE SIZE DTRN.: POINT 12,D.RN(I16),11 ; MTA REEL NUMBER REPEAT 0,< ;FILE TABLE CONSTANTS F.WFNM==0 ; 30 CHARACTER PROGRAM NAME - SIXBIT F.WCVR==5 ; COMPILER'S VERSION NUMBER F.WBLC==5 ; BUFFER LOCATION IS ASSIGNED - BUFLOC F.WSDF==5 ; SORT-DESCRIPTION FILE FLAG - SRTFIL F.WNOD==5 ; NUMBER OF DEVICES ASSIGNED TO FILE F.WDNM==5 ; ADR OF FIRST DEVICE NAME - SIXBIT F.WNFL==6 ; NUMBER OF FILE LIMIT CLAUSES F.WPMT==6 ; FILE POSITION ON MAG-TAPE F.RNFT==6 ; LINK TO NEXT FILE TABLE F.WNAB==7 ; NUMBER OF ALTERNATE BUFFERS F.WMRS==7 ; MAXIMUM RECORD SIZE IN CHARS F.RRRC==7 ; NUMBER OF RECORDS BETWEEN RERUN DUMPS F.WFLG==10 ; FLAGS,,ADR OF RECORD AREA F.LNLS==11 ; SIZE OF NON-STANDARD LABEL F.RFSD==11 ; LINK TO FILE-TABLE THAT SHARES DEVICE F.WBKF==12 ; THE BLOCKING FACTOR F.RACK==12 ; ADR OF ACTUAL KEY TABLE F.WVID==13 ; BYTE POINTER TO VALUE OF ID F.WVDW==14 ; BYTE POINTER TO VALUE OF DATE WRITTEN F.LSBA==15 ; LINK TO FILE-TABLE THAT SHARES BUFFER AREA F.REUP==15 ; ADR OF ERROR USE PROCEDURE F.LBBR==16 ; BEFORE-BEGINNING-REEL USE PROCEDURE F.RBBF==16 ; BEFORE-BEGINNING-FILE USE PROCEDURE F.LABR==17 ; AFTER-BEGINNING-REEL USE PROCEDURE F.RABF==17 ; AFTER-BEGINNING-FILE USE PROCEDURE F.LBER==20 ; BEFORE-ENDING-REEL USE PROCEDURE F.RBEF==20 ; BEFORE-ENDING-FILE USE PROCEDURE F.LAER==21 ; AFTER-ENDING-REEL USE PROCEDURE F.RAEF==21 ; AFTER-ENDING-FILE USE PROCEDURE F.WDNS==22 ; MAG-TAPE DENSITY F.WDIO==22 ; DEFERRED ISAM OUTPUT FLAG F.WOUP==22 ; OPEN USE-PROCEDURE WHEN ENTER FAILS F.RPPN==22 ; ADR OF USER-NUMBER F.WBSK==23 ; BYTE POINTER TO SYMBOLIC KEY F.WBRK==24 ; BYTE POINTER TO RECORD KEY F.WIKD==25 ; ISAM KEY DESCRIPTION WORD F.WSMU==26 ; 0-8= OWNER ACCESS 9-17= OTHERS ACCESS ; 18-35= RETAINED REC COUNT F.WPFS==27 ; POINTER TO FILE-STATUS DATA-ITEM F.WPEN==30 ; POINTER TO ERROR-NUMBER DATA-ITEM F.WPAC==31 ; POINTER TO ACTION-CODE DATA-ITEM F.WPID==32 ; POINTER TO VALUE-OF-ID DATA-ITEM F.WPBN==33 ; POINTER TO BLOCK-NUMBER DATA-ITEM F.WPRN==34 ; POINTER TO RECORD-NUMBER DATA-ITEM F.WPFN==35 ; POINTER TO FILE-NAME DATA-ITEM F.WPFT==36 ; POINTER TO FILE-TABLE ADR DATA-ITEM F.WLHL==37 ; POINTER TO LOW,,HIGH FILE LIMIT > ;END OF REPEAT 0 F.BCVR: F%BCVR ; COMPILER'S VERSION NUMBER F.BBLC: F%BBLC ; BUFFER LOCATION IS ASSIGNED - BUFLOC F.BSDF: F%BSDF ; SORT-DESCRIPTION FILE FLAG - SRTFIL F.BNOD: F%BNOD ; NUMBER OF DEVICES ASSIGNED TO FILE F.BNFL: F%BNFL ; NUMBER OF FILE LIMIT CLAUSES F.BPMT: F%BPMT ; FILE POSITION ON MAG-TAPE F.BNAB: F%BNAB ; NUMBER OF ALTERNATE BUFFERS F.BMRS: F%BMRS ; MAXIMUM RECORD SIZE IN CHARS F.BBKF: F%BBKF ; THE BLOCKING FACTOR F.BPAR: F%BPAR ; MAG-TAPE PARITY F.BDNS: F%BDNS ; MAG-TAPE DENSITY F.BDIO: F%BDIO ; DEFERRED ISAM OUTPUT FLAG F.BOUP: F%BOUP ; OPEN USE-PROCEDURE WHEN ENTER FAILS ;THE TABLE IS USED TO CONVERT FROM LOWER CASE TO UPPER CASE ;TO SIXBIT ETC. END-OF-LINE (EOL) CHARS ARE NEGATIVE. ; SIXBIT ASCII ;CHAR CHTAB: XWD 0, 0 ; XWD 0, 1 ; XWD 0, 2 ; XWD 0, 3 ; XWD 0, 4 ; XWD 0, 5 ; XWD 0, 6 ; XWD 0, 7 ; XWD 0, 10 ; XWD 0, 11 ;HT XWD 400000, 400012 ;LF XWD 400000, 400013 ;VT XWD 400000, 400014 ;FF XWD 400000, 400015 ;CR XWD 0, 16 ; XWD 0, 17 ; XWD 400000, 400020 ;PC XWD 400000, 400021 ;PC XWD 400000, 400022 ;PC XWD 400000, 400023 ;PC XWD 400000, 400024 ;PC XWD 0, 25 ; XWD 0, 26 ; XWD 0, 27 ; XWD 0, 30 ; XWD 0, 31 ; XWD 400000, 400032 ;TTY EOF XWD 0, 33 ;ALT-MODE XWD 0, 34 ; XWD 0, 35 ; XWD 0, 36 ; XWD 0, 37 ; XWD 0, 40 ;SPACE XWD 1, 41 ;! XWD 2, 42 ;" XWD 3, 43 ;# XWD 4, 44 ;$ XWD 5, 45 ;% XWD 6, 46 ;& XWD 7, 47 ;' XWD 10, 50 ;( XWD 11, 51 ;) XWD 12, 52 ;* XWD 13, 53 ;+ XWD 14, 54 ;, XWD 15, 55 ;- XWD 16, 56 ;. XWD 17, 57 ;/ XWD 20, 60 ;0 XWD 21, 61 ;1 XWD 22, 62 ;2 XWD 23, 63 ;3 XWD 24, 64 ;4 XWD 25, 65 ;5 XWD 26, 66 ;6 XWD 27, 67 ;7 XWD 30, 70 ;8 XWD 31, 71 ;9 XWD 32, 72 ;: XWD 33, 73 ;; XWD 34, 74 ;< XWD 35, 75 ;= XWD 36, 76 ;> XWD 37, 77 ;? XWD 40, 100 ;@ XWD 41, 101 ;A XWD 42, 102 ;B XWD 43, 103 ;C XWD 44, 104 ;D XWD 45, 105 ;E XWD 46, 106 ;F XWD 47, 107 ;G XWD 50, 110 ;H XWD 51, 111 ;I XWD 52, 112 ;J XWD 53, 113 ;K XWD 54, 114 ;L XWD 55, 115 ;M XWD 56, 116 ;N XWD 57, 117 ;O XWD 60, 120 ;P XWD 61, 121 ;Q XWD 62, 122 ;R XWD 63, 123 ;S XWD 64, 124 ;T XWD 65, 125 ;U XWD 66, 126 ;V XWD 67, 127 ;W XWD 70, 130 ;X XWD 71, 131 ;Y XWD 72, 132 ;Z XWD 73, 133 ;[ XWD 74, 134 ;\ XWD 75, 135 ;] XWD 76, 136 ;^ XWD 77, 137 ;_ XWD 0, 140 ; XWD 41, 141 ;A XWD 42, 142 ;B XWD 43, 143 ;C XWD 44, 144 ;D XWD 45, 145 ;E XWD 46, 146 ;F XWD 47, 147 ;G XWD 50, 150 ;H XWD 51, 151 ;I XWD 52, 152 ;J XWD 53, 153 ;K XWD 54, 154 ;L XWD 55, 155 ;M XWD 56, 156 ;N XWD 57, 157 ;O XWD 60, 160 ;P XWD 61, 161 ;Q XWD 62, 162 ;R XWD 63, 163 ;S XWD 64, 164 ;T XWD 65, 165 ;U XWD 66, 166 ;V XWD 67, 167 ;W XWD 70, 170 ;X XWD 71, 171 ;Y XWD 72, 172 ;Z XWD 20, 173 ; LEFT BRACE TO ZERO [326] XWD 0, 174 ; XWD 32, 175 ;ALT-MODE OR RIGHT BRACE TO : FOR -0 [326] XWD 0, 176 ;ALT-MODE XWD 0, 177 ;RUBOUT / HIGH-VALUE C.END: END