Trailing-Edge
-
PDP-10 Archives
-
BB-H580E-SB_1985
-
cblio.mac
Click cblio.mac to
see without markup as text/plain
There are 21 other files named cblio.mac in the archive. Click here to see a list.
; UPD ID= 3578 on 6/10/81 at 2:36 PM by MAYBERRY
TITLE CBLIO FOR LIBOL V12C
SEARCH COPYRT
SALL
COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1974, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;EDIT HISTORY
;***** V12B *****
;WHO DATE COMMENT
;KWS 11-SEP-84 [1130] Add conversion factor so OPEN I-O will work properly
;JEH 21-MAY-84 [1126] New feature test switch and code to print blank
; ascii text lines
;JEH 10-APR-84 [1115] TOPS-10 system-labeled tapes - 7.02 sets DV.DIR
; bit now, causes wrong path to be followed
;JSM 02-APR-84 [1114] Eliminate extra <CRLF> on Rewrite of ASCII Record
;RLF 22-MAR-84 [1113] Make use procedure works with filename-1 OPEN
;JEH 19-MAR-84 [1112] No <CR> at end of std-ascii tape
;JBB 21-DEC-83 [1105] Put a '?' in front of warning to make it FATAL.
;JBB 20-DEC-83 [1104] Remove SETEOF warning message and set max byte count
;JSM 09-NOV-83 [1103] On Fake Read for SMU Retain on TOPS-10, check for
; EOF Return and don't cause program failure if so.
;JEH 08-NOV-83 [1102] Determine TOPS-20 monitor level and if < 5.0,
; skip all read unrestricted code - not implemented
;JM/RF 25-OCT-83 [1100] SMU with relative file gets race condition,
; record not written to disk but gets
; invalid key error.
;JEH 24-OCT-83 [1077] If dynamic access and REWRITE, update pointers
; so READ NEXT can work
;JBB 22-AUG-83 [1075] Prevent multi-level ISAM file from missing records
; when using START, READ NEXT sequences
;RLF/JM 21-APR-83 [1065] Make FREE RECORD KEY work for SMU after RETAIN NEXT
;JSM 08-APR-83 [1064] GET CHECKPOINTING AND RERUN IN FRONT OF IMPLICIT FREE
; FOR SIMULTANEOUS UPDATE
;JSM 08-APR-83 [1063] IF FILE OPENED FOR SMU DOES NOT HAVE MAX BYTE
; COUNT IN FDB GIVE WARNING MESSAGE
;JEH 07-APR-83 [1062] If program's blocking factor differs from ISAM's
; blocking factor, give error
;SMI 31-MAR-83 [1061] Fix bytesize on open of MAGTAPE with RECORDING MODE
; SIXBIT
;RLF 16-MAR-83 [1057] Set correct value for files status and error number.
;JEH 24-FEB-83 [1055] Extend sixbit w/ logical blk > physical blk fails
; if re-opened at logical block boundary
;JEH 10-FEB-83 [1052] Extend blocked sixbit files correctly
;JEH 25-JAN-83 [1050] Set last blk nbr (D.LBN) for random input file
;SMI 13-SEP-82 [1043] Process end-of-file errors.
;SMI 30-AUG-82 [1042] Pop stack if error on blocked file open.
;RLF 26-JUL-82 [1037] Change error message to "for OUTPUT only".
;RLF 21-JUL-82 [1036] Zero out right half of UOUT. after checkpointing
;RLF 20-JUL-82 [1035] READ NEXT after DELETE get correct record
;JEH 15-JUL-82 [1034] Zero out end of data block after deleting a record
;SMI 06-JUL-82 [1033] Do abort close on labeled tapes during fatal error
; processing
;LEM 07-JUN-82 [1031] FIX RECORDS MISSING WHEN READING AN ASCII FILE SEQUENTIALLY
;RJD 08-JUN-82 [1030] Check for use of ersatz device when opening a SMU
; file from a SFD
;JEH 04-JUN-82 [1027] Zero buffer address to force FAKE READ to get block
; number for a RETAIN of a LOW-VALUE key
;JEH 01-JUN-82 [1026] APPEND FILOP. doesn't reset buffer ptr if file ended
; on a block boundary
;RJD 14-MAY-82 [1024] USE COUNT ON LAST BLOCK TO CHECK FOR END OF RECORD
;RLF 07-MAY-82 [1023] UPDATE POINTER FOR READ AFTER REWRITE
;LEM 27-MAR-82 [1021] make READ NEXT return correct record as ANSI standard states
;RJD 17-MAR-82 [1016] TEST FOR ISAM FILES CHECKPOINTING EVERY n RECORDS
;LEM 02-MAR-82 [1015] ALLOW COMPT. UUO TO RETURN CORRECT FILE STATUS ERROR NO
;LEM 16-FEB-82 [1014] ALLOW ASCII FILE ON MTA TO HAVE EXTRA <CR>
;WTK 20-JAN-82 [1013] SEQ REL ASCII FILE: NULL REC IN BLK CAUSES
; REST OF BLOCK TO BE SKIPPED
;JSM 22-OCT-81 [1011] FIX CLOSE WITH DELETE FOR NON-SMU OUTPUT
;JEH/JM 13-OCT-81 [1010] LOOKUP ERROR MSG IS INCORRECT
;DMN 09-OCT-81 [1007] TURN ON TOPS2X SWITCH FOR TOPS-20 VERSION 5
;WTK/JM 6-OCT-81 [1006] CAN'T REWRITE A NON-NULL EBCDIC RECORD
;JEH/JM 6-OCT-81 [1005] SMU CLOSE W/DELETE FAILS UNDER TOPS-10 7.01
;DMN/JM 3-SEP-81 [1003] FIE INCORRECTLY CLOSED WITH DELETE
;HAM/JM 9-SEP-81 [1001] RESET ISAM INDEX AND DATA POINTERS AFTER DEL/REWRITE
;
SUBTTL PICK UP UNIVERSALS AND SET UP JOBDAT.
SEARCH LBLPRM,COBVER ;DEFINE PARAMETERS.
%%LBLP==:%%LBLP
SEARCH COMUNI
%%COMU==:%%COMU
INFIX%
ISAM==:ISAM
EBCMP.==:EBCMP.
SEARCH FTDEFS ;FILE-TABLE DEFINITIONS
%%FTDF==:%%FTDF
IFN LSTATS,<
SEARCH METUNV
>
SEARCH UUOSYM
IFN TOPS20,< SEARCH MONSYM, MACSYM>
IFE TOPS20,< SEARCH MACTEN>
IFN TOPS20,<OF%RDU==1B23 ;[667] READ UNRESTRICTED>
IFE TOPS20,<UU.RRC==1B6 ;UNTIL 7.01 IS RELEASED>
.COPYRIGHT ;Put standard copyright statement in REL file
LOC 124 ;.JBREN
EXP RENDP ;TO FORCE A DUMP.
LOC 137 ;.JBVER
EXP LBLVER
IFNDEF SIRUS,<SIRUS==0> ; [403] SPECIAL CODE FOR SIRUS
IFNDEF SUPPTB,<SUPPTB==0> ; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES.
IFNDEF ISTKS,<ISTKS==0> ;TYPE # OF IN'S AND OUT'S
SUPP==SIRUS!SUPPTB ; [403] SUPPRESS TRALING BLANKS FOR SIRUS
IFNDEF EBCMP.,<EBCMP.==0>
HISEG
.COPYRIGHT ;Put COPYRIGHT statement in .REL file.
SALL
MLON
SUBTTL CONSTANTS
;AC ASSIGNMENTS
FLG=7
C=11
I12=12
LVL=13
FLG1=14
I16=16
BUFLOC==4000 ;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF F.WDNM(I16)
; FLAG BITS IN D.RFLG RIGHT HALF
SASCII==1 ; REQUEST FOR STANDARD ASCII, IN D.RFLG
RDDREV==2 ; OPEN REVERSED ACTIVE
FSTIDX==4 ;[605] FIRST ISAM READ IS SEQ, FOR IBS SCAN CODE
RDRVBK==10 ; READ REV BLOCKED GTR 10
RDLAST==20 ; = 1 IF LAST ISAM IO OPERATION WAS READ
SAVNXT==40 ; = 1 IF LAST I-O WAS DELETE OR REWRITE (NXT REC SAVED)
EXTOPN==100 ; =1 IF FILE WAS OPENED EXTEND
AFTADV==200 ; =1 IF LAST WRITE WAS AFTER-ADVANCING ("CR" BEFORE BFR-ADV)
;RPW BIT FOR TERMINATE HAS BEEN DONE ==400
INDASC==1000 ; =1 IF MTA STD ASCII NEEDS INDUSTRY-COMP MODE (TM03 TROUBLE)
; DON'T CLEAR AT CLOSE TIME
RF1CLR==376 ; BITS TO CLEAR AT CLOSE TIME
;RMSIO BITS: (DEFINED IN LBLPRM IN THE FUTURE)
LF%INP==1B33 ;FILE IS OPEN FOR INPUT
LF%OUT==1B34 ;FILE IS OPEN FOR OUTPUT
; USE PROCEDURE TABLE OFFSET VALUES
USESEC==5 ; USE PROCEDURE TABLE SECTION SIZE
EXTUSE==^D15 ; OFFSET TO EXTEND ERROR USE PRODECURE
;VALUES FOR FILE STATUS CODE
FSNRCF==23 ;NO RECORD FOUND ON READ,REWRITE,DELETE
;VALUES FOR FILE ACCESS MODE
%FAM.S==0 ;SEQUENTIAL
%FAM.R==1 ;RANDOM
%FAM.D==2 ;DYNAMIC
;[566] LOOKUP BLK OFFSETS
LKPSIZ==3 ;[566] OFFSET TO FILE SIZE RETURNED IN LOOKUP BLOCK
;MTOPR CONSTANTS
MTOSIZ==15 ;SIZE OF TEMP TABLE USED BY .MORLI MTOPR FUNCTION
;COMPT. UUO FUNCTIONS
IFN TOPS20,<
CMP.1==1 ;SIMULATE LOOKUP OR ENTER
CMP.3==3 ;TRANSLATE PPN TO STRING
CMP.10==10 ;GET JFN FROM CHANNEL NUMBER
>
;MTA CONSTANTS
IFNDEF .TFKD2,<.TFKD2==6> ; [645] DX20 CONTROLLER CODE FOR TAPOP.
MXTPRC==20000 ;MAX. MTA REC SIZE (IN WORDS)
MINMTA==4 ;MINIMUM MTA OUTPUT SIZE
; OFFSETS INTO LABEL INFORMATION BLOCK
LABTYP==1 ; TO LABEL TYP
IFN TOPS20,<
LABFOR==4 ; LABEL FORMAT CHARACTER
>
IFE TOPS20,<
LABFOR==.TPREC ; LABEL FORMAT CODE
LABFMS==0 ; FORMS CONTROL HERE
>
; BIT DEFINITIONS FOR LABELED TAPE FORMAT
FRMATU==10 ; "U" FORMAT
FRMATS==4 ; "S" FORMAT
FRMATD==2 ; "D" FORMAT
FRMATF==1 ; "F" FORMAT
;DEF SYMBOLS FOR DISK BLOCK SIZE
DSKBSZ==200 ;SIZE OF A DISK BLOCK (BUFFER)
DSKMSK==177 ;MASK FOR BITS TO RIGHT OF DSKBSZ
DFLTBF==2 ; DEFAULT NUMBER OF SEQ (RING) BUFFERS
BYTCTW==12 ;BYTE COUNT WORD IN FILE'S FDB
;CONSTANTS FOR CONSTRUCTION OF ERROR NUMBERS
E.VOPE==^D100000000 ;COBOL VERB OPEN
E.VCLO==^D200000000 ; CLOSE
E.VWRI==^D300000000 ; WRITE
E.VREW==^D400000000 ; REWRITE
E.VDEL==^D500000000 ; DELETE
E.VREA==^D600000000 ; READ
E.VRET==^D700000000 ; RETAIN
E.VEXT==^D800000000 ; OPEN EXTEND
E.VSTR==^D900000000 ; START
E.MINP==^D1000000 ;MONITOR INPUT ERROR
E.MOUT==^D2000000 ; OUTPUT
E.MLOO==^D3000000 ; LOOKUP
E.MENT==^D4000000 ; ENTER
E.MREN==^D5000000 ; RENAME
E.MOPE==^D6000000 ; OPEN
E.MFOP==^D7000000 ; FILOP
E.MTAP==^D8000000 ; TAPOP.
E.FIDX==^D10000 ;ISAM INDEX FILE
E.FIDA==^D20000 ;ISAM DATA FILE
E.FSEQ==^D30000 ;SEQUENTIAL FILE
E.FRAN==^D40000 ;RANDOM FILE
E.FMTA==^D50000 ; LABEL PROCESSING ERROR (MTA FILE)
E.BSTS==^D1000 ;ISAM STATISTICS BLOCK
E.BSAT==^D2000 ;ISAM SAT BLOCK
E.BIDX==^D3000 ;ISAM INDEX BLOCK
E.BDAT==^D4000 ;ISAM DATA BLOCK
;FLAGS IN LEFT SIDE OF "FLG" & F.WFLG(I16) AFTER RESET.
; **WARNING** DO NOT DISTURB DDM??? OR CDM???
DDMASC==400000 ;DEVICE DATA MODE IS ASCII
DDMSIX==200000 ;DEVICE DATA MODE IS SIXBIT
DDMEBC==100000 ;DEVICE DATA MODE IS EBCDIC
DDMBIN==40000 ;DEVICE DATA MODE IS BINARY
OPNIN==20000 ;FILE IS OPEN FOR INPUT
OPNOUT==10000 ;FILE IS OPEN FOR OUTPUT
OPNIO==30000 ;[622] FILE IS OPEN FOR I-O
IOFIL==4000 ;[622] FILE IS AN INPUT/OUTPUT FILE
ATEND==2000 ;AN "EOF" WAS SEEN
CONNEC==1000 ;DEVICE & CORE DATA MODES DIFFER
NOTPRS==400 ;OPTIONAL FILE NOT PRESENT
RRUNER==200 ;RERUN DUMP AT END-OF-REEL
RRUNRC==100 ;RERUN DUMP VIA RECORD-COUNT
CDMASC==40 ;CORE DATA MODE IS ASCII
CDMSIX==20 ;CORE DATA MODE IS SIXBIT
CDMEBC==10 ;CORE DATA MODE IS EBCDIC
IDXFIL==4 ;ACCESS MODE IS INDEX-SEQUENTIAL
SEQFIL==2 ;ACCESS MODE IS SEQUENTIAL
RANFIL==1 ;ACCESS MODE IS RANDOM
;FLAGS IN LEFT SIDE OF FLG1 & D.F1(I16) AFTER RESET.
VLREBC==400000 ;VARIABLE LENGTH EBCDIC RECORDS
FILOPT==200000 ;FILE IS OPTIONAL
NONSTD==100000 ;LABELS ARE NON-STANDARD
STNDRD==40000 ;LABELS ARE STANDARD
MSTNDR==20000 ;STANDARD BUT MONITOR DOES LABEL PROCESSING
MTNOLB==10000 ;MOUNTR HANDLING LABELS,BUT NO LABELING
IFN TOPS20,<
F1CLR==7777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME
>
IFE TOPS20,<
F1CLR==37777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME
>
; BITS IN LEFT HALF OF AC15 DURING WADV.
WDVADR==40 ; BIT18-35 IS THE ADDRESS OF THE ADVANCING COUNT
WDVBFR==20 ; =1 IF BEFORE ADVANCING
WDVPOS==10 ; POSITIONING
FOPERR==2 ; FILOP.UUO FAILED
IFN ISAM,<
KEYSIZ==7777 ; MASK TO GET KEY SIZE FIELD OF ISAM KEY DESCRIPTOR
NOTEST==2000 ;[276] SKIPE THE CONVERSION TEST AT ADJKEY
WSTB==1000 ;WRITE THE STATISTICS BLOCK
IIAB==400 ;INSERTION IS IN AUX BUFFER
TRYAGN==200 ;MAKE A SECOND PASS AT ALC01 OR DON'T AT VNDE
BVN==100 ;BUMP-VERSION-NUMBER SPLITTING A BLOCK
WSB==40 ;WRITE THE SAT BLOCK
BLK2==20 ;REQ FOR 2ND DATA BLOCK
SEQ==10 ;SEQUENTIAL READ
VERR==4 ;VERSION NUMBER DISCREPANCY BTWEEN INDEX LEVELS
WIVK==2 ;WRITE INVALID-KEY
FOPIDX==2 ;FILOP OF NAME.IDX IN PROGRESS
RIVK==1 ;READ, RERIT OR DELET INVALID-KEY
EIX==1 ;ENTER OF NAME.IDX IN PROGRESS
>
SUBTTL EXTERNALS.
ENTRY C.RSET ;MAKE SURE WE GET LOADED.
ENTRY DSPL.6,DSPL.7,DSPLY. ;FOR OVERLAYS
ENTRY METER.
IFN LSTATS,<
;ROUTINES IN METIO
EXTERN MRLSET,MRDMPT,MRDMP
;LOWSEG LOCATIONS
EXTERN MBTIM.,MRTMB.,MRTDBP
EXTERN MRBKO.,MRBLKO,MRBNUM
EXTERN MRFPGT,MRKILL,MROPTT,MRPSTM,MRRERN
>;END IFN LSTATS
EXTERNAL LIBIMP ;CAUSES LIBREL ( LIBOL.LOW) TO BE LOADED FOR /R
; [440] REMOVE EXTERNAL SYMBOL FOR EDIT 414
EXTERNAL IIN,IOUT,ISETI,ISETO,ICLOS,IRELE,IGETS,IWAIT,IRNAM
EXTERNAL MWAIT.,MREW.,MREWU.,MBSPR.,MBSPF.,MADVR.,MADVF.,MWEOF.,MTIND.
EXTERNAL MERAS. ;[470]
EXTERNAL SOBOT.,SZBOT.,SZEOF.,SZEOT.
EXTERNAL UOPEN.,UENTR.,ULKUP.,UOBUF.,UIBUF.,UCLOS.,URELE.,USETI.
EXTERNAL USETO.,UOUT.,UIN.,USETS.,UGETS.,UWAIT.,URNAM.
EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV.,AUTOLB,TMP.BK
EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB.
EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,SEGNO.,AINFO.,OVRBF.,FLDCT.,OVRIX.
EXTERNAL SHRDX. ;[556]
EXTERNAL NOCR.,PRGFLG,TTYOPN,ACSAV0,MXIE,IESAVE,MXBUF,AUXBUF,AUXIOW,AUXBNO,CMDLST,NEWBK1
EXTERNAL NEWBK2,OLDBK,MXBF,DRTAB,LRWA
EXTERNAL FS.ZRO,FS.FS,FS.EN,FS.BN,FS.RN,FS.UPD,FS.IGE,FS.IF,ISETS,FS.IEC
EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6
IFN EBCMP. <
EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9
>
EXTERNAL FRSTIC,LASTIC,PFRST.,UFRST.,ULAST.,IFRST.,ILAST.
EXTERNAL RELEN. ;[332]
EXTERN TODAY.,TODA1.
EXTERNAL RN.PPN, RUN.TM, RN.DEV, RN.NAM ;[333]
EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,COBSW.,SBPSA.
EXTERNAL SU.RBP,SU.CL,SU.WR,SU.RD,SU.DL,SU.RW ;SIMULTANEOUS UPDATE
EXTERN FOP.BK,FOP.IS,FOP.DN,FOP.LB ;SIMULTANEOUS UPDATE
EXTERN SU.T1 ;[1065] SMU, CARRY RRT ENTRY ADDR HERE
EXTERN SU.FRF ;FAKE READ FLAG
EXTERN .JBSA,.JBFF,.JBREL,.JBAPR,.JBTPC,.JBCNI,.JBDA,.JBOPC,.JBREN
IFN ISAM,<INTERN GDPSK> ;[447]SIMULTANEOUS UPDATE
INTERN CHTAB ;[455] SIMULTANEOUS UPDATE
INTERN SEQFIL ;[455] SIMULTANEOUS UPDATE
IFN ANS74,<INTERN F.BFAM, SAVNXT> ;FOR SIM. UPDATE
INTERN FAKER.,IGSS,RANFIL,E.VRET
INTERN C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH.
INTERN OUT6B.,OUTBF.,READ.,RSTAB.,STOPR.,C.STOP,TRAP.,WRITE.,WADV.,WRPW.
INTERN WADVV.,WRITV.
INTERN GOTO.,KILL.,PPOUT.,PPOT4.,SAVAC.,RSTAC.
INTERN KPROG. ;NO UNCONDITIONAL TRANSFER AT END OF PROGRAM
INTERN KDECL. ;NO UNCONDITIONAL TRANSFER AFTER DECLARATIVES
INTERN ILLC. ;RECURSIVE CALL
INTERN SEEK.
EXTERN USEEK.
INTERN C.STRT,RDNXT.
EXTERNAL RET.1,RET.2,RET.3
INTERN DELET.,RERIT.,PURGE.
EXTERNAL HLOVL. ;[346] XWD HIGHEST OVERLAY LOC , LOWEST LOC
IFN ISAM,<EXTERNAL GD6.,GD7.,GD9.,GC3.,PD6.,PD7.,PD9.,PC3.,KEYCV.> ;[370]
IFN ISAM,<INTERN USOBJ,LVTST,LV2SK.,FOPIDX,NNTRY>
EXTERNAL FILES.,USES.,OVRFN.,TRAC1.
EXTERN FUSIA.,FUSOA.,FUSCP. ;[523] FILOP. ARG-BLOCK
INTERN LIBVR.,LIBSW.
IFN LSTATS,< ;EXTERNALIZE LIBOL METERING ROUTINES
INTERN LMETR.,MRACDP
IFN TOPS20,<
INTERN MRTM.S,MRTM.E
>
>
IFN ISAM,<
ADR==0
DEFINE TABADR(N,L) <
N==ADR
ADR==ADR+L
>
TABADR STAHDR,1 ;SIZE OF STATISTICS BLOCK IN SIXBIT BYTES
TABADR DDEVNM,1 ;DATA FILE'S DEVICE NAME
TABADR DFILNM,1 ;DATA FILE'S FILE NAME
TABADR DEXT,1 ;DATA FILE'S EXTENSION
TABADR DCDATE,1 ;DATA FILE'S CREATION DATE
TABADR DADATE,1 ;DATA FILE'S ACCESS DATE
TABADR MXLVL,1 ;NUMBER OF LEVELS IN INDEX FILE
TABADR DBF,1 ;DATA FILE BLOCKING FACTOR
TABADR DMTREC,1 ;NUMBER OF EMPTY RECORDS PER DATA BLOCK
TABADR EPIB,^D20 ;TWO WORDS PER INDEX LEVEL
;FIRST WORD: NUMBER OF ENTRIES PER INDEX BLOCK
;SECOND WORD: NUMBER OF EMPTY ENTRIES
TABADR DMXBLK,1 ;TOTAL BLOCKS IN DATA FILE
TABADR DMTBLK,1 ;EMPTY BLOCKS IN DATA FILE
TABADR IMXSCT,1 ;TOTAL SECTORS IN INDEX FILE
TABADR IMTSCT,1 ;EMPTY SECTORS IN INDEX FILE
TABADR FMTSCT,1 ;FIRST EMPTY SECTOR IN INDEX FILE
TABADR DMXREC,1 ;MAXIMUM DATA RECORD SIZE IN WORDS
TABADR DBPRK,1 ;BYTE POINTER TO RECORD KEY RELATIVE TO DATA RECORD
TABADR RWRSTA,1 ;NUMBER OF READ, WRITE, REWRITE STATEMENTS SINCE INITIALIZATION
TABADR IOUUOS,1 ;NUMBER OF IN'S AND OUT'S SINCE INITIALIZATION
TABADR SBLOC,1 ;RELATIVE ADR OF FIRST SAT BLOCK
TABADR SBTOT,1 ;TOTAL SAT BLOCKS
TABADR ISPB,1 ;INDEX FILE, SECTORS PER LOGICAL BLOCK
TABADR FILSIZ,1 ;MAXIMUM POSSIBLE NUMBER OF DATA BLOCKS IN FILE
TABADR KEYTYP,0 ;KEY-TYPE IN LEFT HALF
TABADR KEYDES,1 ;DESCRIPTION OF RECORD KEY
TABADR IESIZ,1 ;INDEX ENTRY SIZE IN WORDS
TABADR TOPIBN,1 ;TOP INDEX BLOCK NUMBER
TABADR %DAT,1 ;% OF DATA FILE EMPTY
TABADR %IDX,1 ;% OF INDEX FILE EMPTY
TABADR RECBYT,1 ;SIZE OF LARGEST DATA BLOCK IN BYTES
TABADR MAXSAT,1 ;MAX # OF RECORDS FILE CAN BECOME
TABADR ISAVER,1 ;"ISAM" VERSION NUMBER
TABADR PAGBUF,1 ;I/O SW.. 0 = SECTOR MULTIPLES, NONZERO = PAGES
STABL==ADR ;EQUALS SIZE OF STATISTICS BLOCK
TABADR IOWRD,14+1 ;TABLE OF DUMP MODE IOWD'S FOR EACH INDEX LEVEL
;0 DATA BLOCK
;1-12 INDEX BLOCKS
;13 SAT BLOCK
;14 STATISTICS BLOCK
TABADR OMXLVL,1 ;ORIGINAL MAX NUMBER OF LEVELS IN INDEX FILE
TABADR OKEYDS,1 ;[515] KEY DESCRIPTOR AT RESET TIME
TABADR ORCBYT,1 ;[515] RECORD SIZE AT RESET TIME
TABADR OEPIB,1 ;[515] ENTRIES PER INDEX BLOCK AT RESET TIME
TABADR CORE0,1 ;LAST,,FIRST - CORE AREA CLEARED AT CLOSE
TABADR ICHAN,1 ;CHANNEL NUMBER FOR INDEX DEVICE
TABADR USOBJ,14+1 ;USETI/O OBJECT: DATA, 10 INDEX, SAT & STA
INTERN CNTRY ;[650] MAKE INTERNAL FOR LSU
TABADR CNTRY,14+1 ;CURRENT INDEX ENTRY
TABADR NNTRY,14+1 ;FLAG, CNTRY POINTS TO NEXT ENTRY NOT CURRENT
TABADR LIVE,1 ;(-1) IF DATA NOT YET OUTPUT
TABADR BRISK,1 ;IF -1 OUTPUT ONLY WHEN INPUT IS EMINENT
TABADR CLVL,1 ;CURRENT LEVEL
IFN ANS74,<
TABADR RWDLKY,1 ; NNTRY,,ADDR OF CNTRY KEY COPYS FOR RWT/DEL
TABADR RCARSZ,1 ; ReCord ARea SiZe in words
TABADR RWDLRT,1 ; NNTRY,,Addr of RWDLKY during RETAIN
TABADR SVNXRT,1 ; Saves D.RFLG during RETAIN, when none zero flags that
; RWDLKY points to RETAINS del/rewrt key save area,
; that RWDLKY must be restored at the end of RETAIN
>
TABADR IAKBP,1 ;INDEX ADJUSTED SYMBOLIC KEY BYTE-POINTER
TABADR IAKBP1,1 ;POINTER TO SECOND KEY WORD
TABADR DAKBP,1 ;DATA ADJUSTED SYMBOLIC KEY BP
TABADR DAKBP1,1 ;POINTER TO THE SECOND KEY WORD
TABADR SINC,1 ;BINARY SEARCH INCREMENT
TABADR IBLEN,1 ;INDEX BLOCK LENGTH NOT COUNTING HEADERS
TABADR IKWCNT,1 ;INDEX, NUMBER OF WORDS IN THE KEY
TABADR DKWCNT,1 ;DATA, NUMBER OF WORDS IN KEY
TABADR FWMASK,1 ;MASK FOR FIRST WORD OF DATA KEY
TABADR LWMASK,1 ;MASK FOR LAST WORD OF DATA KEY
TABADR ICMP,1 ;HOLDS ADR OF THE INDEX COMPARE ROUTINE
TABADR DCMP,1 ;HOLDS ADR OF DATA COMPARE OR CONVERT ROUTINE
TABADR DCMP1,1 ;HOLDS ADR OF DATA COMPARE ROUTINE IF KEY IS NUMERIC DISPLAY
TABADR GDX.I,1 ; ADR OF CONVERT ROUTINE -- SK VS INDEX-ENTRY
TABADR GDX.D,1 ; ADR OF CONVERT ROUTINE -- SK VS DATA FILE KEY
TABADR GDPSK,1 ;PARAMETER FOR SYM-KEY CONVERSION
TABADR GDPRK,1 ;PARAMETER FOR REC-KEY CONVERSION
TABADR GDPRK1,1 ;
TABADR GETSET,1 ;DISPATCH LOC: ADJKEY OR GD67 OR FPORFP
TABADR RECBP,1 ;RECORD AREA BYTE-POINTER
TABADR RSBP,1 ;BYTE POINTER TO RECORD SIZE IN BUFFER
TABADR RSBP1,1 ;ANOTHER BP TO RECORD SIZE
TABADR LRW,1 ;FIRST FREE RECORD WORD, USED BY SETLRW
IFN ISTKS,<
TABADR INSSS0,1 ;EXP (LVL)INSSSS
TABADR OUTSS0,1 ;EXP (LVL)OUTSSS
TABADR INSSSS,16 ;NUMBER OF INS/LEVEL
TABADR OUTSSS,16 ;NUMBER OF OUTS/LEVEL
>
TABADR IOWRD0,1 ;POINTS TO CURRENT IOWRD
TABADR USOBJ0,1 ;POINTS TO CURRENT USOBJ
TABADR CNTRY0,1 ;POINTS TO CURRENT CNTRY
TABADR NNTRY0,1 ;FLAG, CNTRY POINTS TO NEXT ENTRY
TABADR BPSB,1 ;NUMBER OF BITS PER SAT BLOCK
ITABL==ADR-STABL ;INDEX TABLE LEN
TABADR BA,0 ;START OF BUFFER AREA
ISCLR1==IOWRD ;[432] [377] START OF ISAM SHARED BUFFER AREA TO SAVE
ISCLR2==ICHAN-1 ; [377] END OF ISAM SHARED BUFFER TO SAVE
ISMCLR==ISCLR2-ISCLR1 ; [377] DIFFERENCE OR SIZE OF AREA LESS 1 TO SAVE
> ;END OF 'IFN ISAM'
SUBTTL RESET
;RESET IS CALLED WITH A JSP 14,C.RSET
$COPYRIGHT ;Put standard copyright statement in EXE file
LIBVR.: EXP LBLVER ;LIBOL VERSION NUMBER
LIBSW.: EXP SWSET% ;LIBOL ASSEMBLY SWITCHES
SRTVR.: EXP V%SORT## ;SORT VERSION NUMBER
C.RSET: JRST .+2 ;ENTRY FOR 'C.RSET'
JRST STOPR. ;ENTRY FOR 'STOP RUN'
CALLI ;RESET
MOVE AC1,(AC14) ; GET ADDRESS OF ENTRY POINT
MOVEM AC1,%F.PTR ; (%F.PTR)+1 IS ADR OF FILES.
RUNTIM AC11, ;[346]GET THE RUNTIME.
MOVEM AC11,RUN.TM ;[346]SAVE IT.
IFN LSTATS,< ;(LSTATS) SAVE STARTING RUNTIME
IFE TOPS20,<
MOVEM AC11,MRPSTM ;SAVE RUNTIME AT START
>
IFN TOPS20,<
MTRJS% ;GET STARTING TICKS
ERJMP .+2 ;MOVE ZER0 IF NO CLOCK
DMOVEM AC1,MRPSTM ;SAVE VALUE
>
>;END IFN LSTATS
IFN DBMS,<
MOVE AC1,DBSTP%## ;GET FROM VISIBLE, BUT NOT SAFE PLACE
MOVEM AC1,DBSTP.## ;PUT IN INVISIBLE (FROM USER) BUT SAFE PLACE
SETZM DBSTP% ;CLEAN UP (ITS REALLY LEVEL.)
>
;;12B HACK - IN V13, THE FOLLOWING THREE LINES SHOULD BE DELETED
MOVE AC1,OVFLO.## ;COPY OVFLO. TO SLRSW.
MOVEM AC1,SLRSW.##
SETZM OVFLO. ;CLEAN UP
HRRZ AC1,.JBSA ;[START.]
MOVEM AC1,JSARR. ;SAVE FOR RRDMP
HRRZ AC1,.JBFF ;TO-1
CAMG AC1,.JBREL ;SKIP ILL-MEM-REF
SETZM (AC1) ;ZERO WORD
HRL AC1,AC1 ;FROM,,TO-1
ADDI AC1,1 ;FROM,,TO
HRRZ AC2,.JBREL ;UNTIL
CAIL AC2,(AC1) ;SKIP ILL-MEM-REF IF .JBFF = .JBREL
BLT AC1,(AC2) ;ZERO FREE COR
RESET1: MOVEI AC0,[OUTSTR [ASCIZ/?COBOL programs may only be started through
use of "GET and ST" or "RUN" monitor commands./]
EXIT] ;[1105] CONSIDER THIS FATAL
HRRM AC0,.JBSA
MOVE PP,[XWD PFRST.,IFRST.]
TLNE PP,777777 ;NO BLT IF PFRST. = 0 - LOW SEG WAS LOADED
BLT PP,ILAST. ;THE IO UUO'S
MOVEI AC10,MEMRY.## ;SET UP MEMRY. POINTER
MOVEM AC10,MEMRY%##
IFN TOPS20, <
MOVEI AC1,.SCOUNT ;[1102]
GETAB ;[1102] SEE WHICH VERSION WE'RE RUNNING UNDER
ERJMP [ CAIN AC1,GTABX1 ;[1102] DOES THIS TABLE EXIST
SKIPA AC2,[-1] ;[1102] NO - SAY VERSION 4.1
SETZM AC2 ;[1102] SAY V 5
MOVEM AC2,MNTR5## ;[1102] STORE IT
JRST .+1] ;[1102]
>; END TOPS20
HRRZ AC10,(AC14) ;GET THE PROGRAM'S ENTRY POINT.
HRRZ AC10,1(AC10) ;GET THE ADDRESS OF %FILES.
SKIPN AC10,%PUSHL(AC10) ;GET THE PDL SIZE.
MOVEI AC10,200 ;THIS IS FOR CSORT
MOVNI PP,(AC10) ;0,,-LENGTH
HRL PP,.JBFF ;START-LOC,,-LENGTH
MOVSS PP,PP ;POINTER IS SET UP.
MOVEI AC10,20(AC10) ;[660] LENGTH+20
ADDB AC10,.JBFF ;ADJUST .JBFF
IORI AC10,1777 ;MOVE UP TO THE NEXT K BOUNDARY
CAMG AC10,.JBREL ;ARE WE BEYOND .JBREL?
JRST RESET2 ;NO, GO ON.
CORE AC10, ;YES, GO ASK FOR MORE CORE.
JRST GETSPK ;CAN'T HAVE ANY MORE, ERROR.
;SET FLAGS TO TRAP ON
RESET2: MOVEI AC0,TRAP. ;[312] INTERUPT ROUTINE ADR
MOVEM AC0,.JBAPR ;[312]
MOVEI AC0,AP.POV!AP.ILM!AP.NXM ;[312] PDLOV - MPVIO - NXM
APRENB AC0, ;[312] APRENB UUO
PUSH PP,AC14 ;SO WE CAN PRINT PC ON ERRORS
PUSHJ PP,RSAREN ;[312] INIT .JBSA AND .JBREN
PUSHJ PP,OUTBF1 ;SETUP TTY BYTE-POINTER AND BYTE-COUNT
PUSHJ PP,RSTLNK ;LINK ALL SUB-PROGRAM'S FILE-TABLES
PUSHJ PP,SUSPC ;COMPUTE SPACE REQUIRED FOR SIMULTANEOUS
;UPDATE, AND GET IT
SKIPE AC1,OVRFN. ;DOES OVERLAY FILE HAVE TO BE OPENED?
PUSHJ PP,SETOVR ;YES, SET UP OVERLAY FILE
SETZM RMFLG.## ;CLEAR "RMS NEEDED" FLAG
PUSHJ PP,RSTAB. ;ASSIGN THE BUFFER AREA
; THIS WILL SET "RMFLG." TO -1 IF ANY RMS
; FILES ARE DEFINED IN THE PROGRAM
IFE TOPS20,<
PUSHJ PP,SETALB ;SET AUTOLB IF AUTO MTA LABEL PROCESSING
>
POP PP,(PP) ;CLEAN UP STACK
IFN CSTATS,<
SKIPE METR.## ;METER--ING SETUP?
PUSHJ PP,SETMTR ;YES, SET UP FOR IT
>
IFN LSTATS,<
PUSHJ PP,MRLSET ;SETUP FOR LSTATS FILE WRITING
>
IFN ANS74,<
SKIPE RMFLG.## ;SKIP IF RMS NOT USED
PUSHJ PP,RMSGET## ; ** GO GET RMS **
>
SETOM OSHOOT## ;[530] SET END OF RESET FLAG
HRRZ AC10,COBSW. ;GET COMPILER ASSEMBLY SWITCHES
HRRZ AC3,LIBSW. ;GET LIBOL ASS-SWITCHES
CAME AC10,AC3 ;THE SAME?
OUTSTR [ASCIZ /%Compiler-OTS assembly switches mismatched.
/]
HLRZ AC10,COBVR.## ;GET COMPILER VERSION NUMBER
HLRZ AC3,LIBVR. ;GET OTS VERSION NUMBER
TRZ AC10,700000 ;GET RID OF CUSTOMER BITS
TRZ AC3,700000 ;...
CAMGE AC3,AC10 ;OTS THE SAME OR NEWER?
OUTSTR [ASCIZ /%Compiler-OTS version number mismatch.
/]
IFE TOPS20,<
MOVE AC10,[%CNVER] ;CONFIG TABLE
GETTAB AC10,
SETZ AC10, ;MUST BE VERY OLD
LDB AC10,[POINT 5,AC10,23] ;MONITOR VERSION NO.
CAIN AC10,7 ;TEST FOR 7.00 SERIES MONITOR
SETOM M7.00## ;SET FLAG IF TRUE
>
JRST 1(AC14) ;RETURN
;HERE TO CHAIN FILE-TABLES OF ALL SUBPROGRAMS TOGETHER
;POINTERS ARE AS FOLLOWS
;AC14/ ADR OF SP1 ;ADR OF ADR OF "MAIN" PROGRAM
;THE FOLLOWING ARE THE SAME FOR ALL SUBPROGRAMS
;SP1+1/ LST,,FILES. ;FILES. HAS ADR OF FIRST FILE-TABLE
;LST/ SP2 ;ADR OF SUBPROGRAMS CALLED BY SP1
;LST+1/ SP4 ; .
;LST+N/ 0 ;TERMINATES WITH A ZERO
RSTLNK: MOVEI AC3,AC3 ;THWART THE FIRST LINK
HRR AC1,(AC14) ;ADDRESS OF "MAIN" PRG + 1
HRL AC2,1(AC1) ;SETUP THE
HRRI AC2,FILES. ; FIXED
HRRZI AC4,FILES. ; PARAMETERS
BLT AC2,FIXNUM-1(AC4); %FILES THRU %PR
SETZM OVRFN. ;CLEAR THE OVR FILE PTR TO START
RSTL10: HRRZ AC5,(AC1) ;[346] CHECK TO SEE IF THIS SUBROUTINE
JUMPN AC5,RSTLNX ;[471] IS IN A LINK-10 OVERLAY AREA.
; ((AC1)) = SKIPA 0,0 ==> IT ISN'T
; ((AC1)) = JSP 1,MUMBLE ==> IT IS.
MOVE AC1,1(AC1) ;ADDRESS OF [LIST ,, FILES.]
HLRZ AC2,AC1 ;ADR OF LIST OF CALLED SUBPROGRAMS
SKIPGE AC4,(AC1) ;HAVE WE BEEN HERE BEFORE?
POPJ PP, ;YES, -1 IN LEFT HALF
MOVEI AC10,%OVRFN(AC1) ;[453] GET OVRFN ADDR
MOVE AC10,(AC10) ;[453] GET OVR FILE NAME
JUMPE AC10,RSTL13 ;[453] JUMP IF NO OVR FILE
SKIPE OVRFN. ;[453] ALREADY SEEN ONE?
JRST RSOVE1 ;[453] YES--ERROR
MOVEM AC10,OVRFN. ;[453] SAVE OVR FILE NAME
RSTL13: JUMPE AC4,RSTL12 ;[453] JUMP IF SUBPRG HAS NO FILE-TABLES
SKIPN FILES. ;HAS FILES. BEEN SETUP YET?
HRRM AC4,FILES. ;NO - SO DOIT
HRRM AC4,(AC3) ;LINK THIS FILE-TABLE GROUP TO LAST GROUP
RSTL11: HRRZI AC3,F.RNFT(AC4) ;GET ADR OF LINK TO NEXT TABLE
HRRZ AC4,(AC3) ;GET THE LINK TO NEXT TABLE
JUMPN AC4,RSTL11 ;LOOP IF NOT THE LAST TABLE
RSTL12: HRROS (AC1) ;MARK THIS FILE-TABLE GROUP DONE
RSTL20: SKIPN AC1,(AC2) ;ANY SUBPRGMS?
POPJ PP, ;NO -- BACK TO THE LAST SUBPRG OR EXIT
PUSH PP,AC2 ;SAVE POINTER TO SUBPROGRAM LIST
PUSHJ PP,RSTL10 ;GO LINK THE FILE-TABLES
POP PP,AC2 ;RETREIVE LIST POINTER
SKIPE 1(AC2) ;ANY MORE SUBPRGMS?
AOJA AC2,RSTL20 ;INCREMENT POINTER AND TRY AGAIN
RSTLNX: POPJ PP, ;[312];NO--DONE.
RSOVE1: OUTSTR [ASCIZ /?Only one module in a COBOL run-unit may have segmentation.
/] ;[453]
JRST KILL ;[453]
;ASSIGN THE BUFFER AREA. ***POPJ***
RSTAB.: PUSHJ PP,GCHAN ;FIND A FREE CHANNEL
PUSHJ PP,SETC1. ; ASSIGN TO IO UUOS
SETOM FS.IF ;IDX FILE
SETZM TEMP.1 ;ZERO THE ERROR COUNT
SETZM SHRDX. ;[556] CLEAR SHARED ISAM BUF AREA FLAG
HRRZ AC16,FILES. ;FIRST FILE TABLE
JUMPE AC16,RET.1 ;THERE ARE NO FILES
RSTIFI: SETZM TEMP. ;MAX SIZE OF BUF AREA
RSTIF1: MOVE AC15,F.WDNM(I16);IF THIS IS FIRST
TLNN AC15,BUFLOC ;[316] TIME THROUGH TABLE,
PUSHJ PP,RSTFLG ;REORGANIZE THE FLAGS
LDB AC5,[POINT 4,UFRST.,12] ; GET CHAN FROM UUO
DPB AC5,DTCN. ;SAVE IT
MOVE FLG,F.WFLG(I16) ;GET THE FLAGS
HRLOI AC15,4077 ;[316] #OF DEVICES,,LOC OF FIRST ONE
AND AC15,F.WDNM(I16) ;
TLZE AC15,BUFLOC ;IS BUFLOC SET?
JRST RSTNFL ; [377A] YES-NEXT FILE
IFN ANS74,<
LDB AC1,F.BRMS ; GET RMS FLAG BIT
JUMPE AC1,RSTIF2 ; JUMP IF NOT AN RMS FILE
SETOM RMFLG.## ;SET FLAG SAYING RMS IS NEEDED
MOVSI AC15,BUFLOC ; NOTE WE ARE DONE
IORM AC15,F.WDNM(I16) ; WITH THIS FILE TABLE
JRST RSTNFL ; AND GET NEXT FILE
RSTIF2:>
MOVEM AC15,AC13 ;
TLC AC13,777777 ;MAKE
AOBJP AC13, .+1 ;KIND OF
HRR AC13,AC15 ;AN IOWD
MOVEM AC13,D.ICD(I16) ;%-<#OF DEVS>,,LOC OF FIRST DEVNAM
RSTDEV: MOVE AC3,(AC13) ;SIXBIT /DEVICE NAME/
IFN SIRUS,<MOVE AC1,AC3 ; [403] KEEP DEVICE >
DEVCHR AC3, ;DEVCHR UUO
TXNN AC3,DV.CDR!DV.LPT!DV.PTP!DV.PTR!DV.TTY ;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR
JRST RSTDE0 ;
TXC AC3,DV.DSK!DV.CDR ;[506] IF A DSK AND A CDR ...
TXCE AC3,DV.DSK!DV.CDR ;[506] THEN IT'S DEVICE NUL:
JRST RSTDV1 ;[506] NOT NUL:, CONTINUE
TXZ AC3,DV.MTA!DV.TTY ;[506] NUL:, SO NOT MTA OR TTY
LDB AC12,[POINT 3,FLG,14] ;[506] CORE DATA MODE
DPB AC12,[POINT 3,FLG,2] ;[506] MAKE DEV DATA MODE SAME
MOVEM FLG,F.WFLG(I16) ;[506] SAVE IT
JRST RSTDE0 ;[506] CONTINUE
RSTDV1: TLO FLG,DDMASC ;FORCE ASCII MODE
TLZ FLG,DDMBIN!DDMSIX!DDMEBC ; FOR THE ABOVE DEVICES
MOVEM FLG,F.WFLG(I16) ;
RSTDE0: JUMPN AC3,RSTDE2 ;
IFN SIRUS,<
MOVE AC3,(AC13) ; [403] GET DEVICE NAME
CAME AC3,SIRDEV ; [403] IS IT SIRUS DEVICE?
JRST RSTDE1 ; [403] NO-ERROR
MOVSI AC3,'NUL' ; [403] YES-MAKE IT NULL DEVICE
JRST RSTDEV+1 ; [403] TRY AGAIN
>; END OF IFN SIRUS
RSTDE1: MOVE AC2,[BYTE(5)25,4,20,13,23,15,14];"NOT A DEVICE OR
PUSHJ PP,MSOUT. ;NOT AVAILABLE TO THIS JOB
AOS TEMP.1 ;COUNT THE ERRORS
JRST RSTLOO ;
RSTDE2: SETZM UOBLK. ;[411] MAKE SURE WE DONT GET ILLEGAL MODE IF ASCII DEV
MOVE AC12,.JBFF
SKIPN SHRDX. ;[556] IF ISAM SHARED BUF, D.BL ALREADY SET
HRLM AC12,D.BL(I16) ;SET BUFFER LOCATION
IFN SIRUS,< MOVE AC12,AC1 ; [403] GET BACK DEVICE >
IFE SIRUS,< MOVE AC12,(AC13) ;SIXBIT /DEVNAM/>
MOVEM AC12,UOBLK.+1 ;FOR THE INIT BLOCK
HRLZI AC12,D.OBH(I16) ;LOC OF OBUF HDR
TLNE FLG,IOFIL ;[622] SKIP IF NOT IO
HRRI AC12,D.IBH(I16) ;LOC OF IBUF HDR
MOVEM AC12,UOBLK.+2 ;INIT BLOCK
IFN ISAM,<
MOVEI AC1,.IODMP ;DUMP MODE
TLNE FLG,IDXFIL ;INDEX-FILE?
HRRZM AC1,UOBLK. ;YES
>
IFN TOPS20,<
TLNE FLG,IDXFIL ;ISAM FILE?
JRST RSTD21 ;YES
>
XCT UOPEN. ;********************
JRST RSTDE1 ;INIT FAILED, ERROR RETURN
RSTD21: PUSH PP,.JBFF ;
TLNE FLG,IDXFIL ;
JRST RSTIDX ;SETUP FOR AN INDEX FILE
SUBTTL LABELED TAPE RESET CODE
TXNN AC3,DV.MTA ; SKIP IF MTA
JRST MTOXX0 ; ELSE GO ON
MOVE AC12,AC3 ;SAVE AC3, CLOBERED LATER
IFN TOPS20,<
; THIS IS STUFF FOR VERSION 4 OF TOPS20, TO TAKE
; CARE OF TAPE HANDLING BY MOUNTR , INCLUDING LABEL
; PROCESSING.
HLLZ AC6,D.F1(I16) ; GET SECOND FLAG WORD
; NOW CHECK FOR MONITOR LABEL PROCESSING
PUSHJ PP,MTALAB ; GET MTA LABEL INFO
JRST MTOXXY ; NON SYS-LABELING, CONT
LDB AC2,F.BLBT ; GET LABEL TYPE FROM FILTAB
SOSE AC2 ; SKIP IF NO LABELING, TYP=1 IF NO LABELING
TLOA AC6,MSTNDR ;INDICATE MONITOR IS LABELING
TLOA AC6,MTNOLB ;SET MOUNTR WITH NO LABELING FLAG
TLZ AC6,STNDRD!NONSTD ;CLEAR LABEL BITS IN D.F1
HLLM AC6,D.F1(I16) ;RESET IN FILTAB
> ;END IFN TOPS20
JRST MTOXXY ; CONT WITH OTHER CHECKS
; GTDFLT ROUTINE TO GET DEFAULT DATA MODE SETTING
;
; RETURNS AC3=DEFAULT MODE
; USES AC1-AC3
;
GTDFLT:
IFN TOPS20,<
SETO AC1, ; AC1=-1, THIS JOB
HRROI AC2,3 ; DATA MODE AT AC3
MOVEI AC3,.JIDM ; START BLOCK AT THE DEFAULT DATA MODE WORD
GETJI% ; GET THE DATA MODE
JRST KILL. ; ASSUME IT WORKS, SHOULD ALWAYS
POPJ PP, ; RET
>; END IFN TOPS20
IFE TOPS20,<
MOVE AC3,[2,,1] ; 2 ARGS START AT AC1
MOVEI AC1,.TFMOD ; DATA MOD FUNCTION
MOVE AC2,UOBLK.+1 ; DEVICE NAME
TAPOP. AC3, ; GET DEFAULT DEVICE DATA MODE
JRST [MOVE AC2,AC3 ; ERROR, PUT ERROR CODE INTO AC2
JRST OMTA93 ] ; AND GIVE ERROR
POPJ PP, ; OK, RET
>; END IFE TOPS20
IFN TOPS20,<
; GETJFN ROUTINE TO GET JFN FROM PA1050 USING COMPT. UUO
;
; ARGS AC2=CHAN NUMBER
;
; RETURNS NON-SKIP ERROR RETURN
; SKIP OK, AC1=JFN
;
; USES AC1,AC2
;
GETJFN: HRLZ AC2,AC2 ;GET CHAN NUM IN LEFT,AS ARG TO COMPT.
HRRI AC2,CMP.10 ;SET COMPT. FUNCTION NUM FOR CHAN TO JFN
MOVE AC1,[1,,2] ;INDICATE 1 ARG IN ADDR 2
COMPT. AC1, ;GET JFN *************
POPJ PP, ; ERROR RETURN
JRST RET.2 ; OK, RETURN
>;END IFN TOPS20
; MTALAB A ROUTINE TO READ MTA LABEL INFO
;
; USES AC1-AC3, TEMP AREA (SIZE MTOSIZ+1) ON STACK
;
; RETURNS NON-SKIP IF LAB-BYPASS (NO MOUNTR CONTROL)
; SKIP IF LABELED, LABEL INFORMATION IS LOCATED
; AT TMP.BK
MTALAB:
IFN TOPS20,<
LDB AC2,UUOCHN ;GET CHANNEL NUM
PUSHJ PP,GETJFN ; GET JFN IN AC1
JRST [OUTSTR [ASCIZ/RESET get JFN /] ;ERROR, ISSUE MESSAGE
JRST OCPERR ] ;MORE MESS AND KILL
;GET AND CLEAR A TEMP TABLE AREA FOR MTOPR
;PUT TABLE LENGTH IN FIRST WORD,AS MTOPR WANTS
MOVE AC3,AC1 ; SAVE JFN IN CASE OF OPEN ERROR
GTSTS% ; GET FILE STATUS
HRR AC2,AC3 ; SAV JFN HERE
PUSH PP,AC2 ; SAV STATUS,,JFN
JUMPL AC2,MTLAB1 ; JUMP IF ALREADY OPEN
MOVE AC2,[440000,,OF%RD] ;INDICATE SIMPLE 36 BIT BYTE,INPUT
OPENF% ;OPEN THE JFN***************
ERCAL OPNFER ;ERROR?, THEN GO CHECK IT (RETURNS IF OK)
MTLAB1: MOVEI AC3,TMP.BK ; INDICATE THAT THE TEMP AREA WILL BE TMP.BK
MOVEI AC2,1(AC3) ;GET TEMP TAB ADDR
SETZM (AC3) ;ZERO FIRST WORD
HRLI AC2,-1(AC2) ;MAKE BLT PTR
BLT AC2,MTOSIZ-1(AC3) ;ZERO TEMP AREA,TO MAKE SURE NO INFO FROM
;MTOPR WILL BE STUCK IN A BAD PLACE
MOVEI AC2,MTOSIZ ;GET MTOPR SIZE
MOVEM AC2,(AC3) ;INITIALIZE TAB LENGTH
MOVEI AC2,.MORLI ;SET MTOPR FUNCTION CODE FOR READING LABELS
MTOPR% ;GET LABEL INFO ***************
ERJMP MTOPER ;ERROR, CHECK FOR ILLEGAL FUNCTION
;INDICATING MOUNTR NOT AROUND
MOVE AC5,TMP.BK+LABFOR ; GET LABEL FORMAT CHAR
PUSHJ PP,SETFMT ; SET LABEL FORMAT BITS
MOVE AC2,TMP.BK+LABTYP ; GET LABEL TYPE
DPB AC2,F.BLBT ; SET LABEL TYPE INTO FILTAB
CAIE AC2,.LTEBC ; IS LABEL TYPE EBCDIC?
JRST MTLAB2 ; NO, CONT
; IF EBCDIC LABELS, SET NO TRANSLATE
HRRZ AC1,(PP) ; GET JFN FROM SAVED POSITION ON STACK
MOVEI AC2,.MONTR ; INDICATE NO TRANSLATE
SETO AC3, ; TO BE SET
MTOPR% ; DO IT
ERJMP MTOERR ; ERROR, ISSUE MESSAGE AND QUIT
MTLAB2: POP PP,AC3 ; RESTORE INITIAL FILE STATUS
JUMPL AC3,RET.2 ; RETURN IF OPEN AT START
HRRZ AC1,AC3 ; GET JFN
TXO AC1,CO%NRJ ; DON'T RELEASE IT
CLOSF% ; CLOSE THE FILE
JRST CLSERR ; ERROR, MESSAGE AND QUIT
JRST RET.2 ; OK, LABELING OF SOME KIND, GIVE SKIP RETURN
; ERROR ON GET-LABEL-INFO MTOPR, CHECK FOR ILLEGAL OPERATION,
; INDICATING NO MOUNTR, OR LABELS-BYPASS
MTOPER: POP PP,AC3 ; RESTORE GTSTS CODE
MOVEI AC1,.FHSLF ;INDICATE CURRENT PROCESS
GETER% ;GET LAST ERROR NUM IN AC2 (RT HALF)
CAME AC2,[.FHSLF,,MTOX1] ; AN INVALID FUNCTION ERROR (VER. 4)?
JRST MTOERR ; NO, MTOPR ERROR, ISSUE MESSAGE AND QUIT
; YES,THEN THIS INDICATES THAT NO MOUNTR
JUMPL AC3,RET.1 ; RETURN, NON-SKIP IF FILE WAS OPEN
HRRZ AC1,AC3 ; ELSE,GET JFN
TXO AC1,CO%NRJ ; DON'T RELEASE IT
CLOSF% ; CLOSE THE FILE
JRST CLSERR ; ERROR, MESSAGE AND QUIT
POPJ PP, ; GIVE NON-SKIP RETURN
>;END IFN TOPS20
IFE TOPS20,<
; FOR TOPS10 NEED TO DO A COUPLE OF UUOS TO GET INFO
; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING
; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS
; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS.
SKIPN AUTOLB ; DO WE HAVE AUTO LABEL PROCESSING?
POPJ PP, ; NO, GIVE NO-LABELS RETURN
; YES
MOVEI AC3,TMP.BK ; INDICATE THAT THE TEMP AREA WILL BE TMP.BK
MOVEI AC2,1(AC3) ;GET TEMP TAB ADDR
SETZM (AC3) ;ZERO FIRST WORD
HRLI AC2,-1(AC2) ;MAKE BLT PTR
BLT AC2,MTOSIZ-1(AC3) ;ZERO TEMP AREA
HRLZI AC3,2 ; LENGTH ,, ADDRESS
MOVEI AC0,.TFLBL ; FUNCT - LABEL PROCESSING
MOVE AC1,UOBLK.+1 ; SIXBIT /DEVICE NAME/
MOVEM AC1,TMP.BK+1 ; ALSO SET IN ARG BLK FOR LABEL INFO
TAPOP. AC3, ; GET TYPE OF LABEL PROCESSING
JRST OMTA96 ; OOPS - COMPLAIN
CAIN AC3,.TFLNV ; WAS THAT "USER EOV , UNLABELED"?
MOVEI AC3,.TFLNL ; YES, INDICATE UNLABELED
DPB AC3,F.BLBT ; SET LABEL TYPE IN FILTAB
CAIN AC3,.TFLBP ; LABEL-BYPASS?
POPJ PP, ; YES,GIVE NON-LABELING RETURN IF BYPASS
; NOW GET OTHER LABEL INFO
MOVE AC2,[XWD .TPLEN,TMP.BK] ; INDICATE SIZE AND POSITION OF ARGBLK
MOVEI AC1,.TFLPR ; INDICATE GET LABEL INFORMATION
MOVEM AC1,TMP.BK ;
TAPOP. AC2, ; GET LABEL INFORMATION
JRST LBTPER ; ERROR, COMPLAIN
MOVEM AC3,TMP.BK+LABTYP ; SET LABEL TYPE
MOVE AC1,TMP.BK+.TPREC ; GET FORMAT AND FORMS CONTROL INFO
HLRZM AC1,TMP.BK+LABFMS ; RESET FORMS CONTROL WORD
HRRZM AC1,TMP.BK+LABFOR ; AND FORMAT WORD
TLZ AC1,-1 ; CLEAR LEFT HALF
MOVEI AC2,1 ; SET A BIT
SOJLE AC1,.+2 ; IF "F" (OR DEFAULT) USE 1
LSH AC2,(AC1) ; SHIFT BIT TO INDICATE FORMAT
DPB AC2,F.BFMT ; SET LABEL FORMAT BITS
JRST RET.2 ; GIVE LABELED RETURN
; HERE IF LABELED TAPOP. ERROR
; ASSUMES THAT AC2 HAS ERROR CODE
LBTPER: JUMPN AC2,OMTA96 ; GO GIVE ERROR IF REAL ONE
; HERE FOR UNIMPLEMENTED FEATURE ERROR
MOVEI AC3,.TFLNL ; SET UNLABELED
DPB AC3,F.BLBT ; SET LABEL TYPE IN FILTAB
JRST RET.2 ; GIVE LABELED RETURN
>;END IFE TOPS20
; TM03AS ROUTINE TO CHECK FOR ANSI-ASCI SUPPORT ON TAPE
;
; IF STD-ASCII NOT SUPPORTED, INDASC FLAG SET TO
; INDICATE THAT STD-ASCII MUST BE DONE WITH INDUSTRY
; COMPATIBLE MODE TAPE SETTING
;
; RETURNS CALL +1 ALWAYS
;
TM03AS:
IFN TOPS20,<
PUSHJ PP,MTASTS ; GET MTA STATUS INTO TMP.BK
JRST TM03AY ; ERROR, ASSUME NO STD-ASCII SUPPORT
MOVE AC2,TMP.BK+.MODDM ; GET DATA MODES WORD
TXNE AC2,SJ%CMA ; IS STD-ASCII SUPPORTED?
TM03X: POPJ PP, ; YES,RETURN NOW
>;END IFN TOPS20
IFE TOPS20,<
HRLZI AC3,2 ; LENGTH ,, ADDR
MOVEI AC0,.TFKTP ; FUNCTION
MOVE AC1,UOBLK.+1 ; GET DEVICE NAME
TAPOP. AC3, ; GET CONTROLER TYPE
JRST TM03AY ; ERROR, ASSUME NOT SUPPORTED
CAIE AC3,.TFKTX ; TX01 CONTROLLER (TU70/TU71)?
CAIN AC3,.TFKD2 ; SKIP IF DX20/TX02 CONTROLLER (OK TOO)
POPJ PP, ; YES, RETURN, STDASC IS SUPPORTED
; NO, NOT SUPPORTED FOR SURE
>; END IFE TOPS20
; NOT SUPPORTED,SET INDASC FLAG, INDUSTRY-COMPT. NEEDED
TM03AY: HRRZ AC2,D.RFLG(I16) ; GET STANDARD ASCII FLAG
TRO AC2,INDASC ; SET IT
HRRM AC2,D.RFLG(I16) ; AND PUT IT BACK
POPJ PP, ; RETURN NOW
MTOXXY:
; CHECK TO SEE IF AN ASCII TAPE IS TO BE WRITTEN TO
; A DRIVE WITH STANDARD-ASCII DATA MODE SET. IFSO, SET STD-ASCII
; RECORDING MODE.
HRRZ AC1,D.RFLG(I16) ; GET STANDARD ASCII FLAG
TRNE AC1,SASCII ; IS IT?
JRST MTALB0 ; YES, ALL OK
; NO ATTRIBUTES SET, HOW ABOUT DEFAULT DATA MODE?
MTLB0D: PUSHJ PP,GTDFLT ; GET DEFAULT DATA MODE IN AC3
IFN TOPS20,<
CAIE AC3,.SJDMA ; IS DATA MODE ANSI-ASCII?
>
IFE TOPS20,<
CAIE AC3,.TFM7B ; IS DATA MODE ANSI-ASCII?
>
JRST MTLB0F ; NO, SKIP THIS
MTLB0E: JUMPGE FLG,MTLB0A ; JUMP IF NOT AN ASCII DEVICE MODE
MTLB0C: HRRZ AC3,D.RFLG(I16) ; GET SOME RUNTIME FLAGS
TRO AC3,SASCII ; SET STD-ASCII BIT
HRRM AC3,D.RFLG(I16) ; AND PUT IT BACK
; THIS WILL INDICATE THAT DEFAULT
; ADVANCING WILL BE 0 ADVANCING
; CHECK FOR BLK-FTR = 0 CASE, HERE IF STD-ASCII
MTALB0:
IFN TOPS20,<
TLNN AC6,MSTNDR ; WAS THAT A LABELED TAPE?
> ; TOPS20 DOES PROPER MAP TO 7-BIT
; NO NEED TO CHECK (CAN'T SET HARDWARE MODE
; IF WE WANTED TO )
PUSHJ PP,TM03AS ; NO, CHECK FOR TM03: (MAYBE SET INDASC BIT)
MTAB0A: LDB AC5,F.BBKF ; GET BLOCKING FACTOR
JUMPN AC5,MTOXXX ; CONTINUE IF BLK-FTR NOT 0
MOVEI AC2,1 ; ELSE BLK-FTR DEFAULTS TO 1
MOVE AC3,AC12 ; GET DEVICE CHAR AGAIN
DPB AC2,F.BBKF ;
PUSHJ PP,RSTBPB ; CALC BUFFS PER BLOCK
JRST MTOXXX ; CONT
; HERE IF STD-ASCI TAP FORMAT, BUT NOT ASCII RECORDING MODE
; IF RECORDING MODE IS DEFAULT, THEN SET TO ASCII
; IN THOSE CASES THAT MAKE SENSE
MTLB0A: LDB AC3,F.BDRM ; GET DEFAULT DDM MODE FLAG
JUMPE AC3,MTOXXX ; IS DEV-DATA-MODE DEFAULT?
; NO, JUMP ASSUMING HE KNOWS WHAT HES DOING
TLCN FLG,DDMSIX ; SKIP IF MODE SIXBIT
TLCA FLG,DDMSIX ; NO, CLEAR IT , ERROR CONDITION, SKIP
JRST MTLB0B ; YES, ITS CLEARED, GO SET ASCII
; HERE IF NOT SIXBIT DEFAULT RECORDING MODE, ASSUMES ITS AN ERROR
; CONDITION TO TRY WRITING OTHER DATA MODES ON STD-ASCII TAPE
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Tape data mode mismatchs file default recording mode./]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
MTLB0B: TLO FLG,DDMASC ; SET ASCII RECORDING MODE
MOVEM FLG,F.WFLG(I16) ; AND UPDATE FLAG WORD
JRST MTLB0C ; AND GO BACK AS IF ASCII RECORDING MODE SET
MTLB0F:
; HERE IF NOT STD-ASCII HARD MODE
TLNN AC6,MSTNDR ; WAS THAT A LABELED TAPE?
JRST MTOXXX ; NO, CONT
IFE TOPS20,<
; IF ANSI LABELED TAPE WITH ASCII DDM, MAKE
; SURE HE WILL WRITE COMPATIBLE TAPE MODE (ANSI-ASC OR IND-CMP)
JUMPGE FLG,MTOXXX ; CONT IF NOT ASCII RECORDING MODE
PUSHJ PP,MTALAB ; GET LABEL INFO (SETS AC3)
JRST MTOXXX ; UNLABELED,CONT
LDB AC3,F.BLBT ; GET LABEL TYPE FROM FILTAB
CAIE AC3,.TFLAL ; IS THE LABEL TYPE ANSI
CAIN AC3,.TFLAU ; OR ANSI WITH USER LABELS?
JRST MTALB0 ; YES, CHECK BLOCKING AND HARD MODE
JRST MTOXXX ; NO, CONT
>; END IFE TOPS20
IFN TOPS20,<
; IF ASCII WITH F OR D ATTRIBUTE
; THEN CHANGE UNBLOCKED TO BLOCK 1
JUMPGE FLG,MTOXXX ; CONT IF NOT ASCII
LDB AC1,F.BLBT ; GET LABEL TYPE
CAIE AC1,.LTEBC ; SKIP IF EBCDIC LABEL
PUSHJ PP,GETATB ; GET FILE FORMAT ATTRIBUTES
JRST MTOXXX ; NONE SET, DO OTHER CHECK
CAIE AC5,"F" ; IS FORMAT "F"?
CAIN AC5,"D" ; IS FORMAT "D"?
JRST MTAB0A ; YES, CHECK BLOCKING
JRST MTOXXX ; NO, CONT
>; END IFN TOPS20
MTOXXX: MOVE AC3,AC12 ; RESTORE AC3
MTOXX0:
SUBTTL MORE RESET
TXNN AC3,DV.MTA ;SKIP IF A MTA
TLNE FLG,RANFIL+IOFIL ;[622] SKIP IF NOT RANDOM OR IO
JRST RSTDE4 ;SETUP FOR NON-STD OR DUMP MODE BUFFERS
RSTDE7: LDB AC6,F.BNAB ;NUMBER OF BUFFERS
CAIN AC6,77 ; [414] REALLY WANTS ONE?
SETOI AC6, ; [414] YES ONE BUFFER.
XCT UOBUF. ;ALLOCATE **************
TLNE FLG,IOFIL ;[622] THE
XCT UIBUF. ;BUFFERS **************
HLLZ AC6,D.F1(I16) ; GET SECOND FLAG WORD
; CALC THE BUFFS/BLOCK FOR BLOCKED CASES
LDB AC5,F.BBKF ; GET BLOCKING FACTOR
JUMPE AC5,RSTDE5 ; GO ON IF UNBLOCKED
PUSHJ PP,RSTBPB ; CALC BUFFS PER BLOCK
RSTDE5:
HLRZ AC12,D.BL(I16) ;CALCULATE
SUB AC12,.JBFF ;THE SIZE
POP PP,.JBFF ;
MOVNS AC12 ;OF THE
RSTDE3: CAML AC12,TEMP. ;BUFFER AREA
MOVEM AC12,TEMP. ;SAVE SIZE OF LARGER
;LOOP AGAIN
RSTLOO:
IFN ISAM,<TLNN FLG,IDXFIL >
AOBJN AC13,RSTDEV ;JUMP IF MORE DEV/FILTAB
RSTLO1: MOVSI AC15,BUFLOC ;[316];NOTE WE ARE DONE
IORM AC15,F.WDNM(I16);WITH THIS FILE TABLE
HLRZ AC1,F.LSBA(I16) ;SEE IF ANY SHARING OF BUFFERS
JUMPE AC1,RSTNFL ;GET THE NEXT FILE TABLE
MOVEM AC1,AC16 ;
JRST RSTIF1 ;SHARES THE SAME BUFFER AREA
RSTNFL: MOVE AC12,TEMP. ;INCREASE .JBFF BY
ADDM AC12,.JBFF ;THE BUFFER AREA SIZE
SETZM SHRDX. ;[556] CLEAR ISAM SHARED BUF FLAG
HRRZ AC16,F.RNFT(I16);LOCATE THE NEXT FILE TABLE
JUMPN AC16,RSTIFI ;AND JUMP IF THERE IS ONE.
SKIPE TEMP.1 ;ANY ERRORS ?
JRST KILL ;YES
XCT URELE. ;RELEASE THE CHANNEL
IFN ISAM,<
;GRAB SPACE FOR THE AUX BLOCK
SKIPE MXBUF ;EXIT IF NO INDEXED FILES
SKIPE KEYCV. ;SKIP IF RESET UUO
JRST RSTXIT ;EXIT - ITS A SORT CALL
MOVE AC0,MXBUF ;SIZE OF AUX BLOCK
MOVE AC1,.JBFF ;
HRRZM AC1,AUXBUF ;LOCATION OF AUX BLK
PUSHJ PP,GETSPC ;
JRST GETSPK ;ERROR RETURN
;SPACE FOR DATA-RECORD-TABLE FOR SPLITTING BLOCKS
MOVE AC0,MXBF ;MAX-BLOCKING FACTOR OF ALL IDXFIL'S
ADDI AC0,1 ;TERMINATOR
MOVE AC1,.JBFF ;
HRRZM AC1,DRTAB ;
PUSHJ PP,GETSPC ;
JRST GETSPK ;ERROR RETURN
;SPACE FOR INDEX ENTRY WHEN SPLITTING TOP INDEX BLOCK
MOVE AC0,MXIE ;SIZE OF LARGEST INDEX ENTRY
MOVE AC1,.JBFF ;
HRRZM AC1,IESAVE ;LOC OF SAVE AREA
PUSHJ PP,GETSPC ;
JRST GETSPK
>
RSTXIT: LDB AC2,[POINT 4,UOPEN.,12] ;FREE THE CHANNEL
PUSHJ PP,FRECH2 ; AND POPJ
HRLZI AC0,577774 ;[342]TURN OFF CHAN 1
SKIPN TEMP.2 ;ANY RERUNS?
POPJ PP, ;NO
ANDM AC0,OPNCH. ;YES, DOIT
SETOM RRFLG.## ;REMEMBER
POPJ PP,
; CALCULATE THE NUMBER OF BUFFERS PER LOGICAL BLOCK
RSTBPB: PUSH PP,AC13 ; SAVE AC13,OPNWPB ASSUMES DEVICE CHAR IN AC13
MOVE AC13,AC3 ; GET DEVICE CHAR
PUSHJ PP,OPNWPB ; AC10= WORDS PER LOGICAL BLOCK
PUSH PP,AC10 ; SAVE AC10 FOR CALLER
MOVEI AC0,DSKBSZ ;DSK BUFFER SIZE
TLNE FLG,IOFIL!RANFIL!IDXFIL ;[622] SKIP IF NOT RANDOM OR IO
JRST RSTBP3 ;
TXNN AC13,DV.MTA ;SKIP IF A MTA
JRST RSTBP1 ;JUMP, NOT A MTA
JUMPE AC5,RSTBP1 ;JUMP IF BLK-FTR IS ZERO (AC5)
MOVEI AC10,1 ;ONE BUFFER PER LOGICAL BLOCK
JRST RSTBP2 ;
RSTBP1: HRRZ AC11,D.OBH(I16) ; RESET ASSUMES USE OF AT LEAST OUTBUF
HLRZ AC0,(AC11) ;BUFFER SIZE + 1 IN WORDS
SUBI AC0,1 ;SIZE
RSTBP3: IDIV AC10,AC0 ;/BUF-SIZE
SKIPE AC10+1 ;ROUND UP
ADDI AC10,1 ;AC10=BUFFERS PER LOGICAL BLOCK
;BL; 2 LINES INSERTED AT RSTBP3+3 TO FIX ISAM/RANDOM SHARED BUFFR BUG
TLNE FLG,IDXFIL ;ISAM FILE?
SKIPN PAGBUF(I12) ;YES, & PAGE I/O TOO?
JRST RSTBP2 ; NO
ADDI AC10,3 ; YES, ADD 3 SECTORS
LSH AC10,-2 ; AND
LSH AC10,2 ; ROUND OFF
RSTBP2: MOVEM AC10,D.BPL(I16) ;BUFBLK
POP PP,AC10 ; RESTORE AC10, WDS/LOG-BLK
POP PP,AC13 ; RESTORE AC13
POPJ PP, ; ALL DONE RETURN
;SETUP FOR NONSTD BUFFERS OR DUMP MODE
RSTDE4: LDB AC5,F.BBKF ;BLOCKING FACTOR
JUMPN AC5,RSTD40 ; IF BLK-FTR = 0
TLNE FLG,DDMEBC ; AND DEVICE DATA MODE IS EBCDIC
TXNN AC3,DV.MTA ; AND DEVICE IS A MTA
JRST RSTD40 ;
MOVEI AC5,1 ; THEN BLK-FTR DEFAULTS TO 1
DPB AC5,F.BBKF ;
RSTD40: JUMPE AC5,RSTDE7 ;JUMP IF BLOCKING FACTOR IS 0
PUSHJ PP,RSTBPB ; CALC BUFFS PER LOG-BLK,AC10=WDS PER LOG-BLK
TXNN AC3,DV.MTA ;SKIP IF A MTA
JRST RSTDE6 ;JUMP ITS NOT A MTA
CAIL AC10,MXTPRC ;SKIP IF LOG. BLK NOT TOO LARGE
JRST MXTPER ;JUMP IF TOO LONG
ADDI AC10,3 ; PLUS 3 FOR BOOKEEPING WORDS
HLLZ AC6,D.F1(I16) ;SECOND FLAG REG
TLNN AC6,STNDRD ;SKIP IF STANDARD LABELS
JRST RSTD41 ;MTA W/NONSTD OR OMITTED LABELS
CAIGE AC10,^D16+4 ;SKIP IF RECORD IS GE THE LABEL RECORD
MOVEI AC10,^D16+4 ;ENSURE LABEL REC WILL FIT IN REC AREA
RSTD41: TLNN FLG,DDMEBC ;SKIP IF EBCDIC
JRST RSTDE8 ;ITS NOT
SKIPGE D.F1(I16) ; VARIABLE LENGTH EBCDIC?
ADDI AC10,1 ; YES - ADD IN ONE FOR BLOCK DESCRIPTOR WORD
RSTD42: TLNN AC6,STNDRD ; LABELS STANDARD?
JRST RSTDE8 ;NO - MUST BE OMITTED
CAIGE AC10,^D20+4 ;
MOVEI AC10,^D20+4 ;LABEL RECORD IS THE LARGEST RECORD
RSTDE8: TLNN AC6,NONSTD ;SKIP IF NON-STANDARD LABELS
JRST RSTDE9 ;
HLRZ AC1,F.LNLS(I16) ;NONSTD LABEL SIZE
JUMPGE FLG,RSTD10 ;JUMP IF NOT ASCII
ADDI AC1,2 ;ADD IN "CR-LF" CHARS
IDIVI AC1,5 ;
RSTD10: TLNN FLG,DDMASC ;SKIP IF ASCII
IDIVI AC1,6 ;
SKIPE AC2 ;
ADDI AC1,1 ;CONVERT CHARS TO WORDS
CAIGE AC10,3(AC1) ;
MOVEI AC10,3(AC1) ;ENSURE LABEL REC WILL FIT IN REC AREA
RSTDE9: MOVEI AC1,-3(AC10) ;
HRRM AC1,D.LRS(I16) ;SAVE IT FOR OPNNSB
LDB AC12,F.BNAB ;NUMBER OF ALTERNATES
CAIN I12,77 ; [414] REALLY WANTS ONE?
JRST RSTD11 ; YES, DON'T MULTIPLY
IFN ANS68,<
IMULI AC10,DFLTBF(I12) ; NO,REC TIMES NUMBER OF ALTERNATE BUFFERS
>
IFN ANS74,<
REPEAT 0,< ;V13 INCOMPATIBLE CODE - NEEDS COMPILER CHANGE
JUMPN AC12,.+2 ; SKIP IF NOT ZERO RESERVED
MOVEI AC12,DFLTBF ; 0 MEANS DEFAULT NUMBER
IMULI AC10,(I12) ; NO,REC TIMES NUMBER OF BUFFERS
>
REPEAT 1,< ;COMPATIBLE WITH 12A
IMULI AC10,DFLTBF(I12) ; NO,REC TIMES NUMBER OF ALTERNATE BUFFERS
>>
JRST RSTD11 ; OK, NOW GET MEM
RSTDE6: TXNN AC3,DV.DSK ;SKIP IF DEV IS A DSK
JRST RSTER0 ;COMPLAIN
TRZE AC10,DSKMSK ;ALLOCATE FULL DISK BLKS
ADDI AC10,DSKBSZ ;ROUND UP TO NEXT DISK BLK
IFN ANS68,<
ADDI AC10,12 ;3+7=12 FLAG WORDS REQD FOR RANDOM OR IO
>
IFN ANS74,<
ADDI AC10,13 ;3+8=13 FLAG WORDS REQD FOR RANDOM OR IO
>
RSTD11: MOVE AC0,AC10 ;SETUP AC0 FOR GETSPC
PUSHJ PP,GETSPC ;CLAIM THE BUFFER AREA
JRST GETSPK ;NO MORE CORE
JRST RSTDE5 ;RETURN
RSTER0: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Only DSK may be used for RANDOM, I-O or INDEX-SEQUENTIAL processing./]
RSTERR: MOVE AC2,[BYTE (5)10,31,20]
PUSHJ PP,MSOUT.
MXTPER: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Mag tape logical block size too large./]
MOVE AC2,[BYTE (5) 25,4,10,31,20] ;INDICATE WHICH FILE AND
;WHICH DEVICE HAS TROUBLE
PUSHJ PP,MSOUT. ;THEN QUIT
IFE ISAM,<
RERIT.: OUTSTR [ASCIZ /REWRITE ?/]
SKIPA
DELET.: OUTSTR [ASCIZ /DELETE ?/]
RSTIDX: OUTSTR [ASCIZ /
To process ISAM files CBLIO must be reassembled with the conditional
assembly switch,ISAM, equal to a non-zero value./]
JRST KILL
>
IFN ISAM,<
;SETUP FOR AN INDEX FILE
RSTIDX: ; IF THERE ARE ANY FILES THAT SHARE THE SAME BUFFER AREA
; THEN ALLOCATE THE SPACE FOR THE "SAVE" AREAS NOW.
; THE "SAVE" AREAS, ONE PER FILE, ARE LOCATED DIRECTLY
; BEFORE THE SHARED BUFFER AREA AND ARE POINTED TO BY D.IBL.
HLRZ AC12,F.LSBA(I16); [377A] GET LINK TO FILE TBL THAT SHARES
JUMPE AC12,RSTI05 ; [377A] [556] JUMP IF NONE
HRRZ AC6,D.IBL(I16) ; [377A] GET ADR OF "SAVE" AREA
JUMPN AC6,RSTI05 ; [377A] [556] JUMP IF ALREADY DONE
SETOM SHRDX. ;[556] SET SHARED ISAM BUF FLAG,INDICATING THAT
;[556] ALL FILES IN THIS SHARE CHAIN WILL HAVE
;[556] THEIR D.BL LOCATIONS SET BELOW AT RSTI04
MOVE AC12,I16 ; [377A] GET FIRST LINK
HLRZ AC4,D.BL(I16) ; [377A] ADR OF SBA (SHARED BUFFER AREA)
RSTI01: MOVEI AC0,ISMCLR+1 ; [377A] GET SIZE OF "SAVE" AREA
PUSHJ PP,GETSPC ; [377A] GET THE CORE SPACE
JRST GETSPK ; [377A] OOPS
HRRM AC4,D.IBL(AC12) ; [377A] SAVE ADR OF "SAVE" AREA
HRLZI AC6,ISMCLR+1 ; [377A] SIZE OF "SAVE" AREA
ADDM AC6,D.BL(I16) ; [377A] MOVE SBA TO OTHER SIDE OF "SAVE" AREA
MOVEI AC6,ISMCLR+1 ; [377A] SIZE OF "SAVE" AREA
ADDM AC6,(PP) ; [377A] UPDATE SAVED .JBFF
RSTI02: HLRZ AC12,F.LSBA(AC12);[377A] GET LINK TO NEXT FILE TBL
CAMN AC12,I16 ; [377A] HAVE WE CIRCLED THE CHAIN?
JRST RSTI03 ; [377A] YES - THEN DONE
LDB AC0,[POINT 2,F.WFLG(AC12),17]; [377A] GET ACCESS MODE
CAIE AC0,2 ; [377A] IS THIS AN ISAM FILE?
JRST RSTI02 ; [377A] NO - TRY NEXT LINK
HRRZ AC4,.JBFF ; [377A] GET ADR OF NEXT FREE LOC
JRST RSTI01 ; [377A] LOOP
;[556] NOW UPDATE BUF LOCATIONS FOR ALL THAT SHARE WITH THIS
;[556] INDEX FILE,SINCE ALLOCATION OF SAVE AREAS HAS MOVED IT
;[556] DOWN AT LEAST ONCE.
; [556] THIS CROCK UPDATES MORE THAN NECESSARY,SINCE THOSE IN
; [556] CHAIN FOLLOWING THE FIRST ISAM FILE WILL BE UPDATED
; [556] AT RSTDE2+2. THIS IS EASIEST WAY TO GET AT ALL
; [556] THAT MAY HAVE COME BEFORE THE FIRST ISAM FILE.
RSTI03: MOVE AC0,D.BL(I16) ;[556] GET NEW BUF LOC FOR ALL THIS SHARE CHAIN
RSTI04: HLRZ AC12,F.LSBA(AC12) ;[556] GET FILTAB OF NEXT FILE THAT SHARES
CAMN AC12,I16 ;[556] ALL WHO SHARE UPDATED?
JRST RSTI05 ;[556] YES,CONT.
HLLM AC0,D.BL(I12) ;[556] NO,UPDATE BUF LOC OF NEXT THAT SHARES
JRST RSTI04 ;[556] CONT. AROUND CHAIN
RSTI05: ;[556]
PUSHJ PP,OPNLIX ;IDXFIL FILENAME
IFE TOPS20,<
XCT ULKUP. ;***************
JRST RSTID1 ;
>
IFN TOPS20,<
PUSH PP,.JBFF ;SAVE IT
MOVEI AC0,ICHAN ;MAKE SURE WE HAVE CORE
PUSHJ PP,GETSPC ;GO SEE
JRST GETSPK ;NO CORE RETURN SO COMPLAIN
POP PP,.JBFF ;RESTORE JOBFF
PUSH PP,AC13 ;SAVE AC13
HLRZ I12,D.BL(I16) ;GET BUFFER LOCATION
LDB AC0,[POINT 4,UFRST.,12] ;[467] USE ALREADY ALLOCD CHAN
MOVEM AC0,ICHAN(I12) ;SAVE IT AWAY
PUSHJ PP,OCPT ;USE TOPS20 COMPT. UUO
JRST [CAIE AC1,600130 ;INVALID SMU ACCESS?
JRST [OUTSTR [ASCIZ /RESET time /]
JRST OCPERR ]
HRRZI AC0,OF%THW ;YES - SO TRY A VALID ACCESS
ANDCAM AC0,CP.BK3 ;TURN OFF THAWED (ON FROZEN)
MOVE AC1,[10,,CP.BLK];COUNT,,ADR OF ARG-BLK
COMPT. AC1, ;OPEN FILE IN FROZEN MODE
JRST [OUTSTR [ASCIZ /RESET time /]
JRST OCPERR ]
JRST .+1]
POP PP,AC13 ;RESTORE AC13
MOVE AC3,(AC13) ;GET DEVICE NAME
DEVCHR AC3, ;RESTORE DEVICE CHARACTERISTICS
>
MOVEI AC0,ITABL ;
HRR AC1,.JBFF ;
PUSHJ PP,GETSPC ;
JRST GETSPK ;ERROR RETURN
HRLI AC1,-STABL ;
SUBI AC1,1 ;DUMP MODE IOWD
SETZ AC2, ;TERMINATOR
MOVEI AC6,1 ;LOCATION OF
HRRM AC6,UIN. ; IOWD
XCT UIN. ;READ IN STATISTICS BLOCK
SKIPA AC2,1+MXLVL(AC1);[442] GET ORIGINAL # OF IDX LEVELS
JRST RSTIER ;
HLRZ I12,D.BL(I16) ;[442] GET BUFFER LOCATION
MOVNM AC2,OMXLVL(I12) ;[442] SAVE FOR OPNI22
MOVE AC12,1+ISPB(AC1);[442] INDEX SECTORS / BLK
HLRZ AC2,1(AC1) ;GET FILE FORMAT CODE
CAIN AC2,401 ;COMPLAIN IF NOT 401
JRST RSTID7 ;OK
PUSHJ PP,MSVID ;OUTPUT VALUE-OF-ID
OUTSTR [ASCIZ/ is not the index for ISAM,/]
PUSHJ PP,MSFIL. ;OUTPUT FILE NAME AND VID
PUSHJ PP,KILL ;KILL NEVER RETURNS
;HERE IF LOOKUP FAILURE
RSTID1: HLLZ AC1,D.F1(I16) ;[377] GET FLG1 PARMS
TLNN AC1,FILOPT ;[374] OPTIONAL FILE?
JRST RSTID8 ;[323] NO, FATAL
HRRZ AC1,ULBLK.+1 ;GET THE ERROR CODE
TRZ AC1,777740 ;WAS IT FILE NOT FOUND?
JUMPN AC1,LUPERR ;EXIT HERE IF OTHER
POP PP,.JBFF ;RESTORE THE STACK
SETOM D.OPT(I16) ;FILE NOT FOUND - REMEMBER THAT
JRST RSTLOO ; AND SHOOT HIM DOWN AT OPEN TIME
RSTID8: PUSHJ PP,MSFIL. ; [323]OUTPUT FILE NAME
OUTSTR [ASCIZ/ not found at reset time./]
PUSHJ PP,KILL ;[323] FATAL ERROR
RSTID7: HLLZS UIN. ;CLEAR IOWD POINTER
IMULI AC12,200 ;WRDS / SECTOR
CAMLE AC12,MXBUF ;LARGER THAN LARGEST?
MOVEM AC12,MXBUF ;YES, SAVE AS NEW LARGEST
MOVE AC6,1+MXLVL(AC1) ;NUMBER OF INDEX LEVELS
ADDI AC6,2 ;PLUS ONE FOR SAT BLK & ONE FOR SPLITING TOP-LEVEL
IMUL AC12,AC6 ;
;FIND THE LARGEST INDEX ENTRY SIZE
MOVE AC2,1+IESIZ(AC1)
CAMLE AC2,MXIE ;
MOVEM AC2,MXIE ;
;FIND THE MAX BLOCKING-FACTOR
MOVE AC2,DBF+1(AC1) ;
LDB AC6,F.BBKF ;[515] BLOCKING FACTOR IN PROGRAM
CAME AC2,AC6 ;[535] [515] [1062] IF NOT EQUAL, ERROR
JRST RSTER1 ;[515] TELL USER AND GET OUT
CAMLE AC2,MXBF ;
MOVEM AC2,MXBF ;
MOVE AC4,KEYDES+1(AC1) ;[515] GET ISAM KEY DESCRIPTION
MOVEM AC4,OKEYDS+1(AC1) ;[515] SAVE KEY FOR OPEN CHECKING
MOVE AC4,RECBYT+1(AC1) ;[515] GET SIZE OF DATA BLOCK IN BYTES
MOVEM AC4,ORCBYT+1(AC1) ;[515] SAVE IT FOR CHECKING AT OPEN
MOVE AC4,EPIB+1(AC1) ;[515] GET NUM OF ENTRIES/INDEX BLOCK
MOVEM AC4,OEPIB+1(AC1) ;[515] SAVE IT FOR CHECKING AT OPEN
LDB AC6,KY.TP ; GET KEY TYPE
JUMPN AC6,RSTID2 ;BRANCH IF NON-NUMERIC-DISPLAY
MOVE AC4,1+IESIZ(AC1) ;INDEX ENTRY BLOCK SIZE
SUBI AC4,1 ;-2 HDR WRDS, +1 WRD FOR WRAP-AROUND
IFN ANS68,<
IMULI AC4,3 ;RESERVE 3 KEY AREAS
>
IFN ANS74,<
IMULI AC4,7 ;RESERVE 7 KEY AREAS (2 FOR DEL/RWT CNTRY )
>
JRST RSTID3 ;
RSTER1: OUTSTR [ASCIZ/ Reset blocking factor for/] ;[515]
PUSHJ PP,MSFIL. ;[515] OUTPUT FILE NAME
OUTSTR [ASCIZ/ differs from user's program ./] ;[515]
PUSHJ PP,KILL ;[515] FATAL ERROR
RSTER2: PUSH PP,AC1 ;[515] SAVE IT FOR LATER
PUSH PP,AC4 ;[515] SAVE IT FOR LATER
OUTSTR [ASCIZ/ Reset key descriptor for/] ;[515]
PUSHJ PP,MSFIL. ;[515] GIVE HIM FILE NAME
OUTSTR [ASCIZ/ differs from program key descriptor.
/]
POP PP,AC4 ;[515] GET AC4 BACK
POP PP,AC1 ;[515] GET AC1 BACK
POPJ PP, ;[515] PROCEED AT YOUR OWN RISK
RSTID2:
IFN ANS68,<
MOVEI AC4,6 ;(1+1)*3
TRNN AC6,1 ;ODD = 1 WRD, EVEN = 2 WRDS
MOVEI AC4,9 ;(2+1)*3
>
IFN ANS74,<
MOVEI AC4,12 ; (1+1)*5
TRNN AC6,1 ; ODD = 1, EVEN = 2
MOVEI AC4,17 ; (2+1)*5
>
RSTID3:
IFN ANS68,<
ADDI AC12,2(AC4) ;NUMBER OF WORDS ALLOCATED
>
IFN ANS74,<
ADDI AC12,4(AC4) ;NUMBER OF WORDS ALLOCATED
>
MOVE AC2,F.WDNM(I16)
MOVE AC2,1(AC2) ;DATA FILE DEVICE NAME
MOVEM AC2,UOBLK.+1 ;
XCT UOPEN. ;**************
JRST RSTDE1 ;ERROR
DEVCHR AC2, ;DEVCHR
TXNE AC2,DV.DSK ;DATA FILE
TXNN AC3,DV.DSK ;IDX FILE
JRST RSTER0 ;MUST BE A DSK
LDB AC5,KY.MD ; GET DATA MODE FROM STS-BLOCK
XCT RSTID4(AC5) ; SAME AS FILE TABLE DATA MODE?
JRST RSTID5 ; YES
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Data-mode discrepancy/]
MOVE AC2,[BYTE (5)10,31,20,4]
JRST MSOUT1
RSTID4: TLNE FLG,DDMSIX ; SKIP IF NOT SIXBIT
TLNE FLG,DDMEBC ; EBCDIC
TLNE FLG,DDMASC ; ASCII
Z ;
RSTID5: PUSH PP,AC12 ; [375] SAV REG 12
MOVEI AC12,1(AC1) ; [375] SET UP TO GET ISAM REC SIZE
PUSHJ PP,OPNWPB ;RETURNS WRDS/LOGICAL BLOCK IN AC10
IFN ANS74,<
; make sure that the internal record area will fit in AUXBUF
LDB AC5,F.BMRS ; Get record size
LDB AC4,[POINT 2,FLG,14] ; Get internal mode
HRRZ AC4,RBPTBL(AC4) ; Get bytes per internal record word
IDIVI AC5,(AC4) ; Get words in record area
SKIPE AC6 ; Skip if no round up
ADDI AC5,1 ; Round up
CAIGE AC10,(AC5) ; Is record area larger than aux buf?
MOVE AC10,AC5 ; Yes, reset so it will hold record area
>; END IFN ANS74
;BL; 2 LINES INSERTED AT RSTID5 + 3 TO FIX ISAM/RANDOM SHARED BUFFR BUG
TLNE FLG,IDXFIL ;ISAM FILE?
SKIPN ,PAGBUF(I12) ;YES, & PAGE I/O TOO?
JRST RSTID6 ; NO
ADDI AC10,777 ; YES, AT LEAST 512 WD/PG
LSH AC10,-9 ; ROUND
LSH AC10,9 ; OFF
RSTID6: POP PP,AC12 ; [375]RESTORE AC12
CAMLE AC10,MXBUF ;
MOVEM AC10,MXBUF ;SAVE AS LARGEST AUX BUF
ADD AC12,AC10 ;
ADDI AC12,ITABL ;INDEX TABLE LEN
MOVE AC0,AC12 ;
MOVEM AC0,D.OBH(I16) ;SAVE AMOUNT OF CORE REQUIRED
PUSHJ PP,GETSPC ;GRAB SOME CORE AREA
JRST GETSPK ;ERROR RETURN
IFN ANS74,<
HLRZ AC4,D.BL(I16) ; Reget buffer location
MOVEM AC5,RCARSZ(AC4) ; Save record area length for START checks
>
SETZM UOBLK. ;
;NOW SAVE INITIAL CONDITIONS FOR OPEN LOGIC
HRRZ AC4,D.IBL(I16) ; [377A] GET ADR OF "SAVE" AREA
HRLI AC4,ISCLR1+1(AC1); [377A] ADR OF AREA TO BE SAVED
MOVEI AC2,ISMCLR(AC4) ; [377A] END OF AREA TO BE SAVED
TRNE AC4,-1 ; [377A] SKIP IF NOTHING TO SAVE
BLT AC4,(AC2) ; [377A] DOIT
PUSH PP,AC12 ; SAV REG 12
MOVEI AC12,1(AC1) ; POINT AT STAT BLOCK
PUSHJ PP,RSTBPB ; CALC BUFFS PER LOG-BLK
POP PP,AC12 ; RESTORE AC12
JRST RSTDE5 ;RETURN
RSTIER: XCT UGETS. ;INPUT ERROR DURING RESET UUO
TXNE AC2,IO.EOF ;[376] EOF?
OUTSTR [ASCIZ / Unexpected EOF on ISAM index file./] ;[376]
PUSHJ PP,IOERM1 ;
MOVE AC2,[BYTE (5)35,4,10,31,20,2]
JRST KILL ;&KILL
>
;GET CORE SPECIFIED BY (AC0)
GETSPC: PUSH PP,.JBFF ;INCASE THE CORE UUO FAILS
ADDB AC0,.JBFF ;ASSUME WE'LL GET IT
CAMG AC0,.JBREL ;IS THERE ENOUGH IN FREE CORE
JRST GETSP1 ;YEP
CORE AC0, ;NO, GET SOME MORE CORE
JRST GETSP2 ;ERROR RETURN
GETSP1: POP PP,(PP) ;.JBFF IS GOOD
JRST RET.2 ;NORMAL EXIT
GETSP2: POP PP,.JBFF ;RESTORE .JBFF, CORE UUO FAILED
POPJ PP,
GETSP9: OUTSTR [ASCIZ/Insuficient core for buffer requirements./]
POPJ PP,
GETSPK: PUSHJ PP,GETSP9
JRST KILL
IFE TOPS20,<
;SEE IF MONITOR HAS AUTO LABELING FACILITY.
;SET SUTOLB TO NON-ZERO IF IT DOES.
SETALB: SETZM AUTOLB ; INIT TO NO AUTO FACILITY
MOVE AC1,[%SITLP]
GETTAB AC1,
SETZ AC1, ; ERROR SO OLD STYLE PROCESSING
SKIPE AC1 ; WHAT IS IT?
SETOM AUTOLB ; AUTO FACILITY!
POPJ PP,
>
;SUBROUTINE TO SET UP OVERLAY FILE
;ENTER WITH AC1 = FILE NAME
SETOVR: HRLZI AC0,577774 ;[342]TURN OFF CHAN 1
ANDM AC0,OPNCH. ;DOIT
SETO AC0, ;DSK = -1
SKIPN AC3,RN.DEV ;[333]IF DEVICE SPECIFIED, GET IT
HRLZI AC3,'DSK'
SETOV1: MOVEI AC2,IO.SYN+.IOBIN ;SET UP DEVICE
HRRZI AC4,OVRBF. ;
OPEN 1,AC2 ;[342]INIT
JRST SETOV4 ;
MOVSI AC2,'OVR'
SETZB AC3,AC4 ;
SKIPE AC0 ;[333]IF NOT TRYING SYS
MOVE AC4,RN.PPN ;[333]GET OVERLAY PPN
LOOKUP 1,AC1 ;[342]
JRST SETOV5 ;LOOKUP FAILED
INBUF 1,2 ;GET 2 BUFFERS
MOVE AC1,.JBFF ;GET NEXT FREE WORD
MOVEM AC1,OVRIX. ;WHERE INDEX BLOCK WILL BE
MOVEI AC0,400 ;SIZE WE NEED
PUSHJ PP,GETSPC ;GET IT
JRST GETSPK ;FAILED
MOVE AC1,OVRIX. ;
PUSHJ PP,SETOV2 ;
MOVE AC1,OVRIX.
ADDI AC1,200
SETOV2: IN 1, ;[342]
SKIPA AC2,OVRBF. ;
JRST SETOV6 ;
MOVSI AC2,2(AC2) ;
HRR AC2,AC1 ;
BLT AC2,177(AC1) ;
POPJ PP,
SETOV4: OUTSTR [ASCIZ "Cannot initialize overlay."] ;[536]
JRST SETOV7 ;[536]
SETOV5: HRLZI AC3,'SYS' ;[536]TRY SYS IF DSK FAILS
AOJE SETOV1
OUTSTR [ASCIZ "Cannot find overlay file ."]
SKIPN AC3,RN.DEV ;[536]
MOVSI AC3,'DSK' ;[536]
PUSHJ PP,MSDEV1 ;[536] PRINT DEVICE PART
PUSHJ PP,COLON ;[536] PRINT ":"
MOVE AC3,OVRFN. ;[536] FILE NAME
PUSHJ PP,MSDEV1 ;[536] PRINT IT
OUTSTR [ASCIZ /.OVR/] ;[536] EXT
SKIPE AC3,RN.PPN ;[536] ANY PPN?
PUSHJ PP,MSDIR. ;[536] YES, PRINT IT
JRST KILL
SETOV6: OUTSTR [ASCIZ "INPUT error on overlay."]
SETOV7: SKIPN AC3,RN.DEV ;[536]
MOVSI AC3,'DSK' ;[536]
MOVEI AC1,AC3 ;[536] POINT TO WHERE IT IS
PUSHJ PP,MSDEVA ;[536] PRINT DEVICE PART
JRST KILL
;ROUTINE TO REORGANIZE THE FLAGS
RSTFLG: MOVE FLG,F.WFLG(I16) ;GET FLAGS
MOVX AC15,BR%IO!BR%RER!BR%RRC
AND AC15,FLG ;RRUNER & RRUNRC
LDB AC1,[POINT 3,FLG,9]
HLLZ AC2,FLGTAB(AC1) ;DEVICE DATA MODE
TLZ AC2,037777 ;
IOR AC15,AC2 ;
MOVEI AC0,SASCII ; GET STANDARD ASCII FLAG
CAIN AC1,4 ; AND SET IT IF REQUESTED
IORM AC0,D.RFLG(I16) ; DOIT
LDB AC1,[POINT 2,FLG,15]
HLLZ AC2,FLGTAB(AC1) ;CORE DATA MODE
TLZ AC2,777707 ;
IOR AC15,AC2 ;
LDB AC1,[POINT 2,FLG,17]
HLLZ AC2,FLGTAB(AC1) ;ACCESS MODE
TLZ AC2,777770 ;
IOR AC15,AC2 ;
TXNE FLG,BR%OPF ;FILOPT?
TRO AC15,FILOPT ;
TXNE FLG,BR%NSL ;NONSTD?
TRO AC15,NONSTD ;
TXNE FLG,BR%STL ;STNDRD?
TRO AC15,STNDRD ;
TLNN AC15,DDMEBC ;ONLY EBCDIC HAS VAR-LEN RECORDS
JRST RSTFL1 ;
TXNE FLG,BR%VLE ;VARIABLE LENGTH EBCDIC RECORDS?
TRO AC15,VLREBC ;
RSTFL1: HLLM AC15,F.WFLG(I16);SAVE IT
HRLM AC15,D.F1(I16) ;FLG1
TLNE FLG,RRUNER!RRUNRC ;RERUNING?
SETOM TEMP.2 ;YES, REMEMBER TO TURN OFF CHAN 17
POPJ PP, ;
;BITS 0-3 DEVICE DATA MODE
; 12-14 CORE DATA MODE
; 15-17 ACCESS MODE
FLGTAB: 200022,,0
040001,,0
400044,,0
100010,,0
400000,,0 ; STANDARD ASCII
Z
Z
Z
;TRAP INTERUPT ROUTINE
TRAP.:
IFE TOPS20,<
PORTAL .+1 ; SET EXECUTE ONLY ENTRY POINT
>
SKIPE INTRAP## ;ARE WE ALREADY IN A TRAP?
EXIT ;YES, JUST QUIT
SETOM INTRAP## ;SET THE FLAG TO PREVENT LOOPING
MOVE AC0,.JBCNI ; APR STATUS
TXNE AC0,AP.ILM
OUTSTR [ASCIZ/Memory protection violation at user loc /]
TXNE AC0,AP.NXM
OUTSTR [ASCIZ/Non-ex-mem request at user loc /]
TXNE AC0,AP.POV
JRST TRAP1 ;PDLOV
TRAP0: PUSHJ PP,OUTBF1 ;REINIT THE TTY BUFFER
HRLO AC12,.JBTPC ;THE GUILTY LOCATION
PUSHJ PP,PPOUT4 ;OUTPUT THE LOC
HRRZ AC0,.JBTPC ;[312] SEE IF ERROR IS
CAIL AC0,RSTLNK ;[312] IN RSTLNK
CAIL AC0,RSTLNX ;[312] ROUTINE.
JRST KILL ;[312] NO
OUTSTR [ASCIZ /$Failing routine is RSTLNK in CBLIO
MACRO routine loaded in place of COBOL subroutine?/]
JRST KILL ;AND KILL
TRAP1: OUTSTR [ASCIZ/?LBLPDL Push-down-list overflow at /]
JRST TRAP0
KPROG.: TTCALL 3,[ASCIZ "?LBLADP Attempt to drop off end of program."]
JRST KILL.
KDECL.: TTCALL 3,[ASCIZ "?LBLADD Attempt to drop off end of DECLARATIVES."]
JRST KILL.
ILLC.: TTCALL 3,[ASCIZ "?LBLRCL Recursive call."]
JRST KILL.
;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO"
;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME.
GOTO.: OUTSTR [ASCIZ /?LBLEUG Encountered an unaltered GOTO with no destination.
/]
;FALL THRU
;KILL TYPES OUT THE LOCATION OF THE LAST COBOL VERB,
;STOPS ALL IO AND EXITS TO THE MONITOR.
KILL: PUSHJ PP,TYPSTS ;TYPE ERROR-NUMBER, BLOCK # + REC #
KILL.:
IFN LSTATS, SETOM MRKILL ;NOTE PROGRAM WAS ABORTED
PUSHJ PP,VEROUT ;TYPE THE VERSION NUMBER
OUTSTR [ASCIZ /
?/]
SKIPE TRAC1. ;[270] IS THIS A PRODUCTION PROGRAM (I.E. /P)?
PUSHJ PP,@TRAC1. ;NO, CALL BTRAC. IN TRACE ROUTINE
PUSHJ PP,PPOUT. ;TYPE THE LOCATION OF LAST COBOL VERB
HRRZ AC16,FILES. ;[444] GET START OF FILE TABLES
JUMPE AC16,STOPR2 ;[444] NO FILES, DON'T BOTHER
KILL1: MOVE FLG,F.WFLG(I16) ;[444] GET FLAGS FOR THIS FILE
TLNE FLG,OPNOUT ;[622][444] OPEN FOR OUTPUT
TLNE FLG,OPNIN ;[622][444] YES, OPEN FOR OUTPUT ONLY
SKIPA ;[1033] SKIP IF INPUT FILE
JRST KILL1A ;[1033] JUMP IF OUTPUT ONLY
MOVE AC13,D.DC(I16) ;[1033] GET DEV CHARACTERISTICS
TXNE AC13,DV.MTA ;[1033] MAG TAPE?
JRST KILL2A ;[1033] YES, DO ABORT CLOSE
JRST KILL4 ;[444] NO, CHECK NEXT ONE
KILL1A: MOVE AC13,D.DC(I16) ;[1033][444] GET DEV CHARACTERISTICS
TXNN AC13,DV.DSK ;[444] DISK?
JRST KILL4 ;[444] NO, TRY NEXT FILE
SETZB AC2,AC3 ;[444]
MOVE AC10,[POINT 6,2] ;[444] SET UP TO PUT VID IN 2 AND 3
MOVE AC5,F.WVID(I16) ;[444] GET PTR TO VALUE OF ID
PUSHJ PP,OPNVID ;[444] GET IT INTO AC2 AN AC3
HRRZ AC1,FILES. ;[444] SET UP FOR SUB-LOOP
KILL2: CAIN AC16,(AC1) ;[444] COMPARING AGAINST ITSELF
JRST KILL3 ;[444] YES, DON'T BOTHER
MOVE AC13,D.DC(AC1) ;[444] GET DEV CHARS
TXNN AC13,DV.DSK ;[444] IS IT A DISK?
JRST KILL3 ;[444] NO, IGNORE
MOVE FLG,F.WFLG(AC1) ;[444] GET FLAGS
TLNN FLG,OPNIN ;[444] IS IT OPEN FOR INPUT
JRST KILL3 ;[444] NO, CAN'T BE SUPERSEDING
SETZB AC14,AC15 ;[444]
MOVE AC10,[POINT 6,14] ;[444] PUT VID IN 14 AND 15
MOVE AC5,F.WVID(AC1) ;[444] BYTE PTR TO VALUE OF ID
PUSHJ PP,OPNVID ;[444] GET IT
CAMN AC2,AC14 ;[444] FILENAMES EQUAL?
CAME AC3,AC15 ;[444] YES, EXTENSIONS EQUAL?
JRST KILL3 ;[444] NO, FORGET IT
KILL2A: LDB AC4,DTCN. ;[1033][444] GET CHANNEL NUMBER
LSH AC4,27 ;[444] POSITION IT
MOVE AC5,[CLOSE CL.RST] ;[444] SET UP A CLOSE
ADD AC5,AC4 ;[444] ADD CHANNEL
XCT AC5 ;[444] CLOSE FILE, DELETING NEW
;[444] FILE, LEAVING OLD INPUT
JRST KILL4 ;[444] GO CHECK ANOTHER ONE
KILL3: HRRZ AC1,F.RNFT(AC1) ;[444] GET ANOTHER FILE FOR SUB-LOOP
JUMPN AC1,KILL2 ;[444] GO CHECK, IF ANY LEFT
KILL4: HRRZ AC16,F.RNFT(AC16) ;[444] GET ANOTHER FILE TO CHECK
JUMPN AC16,KILL1 ;[444] GO CHECK IF ANY LEFT
JRST STOPR2
;TYPE OUT SOME ERROR INFORMATION
TYPSTS: OUTSTR [ASCIZ /
$ Error-number = /]
TYPST1: MOVE AC0,FS.EN ;ERROR-NUMBER
PUSHJ PP,PUTDEC ;TYPE IT
MOVE AC0,FS.BN ;BLOCK-NUMBER
JUMPE AC0,TYPST2 ;
OUTSTR [ASCIZ / Block-number = /]
PUSHJ PP,PUTDEC ;
TYPST2: MOVE AC0,FS.RN ;RECORD-NUMBER
JUMPE AC0,RET.1 ;
OUTSTR [ASCIZ / Record-number = /]
JRST PUTDEC ;RETURN
;STOPR. IS CALLED WITH A "PUSHJ PP,STOPR." ALL FILES ARE
;CLOSED VIA COBOL CLOSE UUOS AND A CALLI EXIT IS EXECUTED.
STOPR.: HRRZ AC16,FILES. ;LOOP THROUGH THE FILE TABLES
JUMPE AC16,STOPR2 ;DONE
STOPR1: HRLI AC16,001040 ;STANDARD CLOSE UUO
MOVE FLG,F.WFLG(I16) ;GET THE FLAGS
IFN ANS68,<
TLNE FLG,OPNIN+OPNOUT; IF THE FILE IS OPEN
PUSHJ PP,C.CLOS ; CLOSE IT
>;END IFN ANS68
IFN ANS74,<
LDB AC1,F.BRMS ; Get RMS flag bit
JUMPN AC1,STOP1C ;Jump if this is an RMS file.
TLNE FLG,OPNIN+OPNOUT; Skip if the file is not open
PUSHJ PP,C.CLOS ;Close file
JRST STOPRA ;and continue
;Check RMS file to see if it is open
STOP1C: HRRZ AC1,D.F1(I16) ;Get flag bits
TXNN AC1,LF%INP!LF%OUT ;Is file open?
JRST STOPRA ;No
PUSH PP,AC16 ;SAVE AC16
HRRZ AC1,I16 ;NO FLAG BITS,,FILTAB
PUSH PP,AC1 ;STORE ARGLIST ON THE STACK
MOVEI AC16,(PP) ;POINT TO THE STACK ARG LIST
PUSHJ PP,CL.MIX## ;CALL RMS CLOSE
POP PP,(PP) ;THROW AWAY ARGLIST
POP PP,AC16 ;RESTORE AC16
STOPRA:>;END IFN ANS74
HRRZ AC16,F.RNFT(I16);NEXT FILE
JUMPN AC16,STOPR1 ;LOOP
STOPR2: MOVE AC0,FS.IEC ; NUMBER OF IGNORED ERRORS
JUMPE AC0,STOPR3 ; NONE IGNORED
OUTSTR [ASCIZ /%LBLIGN /] ;
CAIE AC0,1 ; ONLY ONE?
JRST STPR2A ; NO
OUTSTR [ASCIZ/ 1 error ignored./]
JRST STOPR3 ; CONT
STPR2A: PUSHJ PP,PUTDEC ; TYPE NUMBER
OUTSTR [ASCIZ/ errors ignored./]
STOPR3: PUSHJ PP,@HPRT.## ; PRINT HISTORY REPORT IF ANY
IFN CSTATS,<
SKIPE METR.## ;WERE METER POINTS ENABLED?
PUSHJ PP,WRTMET ;YES, WRITE THE FILE
>
IFN LSTATS,<
PUSHJ PP,MRDMPT ;DUMP ALL LSTATS DATA
>
IFN DBMS,<
SKIPE DBSTP. ;IGNORE IF BEFORE VERSION 12A
PUSHJ PP,@DBSTP. ;CLEANUP DBMS
>
EXIT ;CALLI EXIT
JRST .-1 ;For TOPS20: Stay stopped.
; C.STOP IS CALLED WITH A "PUSHJ PP,C.STOP" AFTER THE OPERATOR
; TYPES "CONTINUE" IT RETURNS TO THE CALLING ROUTINE
C.STOP: OUTSTR [ASCIZ /
$ type CONTINUE to proceed .../]
EXIT 1, ; WAIT FOR CONT
POPJ PP, ;
;TYPE THE VERSION NUMBER OF COBOL, LIBOL, SORT, DBMS, RMS, etc.
VEROUT: PUSHJ PP,OUTBF. ;DUMP THE CURRENT BUFFER TO SYNC WITH TTCALLS
IFN ANS68,<
OUTSTR [ASCIZ /
COBOL-68 /]
>
IFN ANS74,<
OUTSTR [ASCIZ /
COBOL-74 /]
>
MOVE AC12,COBVR. ;GET COBOL VERSION NUMBER
PUSHJ PP,VEROU0 ;TYPE VERSION NUMBER IN STANDARD FORMAT
IFN ANS68,<
OUTSTR [ASCIZ /, LIBOL /]
>
IFN ANS74,<
OUTSTR [ASCIZ /, C74OTS /]
>
MOVE AC12,LIBVR. ;GET VERSION NUMBER
PUSHJ PP,VEROU0 ;TYPE THE VERSION NUMBER IN STANDARD FORMAT
SKIPE AC12,SRTVR. ;GET SORT VERSION NUMBER
PUSHJ PP,[OUTSTR [ASCIZ /, SORT /]
JRST VEROU0] ;TYPE THE VERSION NUMBE IN STANDARD FORM
IFN DBMS,<
SKIPE AC12,DBMVR.## ;GET DBMS VERSION NUMBER
PUSHJ PP,[OUTSTR [ASCIZ /, DBMS /]
JRST VEROU0] ;TYPE THE VERSION NUMBER IN STANDARD FORM
>
IFN ANS74,<
SKIPE AC12,RMSVR.## ;GET RMS VERSION NUMBER
PUSHJ PP,[OUTSTR [ASCIZ /, RMS /]
JRST VEROU0] ;TYPE THE VERSION NUMBER IN STANDARD FORM
>
JRST DSPL1. ;"CRLF" AND EXIT
VEROU0: ROT AC12,3 ;GET WHO FIELD OUT OF THE WAY
MOVEI AC0,3 ;
PUSHJ PP,NUMOUT ;THE VERSION NUMBER
LDB AC1,[POINT 6,AC12,5] ;GET MINOR VERSION
SOJL AC1,VEROU2 ;DON'T OUTPUT IF NULL
IDIVI AC1,^D26 ;^D26="Z", ^D27="AA"
JUMPE AC1,VEROU1 ; DON'T OUTPUT FIRST IF NULL
PUSH PP,AC2 ;SAVE 2ND
MOVEI C,100(AC1) ;GET 1ST LETTER
PUSHJ PP,OUTCH. ;OUTPUT IT
POP PP,AC2
VEROU1: MOVEI C,101(AC2) ;GET 2ND LETTER
PUSHJ PP,OUTCH. ;OUTPUT IT
VEROU2: MOVEI AC0,6 ;
LSH AC12,6 ;SHIFT EDIT # INTO LEFT HALF
TLNN AC12,-1
JRST VEROU3 ;DONE IF NO EDIT NUMBER
MOVEI C,"(" ;
PUSHJ PP,OUTCH. ;
PUSHJ PP,NUMOUT ;THE EDIT NUMBER
MOVEI C,")" ;
PUSHJ PP,OUTCH. ;
VEROU3: ROT AC12,3 ;GET WHO FIELD BACK IN RHS
JUMPE AC12,OUTBF. ;DON'T OUTPUT IF NULL
MOVEI C,"-" ;SEPARATE BY HYPHEN
PUSHJ PP,OUTCH.
MOVEI C,"0"(AC12) ;TURN INTO ASCII
PUSHJ PP,OUTCH. ;STORE
JRST OUTBF. ;OUTPUT AND RETURN
NUMOUT: MOVEI C,6 ;HALF AN ASCII ZERO
LSHC C,3
TRNN C,7 ;SKIP LEADING ZEROES
SOJG AC0,NUMOUT
JUMPL AC0,RET.1
PUSHJ PP,OUTCH.
MOVEI C,6
LSHC C,3
SOJG AC0,.-3
LSHC C,-3 ;RESTORE LAST DIGIT
POPJ PP,
; TYPES OUT THE LISTING'S LOCATION OF "PUSHJ PP,VERB"
; OR THE PUSHJ'S RETURN ADR IF NO PUSHJ IS FOUND
; (SBPSA.) NON-ZERO IF A SUBPROGRAM CALL IS ACTIVE
; LH IS (RH(17)) I.E. PUSH DOWN STACK
; RH IS ENTRY POINT'S ADDRESS
; ENTRY-1 SIXBIT /NAME-OF-ENTRY-POINT/
; ENTRY-2 LH: FIRST LOCATION OF CURRENT (SUB)PROGRAM
; RH: SIXBIT /SUBPROGRAM-NAME/
PPOUT.: OUTSTR [ASCIZ /Last COBOL verb called from /]
HLRO AC12,PP ; FIND THE BEG OF THE STACK
ADD AC12,PUSHL. ; --
SUBI AC12,(PP) ; --
MOVNS AC12 ; --
SKIPE AC11,SBPSA. ; THIS A SUBPROGRAM OR OVERLAY?
HLRZ AC12,AC11 ; YES - GET FIRST ENTRY FROM HERE
ADDI 12,1 ; 12 HAS POINTER TO FIRST ENTRY ON STACK
MOVEI AC1,0 ; ASSUME NO COBDDT
SKIPE CB.DDT ; ANY COBDDT?
MOVEI AC1,2 ; YES - THERE ARE 2 ENTRIES ON LIST
MOVE AC2,LIBSW. ; GET MULTIPLE PERFORM FLAG
TRNE AC2,MPWC.S ; MULTIPLE-PERFORMS?
ADDI AC1,1 ; YES - ANOTHER ENTRY ON PDLIST
IMUL AC1,LEVEL. ; ENTRIES PER LEVEL.
ADD AC12,AC1 ; SKIP OVER COBDDT+PERF. STUFF
HRRZ AC12,(AC12) ; GET RETURN ADR MINUS ONE
MOVEI AC2,5 ; LOOK BACK 5 LOCS FOR A PUSHJ
MOVEI AC1,-1(AC12) ; START AT THE RETURN ADR-1
PPOUT1: HLRZ AC3,(AC1) ; GET THE PUSHJ TO THE RIGHT HALF
SUBI AC1,1 ; SET UP FOR NEXT COMPARE
CAIE AC3,(PUSHJ PP,) ; WHAT IS IT?
SOJG AC2,PPOUT1 ; NOT A PUSHJ SO LOOP
JUMPE AC2,PPOUT2 ; NOT THERE SO GIVE RET ADR-1
HRRI AC12,1(AC1) ; THE PUSHJ'S ADR
PPOUT2: SKIPN AC11,SBPSA. ; IF SUBPROGRAM
MOVE AC11,%F.PTR ; NO - MAIN PROGRAM
HLRZ AC11,-2(AC11) ; GET START ADR
TRZ AC11,400000 ; TURN OFF BIT18 IF ON
SUB AC12,AC11 ; GET OFFSET FROM HERE
HRLOI AC12,(AC12) ; XWD ADR,,-1
PPOUT4: MOVEI C,6 ; HALF OF AN ASCII ZERO-60
LSHC C,3 ; APPEND THE OCTAL NUMBER
PUSHJ PP,OUTCH. ; DEPOSIT IT IN THE TTY BUFFER
TRNE AC12,-1 ; HAVE WE SEEN SIX NUMBERS?
JRST PPOUT4 ; NO, LOOP
PUSHJ PP,OUTBF. ; DUMP IT NOW
PPOT4.: OUTSTR [ASCIZ/ in program /]
SKIPN AC3,SBPSA. ; SKIP IF ANY SUBPRGMS
JRST PPOUT6 ; NONE
PPOUT5: OUTSTR [ASCIZ /
/]
HRRI AC1,(AC3) ; GET ADR OF SUBPRG NAME
HRL AC1,-2(AC1) ;
TLNE AC1,-1 ;
HLRZS AC1 ; IF IT'S ZERO
SUBI AC1,1 ; ITS SAME AS ENTRY POINT
HRLI AC1,(POINT 6) ; MAKE A BYTE-PTR
MOVEI AC4,6 ; ONLY 6 CHARS PER NAME
PUSHJ PP,MSVID4 ; TYPE IT
OUTSTR [ASCIZ / entry /]
HRRI AC1,-1(AC3) ; MAKE BYTE-PTR TO ENTRY POINT
HRLI AC1,(POINT 6) ; FINISH BYTE-POINTER
MOVEI AC4,6 ; 6 IS MAX
PUSHJ PP,MSVID4 ; TYPE IT
OUTSTR [ASCIZ / called from/]
MOVS AC3,AC3 ; ANY MORE SUBPRGMS?
SKIPE AC3,(AC3) ; SKIP IF NOT
JRST PPOUT5 ; THERE ARE
PPOUT6: MOVE AC1,%F.PTR ; GET THE PROGRAM NAME
MOVEI AC1,-1(AC1) ; THIS IS IT
HRLI AC1,(POINT 6) ; MAKE BYTE POINTER
MOVEI AC4,6 ; NAME HAS 6 CHARS
PUSHJ PP,MSVID4 ; DUMP THE NAME
JRST DSPL1. ; APPEND "CRLF", THEN EXIT
; SUSPC: A SUBROUTINE THAT DETERMINES THE AMOUNT OF SPACE REQUIRED
; FOR SIMULTANEOUS UPDATE, AND GETS IT. IT ALSO INITIALIZES THE
; GLOBAL VARIABLES SU.RRT, SU.EQT, SU.DQT, SU.MQT,
; AND SU.FBT TO POINT TO THE RETAINED RECORDS TABLE, THE ENQUEUE
; TABLE, THE DEQUEUE TABLE, THE MODIFY TABLE, AND THE FILL/FLUSH
; BUFFER TABLE.
;
; ARGUMENTS:
;
; AC14 CONTAINS THE ADDRESS OF A WORD CONTAINING THE
; STARTING ADDRESS OF THE MAIN PROGRAM.
;
; CHANGES:
;
; AC0
; AC1
; AC2
; AC3
; WHATEVER GETSPC CHANGES
;
; CALLS:
;
; SUSPC1
; GETSPC
;
; ERRORS:
;
; NOT ENOUGH SPACE AVAILABLE FOR SIMULTANEOUS UPDATE
; REQUIREMENTS. IF THIS OCCURS, A MESSAGE IS SENT
; TO TTY AND A JRST KILL. IS EXECUTED.
EXTERN SU.RRT, SU.EQT, SU.FBT, SU.DQT, SU.MQT
SUSPC: HRRZ AC1,0(AC14) ;GET STARTING ADDRESS OF MAIN PROGRAM
SETZM SU.RRT ;INITIALIZE GLOBAL VARIABLES
SETZM SU.EQT
SETZM SU.FBT
PUSHJ PP,SUSPC1 ;EXAMINE THE MAIN PROGRAM AND ALL ITS
;SUBPROGRAMS TO DETERMINE THE MAXIMUM
;REQUIREMENTS FOR SIMULTANEOUS UPDATE
;SPACE
MOVE AC0,SU.EQT ;[437]
IMULI AC0,4 ;[437]
ADD AC0,SU.RRT ;[437] (THERE ARE FOUR ENQ/DEQ TABLES)
ADD AC0,SU.FBT
JUMPE AC0,RET.1 ;RETURN IF NO SPACE REQUIRED
PUSH PP,.JBFF ;SAVE .JBFF ON THE STACK
PUSHJ PP,GETSPC ;GET THE SPACE, IF POSSIBLE
JRST SUERR ;JUMP IF NOT POSSIBLE
POP PP,AC1
MOVE AC2,AC1
ADD AC2,SU.RRT
MOVEM AC1,SU.RRT ;PUT RETAINED RECORDS TABLE AT ADDRESS
;OF FORMER .JBFF
MOVE AC1,AC2 ;PUT ENQ/DEQ TABLES AT END OF THE
;RETAINED RECORDS TABLE
ADD AC2,SU.EQT
MOVEM AC2,SU.DQT
ADD AC2,SU.EQT
MOVEM AC2,SU.MQT
ADD AC2,SU.EQT
MOVEM AC1,SU.EQT
MOVEM AC2,SU.FBT ;PUT THE FILL/FLUSH BUFFER TABLE AT THE
;END OF THE ENQ/DEQ TABLES
POPJ PP, ;WE'RE ALL DONE
SUERR: OUTSTR [ASCIZ"Not enough space available to meet the requirements of simultaneous update. Please relink to provide more space."]
JRST KILL.
; SUSPC1: A SUBOUTINE TO DETERMINE THE MAXIMUM REQUIREMENT FOR SIMULTANEOUS
; UPDATE SPACE OF A PROGRAM AND ITS SUBPROGRAMS
;
; ARGUMENTS:
;
; AC1: THE STARTING ADDRESS OF THE PROGRAM
;
; IN THE %FILES AREA OF THE PROGRAMS THERE ARE THESE QUANTITIES:
;
; %SURRT: THE SPACE REQUIRED BY THE PROGRAM FOR
; THE RETAINED RECORDS TABLE
;
; %SUEQT: THE SPACE REQUIRED BY THE PROGRAM FOR
; EACH OF THE ENQ/DEQ TABLES
;
; %SUFBT: THE SPACE REQUIRED BY THE PROGRAM FOR
; THE FILL/FLUSH BUFFER TABLE
;
; RESULTS:
;
; SU.RRT IS SET TO THE MAX OF SU.RRT AND %SURRT IN THE
; PROGRAM AND EACH OF ITS SUBPROGRAMS
;
; SU.EQT IS SET TO THE MAX OF SU.EQT AND %SUEQT IN THE
; PROGRAM AND EACH OF ITS SUBPROGRAMS
;
; SU.FBT IS SET TO THE MAX OF SU.FBT AND %SUFBT IN THE
; PROGRAM AND EACH OF ITS SUBPROGRAMS
;
; CHANGES:
;
; AC1
; AC2
; AC3
;
; ASSUMPTIONS:
;
; SU.RRT, SU.EQT, SU.FBT ARE INITIALIZED BEFORE THIS
; ROUTINE IS CALLED THE FIRST TIME
;
; NOTES:
;
; THE ROUTINE CALLS ITSELF RECURSIVELY.
SUSPC1: HRRZ AC2,(AC1) ;CHECK TO SEE IF THIS SUBROUTINE IS IN
JUMPN AC2,RET.1 ; A LINK-10 OVERLAY AREA.
; ((AC1)) = SKIPA 0,0 <==> IT ISN'T
; ((AC1)) = JSP 1,MUMBLE <==> IT IS.
HRRZ AC2,1(AC1) ;ADDRESS OF %FILES TO AC2
HLRZ AC3,(AC2) ;HAVE WE BEEN HERE BEFORE?
JUMPE AC3,RET.1 ;YES, LEAVE.
MOVE AC3,%SURRT(AC2) ;SET SU.RRT TO MAX OF SU.RRT AND %SURRT
CAMLE AC3,SU.RRT
MOVEM AC3,SU.RRT
MOVE AC3,%SUEQT(AC2) ;SET SU.EQT TO MAX OF SU.EQT AND %SUEQT
CAMLE AC3,SU.EQT
MOVEM AC3,SU.EQT
MOVE AC3,%SUFBT(AC2) ;SET SU.FBT TO MAX OF SU.FBT AND %SUFBT
CAMLE AC3,SU.FBT
MOVEM AC3,SU.FBT
HRRZS (AC2) ;MARK THIS SUBPROGRAM AS DONE.
HLRZ AC2,1(AC1) ;GET ADDRESS OF SUBPROGRAM LIST
SUSPCX: SKIPN AC1,0(AC2)
POPJ PP, ;RETURN IF NO MORE SUBPROGRAMS
PUSH PP,AC2 ;SAVE AC2 ON STACK
PUSHJ PP,SUSPC1 ;CALL OURSELVES TO PROCESS SUBPROGRAM
POP PP,AC2 ;RESTORE AC2
AOJA AC2,SUSPCX ;POINT TO NEXT SUBPROGRAM
SUBTTL SEEK VERB
;A SEEK VERB LOOKS LIKE:
;FLAGS,,ADR ADR = FILE TABLE ADDRESS
;CALL+1: ;POPJ RETURN
SEEK.:
IFN ANS68,<
MOVE FLG,F.WFLG(I16) ;FLAG REGISTER
TLNE FLG,RANFIL ;SKIP IF NOT A RANDOM FILE
TLNN FLG,OPNIN!OPNOUT ;SKIP IF RANDOM FILE IS OPEN
POPJ PP, ;EXIT TO ***ACP***
HLRZ I12,D.BL(I16) ;SET UP FOR FLIMIT
PUSHJ PP,FLIMIT ;CHECK THE FILE LIMITS
;INVALID KEY RETURNS TO ***ACP***
MOVE AC1,AC4 ;ACTUAL KEY
PUSHJ PP,SETCN. ;SET UP CHANNEL NUMBER
XCT USETI. ;
XCT USEEK. ;SEEK UUO
>
POPJ PP, ;EXIT TO ***ACP***
;FORCE A CALL TO RRDMP
RENDP: SETOM REDMP. ;
JRSTF @.JBOPC ;CONTINUE
;RESTORE .JBSA, .JBREN - DESTROYED BY RERUN'S GETSEG
RSAREN: HRR AC2,RESET1
HRRM AC2,.JBSA
MOVEI AC2,RENDP
MOVEM AC2,.JBREN
POPJ PP,
SUBTTL DISPLAY VERB
;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING ARG-LIST IN AC 16.
;THE AC16'S EFFECTIVE ADDRESS CONTAINS A MODIFIED BYTE POINTER TO THE
;ASCII CHARACTER STRING. MODIFICATIONS FOLLOW:
; IF BIT 6 IS SET LEADING SPACES AND HOR-TABS ARE SUPPRESSED.
; IF BIT 7 IS SET A "CRLF" IS APPENDED TO THE CHARACTER STRING.
; BITS 8-17 CONTAIN THE NUMBER OF CHARACTERS TO BE DISPLAYED.
;THE ONLY ERROR EXIT IS A CALL TO C.STOP CAUSED BY "TELETYPE OUTPUT
;ERROR". A NORMAL RETURN IS A POPJ PP,.
;MODIFIED ACS ARE: 15,11,7,6,AND 1.
;AC16= ;THE CALLING ARG-LIST
;AC15= ;BYTE POINTER
;AC6= ;CHARACTER COUNT
;AC1= ;TOPS-20 ONLY (LSTATS ALSO)
;AC2= ;LSTATS ARG REGISTER
;AC4= ;BLANK COUNTER (TO SUPPRESS TRAILING BLANKS)
;AC12 ;MUST NOT BE USED
DOPFS.: POINT 10,(I16),17 ;DISPLAY OPERAND FIELD SIZE
DSPLY.:
IFN LSTATS,<
MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT
PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2)
>
SKIPE TTYOPN ;IS THERE A TTY FILE OPEN?
PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING
MOVE AC15,(I16) ;GET DISPLAY OPERAND
MOVE FLG,AC15 ;SAVE IT FOR THE FLAGS
LDB AC6,DOPFS. ;NUMBER OF CHARS. TO BE DISPLAYED
TLZ AC15,7777 ;
TLO AC15,700 ;(AC15) IS BYTE POINTER TO CHARS.
SETZ AC4, ;CLEAR BLANK COUNTER
TXNN FLG,DIS%NM ;NUMERIC?, SUPPRESS LEADING SPACES AND TABS
JRST DSPL4 ;NO
DSPL2: ILDB C,AC15 ;GET A CHARACTER.
JUMPE C,DSPL3 ;DON'T PASS NULLS BUT COUNT THEM
CAIE C," " ;SPACE
CAIN C," " ;OR TAB?
JRST DSPL3 ;YES
JRST DSPL5 ;NO, FIRST OUTPUT CHAR FOUND
DSPL3: SOJG AC6,DSPL2 ;LOOP
JRST DSPL7 ;END OF INPUT
DSPL4: ILDB C,AC15 ;GET A CHARACTER
JUMPE C,DSPL6 ;COUNT NULLS BUT DON'T OUTPUT THEM
CAIN C," " ;BLANK?
AOJA AC4,DSPL6 ; YES, DON'T OUTPUT IF TRAILING BLANK
JUMPE AC4,DSPL5 ;JUMP IF NO ACCUMULATED BLANKS
PUSH PP,C ; SAVE THIS NON-BLANK
MOVEI C," " ;THE BLANKS WE SAW WERE NOT TRAILING BLANKS
PUSHJ PP,OUTCH. ; SO OUTPUT THEM
SOJG AC4,.-1 ;[673] REPLACE EDIT 651
POP PP,C ;RESTORE THE CHARACTER AFTER THE BLANKS
DSPL5: IDPB C,TTOBP. ;DEPOSIT CHARACTER IN BUFFER
SOSG TTOBC. ;BUFFER FULL?
PUSHJ PP,OUTBF. ;YES
DSPL6: SOJG AC6,DSPL4 ;LOOP
DSPL7: TXNN FLG,DIS%LF ;LAST FIELD?, APPEND CR-LF AT END?
JRST DSPL8 ;[533] NO, JUST OUTPUT WHAT WE HAVE
DSPL1.: MOVEI C,$CR ;APPEND CR-LF
PUSHJ PP,OUTCH. ; .
MOVEI C,$LF ; .
PUSHJ PP,OUTCH. ; .
PUSHJ PP,OUTBF. ;DUMP BUFFER
IFN LSTATS,<
MRTME. (AC1) ;END METER TIMING
>
POPJ PP, ; AND EXIT.
DSPL8: JUMPE AC4,DSPL8A ;[533] IF NO MORE TRAILING SPACES, EXIT
MOVEI C," " ;[533] GET ONE
PUSHJ PP,OUTCH. ;[533] AND OUTPUT IT
SOJG AC4,.-1 ;[533] LOOP BACK FOR ALL SPACES
DSPL8A: PUSHJ PP,OUTBF. ; OUTPUT BUFFER AND EXIT
IFN LSTATS,<
MRTME. (AC1) ;END METER TIMING
>
POPJ PP,
;HERE FOR DISPLAY OF SIXBIT DATA
DSPL.6:
IFN LSTATS,<
MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT
PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2)
>
SKIPE TTYOPN ;IS THERE A TTY FILE OPEN?
PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING
MOVE AC15,(I16) ;GET DISPLAY OPERAND
MOVE FLG,AC15 ;SAVE IT FOR THE FLAGS
LDB AC6,DOPFS. ;NUMBER OF CHARS. TO BE DISPLAYED
TLZ AC15,7777 ;
TLO AC15,600 ;(AC15) IS BYTE POINTER TO CHARS.
SETZ AC4, ;CLEAR BLANK COUNTER
TXNN FLG,DIS%NM ;NUMERIC?, SUPPRESS LEADING SPACES AND TABS
JRST DSPL64 ;NO
DSPL62: ILDB C,AC15 ;GET A CHARACTER.
JUMPN C,DSPL65 ;OUTPUT FIRST NON-SPACE
SOJG AC6,DSPL62 ;LOOP
JRST DSPL7 ;END OF INPUT
DSPL64: ILDB C,AC15 ;GET A CHARACTER
DSPL65: ADDI C," " ;CONVERT TO ASCII
CAIN C," " ;A BLANK?
AOJA AC4,DSPL67 ; YES, DON'T OUTPUT TRAILING BLANKS
JUMPE AC4,DSPL66 ;CHECK FOR BLANKS FOLLOWED BY NON-BLANKS
PUSH PP,C ; (YUP) OUTPUT BLANKS IN THE MIDDLE
MOVEI C," "
PUSHJ PP,OUTCH.
SOJG AC4,.-1 ;[673] REPLACE 664 LEAVE AS IT WAS BEFORE
POP PP,C ;GET THE NON-BLANK CHAR BACK
DSPL66: IDPB C,TTOBP. ;DEPOSIT CHARACTER IN BUFFER
SOSG TTOBC. ;BUFFER FULL?
PUSHJ PP,OUTBF. ;YES
DSPL67: SOJG AC6,DSPL64 ;LOOP
JRST DSPL7 ;SEE IF CR-LF NEEDED
;HERE FOR ASCIZ TEXT
DSPL.7:
IFN LSTATS,<
MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT
PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2)
>
SKIPE TTYOPN ;IS THERE A TTY FILE OPEN?
PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING
;IFE TOPS20,<
OUTSTR (I16) ;OUTPUT THE TEXT STRING
;>
REPEAT 0,< ;ALTMODE COMES OUT AS DOLLAR SIGN
IFN TOPS20,<
MOVEI 1,(I16)
HRLI 1,(POINT 7,) ;BUILD BYTE PTR
PSOUT% ;OUTPUT THE STRING
>;END IFN TOPS20
>;END REPEAT 0
MRTME. (AC1) ;END METER TIMING
POPJ PP,
DSPTO: PUSH PP,AC16 ;SAVE AC16
MOVE AC16,TTYOPN ;GET FILE-TABLE ADR FOR ERROR ROUTINES
PUSHJ PP,SETCN. ;SETUP IO CHANNEL
PUSHJ PP,WRTOUT ;DUMP THE BUFFER
POP PP,AC16 ;RESTORE
POPJ PP, ;EXIT
OUT6B.: ADDI C," " ;CONVERT A SIXBIT CHAR
OUTCH.: IDPB C,TTOBP. ;DEPOSIT CHAR. IN BUFFER.
SOSLE TTOBC. ;DUMP THE BUFFER?
POPJ PP, ; NO.
;OUTPUT A TTY BUFFER. ***POPJ***
OUTBF.: PUSH PP,C ;[673] SAVE C
SETZ C, ;ASCIZ TERMINATOR
IDPB C,TTOBP. ;
OUTSTR TTOBF. ;DUMP THE BUFFER
REPEAT 0,< ;*** FIX DURING FIELD TEST ***
IFN TOPS20,<
PUSH PP,1
MOVE 1,[POINT 7,TTOBF.]
PSOUT% ;DUMP THE BUFFER
POP PP,1
>
>;END REPEAT 0
TRNA ;WE HAVE C SAVED ALREADY
OUTBF1: PUSH PP, C ;SAVE C
MOVE C,[POINT 7,TTOBF.]
MOVEM C,TTOBP. ;INITIALIZE THE BYTE-POINTER
MOVEI C,^D132 ;A 132 CHAR BUFFER
MOVEM C,TTOBC. ;INITIALIZE THE BYTE-COUNT
POP PP,C ;[673] RESTORE C
POPJ PP, ;
;RETURN A CHARACTER IN C
;IGNORE "CARRIAGE-RETURN"
;SKIP EXIT IF NOT AN END-OF-LINE CHAR
;POPJ IF EOL, EOL = LF, VT, FF OR ALT-MODE
GETCH.: INCHWL C ;[267] INPUT A LINE, FIRST CHAR TO C
CAIN C,$CR
JRST GETCH.
CAIN C,$ALT
JRST GETCH1
CAIG C,$FF
CAIGE C,$LF
AOSA (PP)
GETCH1: MOVEI C,$LF
POPJ PP,
SUBTTL OPEN VERB
;AN OPEN VERB LOOKS LIKE:
;FLAGS,,ADR WHERE ADR = FILE TABLE ADDRESS
;OPN%OU OPEN FOR OUTPUT
;OPN%IN OPEN FOR INPUT
;OPN%NR DON'T REWIND
;OPN%EX [74] OPEN EXTENDED (APPEND FILOP.)
;OPN%RV [74] OPEN REVERSED
;CALL+1: POPJ RETURN
;MAKE PRELIMINARY CHECKS: ALREADY OPEN, OPTIONAL FILE PRESENT,
;ANOTHER FILE USING SHARED BUFFER AREA ***OPNDEV***
C.OPEN:
IFN LSTATS,< ;LIBOL METER TIMING
SKIPE F.WSMU(I16) ;SKIP TIME START IF SIM. UPDATE
JRST C.OMRX ;SKIP
MRTMS. (AC1) ;START OPEN TIMING
C.OMRX:>;END IFN LSTATS
TXO AC16,V%OPEN ;OPEN VERB
MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
BLT AC0,FS.IF ; STATUS WORDS.
SETOM FS.IF ;IDX FILE IS DEFAULT
MOVE FLG,F.WFLG(I16)
HLLZ FLG1,D.F1(I16) ;MORE FLAGS
HRRZ AC0,D.RFLG(I16) ; GET FLAGS
; BL/10/27/80 TRO AC0,AFTADV ; SET SO BFR-ADV WILL WRITE "CR" FIRST
TRZ AC0,AFTADV ;RESET SO BFR-ADV WILL NOT WRITE 'CR' FIRST ;BL
HRRM AC0,D.RFLG(I16) ; RESET IT
LDB AC0,F.BBLC ;[346] CHECK FLAG TO SEE IF THIS
JUMPE AC0,OOVLER ; FILE TABLE HAS BEEN LINKED TO THE CHAIN.
TLNE FLG,OPNIN+OPNOUT ;IS THE FILE OPEN?
JRST OPNFAO ;YES, ERROR
SETZM D.RP(I16) ;INITIALIZE THE RECORD SEQUENCE NUMBER
SETZM D.EXOF(I16) ; INITIALIZE THE RES SEQ OFFSET FOR SIXBIT
LDB AC5,F.BLF ;IS THE FILE IS LOCKED?
JUMPN AC5,OPNFAL ;YES, ERROR
TXNE AC16,OPN%OU ;SKIP IF NOT OUTPUT
TLO FLG,OPNOUT ;
TXNE AC16,OPN%IN ;SKIP IF NOT INPUT
TLO FLG,OPNIN ;
TLNE FLG1,FILOPT ;IS FILE OPTIONAL?
JRST OPNOP ;YES. RETURNS ONLY IF PRESENT
OPNSBA: PUSHJ PP,DEVIOW ;RESET THE DEVICE IOWD
IFN ANS68,<
TLNE FLG,RANFIL ;SKMFILE
PUSHJ PP,OPNSFL ;STORE THE FILE LIMITS SO HE CAN'T DIDDLE
>
HLRZ AC4,F.LSBA(I16) ;FILTAB THAT SHARES THE SAME BUFFER
OPNSB1: JUMPE AC4,OPNDEV ;JUMP IF NO ONE SHARES
CAIN AC4,(I16) ;HAVE WE CHECKED ALL "SBA" FILTAB'S
JRST OPNDEV ;YES
LDB AC1,[POINT 1,F.RMS(AC4),7] ;RMS BIT FOR THIS FILE
JUMPN AC1,OPNSB3 ; JUMP IF THIS SBA FILE IS AN RMS FILE
; NON-RMS, V12B FILES:
HLL AC4,F.WFLG(AC4) ;GET THE FLAGS
TLNE AC4,OPNIN!OPNOUT ;SKIP IF ANY FILES ARE NOT OPEN
JRST OPNSB2 ;GIVE AN ERROR MESSAGE
JRST OPNSB4 ;OK FOR THIS FILE
; RMS FILES ONLY FOR V12B,
OPNSB3: HRR AC1,D.F1(AC4) ;GET V13 STYLE FLAGS FOR THIS FILE
TXNE AC1,LF%INP!LF%OUT ;IS THIS FILE OPEN?
JRST OPNSB2 ;YES, GIVE AN ERROR MESSAGE
OPNSB4: HLRZ AC4,F.LSBA(AC4) ;GET NEXT "SBA FILTAB"
JRST OPNSB1 ;+LOOP
OPNSB2: MOVEI AC0,^D12 ;ERROR NUMBER
PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS
MOVE AC5,AC4 ;MSOUT. USES AC4
MOVE AC2,[BYTE (5)10,31,20,2,1,14]
PUSHJ PP,MSOUT.
HRLZI AC2,(BYTE (5)10,31,20)
HRR AC16,AC5
JRST MSOUT. ;SOME OTHER FILE IS USING OUR BUFFER AREA
OOVLER: HRRZ AC0,HLOVL. ;[346] GET START OF OVERLAY AREA
CAIG AC0,(I16) ;[346] IF FILE-TABLE IN OVL AREA
JUMPN AC0,OOVLE1 ;[346] COMPLAIN
MOVEI AC0,^D30 ;ERROR NUMBER
PUSHJ PP,OXITP ;POPJ TO MAIN LINE IF IGNORING ERRORS
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ "Attempt to do I/O from a subroutine called by a non resident subroutine."] ;[346]
JRST OOVLE2 ;[346]
OOVLE1: MOVEI AC0,^D31 ;ERROR NUMBER
PUSHJ PP,OXITP ;POPJ IF IGNORING ERRORS
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /IO cannot be done from an overlay./] ;[346]
OOVLE2: HRLZI AC2,(BYTE (5)10,2) ;[346] GO COMPLAIN
PUSHJ PP,MSOUT. ;[346] DOESN'T RETURN
OPNOP: TLNE FLG,OPNOUT ;SKIP IF NOT OUTPUT
JRST OPNSBA ;OUTPUT FILES ARE NOT OPTIONAL
PUSHJ PP,$SIGN ;[277] OUTPUT "$" FOR .OPERATOR
OUTSTR [ASCIZ /Is /] ;OPTIONAL FILE PRESENT?
PUSHJ PP,MSFIL.
OUTSTR [ASCIZ / present? .../]
PUSHJ PP,YES.NO ;SKIP RETURN IF "NO" ANSWER
JRST OPNOP1 ;YES
TLO FLG,NOTPRS ;NO, "NOT PRESENT"
TLZ FLG,OPNIN ;NOTE THAT IT'S NOT OPEN
MOVEM FLG,F.WFLG(I16) ;%SAVE THE FLAG WORD
POPJ PP, ;RETURN TO MAIN LINE *EXIT************
OPNOP1: TLNN FLG,IDXFIL ;ISAM FILE?
JRST OPNSBA ;NO
MOVE AC1,D.OPT(I16) ;WERE THE BUFFERS SETUP AT RESET TIME?
AOJN AC1,OPNSBA ;EXIT HERE IF THEY WERE
MOVEI AC0,^D29 ;ERROR NUMBER
PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS
OUTSTR [ASCIZ /Either the ISAM file does not exist or
the VALUE OF ID changed during the program./] ;[374]
PUSHJ PP,KILL ;AND DONT RETURN
YESNO: CLRBFI ;CLEAR THE BUFFER
OUTSTR [ASCIZ /$ Type YES or NO.
/]
YES.NO: MOVE AC5,[POINT 7,[ASCIZ /ES/],]
PUSHJ PP,GETCH.
JRST .-1
CAIE C,"Y"
CAIN C,"Y"+40 ;ALLOW LOWERCASE
CAIA ;LOOKS LIKE "YES" SO FAR..
JRST YESNO2 ;DIDN'T START WITH "Y", TRY "NO"
YESNO1: PUSHJ PP,GETCH.
POPJ PP, ;IS THE "YES" RETURN
ILDB AC4,AC5
JUMPE AC4,YSNOFN ;[564] [V10] YES FOUND, EAT INPUT UNTIL EOL
CAIE C,(AC4) ;IS THIS A "YES" CHARACTER?
CAIN C,40(AC4) ; CHECK LOWER-CASE CHARACTER TOO
JRST YESNO1 ;YES, KEEP CHECKING AS LONG
; AS HE SPELLED IT OUT
JRST YESNO ;NO, GO ASK AGAIN
YESNO2: MOVE AC5,[POINT 7,[ASCIZ /NO/],]
YESNO3: ILDB AC4,AC5
JUMPN AC4,YESNO4 ;[564] [V10] CHECK NEXT 'NO' CHAR,IF GOT ONE
AOS (PP) ;[564] ELSE, GIVE SKIP RETURN
YSNOFN: PUSHJ PP,GETCH. ;[564] GET ANOTHER CHAR
POPJ PP, ;[564] GOT EOL, RETURN
JRST YSNOFN ;[564] EAT CHARS UNTIL EOL
YESNO4: CAIE C,(AC4) ;SKIP IF A "NO" CHARACTER
CAIN C,40(AC4) ; CHECK LOWERCASE ALSO
CAIA ;SO FAR, SO GOOD
JRST YESNO ;?BAD INPUT, GO PROMPT AGAIN
PUSHJ PP,GETCH.
JRST RET.2 ;THE NO RETURN
JRST YESNO3
;SETUP DEVICE IOWD
DEVIOW: HRLOI AC0,77 ;
AND AC0,F.WDNM(I16) ;
TLC AC0,-1 ;
AOBJP AC0,.+1 ;
HRR AC0,F.WDNM(I16) ;
IFN ISAM,<
TLNE FLG,IDXFIL ;IF INDEX FILE
AOBJP AC0,.+1 ; POINT AT DATA DEVICE
>
MOVEM AC0,D.ICD(I16) ;
POPJ PP, ;
IFN ANS68,<
;SET THE FILE LIMIT CLAUSES IN THE FILE-TABLE. ***POPJ***
OPNSFL: LDB AC5,F.BNFL ;NUMBER OF FILE LIMIT CLAUSES
JUMPE AC5,RET.1 ;RETURN IF NONE
MOVNS AC5 ;
HRL AC1,AC5 ;
HRRI AC1,F.WLHL(I16) ;IOWD NUMBER OF,, FILE LIMIT
HLR I12,D.BL(I16) ;PICK UP THE BUFFER LOCATION
MOVEM AC1,R.FLMT(I12) ;
OPNSF1: MOVE AC5,(AC1) ;LIMIT,,LIMIT
MOVE AC6,(AC5) ;
MOVSS AC5 ;
MOVE AC4,(AC5) ;
CAMLE AC4,AC6 ;SKIP IF AC4 IS THE LOW LIMIT
EXCH AC4,AC6 ;
MOVEM AC4,1(AC1) ;LOW LIMIT
MOVEM AC6,2(AC1) ;HIGH LIMIT
ADDI AC1,2 ;ACCOUNT FOR TWO WORDS
AOBJN AC1,OPNSF1 ;GO AGAIN IF YOU CAN
POPJ PP, ;
>
;GET DEVICE CHARACTERISTICS AND CHECK IF DEVICE CAN DO
;REQUESTED IO FUNCTIONS ***OPNCHN***
;ENTRY POINT FOR READ GENERATED CLOSE GENERATED OPEN. ***READEF+N***
OPNDEV: SETZM D.OE(I16) ;CLEAR NUMBER OF OUTPUTS
SETZM D.IE(I16) ; NUMBER OF INPUTS
PUSHJ PP,DEVCHR ;GET THE DEVICE CHAR.
TXNN AC13,DV.AVL ;SKIP IF AVAILABLE TO JOB
JRST OPNDNA
TXNN AC13,DV.DSK ;SKIP IF A DSK
TRNN AC13,DV.ASP ;SKIP IF DEV IS INITED
JRST OPNDE5
MOVE AC2,[BYTE (5)10,2,4,20,16] ;FCBO,DIATAF.
MOVEI AC0,^D14 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
OPNDE5:
TXNN AC16,OPN%EX ; OPEN EXTEND?
JRST OPNDE6 ; NO
TLNN FLG,IOFIL ; DUMP MODE FILE?
JRST OPDE5A ; NO, CONT
; YES, ERROR, RESET TIME BUFFER ALLOCATION CAUSES TROUBLE
; HERE, WANTS BOTH DUMP MODE AND RING BUFFERS
MOVEI AC0,^D55 ; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE THE ERROR?
JRST RCHAN ; YES
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Program may not have OPEN I-O and OPEN EXTEND for same file FD./]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
OPDE5A: HRRZ AC0,D.RFLG(I16) ; YES,GET RUN FLAGS
TRO AC0,EXTOPN ; SET OPEN WAS EXTEND
HRRM AC0,D.RFLG(I16) ; AND PUT IT BACK
TXNE AC13,DV.MTA ;MTA?
TLZ FLG1,STNDRD!NONSTD ;YES, DON'T CREATE A NEW LABEL
OPNDE6: TLNE FLG,IOFIL ;[622] SKIP UNLESS IO TYPE FILE (DUMP MODE)
JRST OPNDE7 ;IO REQUESTED
OPND6A: TXNN AC16,OPN%EX ; OPEN EXTEND?
TLNE FLG,OPNIN ; OR INPUT ?
TXNE AC13,DV.IN ; YES,SKIP IF DEVICE CANNOT DO INPUT
JRST OPNDE8 ;NEXTEST
MOVE AC2,[BYTE (5)10,2,4,20,21]
MOVEI AC0,^D16 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
OPNDE8:
TXNN AC16,OPN%EX ; OPEN EXTEND
TLNE FLG,OPNOUT ; OR OUTPUT?
TXNE AC13,DV.OUT ; YES,SKIP IF DEVICE CANNOT DO OUTPUT
JRST OPNCHN ; OK,FIND A FREE CHAN
MOVE AC2,[BYTE (5)10,2,4,20,22]
MOVEI AC0,^D17 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
OPNDE7: TXNE AC13,DV.DSK ;SKIP IF DEVICE IS NOT A DSK
JRST OPNCHN ;FIND A FREE CHANNEL
MOVE AC2,[BYTE (5)10,2,4,20,17]
MOVEI AC0,^D15 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
DEVCHR: MOVE AC13,D.ICD(I16) ;ADR OF DEV. NAME
MOVE AC13,(AC13) ;SIXBIT/DEVICE NAME/
MOVEM AC13,UOBLK.+1 ;FOR OPEN
DEVCHR AC13, ;DEVCHR UUO
TXC AC13,DV.DSK!DV.CDR ;[330] IF A DSK AND A CDR
TXCN AC13,DV.DSK!DV.CDR ;[330] THEN ITS DEVICE 'NUL'
TXZ AC13,DV.MTA!DV.TTY ;[506] SO ITS NOT A MTA OR TTY
DEVCH1: MOVEM AC13,D.DC(I16) ;[330] SAVE THE CHARACTERISTICS
JUMPN AC13,RET.1
MOVE AC2,[BYTE (5)10,2,4,20,13] ;FCBO,DINAD.
POP PP,(PP) ;POP OFF THE RETURN
MOVEI AC0,^D18 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS
;XCT OPEN, INBUF AND/OR OUTBUF ***OPNBSI***
OPNCHN: PUSHJ PP,GCHAN ;LOAD AC5 WITH A CHANNEL NUMBER
DPB AC5,DTCN. ;SAVE IT
IFN ISAM,<
TLNN FLG,IDXFIL ;INDEX FILE ?
JRST OPNCH1 ;NO
PUSHJ PP,GCHAN ;
HLRZ I12,D.BL(I16) ;
HRRZM AC5,ICHAN(I12) ;SAVE INDEX FILE CHAN NO.
>
OPNCH1: PUSHJ PP,SETC1. ;DISTRIBUTE THE CHANNEL NUMBER
TLNE FLG,DDMASC ;SKIP IF NOT ASCII
TDZA AC6,AC6 ;ASCII MODE AND SKIP
MOVEI AC6,.IOBIN ;PERHAPS BINARY
TLNE FLG,RANFIL!IOFIL!IDXFIL ;[622] SKIP IF BUFFERED IO
MOVEI AC6,.IODMP ;DUMP MODE
HRRM AC6,UOBLK. ;UOBLK.+1 SET AT DEVCHR
IFE TOPS20,<
PUSHJ PP,OPNCKP ;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
HRLI AC6,D.OBH(I16) ;OUTPUT BUFFER HEADER
HRRI AC6,D.IBH(I16) ;INPUT BUF HDR
MOVEM AC6,UOBLK.+2
IFN ISAM,<
TLNN FLG,IDXFIL ;ISAM ?
JRST OPNCH3 ;NO
MOVE AC1,F.WDNM(I16) ;ADR
MOVE AC1,(AC1) ;IDX DEVICE NAME
MOVEM AC1,UOBLK.+1 ;
OPNCH3:>
TXNN AC16,OPN%EX ;OPEN EXTENDED?
JRST OPNC3A ; NO
OPNC3B: PUSHJ PP,OPNFOP ; [431] YES OPEN FILE VIA FILOP
JRST OFERRI ; [576] [431] ERROR RETURN
JRST OPNC41 ; CONT NORMALLY
OPNC3A: ;[1066]
IFN TOPS20,< ;[1066]
TXNE AC13,DV.MTA ;[1066] IS IT AN MTA
TLNN FLG1,MSTNDR ;[1066] AND MONITOR IS LABELING?
SKIPA ;[1066] NO
JRST OPNC3C ;[1066] YES, OPEN FILE USING FILOP
> ;[1066]
SKIPN F.WSMU(I16) ;[1066] SKIP IF SIMULTANEOUS UPDATE
JRST OPNC31 ; NO, CONT
IFE TOPS20,<
JRST OPNC3B ; OPEN VIA FILOP
>
IFN TOPS20,<
OPNC3C: PUSHJ PP,OCPT ; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
IFN ANS74,<
JRST OCPER ; ERROR FOR 74,FNF IS ALSO ERROR
>
IFN ANS68,<
TRNA ;ERROR, CHECK FOR FNF
>
JRST OPNC41 ; CONT NORMALLY, ALL OK
IFN ANS68,<
TLNE FLG,IDXFIL ;IS IT AN ISAM FILE
JRST OCPER ;YES, GIVE THE ERROR
CAIG AC1,GJFX21 ;IS IT ONE OF FILE NOT FOUND
CAIGE AC1,GJFX17
CAIN AC1,GJFX24
JRST OPNFNF ;YES FNF!!
CAIE AC1,GJFX32 ;STILL MORE FNF POSSIBILITIES
CAIN AC1,OPNX2 ;LAST ONE TO CHECK FOR
JRST OCPER ;NOT FNF, SCREW IT
OPNFNF: MOVX AC1,GJ%SHT ;DO FILE CREATE OPEN
MOVEM AC1,CP.BK1
MOVE AC1,[10,,CP.BLK]
COMPT. AC1, ;DO IT
JRST OCPER ;FAILED AGAIN, SCREW IT
JRST OPNC41 ;GOOD CONTINUE WITH NEW FILE
>;END IFN ANS68
>;END IFN TOPS20
OPNC31:
IFN TOPS20, <
SKIPGE MNTR5## ;[1102] IF NOT AT LEAST V5.0 OF MONITOR,
JRST OPNC40 ;[1102] NO UNRESTRICTED READ
TLNN FLG,OPNOUT ;[667] IF INPUT (READ) ONLY
TXNN AC13,DV.DSK ;[667] FOR A DSK FILE
TRNA ;[667] NO
JRST OPNC3C ;[667] YES, USE COMPT. WITH OF%RDU ON
OPNC40: ;[1102]
>; END TOPS20 ;[1102]
IFE TOPS20,<
TXNN AC13,DV.MTA ; SKIP IF A MTA
JRST OPC31X ; ELSE CONT
; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING
; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS
; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS.
SKIPN AUTOLB ; DO WE HAVE AUTO LABEL PROCESSING?
JRST OPC31X ; NO
PUSHJ PP,MTALAB ; GET LABEL INFORMATION (AC3 GETS LABEL TYPE)
JRST OPC31X ; NO SYS LABELS,LEAVE IT AS IT IS,
LDB AC3,F.BLBT ; GET LABEL TYPE
CAIE AC3,.TFLNL ; UNLABELED?
JRST OPC31L ; NO, SYS-LABELS, CLEAR COBOL LABELING
TLO FLG1,MTNOLB ; YES, SET IT TO INDICATE SO
HLLM FLG1,D.F1(I16) ; SAVE IT FOREVER
JRST OPC31X ; CONT
OPC31L: TLZ FLG1,STNDRD!NONSTD ; SYS LABELS,THEN LET PULSAR DO LABELS
CAIE AC3,.TFLNS ; "NON-STANDARD"?
TLO FLG1,MSTNDR ; NO, SET MONITOR DOING LABELING
HLLM FLG1,D.F1(I16) ; SAVE IT FOREVER
TLNN FLG1,MSTNDR ; WAS THAT SYS-LABELS?
JRST OPC31X ; NO, CONT WITHOUT CHECKS
TLNE FLG,OPNOUT ; AND OPEN OUTPUT?
JRST OPC31X ; YES, CONT
; NO,CHECK INPUT LABEL
; HERE FOR OPEN INPUT
OPC31F: LDB AC1,F.BFMT ; GET LABEL FORMAT BITS
TXNE AC1,FRMATU ; "U" FORMAT?
JRST OPC31J ; YES, NO CHECKS NECESSARY
CAIE AC3,.TFLAL ; IS THE LABEL TYPE ANSI
CAIN AC3,.TFLAU ; OR ANSI WITH USER LABELS?
JRST OPC31H ; YES,JUMP
; ASSUME IBM LABELS HERE
TXNE AC1,FRMATS ; IS IT "S" FORMAT?
JRST RERE6 ; YES, ERROR SPANNED EBCDIC NOT SUPPORTED
TXNN AC1,FRMATD ; IS IT "D" FORMAT?
JRST OPC31I ; NO,CONT
JUMPL FLG1,OPC31X ; JUMP IF VARIABLE EBCDIC, OK
JRST OMTA0E ; ERROR, WRONG FORMAT FOR RECORDING MODE
; HERE IF "F" FORMAT, DDM MUST MATCH
OPC31I: JUMPL FLG1,OMTA0E ; IF VARIABLE EBCDIC, ERROR
JRST OPC31X ; ELSE OK,CONT
; HERE FOR ANSI LABELED INPUT, CHECK FORMATS
OPC31H: TXNE AC1,FRMATS+FRMATD ; IS IT "D" OR "S" FORMAT?
JRST OPC31K ; YES,ERROR JUMP
; OPEN INPUT ANSI-LABELED "F FORMAT"
; MAKE SURE COMPATIBLE DATA MODE IS SET
JUMPGE FLG,OMTA0E ; ERROR IF NOT ASCII RECORDING MODE
PUSHJ PP,CMPASC ; NO,MAKE SURE WE GET COMPATIBLE ASCII
JRST OPC31X ; CONT
; CMPASC ROUTINE TO MAKE SURE COMPATIBLE ASCII WILL BE WRITTEN
; FOR ANSI LABELED TAPES ON TOPS 10 (F FORMAT)
; RETURNS +1 ALWAYS
CMPASC: PUSHJ PP,TM03AS ; ENSURE COMPATIBLE DATA MODE
HRRZ AC0,D.RFLG(I16) ; GET RUNTIME FLAGS
TRNE AC0,INDASC ; IND-ASC?
POPJ PP, ; YES, RETURN, IND-CMP MODE SET LATER
PUSHJ PP,STDASC ; NO, SET ANSI ASCII MODE
TROA AC0,INDASC ; ERROR SET INDASC MODE AND SKIP
POPJ PP, ; OK, RETURN
HRRM AC0,D.RFLG(I16) ; RESET (IF CHANGED)
POPJ PP, ; RETURN
OPC31K: MOVE AC0,[E.MTAP+^D54] ; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE THE ERROR?
JRST RCHAN ; YES
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /ANSI labeled "S" and "D" format mag tape not supported./]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
; HERE IF OPEN INP ANSI LABELED "U FORMAT"
OPC31J: HRRZ AC0,D.RFLG(I16) ; GET STANDARD ASCII FLAG
TRNN AC0,SASCII ; DOES HE WANT IT?
TRZ AC0,INDASC ; NO, CLEAR ANY INDASC SETTING DONE AT RESET
HRRM AC0,D.RFLG(I16) ; PUT IT BACK
JRST OPC31X ; CONT
OPC31X:
> ;END OF IFE TOPS20
PUSHJ PP,SETBM ;SET BYTE MODE IF REQUIRED
XCT UOPEN. ;OPEN THE DEVICE ***************
JRST OERRIF ;OPEN FAILED
OPNC41: PUSHJ PP,OPNWPB ;RETS LOGICAL BLOCK SIZE IN AC10, BLKFTR IN AC5
LDB AC6,F.BNAB ;NUMBER OF ALTERNATE BUFFERS (FOR INBUF X,2(AC6))
IFE TOPS20,< ;[561]
TXNE AC13,DV.MTA ;SKIP IF NOT A MTA
> ;[561]
IFN TOPS20,<
TXNE AC13,DV.MTA ;[561][1066] MTA??
TLNE FLG1,MSTNDR ;[1066] MTA IS UNLABELED TAPE?
JRST OPNC4X ;[561] NO,SKIP FOLLOWING ENTER/LOOKUP
TXNE AC16,OPN%EX ; OPEN EXTEND?
JRST OPNC4D ; YES,SKIP THIS
PUSH PP,AC5 ;[561] YES,SAVE REGS
PUSH PP,AC6 ;[561]
PUSH PP,AC10 ;[561]
TLNN FLG,OPNIN ;[561] OPEN FOR INPUT?
JRST OPNC4A ;[561] NO
PUSHJ PP,OPNLID ;[561] YES,SET UP FOR LOOKUP
XCT ULKUP. ;[561] LOOKUP
JRST OLERR ;[561] ERROR IN LOOKUP
JRST OPNC4F ;[561] RESTORE AND CONT
OPNC4A: PUSHJ PP,OPNEID ;[561] SET UP FOR ENTER
XCT UENTR. ;[561] ENTER
JRST OEERR ;[561] ERROR IN ENTER
OPNC4F: POP PP,AC10 ;[561] RESTORE AC'S
POP PP,AC6 ;[561]
POP PP,AC5 ;[561]
OPNC4D:
>;END IFN TOPS20
JUMPN AC5,OPNNSB ;[561] NON STANDARD BUFFER SETUP
OPNC4X: ;[561]
IFN ISAM,<
TLNE FLG,IDXFIL ;ISAM ?
JRST OPNIDX ;YES
>
TLNE FLG,IOFIL+RANFIL ;[622] IOFIL=IOFILE
JRST OPNRIO ;RANDOM OR IO DUMP MODE BUFFERS
PUSH PP,.JBFF
HLRZ AC11,D.BL(I16) ;BUFFER LOCATION
MOVEM AC11,.JBFF
CAIN AC6,77 ; [414] REALLY WANTS ONE?
SETOI AC6, ; [414] YES, ONE BUFFER.
TXNE AC16,OPN%EX ;APPEND?
JRST OPNC45 ;YES, DO FILOP NOW
TLNE FLG,OPNIN ;INPUT?
XCT UIBUF. ;**********
TLNE FLG,OPNOUT ;OUTPUT?
XCT UOBUF. ;**********
JRST OPNC46
OPNC45: MOVEI AC1,2(AC6) ;GET NO. OF BUFFERS
HRLZM AC1,FOP.BN## ;SET FOR OUTPUT
PUSHJ PP,OPNEXT ; DO THE APPEND OPEN
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
JUMPE AC0,OPNC46 ; CONTINUE IF NOT BLOCKED
MOVEM AC0,D.RCL(I16) ; SET NUMBER RECORDS IN LOG BLOCK
MOVE AC1,ARGBK.+.RBSIZ ; GET FILE SIZE RETURNED BY FILOP
MOVE AC3,D.BPL(I16) ; GET NUMBER OF BUFFERS PER LOG-BLK
IMULI AC3,DSKBSZ ; CALC NUMBER WORDS PER LOG-BLK (FULL BLKS)
IDIVI AC1,(AC3) ; CALC NUMBER OF LOG-BLKS, LEAVING REMAINDER IN
; AC2 INDICATING THE NUMBER OF WORDS IN THE
; CURRENT LOG-BLK.
JUMPGE FLG1,OPC45A ; CONT IF NOT VARIABLE LENGTH EBCDIC
MOVEI AC3,-2(AC2) ; NUMBER OF WORDS WRITTEN IN LOG-BLK
; TAKE CARE OF POSSIBLE LAST PARTIAL WORD (-1)
; AND THE BDW (-2)
IMULI AC3,4 ; CALC NUMBER OF CHARS IN LOG-BLK
SUB AC3,D.TCPL(I16) ; CALC NUMBER OF FREE CHARS
MOVNM AC3,D.FCPL(I16) ; SET NUMBER OF CHARS LEFT IN LOG-BLK
OPC45A: IDIVI AC2,DSKBSZ ; CALC NUMBER OF FULL BUFFERS IN THIS LOG BLK
; THAT HAVE ALREADY BEEN WRITTEN (IN AC2)
MOVE AC3,D.BPL(I16) ; CALC NUMBER OF BUFFS LEFT
SUBI AC3,(AC2) ; IN THE CURRENT LOG-BLK
MOVEM AC3,D.BCL(I16) ; AND RESET
JUMPL FLG1,OPNC46 ; VAR LENGTH EBCDIC ENDS NOW
IMULI AC2,DSKBSZ ; CALC NUMBER OF WORDS OF FULL BUFFERS WRITTEN
TLNE FLG,DDMEBC!DDMASC ; IF ASCII OR IF EBCDIC
JRST OPC45B ; WE WANT THE CHARACTER CASE
MOVE AC1,D.WPR(I16) ; FOR SIXBIT AND BINARY
JRST OPC45C ; USE WORDS PER RECORD
OPC45B: MOVE AC1,D.CPR(I16) ; GET CHARS PER RECORD (INCLUDING OVERHEAD)
; ***NOTE***
; THIS WILL ASSUME THAT NOT VARIABLE LENGTH
; RECORDS IN THE BUFFERS PERVIOUS TO THIS ONE
IMUL AC2,D.BPW(I16) ; CALC CHARS IN FULL BUFFERS
OPC45C: IDIVI AC2,(AC1) ; CALC RECORDS IN FULL BUFS OF LOG-BLK
SUB AC2,D.RCL(I16) ; RESET THE
MOVNM AC2,D.RCL(I16) ; NUMBER OF RECORDS LEFT IN LOG-BLK
PUSHJ PP,EXTSCN ; SCAN THE CURRENT BUFFER TO CALC
; NUMBER OF RECORDS LEFT IN LOG-BLK
JRST OPNC46 ; AND CONTINUE
; OPNEXT ASSUMES FOP.BK SET FOR BUFFER NUMBER
; IT SETS UP AND EXECUTES THE APPEND FILOP, AND ADJUSTS
; THE BYTE COUNT FOR THE BUFFER READ IN, TO REFLECT
; THE CURRENT BYTE SIZE.
OPNEXT:
TXNN AC13,DV.MTA ; SKIP IF MAG TAPE
JRST OPNEX0 ; ELSE CONT
; HERE WE MUST CHECK FOR PROPER DENSITY, PARITY AND DATA MODE FOR
; THE APPEND FILOP.
LDB AC0,F.BPAR ; GET THE PARITY INDICATED IN THE PROGRAM
DPB AC0,[POINT 1,FOP.IS,26] ; SET IT IN THE FILOP. STATUS FIELD
LDB AC0,F.BDNS ; GET DENISTY INDICATED BY PROGRAM
IFN TOPS20,<
; FOR THE 20 GET DEFAULT TAPE SETTINGS AND CHECK AGAINST REQUESTED
PUSHJ PP,GTDFLT ; GET DEFAULT DATA MODE IN AC3
MOVE AC4,AC3 ; SAVE DATA MODE
SETO AC1, ; AC1=-1, THIS JOB
HRROI AC2,3 ; DENSITY AT AC3
MOVEI AC3,.JIDEN ; START BLOCK AT THE DEFAULT DEN WORD
GETJI% ; GET THE DENSITY
JRST KILL. ; ASSUME IT WORKS, SHOULD ALWAYS
CAIGE AC0,.TFD16 ; IS REQUESTED DEN 1600 OR GTR ?
JRST EXTMT0 ; NO, SET IN STATUS FIELD
CAIN AC0,(AC3) ; IS DEFAULT SAME AS REQUESTED?
JRST EXTMT1 ; YES, GO CHECK DATA MODE
>;END IFN TOPS20
IFE TOPS20,<
; FOR THE 10 CHECK FOR CONTROLLERS THAT READ DENISTY. IF NOT
; THEN CHECK DEFAULT SETTING
CAIGE AC0,.TFD16 ; IS REQUESTED DEN 1600 OR GTR ?
JRST EXTMT0 ; NO, SET IN STATUS FIELD
MOVE AC1,[2,,2] ; 2 ARGS START AT AC2
MOVEI AC2,.TFKTP ; GET CONTROLLER TYPE
MOVE AC3,UOBLK.+1 ; GET DEVICE NAME
TAPOP. AC1, ; GET CONTROLLER TYPE INTO AC1
JRST EXTPER ; ERROR IN TAPOP.
CAIE AC1,.TFKTX ; TX01
CAIN AC1,.TFKD2 ; OR DX20/TX02?
JRST EXTMT1 ; YES, DENSITY IS READ FROM TAPE
; NO,CHECK DEFAULT DENISTY SETTING
MOVE AC1,[3,,2] ; 3 ARGS START AT AC2
MOVEI AC2,.TFDEN+.TFSET ; SET TAPE DENSITY
SETZ AC4, ; SET TO UNIT DEFAULT
TAPOP. AC1, ; SET THE DENSITY
JRST EXTPER ; FILOP ERROR
MOVE AC1,[2,,2] ; 2 ARGS START AT AC2
MOVEI AC2,.TFDEN ; DENSITY AGAIN
TAPOP. AC1, ; GET THE UNIT DEFAULT
JRST EXTPER ; TAPOP. ERROR
CAIN AC0,(AC1) ; IS DEFAULT THE REQUESTED?
JRST EXTMT1 ; YES, GO CHECK DATA MODE
>;END IFE TOPS20
; HERE IF DENSITY CAN'T BE SET FOR THE APPEND FILOP.
POP PP,(PP) ; DISCARD OPNEXT POPJ
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
JUMPN AC0,.+2 ; SKIP IF BLOCKED
POP PP,(PP) ; DISCARD .JBFF SAV
MOVEI AC0,^D49 ; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE THE ERROR?
JRST RCHAN ; YES
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Unable to set requested density for OPEN EXTEND./]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
IFE TOPS20,<
; HERE WITH TAPOP. ERROR
EXTPER:
POP PP,(PP) ; DISCARD OPNEXT POPJ
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
JUMPN AC0,.+2 ; SKIP IF BLOCKED
POP PP,(PP) ; DISCARD .JBFF SAV
MOVE AC0,[E.MTAP+^D50] ; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE THE ERROR?
JRST RCHAN ; YES
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /TAPOP. error processing OPEN EXTEND for mag tape./]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
>;END IFE TOPS20
; HERE TO SET DENSITY IN STATUS FIELD
EXTMT0: DPB AC0,[POINT 2,FOP.IS,28] ; DENSITY IN STATUS BITS
; HERE TO CHECK THAT DATA MODE IS PROPER
EXTMT1:
IFE TOPS20,<
PUSH PP,D.OBH(I16) ; SAVE OUT BUFF HEADER
PUSH PP,D.OBB(I16) ; SAVE OUT BUFF PTR
XCT UOPEN. ; OPEN THE DEVICE
JRST [ POP PP,AC0 ; THROW OUT BUFF
POP PP,AC0 ; HEADER AND PTR
JRST OERRIF] ; ERROR
MOVE AC1,[2,,2] ; 2 ARGS START AT AC2
MOVEI AC2,.TFMOD ; DATA MOD FUNCTION
MOVE AC3,UOBLK.+1 ; DEVICE NAME
TAPOP. AC1, ; GET DEFAULT DEVICE DATA MODE
JRST [ POP PP,AC0 ; THROW OUT BUFF
POP PP,AC0 ; HEADER AND PTR
JRST EXTPER] ; TAPOP. ERROR
XCT UCLOS. ; CLOSE IT FOR APPEND FILOP.
XCT URELE. ; RELEASE IT TOO (WACHS SAYS SO)
POP PP,D.OBB(I16) ; RESTORE BUFF PTR
POP PP,D.OBH(I16) ; AND HEADER
>;END IFE TOPS20
TLNN FLG,DDMEBC ; SKIP IF DEVICE MODE EBCDIC
JRST EXTMT2 ; ELSE GO ON
IFE TOPS20,<
CAIE AC1,.TFM8B ; IS DEFAULT MODE INDUSTRY COMPATIBLE
JRST EXTDER ; NO, ERROR
JRST OPNEX0 ; YES, ALL OK, GO DO FILOP.
>;END IFE TOPS20
IFN TOPS20,<
CAIE AC4,.SJDM8 ; IS DEFAULT MODE INDUSTRY COMPATIBLE?
JRST EXTDER ; NO, ERROR
JRST OPNEX0 ; YES, ALL OK, GO DO FILOP.
>;END IFN TOPS20
; NOT EBCDIC IS IT ANSI ACSII ?
EXTMT2: HRRZ AC0,D.RFLG(I16) ; GET STANDARD ASCII FLAG
TRNN AC0,SASCII ; DOES HE WANT IT?
JRST OPNEX0 ; NO, ALL OK GO DO FILOP.
IFE TOPS20,<
CAIE AC1,.TFM7B ; IS DEFAULT MODE ANSI ASCII ?
JRST EXTDER ; NO, ERROR
JRST OPNEX0 ; YES, ALL OK CONT
>; END IFE TOPS20
IFN TOPS20,<
CAIE AC4,.SJDMA ; IS DEFAULT MODE ANSI ASCII ?
JRST EXTDER ; NO, ERROR
JRST OPNEX0 ; YES, ALL OK CONT
>; END IFN TOPS20
; HERE IF DATA MODE CAN'T BE SET
EXTDER: POP PP,(PP) ; DISCARD OPNEXT POPJ
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
JUMPN AC0,.+2 ; SKIP IF BLOCKED
POP PP,(PP) ; DISCARD .JBFF SAV
MOVEI AC0,^D51 ; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE THE ERROR?
JRST RCHAN ; YES
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Unable to set requested data mode for OPEN EXTEND./]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
OPNEX0: MOVE AC1,UOBLK.+2 ;GET BUFFER HEADERS
MOVEM AC1,FOP.BH## ;STORE IN FILOP. BLOCK
SETZM D.OBB(I16) ;[1026] ZERO BUFFER POINTER
MOVE AC1,[7,,FOP.BK]
FILOP. AC1,
JRST [ POP PP,(PP) ; DISCARD OPNEXT RETURN
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
SKIPE AC0 ;[1042] JUMP IF NOT BLOCKED
TLNN FLG,IOFIL+RANFIL+IDXFIL ;[1042] SEQUENTIAL FILE?
POP PP,(PP) ;[1042] YES, DISCARD .JBFF SAV
JRST OFERR ] ; FAILED
JUMPL FLG,OPNEX1 ;JUMP IF ASCII
TLNE FLG,DDMBIN
POPJ PP, ;DON'T CHANGE IF BINARY
HLRZ AC6,FOP.BH ;GET OUTPUT BUFFER HEADER
TLNN FLG,DDMEBC
JRST OPNEXS ; SIXBIT, CONTINUE
MOVEI AC1,9 ; EBCDIC
TXNE AC13,DV.MTA ; SKIP IF NOT MTA
IFN TOPS20,<
MOVEI AC1,8 ; ELSE IT IS INDUSTRY COMPATIBLE
>
IFE TOPS20,<
JRST EX10ER ; EBCIDC TAPE EXTEND NOT SUPPORTED ON 10
>
DPB AC1,[POINT 6,1(AC6),11] ; RESET BYTE SIZE
MOVEI AC1,4 ;
IMULM AC1,2(AC6) ;ADJUST BYTE COUNT
IFE TOPS20,<
EX10ER: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /OPEN EXTEND for EBCDIC tapes currently not supported./]
MOVE AC2,[BYTE (5)10,31,20,2] ; FILENAME AND DEVICE MESSAGE AND KILL
PUSHJ PP,MSOUT.
>
; RESET THE BYTE PTR TO FIRST FREE CHAR
OPNEX1:
;BL; INSERTED AT OPNEX1 TO FIX OPEN-EXTEND BUG
HRRZ AC4,D.OBB(I16) ;GOOD DEST ADDR IN BPTR?
JUMPE AC4,OPNEXX ; NO, WAIT FOR DUMMYOUT
SOS AC1,D.OBB(I16) ; GET BUF BYT PTR
HRRZ AC2,D.OBH(I16) ; GET ADDR OF BUF HEADER
CAIE AC2,(AC1) ; BYT PTR AT BUF BEGINING?
JRST OPNX1A ; NO
AOS D.OBB(I16) ; YES, RESET BYT PTR
OPNEXX: POPJ PP, ; , THEN ALL SET, RETURN
OPNX1A: HRRZ AC2,D.BPW(I16) ; GET BYTS PER WORD
ADDI AC2,1 ; SET BYT COUNT RIGHT FOR LOOP
; SCAN THRU LAST DATA WORD FOR FIRST NULL CHAR
OPNEX2: MOVE AC3,AC1 ; SAVE CURRENT POSITION
SOJE AC2,OPNEX3 ; END SCAN IF NO CHARS LEFT
ILDB AC0,AC1 ; GET CHAR
JUMPN AC0,OPNEX2 ; END SCAN IF NULL FOUND
MOVE AC1,AC3 ; RESET PTR TO WRITE OVER NULL FOUND
OPNEX3: ADDM AC2,D.OBC(I16) ; ADD PARTIAL WORDS CHARS TO AVAILABLE COUNT
MOVEM AC1,D.OBB(I16) ; RESET OUT BUF BYT PTR (IF NO NULL,UNCHANGED)
POPJ PP, ; RETURN, ALL DONE
; THE SIXBIT CASE
OPNEXS: MOVEI AC1,6 ;ASSUME SIXBIT
DPB AC1,[POINT 6,1(AC6),11] ;RESET BYTE SIZE
IMULM AC1,2(AC6) ;ADJUST BYTE COUNT
POPJ PP, ; END NOW,SIXBIT IS WORD ALLIGNED
OPNC46:
HLRZ AC2,F.LSBA(I16) ;[507] FILTAB THAT SHARES SAME BUFFER
JUMPN AC2,ZROBUF ;[507] CLEAR ANY POSSIBLE PREVIOUS JUNK
POP PP,.JBFF ;RESTORE .JBFF
OPNCH2:
IFN ANS74,<
TLNN FLG,IDXFIL!RANFIL!OPNIN ;[622]
TLNN FLG,OPNOUT ;TEST FOR SEQ. OUTPUT
JRST OPNC21 ;NO
SKIPN F.LCP(I16) ;LINAGE-COUNTER?
JRST OPNC21 ;NO
MOVEI AC6,1
MOVEM AC6,F.LCP(I16) ;YES, SET TO 1
OPNC21:>
TXNE AC13,DV.DIR ;SKIP IF NON-DIRECTORY DEVICE
TLNE FLG1,STNDRD!MSTNDR ;[1115] SKIP IF NOT STD OR MONITOR LABELS
JRST OPNBSI ;SET THE BYTE SIZE
TXNE AC13,DV.CDR ;[531] IF DIRECTORY AND CDR
JRST OPNBSI ; THEN ITS NUL: WHICH IS OK
PUSHJ PP,RCHAN ;RELEASE DEVICE AND CHANNEL
MOVEI AC0,^D19 ;ERROR NUMBER
PUSHJ PP,OXITP ;RETURN TO CBL-PRG IF IGNORING ERRORS
MOVE AC2,[BYTE (5)10,2,4,26] ;FCBO,DDMHSL
JRST MSOUT.
;[507] ZERO BUFFERED I/O BUFFER AREA.
ZROBUF: HLRZ AC3,D.BL(I16) ;[507] ORIGINAL BUFFER LOCATION
MOVE AC1,AC3 ;[507] SET UP FOR LOOP
ZRBUF2: SETZM (AC1) ;[507] INITIALIZE FILE STATUS
HLRZ AC2,1(AC1) ;[507] SIZE OF DATA BUFFER ( +1 )
HRRZ AC4,1(AC1) ;[507] ADDR 2ND WORD NEXT BUFFER
HRRZI AC1,2(AC1) ;[507] 3RD WORD OF HEADER
SETZM (AC1) ;[507] THE ZERO
ADDI AC2,-1(AC1) ;[507] UNTIL...
HRLS AC1 ;[507] FROM...
ADDI AC1,1 ;[507] TO...
BLT AC1,(AC2) ;[507] CLEAR THE BUFFER
HRRZI AC1,-1(AC4) ;[507] TOP OF NEXT BUFFER
CAME AC3,AC1 ;[507] AT BEGINNING OF RING?
JRST ZRBUF2 ;[507] NO, LOOP
POP PP,.JBFF ;[507] RESTORE
JRST OPNCH2 ;[507] CONTINUE
;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK). ***OPNCH2***
OPNNSB: CAIN AC6,77 ;[477] REALLY WANTS ONE BUFFER?
SETO AC6, ;[477] YES, SET TO DEFAULT TO 1
ADDI AC6,2 ;ALTERNATE PLUS 2 DEFAULT BUFFERS
TLNE FLG1,STNDRD+NONSTD ;SKIP IF OMITTED LABELS
HRRZ AC10,D.LRS(I16) ;IN CASE LABEL IS GE TO REC AREA
HLRZ AC4,D.BL(I16) ;BUFFER LOCATION
ADDI AC4,1 ;BUF1+1
HRLI AC4,(BF.VBR) ; AND NEVER WAS REFERENCED
MOVEM AC4,D.IBH(I16) ;INPUT HEADER
MOVEM AC4,D.OBH(I16) ;OUTPUT HEADER
HRR AC2,AC4 ;BUF1+1
HRLI AC2,1(AC10) ;SIZE+1,,BUF1+1
SKIPA AC3,AC4 ;BUF1+1
OPNNS1: ADDI AC3,3(AC10) ;LOCATION OF NEXT LINK
ADDI AC2,3(AC10) ;SIZE+2,,<BUF1+1+SIZE+3>
MOVEM AC2,(AC3) ;SIZE+2,,BUF2+1
SOJG AC6,OPNNS1 ;LOOP IF ANY MORE BUFFERS
HRRM AC4,(AC3) ;LAST BUFFER CLOSES THE RING (BUF1+1)
ADDI AC4,1 ;BUF1+2
HRRM AC4,D.IBB(I16) ;INPUT HEADER BYTE POINTER
HRRM AC4,D.OBB(I16) ;OUTPUT H...
TXNN AC16,OPN%EX ;APPEND?
JRST OPNCH2 ;NO
SETZM FOP.BN ;DON'T CHANGE BUFFER ALLOCATION
PUSHJ PP,OPNEXT ; GO OPEN VIA APPEND FILOP
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
MOVEM AC0,D.RCL(I16) ; SET NUMBER RECORDS IN LOG BLOCK
MOVE AC3,D.BPL(I16) ; GET NUMBER OF BUFFS PER LOG-BLK
MOVEM AC3,D.BCL(I16) ; AND RESET IT
PUSHJ PP,EXTSCN ; SCAN THE CURRENT BLOCK TO CALC THE NUMBER OF
; RECORDS LEFT IN THE LOGICAL BLOCK
JRST OPNCH2 ; CONTINUE AT MAIN LINE
; NOW MUST SCAN FROM BEGINING OF BLOCK TO CALC HOW
; MANY RECORDS HAVE BEEN WRITTEN SO FAR.
; THE NUMBER OF RECORDS LEFT IN THE LOGICAL BLOCK (D.RCL) HAS
; BEEN RESET TO INDICATE THE NUMBER OF RECORDS LEFT AT THE BEGINING
; OF THE CURRENT BLOCK.
EXTSCN: HRRZ AC1,D.OBB(I16) ; GET ADDR NEW WRITE POSITION
HRRZ AC2,D.OBH(I16) ; CALC ADDR OF START
ADDI AC2,1 ; OF DATA
SUB AC1,AC2 ; CALC NUMBER OF WORDS OF DATA IN BUFFER
JUMPLE AC1,OPNNXX ; EXIT IF BUFFER EMPTY
JUMPGE FLG,OPNNXS ; JUMP IF NOT ASCII
HRLI AC2,000700 ; SET UP 7-BIT BYTE PTR
; AC2 ADDR SET TO WORD BEFORE DATA ABOVE
OPNXA1: SOJLE AC1,OPNNXX ; JUMP IF SCAN COMPLETE
ILDB AC3,AC2 ; GET A CHAR
CAIL AC3,40 ; SKIP IF NOT "REAL" DATA CHAR
JRST OPNXA2 ; ELSE WE HAVE FOUND THE START OF A RECORD
MOVE AC3,CHTAB(AC3) ; GET CONVERSION TABLE ENTRY (NEG IF IGNORE CHR)
JUMPLE AC3,OPNXA1 ; JUMP IF CHAR TO BE IGNORED
OPNXA2: SOS D.RCL(I16) ; NOW DECREMENT AVAILABLE RECORDS IN BLOCK COUNT
; SCAN TO END OF RECORD
OPNXA3: SOJE AC1,OPNNXX ; JUMP IF REACHED NEW WRITE POSITION
ILDB AC3,AC2 ; GET CHAR
CAIL AC3,40 ; SKIP IF NOT "REAL" DATA CHAR
JRST OPNXA3 ; ELSE CONTINUE WITH RECORD SCAN
MOVE AC3,CHTAB(AC3) ; GET CONVERSION TABLE ENTRY (NEG IF IGNORE CHR)
JUMPGE AC3,OPNXA1 ; JUMP IF CHAR IS PART OF RECORD
JRST OPNXA1 ; CONTINUE SCAN THRU BLOCK
; HERE FOR NON-ASCII CASES
OPNNXS: TLNE FLG,DDMSIX ; SKIP IF DEVICE MODE SIXBIT
TXNN AC13,DV.MTA ; AND IF A MTA
JRST OPNNXE ; ELSE CHECK FOR EBCDIC OR BINARY
AOS AC1,AC2 ; AC2 WAS SET TO WORD BEFORE DATA ABOVE
; ADDRESS FIRST DATA WORD
HRRZ AC0,D.OBB(I16) ; GET ADDR LAST DATA WORD
CAIG AC0,(AC1) ; SKIP IF NOT EMPTY BUFFER
JRST OPNNXX ; ELSE NOTHING TO UPDATE
; SCAN DOWN SIXBIT RECORD COUNTING RECORDS
OPNXS1: CAIL AC0,(AC1) ; SKIP IF MORE TO SCAN
JRST OPNNXX ; ELSE DONE
SOS D.RCL(I16) ; DECREMENT RECORDS LEFT IN BLOCK
HLRZ AC2,(AC1) ; GET RECORD SEQ NUMBER
MOVEM AC2,D.RP(I16) ; RESET REC SEQ NUMBER FOR WRITING
HRRZ AC2,(AC1) ; GET RECORD SIZE
JUMPN AC2,.+2 ; SKIP IF NOT NULL RECORD
AOJA AC1,OPNXS1 ; ELSE ADVANCE, NULL 6-BIT IS ONE WORD
; IN THE RANDOM FORMAT
; THIS WILL NOT WORK CORRECTLY FOR THE SEQ CASE
IDIVI AC2,6 ; CALC NUMBER WORDS
JUMPE AC3,.+2 ; IN THE
ADDI AC2,1 ; RECORD
ADDI AC1,(AC2) ; ADVANCE TO NEXT RECORD
JRST OPNXS1 ; CONTINUE TO SCAN BLOCK
; HERE FOR EBCDIC AND BINARY CASES
OPNNXE: JUMPL FLG1,OPNNXV ; JUMP IF VARIABLE LENGTH EBCDIC
; HERE IF DSK SIXBIT AND, DSK OR MTA
; BINARY OR FIXED LENGTH EBCDIC, CALCULATE NUMBER
; OF RECORDS TO CURRENT POSITION
TLNE FLG,DDMBIN!DDMSIX ;[1052]IS DEVICE MODE BINARY or SIXBIT?
JRST OPNNXB ; YES, SET UP FOR WORDS
IMUL AC1,D.BPW(I16) ; CALC NUMBER OF BYTES DATA ON BUFFER
LDB AC2,F.BMRS ; GET MAX RECORD SIZE
OPNXE2: IDIVI AC1,(AC2) ; CALC NUMER OF MAX RECORDS IN BUFFER
JUMPE AC2,OPNXE1 ; SOME LEFT OVER ?
TXNN AC13,DV.MTA ; YES, MTA??
ADDI AC1,1 ; NO, ROUND UP FOR PARTIAL RECORD
OPNXE1: SUB AC1,D.RCL(I16) ; AC1=-(NUMBER RECORDS LEFT IN BUFFER)
MOVNM AC1,D.RCL(I16) ; RESET NUMBER OF RECORDS LEFT IN BUFFER
JRST OPNNXX ; ALL FINISHED CONTINUE
; BINARY CASE MUST BE DONE USING THE WORD NUMBERS
OPNNXB: HRRZ AC2,D.WPR(I16) ; GET REC SIZE IN WORDS
JRST OPNXE2 ; GO DO CALC WITH AC1 AND AC2 WORDS
; FOR VARIABLE LENGTH EBCIDC WE MUST CHAIN DOWN THE RDWS
; COUNTING THE RECORDS SEEN
OPNNXV: MOVE AC1,D.OBC(I16) ; GET NUMBER AVAILABLE CHARS
MOVEM AC1,D.FCPL(I16) ; RESET NUMBER FREE CHARS IN LOG-BLK
POPJ PP, ; RETURN, ALL DONE
; ALL DONE WITH BUFFER SCAN, IF BUFFER FULL, WRITE IT OUT
; AND SET UP FOR NEXT ONE
OPNNXX: SKIPE D.RP(I16) ; SKIP IF NO SIXBIT REC SEQ NUMBER SET
AOS D.RP(I16) ; ELSE SET SO IT WILL START ONE GTR THAN LAST
SKIPLE D.RCL(I16) ; SKIP IF NO RECORDS LEFT IN BLOCK
POPJ PP, ; ELSE BACK TO MAIN LINE, ALL DONE HERE
PUSHJ PP,WRTOUT ; ADVANCE BUFFERS
LDB AC0,F.BBKF ; GET BLOCKING FACTOR
MOVEM AC0,D.RCL(I16) ; RESET NUMBER RECORDS IN LOG BLOCK
MOVE AC0,D.BPL(I16) ;[1055] GET # OF BUFFERS PER LOGICAL BLOCK
MOVEM AC0,D.BCL(I16) ;[1055] RESET # OF BUFFERS TO FILL CURR LOG BLK
POPJ PP, ;RETURN TO MAIN LINE
;AC10 = WORDS PER LOGICAL BLOCK
;INITIALIZE DUMP MODE BUFFERS FOR RANDOM AND IO. ***OPNCON***
OPNRIO: HLRZ I12,D.BL(I16) ;BUFFER LOCATION
MOVE AC6,AC10 ;GET WDS/LBLK
TRZE AC6,DSKMSK ;FILL TO DISK BLK SIZE,
ADDI AC6,DSKBSZ ;ROUNDING UP IF NECESSARY
MOVN AC6,AC6 ;GET 0,,-N
IFN ANS68,<
HRLI AC6,R.FLMT(I12) ;LOC-1,,-N
>
IFN ANS74,<
HRLI AC6,R.DLRW(I12) ;LOC-1,,-N
>
MOVSM AC6,R.IOWD(I12) ;-N,,LOC-1
SETZM R.TERM(I12) ;IOWD TERMINATOR
SETZM R.DATA(I12) ;NO ACTIVE DATA IN BUFFER
SETZM R.BPLR(I12) ;NO INPUTS DONE FOR THIS FILE
SETOM R.WRIT(I12) ;LAST UUO WAS A WRITE
LDB AC6,[POINT 2,FLG,2] ; GET DEVICE DATA MODE
HLL AC6,RBPTB1(AC6) ; AND BYTE-POINTER
IFN ANS68,<
HRRI AC6,1+R.FLMT(I12);FIRST DATA WORD
>
IFN ANS74,<
SETZM R.DLRW(I12) ; CLEAR DEL/RWT SAVE BLK NUM
HRRI AC6,1+R.DLRW(I12);FIRST DATA WORD
>
TLNE FLG1,VLREBC ; IF VAR-LEN EBCDIC RECORDS
ADDI AC6,1 ; SKIP OVER THE BLOCK-DESCRIPTOR-WORD
MOVEM AC6,R.BPNR(I12) ; NEXT RECORD
MOVEM AC6,R.BPFR(I12) ;BYTE POINTER TO THE FIRST RECORD
HLRZ AC2,F.LSBA(I16) ;[507] FILTAB THAT SHARES SAME BUFFER
SKIPE AC2 ;[507] SHARES BUFFER?
PUSHJ PP,ZDMBUF ;[507] YES, CLEAR IT
JRST OPNCON ;RET
IFN ISAM,<
;SETUP INDEX FILE BUFFER AND TABLE AREAS
OPNIDX: SETZM USOBJ(I12) ;[377] CLEAR THE FIRST WORD OF INDEX TABLE
HRRI AC0,USOBJ+1(I12);TO
HRLI AC0,USOBJ(I12) ;FROM,,TO
HRRZI AC1,ITABL-15+ICHAN(I12) ;UNTIL
BLT AC0,(AC1) ;CLEAR REST OF INDEX TABLE
HRLZ AC0,D.IBL(I16) ; [377] SEE IF WE HAVE A SAVE AREA
JUMPE AC0,OPNIX1 ; [377] NO- GO ON
HRRI AC0,ISCLR1(I12) ; [377] SET UP TO
HRRZI AC1,ISCLR2(I12) ; [377] MOVE ISAM SAVE AREA TO
BLT AC0,(AC1) ; [377] TO SHARED BUFFER AREA
OPNIX1: PUSHJ PP,OPNLIX ;INDEX FILE-NAME TO LOOKUP BLOCK
IFN TOPS20,<
SKIPL MNTR5 ;[1102] NO UNRESTRICTED READ
TLNE FLG,OPNOUT ;[1007][667] IF OPEN READ ONLY OR
>; END TOPS20 ;[1102]
SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE?
JRST OPNIX2 ; YES
;IFN TOPS20,< ;[570]
; TLNE FLG,IOFIL!OPNOUT ;[570] OPEN READ ONLY?
; JRST ONIX1A ;[570] NO, DO LOOKUP
; PUSHJ PP,OCPT ;[570] YES, OPEN IN THAWED MODE
; JRST OCPER ;[570] ERROR IN THAWED OPEN
; JRST OPNIX2 ;[570] OK,CONT
;ONIX1A: >;[570] END IFN TOPS20
XCT ULKUP. ;LOOKUP
JRST OLERRI ;LOOKUP AND(OR) COMPT. FAILED
OPNIX2: TLNN FLG,OPNOUT ;OPEN FOR UPDATING?
JRST OPNI01 ;NO
OPNI00: TLO FLG1,EIX ;ENTER OF .IDX FILE IN PROGRESS
PUSHJ PP,OPNEIX ;INDEX FILE-NAME TO ENTER BLOCK
SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE?
JRST OPNIX3 ; YES
XCT UENTR. ;ENTER, FOR UPDATING
JRST OEERRI ;ENTER FAILED
OPNIX3: TLZ FLG1,EIX ;FREE THIS BIT FOR "RIVK" FLAG
OPNI01: HRLZI AC1,STABL ;STATISTICS BLOCK LEN
MOVNS AC1 ;
HRR AC1,I12 ;
SUBI AC1,1 ;DUMP MODE IOWD
MOVEM AC1,IOWRD+14(I12) ;SAVE IN IOWRD TABLE
SETZ AC2, ;TERMINATOR
MOVEI AC0,1 ;
HRRM AC0,UIN. ;
IFN ISTKS,<AOS INSSSS+14(I12)>
XCT UIN. ;READ THE STATISTICS BLOCK
JRST OPNI02 ;
MOVE AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER
PUSHJ PP,IGMIR ;IGNORE THE ERROR?
JRST RCHAN ;YES - RELEASE THE IO CHANNELS
OUTSTR [ASCIZ /OPEN failed - cannot read statistics block./]
PUSHJ PP,SETIC ;SET UP IGETS CHANNEL NO.
JRST IINER
;OPEN THE DATA FILE
OPNI02: HLLZS UIN. ;CLEAR THE IOWR POINTER
MOVEI AC0,.IODMP ;DUMP MODE
HRRM AC0,UOBLK. ;SETUP OPEN BLOCK
IFE TOPS20,<
PUSHJ PP,OPNCKP ;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
MOVE AC1,F.WDNM(I16) ;
MOVE AC1,1(AC1) ;[522] GET STRUCTURE
MOVEM AC1,UOBLK.+1 ;
SETZM UOBLK.+2 ;
PUSHJ PP,SETCN. ;SET DATA FILE CHANNEL
IFN TOPS20,<
SKIPL MNTR5 ;[1102] IF (AT LEAST V5.0
TLNE FLG,OPNOUT ;[1102] AND READ ONLY) OR
SKIPE F.WSMU(I16) ;[1102] SIMULTANEOUS UPDATE
TRNA ;[1102] THEN SKIP
JRST OPNI21 ;[1102] ELSE ON TO OPNI21
>; END TOPS20
IFE TOPS20,<
SKIPN F.WSMU(I16) ;[1102] SIMULTANEOUS UPDATE?
JRST OPNI21 ;[1102] NO
PUSHJ PP,OPNFPD ; [431] OPEN FILE VIA FILOP UUO
JRST OFERR ; [576] [431] ERROR RETURN
>; [431] END IFE TOPS20
IFN TOPS20,<
PUSHJ PP,OCPTD ; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
JRST OCPERI ; [431] ERROR RETURN
>; [431]END IFN TOPS20
JRST OPNI22 ; SKIP THE OPEN UUO
OPNI21: XCT UOPEN. ;OPEN THE DATA FILE
JRST OERRDF ;ERROR RETURN
;SETUP IOWRD TABLE
OPNI22:
IFN ANS74,<
; Set record area length for START
LDB AC1,F.BMRS ; Get record size
LDB AC3,[POINT 2,FLG,14] ; Get internal mode
HRRZ AC3,RBPTBL(AC3) ; Get bytes per internal record word
IDIVI AC1,(AC3) ; Get words in record area
SKIPE AC2 ; Skip if no round up
ADDI AC1,1 ; Round up
MOVEM AC1,RCARSZ(I12) ; Save for START checks
>; end ifn ans74
MOVEI AC3,BA(I12) ;
MOVE AC1,ISPB(I12) ;SECTORS PER BLOCK
IMULI AC1,200 ;WORDS PER SECTOR
MOVN AC2,AC1 ;-LEN
HRLZS AC2 ;-LEN,,0
HRRI AC2,-1(AC3) ;IOWD, -LEN,,LOC-1
MOVE AC4,OMXLVL(I12) ;[442] USE ORIGINAL # OF INDEX LEVELS
;[V10] SKIPN CORE0(I12) ; SKIP IF NOT FIRST OPEN FOR THIS FILE
SUBI AC4,1 ;PLUS ONE FOR SPLITTING THE TOP LEVEL
HRLZS AC4 ;
HRRI AC4,IOWRD+1(I12) ;
SKIPN (AC4) ;IF IOWRD'S ALREADY SETUP
MOVEM AC2,(AC4) ;
ADD AC2,AC1 ;
AOBJN AC4,.-3 ;LOOP
MOVN AC5,MXLVL(I12) ;SEE IF ANY NEW INDEX LEVELS WERE
SUB AC5,OMXLVL(I12) ; CREATED SINCE LAST TIME FILE WAS OPEN
JUMPGE AC5,OPNI06 ;[504] SKIP THE FOLLOWING IF NOT
HRL AC4,AC5 ;NEW LEVEL(S)
HRRZ AC5,ISPB(I12) ;[306] SECTORS PER BLOCK
IMULI AC5,200 ;[306] WORDS PER SECTOR
MOVN AC6,AC5 ;[306] NEGATE THE LENGTH
HRLZS AC6 ;[306] -LENGTH,,0
HRR AC6,.JBFF ; SO MAKE
SUBI AC6,1 ; ANOTHER IOWD
OPNI03: SKIPE (AC4) ;USE ONLY IF
JRST OPNI04 ; ANOTHER JOB MADE THE NEW LEVEL
SKIPE KEYCV. ;ARE WE SORTING?
JRST OPNIR0 ;YES - CANT HANDLE THAT
HRRZ AC0,AC5 ;[306] SET UP AC0
PUSHJ PP,GETSPC ;GET MORE CORE
JRST OPNIR1 ;TOO BAD
HRRZ AC0,HLOVL. ;DOES THE SPACE WE GOT
CAMGE AC0,.JBFF ; EXTEND INTO THE OVL-AREA?
JUMPN AC0,WOVLR1 ;GO COMPLAIN IF IT DOES
MOVEM AC6,(AC4) ;USE IT
ADD AC6,AC1 ;SET UP FOR NEXT IOWD
OPNI04: AOBJN AC4,OPNI03 ;LOOP IF YOU MUST
OPNI06: SKIPN IOWRD+13(I12) ; SKIP IF ALREADY DONE
MOVEM AC2,IOWRD+13(I12);SAT BLOCK
ADD AC2,AC1 ;
;IOWRD0, USOBJ0, CNTRY0, NNTRY0 - SET TO INDEX ON LVL
HRLZI AC0,LVL ;HOLDS CURRENT LEVEL OF INDEX
HRRI AC0,IOWRD(I12) ;
MOVEM AC0,IOWRD0(I12) ;
HRRI AC0,USOBJ(I12) ;
MOVEM AC0,USOBJ0(I12) ;
HRRI AC0,CNTRY(I12) ;
MOVEM AC0,CNTRY0(I12) ;
HRRI AC0,NNTRY(I12) ;
MOVEM AC0,NNTRY0(I12) ;
;SET BRISK FLAG OUTPUT ONLY WHEN YOU MUST
LDB AC5,F.BDIO ;GET DEFERRED ISAM OUTPUT FLAG
JUMPE AC5,OPNI61 ; 0 = NO DEFERRED OUTPUTS
SKIPN F.WSMU(I16) ; NO DEFERRED OUTS IF SIMU-UPDATE
SETOM BRISK(I12)
;CHECK FILTAB BLKFTR VS STAT-BLK BLKFTR
OPNI61: LDB AC0,F.BMRS ;[371] GET PROGRAMS MAX REC SIZE
CAMN AC0,RECBYT(I12) ;[371] SEE IF SAME AS ISAM PARM
JRST OPNI07 ;[371] IT DOES- OF
CAML AC0,RECBYT(I12) ; [375] WHICH WAY IS FD DIFFERENT?
JRST OPNGR ; [375] FD GT ISAM
TLNN FLG,OPNIN ;[622] [375] FD LT IDX-FILE, OPN OUTPUT ONLY?
JRST OPNI07 ; [375] YES OKAY
JRST OPNER1 ; [375] NO-INPUT OR I/O ERROR
OPNGR: TLNN FLG,OPNOUT ; [622][375] FD GT IDXFIL - OPN FOR INPUT ?
JRST OPNI07 ; [375] YES OKAY
OPNER1: ; [375]
OUTSTR [ASCIZ /Users maximum record size /] ; [371]
PUSHJ PP,PUTDEC ;[371] TYPE IT
OUTSTR [ASCIZ / differs from ISAM parameter ./] ;[371]
MOVE AC0,RECBYT(I12) ;[371] GET ISAM MAX REC SIZE
PUSHJ PP,PUTDEC ;[371] TYPE IT
JRST OPNERX ;[371] FINISH UP MSG AND STOP RUN
OPNI07: ;[371]
MOVE AC6,ORCBYT(I12) ;[515] GET BLOCKFTR AT RESET
CAMGE AC6,RECBYT(I12) ;[535] [515] MUST = OR LESS THAN FILE OPENED
JRST OPNER2 ;[515] NOT THE SAME TROUBLE
MOVE AC6,F.WIKD(I16) ;[535] [515] GET KEY DESC. FROM PROG
CAMN AC6,KEYDES(I12) ;[515] MUST BE THE SAME AS FILE OPENED
JRST OPNI7A ; ELSE CONT NEXT TEST
LDB AC10,KY.TYP ; GET KEY TYPE IN AC10
CAIL AC10,3 ; CHECK FOR VARIOUS FLAVORS OF COMP KEYS;
CAILE AC10,5 ; 3= 1WD COMP, 4=2WD COMP, 5=COMP-1
JRST OPNI7D ; NOT COMP, GIVE WARNING
; COMP, CHECK WITHOUT SIZE FIELD
TRZ AC6,KEYSIZ ; CLEAR SIZE FIELD
MOVE AC10,KEYDES(I12) ; GET ISAM DESCP.
TRZ AC10,KEYSIZ ; CLEAR SIZE HERE TOO
CAIN AC6,(AC10) ; OK NOW?
JRST OPNI7A ; YES, CONT
OPNI7D: OUTSTR [ASCIZ / [Key descriptor of /]
PUSHJ PP,MSFIL. ; PRINT FILE NAME
OUTSTR [ASCIZ / differs from program]
/] ;[535] YOUR ON YOUR OWN AFTER THIS
OPNI7A: MOVE AC6,F.WBRK(I16) ;[574] GET PROGRAM KEY POINTER
CAMN AC6,DBPRK(I12) ;[574] MUST BE SAME AS FILE OPENED
JRST OPNI7B ; ELSE CONT
;[617] BYTE PTRS ARE NOT THE SAME, MAY BE BECAUSE OF MODE TRANSLATION
;[617] CALC BYTE OFFSET TO THE BEGINING OF THE KEY AND COMPARE THIS
;[617] CHECK FOR THE SPECIAL CASE OF COMP
LDB AC10,KY.TYP ;[617] GET KEY TYPE IN AC10
CAIL AC10,3 ;CHECK FOR VARIOUS FLAVORS OF COMP KEYS;
CAILE AC10,5 ;3= 1WD COMP, 4=2WD COMP, 5=COMP-1
JRST OPNI7C ;[617] NOT COMP, JUMP TO BYTE POS CHECK
; 4/28/80: EDIT 617 ENHANCED TO ALSO CHECK FOR COMP-1.
; THE COMPILER GENERATES A 9-BIT BYTE PTR FOR COMP THINGS,
;; AND ISAM DOES NOT. SOMEDAY THE COMPILER COULD BE FIXED SO
;; THIS CODE IS UNNECESSARY.
HRRZ AC10,F.WBRK(I16) ;[617] PUT WORD OFFSET OF KEY IN AC10
HRRZ AC6,DBPRK(I12) ;[617] PUT ISAM-GENERATED WORD OFFSET IN AC6
CAMN AC10,AC6 ;[617] IF THEY MATCH, SKIP PRINTING
JRST OPNI7B ;[617] OF ERROR MESSAGE
; ELSE ERROR, RESET WORD OFFSET TO BYTE OFFSET FOR MESSAGES
LDB AC3,[POINT 2,FLG,14] ; GET CORE DATA MODE
HRRZ AC3,RBPTBL(AC3) ; AND THEN CHARS PER WORD
IMULI AC10,(AC3) ; RESET PRG OFFSET TO BYTES
IMULI AC6,(AC3) ; RESET ISAM OFFSET TO BYTES
JRST OPNERR ; ERROR
;[617] FIRST CALC BYTE OFFSET FOR THE IDX STAT DESCRIPTION
OPNI7C: LDB AC3,KY.MOD ;[617] GET MODE OF KEY
HRRZ AC3,RBPTB1(AC3) ;[617] GET BYTES PER WORD
LDB AC0,[POINT 6,DBPRK(I12),5] ;[617] GET BIT OFFSET FOR IDX STAT
LDB AC1,[POINT 6,DBPRK(I12),11] ;[617] GET BITS PER BYTE
IDIV AC0,AC1 ;[617] CALC NUMBER BYTES IN FIRST WORD OF KEY
MOVE AC1,AC3 ;[617] GET BYTES PER WORD
SUB AC1,AC0 ;[617] CALC NUMBER OF BYTES BFR KEY IN FIRST WD
HRRZ AC6,DBPRK(I12) ;[617] GET NUM FULL WORDS TO KEY
IMULI AC6,(AC3) ;[617] CALC NUMBER BYTES TO KEY (FULL WDS)
ADD AC6,AC1 ;[617] PLUS PARTIAL = BYTES TO KEY FOR IDX STAT
;[617] CALC NUMBER OF BYTES TO BEGIN OF KEY IN INTERNAL RECORD FORMAT
LDB AC3,[POINT 2,FLG,14] ;[617] GET CORE DATA MODE
HRRZ AC3,RBPTBL(AC3) ;[617] AND THEN CHARS PER WORD
LDB AC0,[POINT 6,F.WBRK(I16),5] ;[617] GET BIT OFFSET FOR IDX STAT
LDB AC1,[POINT 6,F.WBRK(I16),11] ;[617] GET BITS PER BYTE
IDIV AC0,AC1 ;[617] CALC NUMBER BYTES IN FIRST WORD OF KEY
MOVE AC1,AC3 ;[617] GET BYTES PER WORD
SUB AC1,AC0 ;[617] CALC NUMBER OF BYTES BFR KEY IN FIRST WD
HRRZ AC10,F.WBRK(I16) ;[617] GET NUM FULL WORDS TO KEY
IMULI AC10,(AC3) ;[617] CALC NUMBER BYTES TO KEY (FULL WDS)
ADD AC10,AC1 ;[617] PLUS PARTIAL = BYTES TO KEY FOR PROGRAM
CAIN AC6,(AC10) ;[617] IS THE BYTE OFFSET TO THE KEY THE SAME??
JRST OPNI7B ;[617] YES, CONT
;[617] NO, TOO BAD
OPNERR: OUTSTR [ASCIZ /?Key pointer of /]
PUSHJ PP,MSFIL. ;[617] PRINT FILE NAME
OUTSTR [ASCIZ / differs from program ./] ;[617][574]
OUTSTR [ASCIZ /
Program key starts at byte /]
MOVE AC0,AC10 ; GET OFFSET TO PROGRAM KEY
PUSHJ PP,PUTDEC ; PRINT IT
OUTSTR [ASCIZ /
ISAM file key starts at byte /]
MOVE AC0,AC6 ; GET ISAM KEY START POSITION
PUSHJ PP,PUTDEC ; PRINT IT
JRST OPNERX ; ERROR MESS AND KILL
OPNI7B: PUSHJ PP,OPNWPB ;AC5 = BLKFTR, AC10 = WPB
;BL; 2 LINES INSERTED AT OPN17B + 1 TO FIX ISAM/RANDOM SHARED BUFFR BUG
TLNE FLG,IDXFIL ;ISAM FILE?
SKIPN PAGBUF(I12) ;YES, & PAGE I/O TOO?
JRST OPNI7E ; NO
ADDI AC10,777 ; YES, AT LEAST 512 WD/PG
LSH AC10,-9 ; ROUND
LSH AC10,9 ; OFF
OPNI7E: MOVE AC6,DBF(I12) ;DATA FILE BLOCKING FACTOR VIA STA BLOCK
CAMN AC5,AC6 ;AC5 = BLKFTR VIA FILE TABLE
JRST OPNI05 ;OK
MOVE AC0,[E.FIDX+^D9] ;ERROR NUMBER
PUSHJ PP,IGCVR ;IGNORE THE ERROR?
JRST RCHAN ;YES - RELEASE IO CHANS
PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Users blocking factor /] ; [371]
MOVE AC0,AC5 ;[371] GET USER BF
PUSHJ PP,PUTDEC ;[371] TYPE IT
OUTSTR [ASCIZ / differs from ISAM parameter /] ;[371]
MOVE AC0,AC6 ;[371] GET ISAM BF
PUSHJ PP,PUTDEC ;[371] TYPE IT
OPNERX: MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT.
OPNER2: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /RESET maximum record size /] ;[515]
MOVE AC0,AC6 ;[515] GIVE HIM RESET VALUE
PUSHJ PP,PUTDEC ;[515] TYPE IT
OUTSTR [ASCIZ / differs from OPEN maximum size /] ;[515]
MOVE AC0,RECBYT(I12) ;[515] GET OPEN VALUE
PUSHJ PP,PUTDEC ;[515] TYPE IT
JRST OPNERX ;[515] FINISH UP AND GET OUT
OPNER4: PUSHJ PP,DSPL1. ;DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /Entries per index block at OPEN /]
PUSHJ PP,PUTDEC ;[515] TYPE OPEN VALUE
OUTSTR [ASCIZ / differs from RESET value /]
MOVE AC0,OEPIB(I12) ;[515] GET RESET VALUE
PUSHJ PP,PUTDEC ;[515] TYPE VALUE
JRST OPNERX ;[515] AND GET OUT
;IOWRD(I12) - SET DATA BLOCK IOWD POINTER
OPNI05: MOVN AC5,AC10 ;
HRL AC2,AC5 ;
SKIPN IOWRD(I12) ;SKIP IF ALREADY SETUP BY PREVIOUS OPEN
MOVEM AC2,IOWRD(I12) ;DATA BLOCK
ADDI AC2,1(AC10) ;AC2 POINT AT NEXT FREE AREA
;IBLEN - LEN OF INDEX BLOCK FOR BINARY SEARCH
MOVE AC0,EPIB(I12) ;
CAMLE AC0,OEPIB(I12) ;[535] [515] IS IT THE SAME AS RESET?
JRST OPNER4 ;[515] NO TROUBLE
IMUL AC0,IESIZ(I12) ;NO. OF WRDS IN IDX BLK
MOVEM AC0,IBLEN(I12) ;IDX BLK LEN
;SINC - SEARCH INCREMENT FOR BINARY SEARCH
MOVE AC1,IESIZ(I12) ;THE INCREMENT TO BE
IMULI AC1,2 ;
CAMG AC1,AC0 ;INC GT INDEX LENGTH?
JRST .-2 ;NO
MOVEM AC1,SINC(I12) ;SAVE THE SEARCH INCREMENT
;DAKBP - BYTE POINTER TO DATA ADJUSTED KEY
MOVE AC1,DBPRK(I12) ;START WITH RELATIVE DATA KEY BP
HRRI AC1,(AC2) ;
MOVEM AC1,DAKBP(I12) ;DATA ADJUSTED KEY BYTE POINTER
SETZM (AC1) ;ZERO THE FIRST DATA REC-KEY WRD
ADDI AC1,1 ;
MOVEM AC1,DAKBP1(I12) ;POINTER TO SECOND REC-KEY WRD
ADD AC1,IESIZ(I12) ;KEY SIZE PLUS 2 WRD HDR
SUBI AC1,2 ;PERMIT 1 EXTRA WRD FOR WRAP-AROUND
SETZM -1(AC1) ;ZERO LAST DATA REC-KEY WRD
;RESERVE AREA FOR INDEX ENTRY
ADDI AC1,2 ;LOC FOR BLOCK # AND VERSION #
IFN ISTKS,<
MOVE AC0,[INSSSS(LVL)]
ADD AC0,I12
MOVEM AC0,INSSS0(I12)
MOVE AC0,[OUTSSS(LVL)]
ADD AC0,I12
MOVEM AC0,OUTSS0(I12)
>
;IAKBP - BYTE POINTER TO INDEX ADJUSTED KEY
TLZ AC1,770000 ;
TLO AC1,440000 ;
MOVEM AC1,IAKBP(I12) ;INDEX ADJUSTED KEY BP
ADDI AC1,1 ;
MOVEM AC1,IAKBP1(I12) ;POINTER TO SECOND IDX-KEY WRD
ADD AC1,IESIZ(I12) ;
SUBI AC1,2 ;
SETZM -1(AC1) ;ZERO LAST IDX-KEY WRD
; FOR ANS74 RESERVE ANOTHER COPY OF THE KEY FOR REWRT/DEL