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