Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
cblio.mac
There are 23 other files named cblio.mac in the archive. Click here to see a list.
; UPD ID= 2011 on 8/22/79 at 11:14 AM by N:<NIXON>
TITLE CBLIO FOR LIBOL V12A
;COPYRIGHT (C) 1974, 1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
EDIT==604
VERWHO==0
VERMJR==12
VERMNR==1
VEREDT==EDIT
VERSION==BYTE(3)VERWHO(9)VERMJR(6)VERMNR(18)VEREDT
PURGE VERWHO,VERMJR,VERMNR,VEREDT
SUBTTL EDIT HISTORY
;***** V12A *****
; 604 9-AUG-79 HAM CLOSR2
; CLEAR ATEND FLAG ON CLOSE REEL
; 603 7-AUG-79 HAM CBLIO
; TAKE OUT CALL TO CLWSMU IN CLSWEL (FROM EDIT 576)
;
; 602 ******* NOT USED *****
;
; 601 25-JUN-79 HAM CBLIO
; MAKE UPD CHANGES 1956 AND 1923 FOR FILE STATUS INTO EDIT
; 600 21-JUN-79 CLRH CBLIO
; CORRECTLY SHUFFLE SIXBIT RECORDS IN SHFREC.
; 577 19-JUN-79 HAM CBLIO
; PUT IN CHECK FOR NO CR-LF IN BLK-1 ASCII MTA FILE, ALLOW IT WITH WARNING
; 576 1-JUN-79 HAM CBLIO
; PUT CHECKPOINT FILOP IN CLSWEL FOR 10'S SMU TYPE CLOSE (FLUSHES BUFFS)
; 575 8-MAY-79 MFY CBLIO
; FIX OPEN FOR SPOOLED CDR WHEN FILE IS EMPTY OR NONEXISTENT.
; 574 4-MAY-79 CLRH CBLIO
; CHECK RECORD POINTER AS WELL AS KEY DESCRIPTION OF ISAM FILE.
; 573 30-APR-79 HAM CBLIO
; FIX EDIT 571 TO SAVE AC 7,14 BEFORE CALL TO SU.CL
; 572 NOT USED.
; 571 18-APR-79 CLRH CBLIO
; AT C.CLOS, DO NOT CALL SU.CL UNTIL ALL BUFFERS ARE OUT
; 570 13-APR-79 HAM CBLIO
; THIS TAKES OUT 557 AND REPLACES IT WITH CODE TO FORCE
; THAWED ACCESS COMPT. LOOKUP FOR ALL READ ONLY OPENS
; 567 5-APR-79 CLRH PERF
; FIX THREE PROBLEMS WITH THE LEVEL IN PERF.MAC
; 566 4-APR-79 HAM CBLIO
; PUT IN LKPSIZ DEF THAT SHOULD HAVE BEEN IN EDIT 565
; THIS EDIT IS NOT NEEDED FOR THESE SOURCES,BUT IS ADDED
; TO CONFORM WITH HOSS SOURCES,WHICH WERE THE ONES THAT MISSED THIS
; 565 21-MAR-79 HAM CBLIO LSU
; FIX OPNELO TO CALC FILE SIZE WHEN CALLED FROM LFENQ., BUT NOT AFTER
; 564 20-MAR-79 HAM CBLIO
; FIX OPTIONAL FILE YES.NO TO EAT WHOLE ANSWER LINE UP TO EOL
; 563 20-MAR-79 DMN CBLIO
; CHECK FOR ILLEGAL FILE NAME AND GIVE FATAL ERROR IF FOUND
; 562 12-MAR-79 MFY CBLIO
; DUMMY EDIT TO GET 10 AND 20 SOURCES BACK IN SYNC.
; 561 12-MAR-79 HAM CBLIO
; FIX MTA LABEL PROCESSING TO ALLOW FOR ANSI LABELS IN MONITOR VERSION 4
; 560 3-MAR-79 MFY CBLIO
; FIX EDIT 544.
; 557 5-MAR-79 HAM CBLIO
; REMOVE EXTENDED LOOKUP IN OPEN AND ALLOW FOR OPEN READ ONLY
; WHEN ANOTHER PROGRAM HAS OPENED THE FILE FOR SIMULTANIOUS UPDATE.
; 556 26-FEB-79 HAM CBLIO
; FIX RESET WITH SHARED BUFFER AREAS TO WORK FOR ISAM "SAVE" AREAS.
; 555 23-FEB-79 MFY CBLIO
; FIX READ OF EBCDIC FILE WITH RECORDING MODE OF BINARY READ WRONG
; NUMBER OF CHARACTERS.
; 554 20-FEB-79 DAW SIZ23
; ENCLOSE QUAD-WORD ROUTINES IN BIS CONDITIONAL
; 553 19-FEB-79 DAW ACCEPT
; ALLOW NO DIGITS FOLLOWING A DECIMAL POINT
; 552 2-FEB-79 CLRH CBLIO
; FIX ISAM SEQUENTIAL READ AFTER A WRITE WHICH SPLITS BOTH A DATA BLOCK AND AN INDEX BLOCK.
; 551 24-JAN-78 MFY COMUNI
; FIX E0.6.1, E0.7.1, E0.9.1 NOT FOUND IN /R CASE
; 550 16-JAN-79 HAM LSU
; FIX NULL CONVERSION IN LRDEQ.
; 547 NOT USED
; 546 8-DEC-78 DAW INSPEC
; FIX SMASHING OF AC WHEN INSPECT REPLACING.
; 545 1-DEC-78 DMN CBLIO FTDEFS
; STORE NO. OF CHARACTERS IN VAR. LEN. RECORD IN FILE TABLE.
; 544 29-NOV-78 DMN CBLIO
; CHECK FOR MISSING HALF OF PPN AND FILL IN DEFAULT
;***** V12 *****
; 543 9-NOV-78 DMN CBLIO COBST
; MOVE CODE TO SETUP .JBHRL TO COBST. THIS IS NEEDED FOR OVERLAYS
; 542 6-OCT-78 DMN CBLIO
; FIX ASCII TO EBCDIC RECORD CONVERSION TO RECOGNIZE E-O-L CHARACTERS
; 541 6-OCT-78 DMN CBLIO
; FIX BYTE MODE TO EBCDIC TAPE (GAVE ILL. ADDR. IN UUO.)
; 540 6-OCT-78 DMN COMUNI DPADD
; ADD QUAD-WORD ROUNDING FUNCTION
; 537 19-SEP-78 DMN COMUNI STRNGL
; FIX EDIT 521, USE TMP.DP
; 536 17-SEP-78 EHM CBLIO
; MAKE LIBOL IDENTIFY AN OVERLAY FILE IT CAN'T FIND
; 535 16-SEP-78 EHM CBLIO
; FIX LIBOL-12 TO RUN WITH IQL
; 534 12-SEP-78 EHM LSU
; FIX EOF FOR LOW-VALUES READ OF ISAM FILES IN SIMULTANIOUS UPDATE
; 533 10-AUG-78 EHM CBLIO
; FIX DISPLAY DOESN'T DISPLAY TRAILING SPACES.
; 532 20-JUN-78 EHM LSU
; FIX ILLEGAL INSTRUCTION FROM LSU FOR SIMULTANIOUS UPDATE
; 531 20-JUN-78 EHM CBLIO
; FIX ERROR ON WRITE OF NON-STANDARD LABELS TO NUL:
; 530 27-APR-78 EHM CBLIO COMUNI
; FIX DEVICE NOT AVAILABLE ERROR TO GIVE THE CORRECT DEVICE NAME
; 527 27-APR-78 EHM EXPON
; TEST FOR OVERFLOW AND UNDERFLOW BEFORE FIXING A FLOATING POINT NUMBER
; 526 14-APR-78 EHM CBLIO
; FIX ASCII WRITES TO RANDOM FILE MAY PUT BIT 35 ON (TOPS-20)
;***** V11 *****
; 525 28-FEB-78 EHM
; FIX EDIT 470. CHANGE WAIT UUO TO TAPE WAIT ALLOW SECOND CHANCE
; 524 27-FEB-78 DAW-EHM
; LSU MAKE RETAIN/READ WORK CORRECTLY FOR COMP AND COMP-1 ISAM KEYS
; 523 21-FEB-78 EHM
; PUT IN NEW SWITCH IMUPDT WHEN ON LIBOL DOES A CHECKPOINT FILOP.
; TO UPDATE THE END OF FILE POINTERS TO MAKE ISAM FILES MORE STABLE
; FOR TOPS20 USERS REQUIRES A PATCH TO THE COMPATIBILITY PACKAGE.
; 522 04-JAN-78 EHM
; FIX USING 2 STRUCTURES FOR ISAM FILES WITH SELECT STATEMENT
; 521 NOT USED.
; 520 10-DEC-77 EHM
; STOP RERUN DUMPING IN PROGRAMS WITH DBMS
; 517 11-NOV-77 DRO
; LCM CONVERTS NULLS TO SPACES INSTEAD OF SPACES TO NULLS
; 516 8-NOV-77 DRO
; LCM FIX FOR MPP SEND OF BAD ADDRESS
; 515 19-OCT-77 EHM
; CHECK FOR DIFFERENCES IN ISAM FILES BETWEEN RESET TIME
; AND OPEN TIME.
; 513 LET USE SPECIFY PAGE FOR IPC
; 512 PREVENT MSC PAGE POOL FROM DISAPPEARING
; 511 CHECK FOR NEGATIVE END INDICATOR ON SEND VERB
; 510 ADD COBOL-74 CODE TO LCM
; 507 16-SEP-77 MDL
; FOR "SAME AREA" FILES, CLEAR BUFFERS AT OPEN TIME FOR NON-ISAM
; FILES.
; 506 07-SEP-77 MDL
; FOR NUL: DEVICE, SET DEVICE DATA MODE TO BE THE SAME AS CORE
; DATA MODE INSTEAD OF DEFAULTING TO ASCII.
; 505 NOT USED
; 504 15-AUG-77 VR
; FIX CHECK FOR NO. OF INDEX LEVELS OF ISAM FILE AT OPEN TIME
; 503 11-JUL-77 VR
; FIX SREAD-ISAM SO IT FINDS 2ND HALF OF SPLIT DATA BLOCK
; 502 24-JUN-77 EHM
; FIX SEQUENTIAL READ OF AN ISAM FILE WITH A SPLIT BLOCK
; 501 24-JUN-77 MDL
; "USE" PROCEDURE GRABBING WRONG FLAG FOR "USE" ERROR RECOVERY.
; 500 16-JUN-77 MDL
; FIX "WRITE AFTER (OR BEFORE) POSITIONING DATA-NAME"
; 477 24-MAY-77 MDL
; FIX "RESERVE NEG-NUM ALTERNATE AREAS" FOR NON-STANDARD BUFFERS
; 476 13-MAY-77 EHM
; TEST FOR EBCDIC BLANK FOR FIRST TWO BYTES OF TAPE RECORD
; 475 03-MAY-77 EHM
; FIX EDIT 473 TO WORK FOR RANDOM FILES
; 474 26-MAR-77 MDL
; ONLY CLEAR NON-OVERLAY FREE CORE WHEN SPLITTING INDEX BLOCKS
; AND USING OVERLAYS.
; 473 22-MAR-77 MDL
; READ PARTIAL LAST LOGICAL BLOCK PROPERLY FOR SIXBIT AND
; EBCDIC RANDOM AND IO FILES.
; 472 4-JAN-77 JM
; COBFUN AND COMUNI FIX TO CUT BACK TO USE PAGE UUO'S
; 471 3-JAN-77 VR
; LIBOL LOOPS WHEN STARTING TO EXECUTE A CORE IMAGE WITH
; MANY SUBPROGRAMS AND OVERLAYS
; 470 30-DEC-76 MDL
; FIRST OUTPUT BUFFER LOST WHEN ATTEMPTING TO DO OUTPUT
; TO WRITE-LOCKED TAPE AND THEN PUTTING WRITE RING ON TAPE
; 467 19-JAN-76 DPL
; FIX RESET CODE FOR ISAM FILES ON TOPS-20 WHEN SEGMENTATION IS
; BEING USED
; 466 30-DEC-76 VR
; DO NOT TRY AGAIN ON INVALID WRITE OF ISAM FILE -OR ON READ
; WHEN FILE IS OPEN FOR I-O.
; 465 19-DEC-76 DPL
; FIX ISAM READING AND WRITING FOR DISPLAY NUMERIC KEYS
; 463 17-SEP-76 DPL
; FIX OPEN OF SIMULTANEOUS UPDATE FILE ON TOPS-20 WHEN A
; USER-NUMBER IS PROVIDED, BUT IS [0,0]
; 462 17-SEP-76 DPL
; ADD NEW FILE-STATUS OF 27 FOR THE WARNING ABOUT THE TOP LEVEL
; INDEX BLOCK SPLITTING
; 461 16-SEP-76 DPL
; FIX WRITING A RECORD IN A RANDOM FILE WITH
; A KEY OF 0. WHEN THE RECORD TO BE WRITTEN WAS IN THE
; LAST BLOCK, IT COULD GET WRITTEN IN THE WRONG PLACE
; 460 16-SEP-76 DPL
; FIX FIXED LENGTH BLOCKED EBCDIC OUTPUT ON MAGTAPE. IT WAS WRITING
; ONE WORD TOO MANY
; 457 16-SEP-76 DPL
; FIX SO THAT THE LAST BLOCK
; NUMBER OF A RANDOM FILE GETS COMPUTED
; WHEN DOING SIMULTANEOUS UPDATE
; 456 10-SEP-76 DPL
; ADD D.BPL AS INTERN TO FIX SIMUL UPDATE RANDOM ACCESS PROBLEM
; OF BLOCKS GT 1 NOT GETTING UPDATED
; 455 03-SEP-76 DPL
; ADD CHTAB AS INTERN FOR SIMUL UPDATE READ OF RANDOM FILES
; WITH ZERO KEYS, ALSO IN LSU AND COMUNI
; 453 17-AUG-76 JC
; FIX CBLIO SO IT CAN FIND THE OVR FILE FROM A SUBROUTINE
; 452 17-AUG-76 DPL
; FOR TOPS20 FIX CBLIO SO LOGICAL DEVICE ASSIGNMENTS WORK
; 451 13-AUG-76 JC
; FIX UP MOVES OF NUMERICS FOR BIS
; 450 13-AUG-76 JC
; ADD NUMERIC ASSEMBLY SWITCH FOR STANDARD NUMERIC TEST
; 447 16-AUG-76 DPL
; RETURN RECORDING MODE BYTE PTR TO SIMUL UPDATE INSTEAD OF
; IN-CORE BYTE PTR SO LOW-VALUES READS WORK
; 445 11-AUG-76 DPL
; ADD GDPSK INTERN FOR LSU TO FIX LOW-VALUES READS WITH DISPLAY
; NUMERIC KEYS
; 444 17-AUG-76 DPL
; FIX KILL CODE TO CHECK FOR USER HAVING SAME FILE OPEN FOR INPUT
; AND OUTPUT, DO NON-SUPERSEDE CLOSE OF OUTPUT IF TRUE
; 442 01-JUL-76 SER
; ALLOW FOR ISAM FILE INDEX BLOCK SPLITTING WHEN SETTING UP
; BUFFERS BETWEEN FIRST AND SECOND OPEN
; 440 01-JUN-76 SER
; REMOVE PART OF EDIT 414
; 437 01-JUN-76 SER
; SET UP FOUR TABLES AND INITIALIZE THE COUNT PROPERLY FOR RANDOM FILES
; UNDER SIMULTANEOUS UPDATE, PATCH IN LSU ALSO
; 432 23-FEB-76 DPL
; MAKE SAME AREA CLAUSE WORK FOR ISAM AND SEQUENTIAL FILES TOGETHER
; 431 23-FEB-76 TOPS20 CODE
; 430 4-FEB-76 DPL
; ADD CSORT SWITCH AROUND KILL: CODE SO STAND ALONE CSORT WON'T
; PRINT 'LAST COBOL UUO CALLED.....' ERROR MESSAGE
; 426 2-FEB-76 DPL
; MAKE SURE APPENDED DATA STARTS WHERE OLD DATA LEFT OFF, NOT ON
; FULL BLOCK BOUNDARY
; 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.
SEARCH LBLPRM ;DEFINE PARAMETERS.
%%LBLP==:%%LBLP
SEARCH COMUNI
%%COMU==:%%COMU
INFIX%
ISAM==:ISAM
EBCMP.==:EBCMP.
SEARCH FTDEFS ;FILE-TABLE DEFINITIONS
%%FTDF==:%%FTDF
IFN LSTATS,<
SEARCH METUNV
>
SEARCH UUOSYM
UU.RRC==1B6 ;UNTIL 7.01 IS RELEASED
IFN TOPS20,< SEARCH MONSYM, MACSYM>
IFE TOPS20,< SEARCH MACTEN>
LOC 124 ;.JBREN
EXP RENDP ;TO FORCE A DUMP.
LOC 137 ;.JBVER
EXP VERSION
IFNDEF EBCLBL,<EBCLBL==0>
IFNDEF SIRUS,<SIRUS==0> ; [403] SPECIAL CODE FOR SIRUS
IFNDEF SUPPTB,<SUPPTB==0> ; [403] SUPPRESS TRAILING BLANKS ON OUTPUT ASCII FILES.
IFNDEF ISTKS,<ISTKS==0> ;TYPE # OF IN'S AND OUT'S
SUPP==SIRUS!SUPPTB ; [403] SUPPRESS TRALING BLANKS FOR SIRUS
IFNDEF EBCMP.,<EBCMP.==0>
HISEG
SALL
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
BUFLOC==4000 ;BUFFER LOCATION HAS BEEN ASSIGNED, LEFT-HALF OF F.WDNM(I16)
SASCII==1 ; REQUEST FOR STANDARD ASCII, IN D.RFLG
;VALUES FOR FILE STATUS CODE
FSNRCF==23 ;NO RECORD FOUND ON READ,REWRITE,DELETE
;VALUES FOR FILE ACCESS MODE
%FAM.S==0 ;SEQUENTIAL
%FAM.R==1 ;RANDOM
%FAM.D==2 ;DYNAMIC
;[566]LOOKUP BLK OFFSETS
LKPSIZ==3 ;[566]OFFSET TO FILE SIZE RETURNED IN LOOKUP BLOCK
;MTOPR CONSTANTS
;(VERSION 4 OF TOPS20)
MOVLS==44 ;MTOPR FUNCTION TO SWITCH VOLUMES UNDER MOUNTR CONTROL
VSFST==2 ;MOUNT FIRST REEL SUBFUNCTION
VSMRV==4 ;MOUNT RELATIVE REEL NUMBER SUBFUNCTION
MONTR==45 ;SET NO TRANSLATE FOR MOUNTR LABEL EBCDIC TAPES
MORLI==50 ;MTOPR FUNCTION NUMBER FOR RETURNING LABEL INFO
MTOSIZ==15 ;SIZE OF TEMP TABLE USED BY .MORLI MTOPR FUNCTION
;COMPT. UUO FUNCTIONS
CMPJFN==10 ;GET JFN FROM CHANNEL NUMBER
;MTA CONSTANTS
LTFKD2==5 ; MONSYM SYMBOL FOR DX20/TX02 MTA CONTROLLER CODE
MXTPRC==20000 ;MAX. MTA REC SIZE (IN WORDS)
MINMTA==4 ;MINIMUM MTA OUTPUT SIZE
;DEF SYMBOLS FOR DISK BLOCK SIZE
DSKBSZ==200 ;SIZE OF A DISK BLOCK (BUFFER)
DSKMSK==177 ;MASK FOR BITS TO RIGHT OF DSKBSZ
;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.FMTA==^D50000 ; LABEL PROCESSING ERROR (MTA FILE)
E.BSTS==^D1000 ;ISAM STATISTICS BLOCK
E.BSAT==^D2000 ;ISAM SAT BLOCK
E.BIDX==^D3000 ;ISAM INDEX BLOCK
E.BDAT==^D4000 ;ISAM DATA BLOCK
;FLAGS IN LEFT SIDE OF "FLG" & F.WFLG(I16) AFTER RESET.
; **WARNING** DO NOT DISTURB DDM??? OR CDM???
DDMASC==400000 ;DEVICE DATA MODE IS ASCII
DDMSIX==200000 ;DEVICE DATA MODE IS SIXBIT
DDMEBC==100000 ;DEVICE DATA MODE IS EBCDIC
DDMBIN==40000 ;DEVICE DATA MODE IS BINARY
OPNIN==20000 ;FILE IS OPEN FOR INPUT
OPNOUT==10000 ;FILE IS OPEN FOR OUTPUT
OPNIO==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
IFN TOPS20,<
MTNOLB==10000 ;MOUNTR HANDLING LABELS,BUT NO LABELING
F1CLR==3777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME
>
MSTNDR==20000 ;STANDARD BUT MONITOR DOES LABEL PROCESSING
IFE TOPS20,<
F1CLR==23777 ; THESE FLAGS ARE CLEARED AT CLOSE TIME
>
FOPERR==2 ; FILOP.UUO FAILED
NOCRLF==4000 ; TEMP FLG IF NO CRLF IN ASCII MTA INPUT
IFN ISAM,<
NOTEST==2000 ;[276] SKIPE THE CONVERSION TEST AT ADJKEY
WSTB==1000 ;WRITE THE STATISTICS BLOCK
IIAB==400 ;INSERTION IS IN AUX BUFFER
TRYAGN==200 ;MAKE A SECOND PASS AT ALC01 OR DON'T AT VNDE
BVN==100 ;BUMP-VERSION-NUMBER SPLITTING A BLOCK
WSB==40 ;WRITE THE SAT BLOCK
BLK2==20 ;REQ FOR 2ND DATA BLOCK
SEQ==10 ;SEQUENTIAL READ
VERR==4 ;VERSION NUMBER DISCREPANCY BTWEEN INDEX LEVELS
WIVK==2 ;WRITE INVALID-KEY
FOPIDX==2 ;FILOP OF NAME.IDX IN PROGRESS
RIVK==1 ;READ, RERIT OR DELET INVALID-KEY
EIX==1 ;ENTER OF NAME.IDX IN PROGRESS
>
SUBTTL EXTERNALS.
ENTRY C.RSET ;MAKE SURE WE GET LOADED.
ENTRY DSPL.6,DSPL.7,DSPLY. ;FOR OVERLAYS
ENTRY METER.
IFN LSTATS,<
;ROUTINES IN METIO
EXTERN MRLSET,MRDMPT,MRDMP
;LOWSEG LOCATIONS
EXTERN MBTIM.,MRTMB.,MRTDBP
EXTERN MRBKO.,MRBLKO,MRBNUM
EXTERN MRFPGT,MRKILL,MROPTT,MRPSTM,MRRERN
>;END IFN LSTATS
EXTERNAL LIBIMP ;CAUSES LIBREL ( LIBOL.LOW) TO BE LOADED FOR /R
; [440] REMOVE EXTERNAL SYMBOL FOR EDIT 414
EXTERNAL IIN,IOUT,ISETI,ISETO,ICLOS,IRELE,IGETS,IWAIT,IRNAM
EXTERNAL MWAIT.,MREW.,MREWU.,MBSPR.,MBSPF.,MADVR.,MADVF.,MWEOF.,MTIND.
EXTERNAL MERAS. ;[470]
EXTERNAL SOBOT.,SZBOT.,SZEOF.,SZEOT.
EXTERNAL UOPEN.,UENTR.,ULKUP.,UOBUF.,UIBUF.,UCLOS.,URELE.,USETI.
EXTERNAL USETO.,UOUT.,UIN.,USETS.,UGETS.,UWAIT.,URNAM.
EXTERNAL UOCAL.,OPNCH.,UOBLK.,NRSAV.,AUTOLB
EXTERNAL UEBLK.,ULBLK.,TTOBP.,TTOBC.,TTOBF.,STDLB.
EXTERNAL REDMP.,TEMP.,TEMP.1,JSARR.,TEMP.2,SEGNO.,AINFO.,OVRBF.,FLDCT.,OVRIX.
EXTERNAL SHRDX. ;[556]
EXTERNAL NOCR.,PRGFLG,TTYOPN,ACSAV0,MXIE,IESAVE,MXBUF,AUXBUF,AUXIOW,AUXBNO,CMDLST,NEWBK1
EXTERNAL NEWBK2,OLDBK,MXBF,DRTAB,LRWA
EXTERNAL FS.ZRO,FS.FS,FS.EN,FS.BN,FS.RN,FS.UPD,FS.IGE,FS.IF,ISETS,FS.IEC
EXTERNAL MOVE.,PD6.,PD7.,C.D6D7,C.D7D6
IFN EBCMP. <
EXTERNAL PD9.,C.D9D6,C.D9D7,C.D6D9,C.D7D9
>
EXTERNAL FRSTIC,LASTIC,PFRST.,UFRST.,ULAST.,IFRST.,ILAST.
EXTERNAL RELEN. ;[332]
EXTERN TODAY.,TODA1.
EXTERNAL RN.PPN, RUN.TM, RN.DEV, RN.NAM ;[333]
EXTERNAL PUSHL.,CB.DDT,LEVEL.,%F.PTR,COBSW.,SBPSA.
EXTERNAL SU.RBP,SU.CL,SU.WR,SU.RD,SU.DL,SU.RW ;SIMULTANEOUS UPDATE
EXTERN FOP.BK,FOP.IS,FOP.DN,FOP.LB ;SIMULTANEOUS UPDATE
EXTERN SU.FRF ;FAKE READ FLAG
EXTERN .JBSA,.JBFF,.JBREL,.JBAPR,.JBTPC,.JBCNI,.JBDA,.JBOPC,.JBREN
IFN ISAM,<INTERN GDPSK> ;[447]SIMULTANEOUS UPDATE
INTERN CHTAB ;[455] SIMULTANEOUS UPDATE
INTERN SEQFIL ;[455] SIMULTANEOUS UPDATE
IFN ANS74,<INTERN F.BFAM> ;FOR SIM. UPDATE
INTERN FAKER.,IGSS,RANFIL,IDXFIL,E.VRET
INTERN C.CLOS,DOPFS.,C.END,GETCH.,DSPL1.,MSOUT.,C.OPEN,OUTCH.
INTERN OUT6B.,OUTBF.,READ.,RSTAB.,STOPR.,C.STOP,TRAP.,WRITE.,WADV.,WRPW.
INTERN WADVV.,WRITV.
INTERN GOTO.,KILL.,PPOUT.,PPOT4.,SAVAC.,RSTAC.
INTERN SEEK.
EXTERN USEEK.
INTERN C.STRT,RDNXT.
EXTERNAL RET.1,RET.2,RET.3
INTERN DELET.,RERIT.,PURGE.
EXTERNAL HLOVL. ;[346] XWD HIGHEST OVERLAY LOC , LOWEST LOC
IFN ISAM,<EXTERNAL GD6.,GD7.,GD9.,GC3.,PD6.,PD7.,PD9.,PC3.,KEYCV.> ;[370]
IFN ISAM,<INTERN USOBJ,LVTST,LV2SK.,FOPIDX,NNTRY>
EXTERNAL FILES.,USES.,OVRFN.,TRAC1.
EXTERN FUSIA.,FUSOA.,FUSCP. ;[523] FILOP. ARG-BLOCK
INTERN LIBVR.,LIBSW.
IFN LSTATS,< ;EXTERNALIZE LIBOL METERING ROUTINES
INTERN LMETR.,MRACDP
IFN TOPS20,<
INTERN MRTM.S,MRTM.E
>
>
IFN ISAM,<
ADR==0
DEFINE TABADR(N,L) <
N==ADR
ADR==ADR+L
>
TABADR STAHDR,1 ;SIZE OF STATISTICS BLOCK IN SIXBIT BYTES
TABADR DDEVNM,1 ;DATA FILE'S DEVICE NAME
TABADR DFILNM,1 ;DATA FILE'S FILE NAME
TABADR DEXT,1 ;DATA FILE'S EXTENSION
TABADR DCDATE,1 ;DATA FILE'S CREATION DATE
TABADR DADATE,1 ;DATA FILE'S ACCESS DATE
TABADR MXLVL,1 ;NUMBER OF LEVELS IN INDEX FILE
TABADR DBF,1 ;DATA FILE BLOCKING FACTOR
TABADR DMTREC,1 ;NUMBER OF EMPTY RECORDS PER DATA BLOCK
TABADR EPIB,^D20 ;TWO WORDS PER INDEX LEVEL
;FIRST WORD: NUMBER OF ENTRIES PER INDEX BLOCK
;SECOND WORD: NUMBER OF EMPTY ENTRIES
TABADR DMXBLK,1 ;TOTAL BLOCKS IN DATA FILE
TABADR DMTBLK,1 ;EMPTY BLOCKS IN DATA FILE
TABADR IMXSCT,1 ;TOTAL SECTORS IN INDEX FILE
TABADR IMTSCT,1 ;EMPTY SECTORS IN INDEX FILE
TABADR FMTSCT,1 ;FIRST EMPTY SECTOR IN INDEX FILE
TABADR DMXREC,1 ;MAXIMUM DATA RECORD SIZE IN WORDS
TABADR DBPRK,1 ;BYTE POINTER TO RECORD KEY RELATIVE TO DATA RECORD
TABADR RWRSTA,1 ;NUMBER OF READ, WRITE, REWRITE STATEMENTS SINCE INITIALIZATION
TABADR IOUUOS,1 ;NUMBER OF IN'S AND OUT'S SINCE INITIALIZATION
TABADR SBLOC,1 ;RELATIVE ADR OF FIRST SAT BLOCK
TABADR SBTOT,1 ;TOTAL SAT BLOCKS
TABADR ISPB,1 ;INDEX FILE, SECTORS PER LOGICAL BLOCK
TABADR FILSIZ,1 ;MAXIMUM POSSIBLE NUMBER OF DATA BLOCKS IN FILE
TABADR KEYTYP,0 ;KEY-TYPE IN LEFT HALF
TABADR KEYDES,1 ;DESCRIPTION OF RECORD KEY
TABADR IESIZ,1 ;INDEX ENTRY SIZE IN WORDS
TABADR TOPIBN,1 ;TOP INDEX BLOCK NUMBER
TABADR %DAT,1 ;% OF DATA FILE EMPTY
TABADR %IDX,1 ;% OF INDEX FILE EMPTY
TABADR RECBYT,1 ;SIZE OF LARGEST DATA BLOCK IN BYTES
TABADR MAXSAT,1 ;MAX # OF RECORDS FILE CAN BECOME
TABADR ISAVER,1 ;"ISAM" VERSION NUMBER
STABL==ADR ;EQUALS SIZE OF STATISTICS BLOCK
TABADR IOWRD,14+1 ;TABLE OF DUMP MODE IOWD'S FOR EACH INDEX LEVEL
;0 DATA BLOCK
;1-12 INDEX BLOCKS
;13 SAT BLOCK
;14 STATISTICS BLOCK
TABADR OMXLVL,1 ;ORIGINAL MAX NUMBER OF LEVELS IN INDEX FILE
TABADR OKEYDS,1 ;[515] KEY DESCRIPTOR AT RESET TIME
TABADR ORCBYT,1 ;[515] RECORD SIZE AT RESET TIME
TABADR OEPIB,1 ;[515] ENTRIES PER INDEX BLOCK AT RESET TIME
TABADR CORE0,1 ;LAST,,FIRST - CORE AREA CLEARED AT CLOSE
TABADR ICHAN,1 ;CHANNEL NUMBER FOR INDEX DEVICE
TABADR USOBJ,14+1 ;USETI/O OBJECT: DATA, 10 INDEX, SAT & STA
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
IFN ISTKS,<
TABADR INSSS0,1 ;EXP (LVL)INSSSS
TABADR OUTSS0,1 ;EXP (LVL)OUTSSS
TABADR INSSSS,16 ;NUMBER OF INS/LEVEL
TABADR OUTSSS,16 ;NUMBER OF OUTS/LEVEL
>
TABADR IOWRD0,1 ;POINTS TO CURRENT IOWRD
TABADR USOBJ0,1 ;POINTS TO CURRENT USOBJ
TABADR CNTRY0,1 ;POINTS TO CURRENT CNTRY
TABADR NNTRY0,1 ;FLAG, CNTRY POINTS TO NEXT ENTRY
TABADR BPSB,1 ;NUMBER OF BITS PER SAT BLOCK
ITABL==ADR-STABL ;INDEX TABLE LEN
TABADR BA,0 ;START OF BUFFER AREA
ISCLR1==IOWRD ;[432] [377] START OF ISAM SHARED BUFFER AREA TO SAVE
ISCLR2==ICHAN-1 ; [377] END OF ISAM SHARED BUFFER TO SAVE
ISMCLR==ISCLR2-ISCLR1 ; [377] DIFFERENCE OR SIZE OF AREA LESS 1 TO SAVE
> ;END OF 'IFN ISAM'
SUBTTL RESET
;RESET IS CALLED WITH A JSP 14,C.RSET
MLON
LIBVR.: EXP VERSION ;LIBOL VERSION NUMBER
LIBSW.: EXP 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.
RUNTIM AC11, ;[346]GET THE RUNTIME.
MOVEM AC11,RUN.TM ;[346]SAVE IT.
IFN LSTATS,< ;(LSTATS) SAVE STARTING RUNTIME
IFE TOPS20,<
MOVEM AC11,MRPSTM ;SAVE RUNTIME AT START
>
IFN TOPS20,<
MTRJS% ;GET STARTING TICKS
ERJMP .+2 ;MOVE ZER0 IF NO CLOCK
DMOVEM AC1,MRPSTM ;SAVE VALUE
>
>;END IFN LSTATS
IFN DBMS,<
MOVE AC1,DBSTP%## ;GET FROM VISIBLE, BUT NOT SAFE PLACE
MOVEM AC1,DBSTP.## ;PUT IN INVISIBLE (FROM USER) BUT SAFE PLACE
SETZM DBSTP% ;CLEAN UP (ITS REALLY LEVEL.)
>
HRRZ AC1,.JBSA ;[START.]
MOVEM AC1,JSARR. ;SAVE FOR RRDMP
HRRZ AC1,.JBFF ;TO-1
CAMG AC1,.JBREL ;SKIP ILL-MEM-REF
SETZM (AC1) ;ZERO WORD
HRL AC1,AC1 ;FROM,,TO-1
ADDI AC1,1 ;FROM,,TO
HRRZ AC2,.JBREL ;UNTIL
CAIL AC2,(AC1) ;SKIP ILL-MEM-REF IF .JBFF = .JBREL
BLT AC1,(AC2) ;ZERO FREE COR
RESET1: MOVEI AC0,[OUTSTR [ASCIZ/COBOL PROGRAMS MAY ONLY BE STARTED THROUGH
USE OF "GET AND ST" OR "RUN" MONITOR COMMANDS/]
EXIT]
HRRM AC0,.JBSA
MOVE PP,[XWD PFRST.,IFRST.]
TLNE PP,777777 ;NO BLT IF PFRST. = 0 - LOW SEG WAS LOADED
BLT PP,ILAST. ;THE IO UUO'S
MOVEI AC10,MEMRY.## ;SET UP MEMRY. POINTER
MOVEM AC10,MEMRY%##
HRRZ AC10,(AC14) ;GET THE PROGRAM'S ENTRY POINT.
HRRZ AC10,1(AC10) ;GET THE ADDRESS OF %FILES.
SKIPN AC10,%PUSHL(AC10) ;GET THE PDL SIZE.
MOVEI AC10,200 ;THIS IS FOR CSORT
MOVNI PP,(AC10) ;0,,-LENGTH
HRL PP,.JBFF ;START-LOC,,-LENGTH
MOVSS PP,PP ;POINTER IS SET UP.
MOVEI AC10,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.
CORE AC10, ;YES, GO ASK FOR MORE CORE.
JRST GETSPK ;CAN'T HAVE ANY MORE, ERROR.
;SET FLAGS TO TRAP ON
RESET2: MOVEI AC0,TRAP. ;[312] INTERUPT ROUTINE ADR
MOVEM AC0,.JBAPR ;[312]
MOVEI AC0,AP.POV!AP.ILM!AP.NXM ;[312] PDLOV - MPVIO - NXM
APRENB AC0, ;[312] APRENB UUO
PUSH PP,AC14 ;SO WE CAN PRINT PC ON ERRORS
PUSHJ PP,RSAREN ;[312] INIT .JBSA AND .JBREN
PUSHJ PP,OUTBF1 ;SETUP TTY BYTE-POINTER AND BYTE-COUNT
PUSHJ PP,RSTLNK ;LINK ALL SUB-PROGRAM'S FILE-TABLES
PUSHJ PP,SUSPC ;COMPUTE SPACE REQUIRED FOR SIMULTANEOUS
;UPDATE, AND GET IT
PUSHJ PP,SETOVR ;SET UP OVERLAY FILE
PUSHJ PP,RSTAB. ;ASSIGN THE BUFFER AREA
IFE TOPS20,<
PUSHJ PP,SETALB ;SET AUTOLB IF AUTO MTA LABEL PROCESSING
>
POP PP,(PP) ;CLEAN UP STACK
IFN CSTATS,<
SKIPE METR.## ;METER--ING SETUP?
PUSHJ PP,SETMTR ;YES, SET UP FOR IT
>
IFN LSTATS,<
PUSHJ PP,MRLSET ;SETUP FOR LSTATS FILE WRITING
>
SETOM OSHOOT## ;[530] SET END OF RESET FLAG
HRRZ AC10,COBSW. ;GET COMPILER ASSEMBLY SWITCHES
HRRZ AC3,LIBSW. ;GET LIBOL ASS-SWITCHES
CAME AC10,AC3 ;THE SAME?
OUTSTR [ASCIZ /% COBOL-LIBOL ASSEMBLY SWITCHES MISMATCHED
/]
IFE TOPS20,<
MOVE AC10,[%CNVER] ;CONFIG TABLE
GETTAB AC10,
SETZ AC10, ;MUST BE VERY OLD
LDB AC10,[POINT 5,AC10,23] ;MONITOR VERSION NO.
CAIN AC10,7 ;TEST FOR 7.00 SERIES MONITOR
SETOM M7.00## ;SET FLAG IF TRUE
>
JRST 1(AC14) ;RETURN
;HERE TO CHAIN FILE-TABLES OF ALL SUBPROGRAMS TOGETHER
;POINTERS ARE AS FOLLOWS
;AC14/ ADR OF SP1 ;ADR OF ADR OF "MAIN" PROGRAM
;THE FOLLOWING ARE THE SAME FOR ALL SUBPROGRAMS
;SP1+1/ LST,,FILES. ;FILES. HAS ADR OF FIRST FILE-TABLE
;LST/ SP2 ;ADR OF SUBPROGRAMS CALLED BY SP1
;LST+1/ SP4 ; .
;LST+N/ 0 ;TERMINATES WITH A ZERO
RSTLNK: MOVEI AC3,AC3 ;THWART THE FIRST LINK
HRR AC1,(AC14) ;ADDRESS OF "MAIN" PRG + 1
HRL AC2,1(AC1) ;SETUP THE
HRRI AC2,FILES. ; FIXED
HRRZI AC4,FILES. ; PARAMETERS
BLT AC2,FIXNUM-1(AC4); %FILES THRU %PR
SETZM OVRFN. ;CLEAR THE OVR FILE PTR TO START
RSTL10: HRRZ AC5,(AC1) ;[346] CHECK TO SEE IF THIS SUBROUTINE
JUMPN AC5,RSTLNX ;[471] IS IN A LINK-10 OVERLAY AREA.
; ((AC1)) = SKIPA 0,0 ==> IT ISN'T
; ((AC1)) = JSP 1,MUMBLE ==> IT IS.
MOVE AC1,1(AC1) ;ADDRESS OF [LIST ,, FILES.]
HLRZ AC2,AC1 ;ADR OF LIST OF CALLED SUBPROGRAMS
SKIPGE AC4,(AC1) ;HAVE WE BEEN HERE BEFORE?
POPJ PP, ;YES, -1 IN LEFT HALF
MOVEI AC10,%OVRFN(AC1) ;[453] GET OVRFN ADDR
MOVE AC10,(AC10) ;[453] GET OVR FILE NAME
JUMPE AC10,RSTL13 ;[453] JUMP IF NO OVR FILE
SKIPE OVRFN. ;[453] ALREADY SEEN ONE?
JRST RSOVE1 ;[453] YES--ERROR
MOVEM AC10,OVRFN. ;[453] SAVE OVR FILE NAME
RSTL13: JUMPE AC4,RSTL12 ;[453] JUMP IF SUBPRG HAS NO FILE-TABLES
SKIPN FILES. ;HAS FILES. BEEN SETUP YET?
HRRM AC4,FILES. ;NO - SO DOIT
HRRM AC4,(AC3) ;LINK THIS FILE-TABLE GROUP TO LAST GROUP
RSTL11: HRRZI AC3,F.RNFT(AC4) ;GET ADR OF LINK TO NEXT TABLE
HRRZ AC4,(AC3) ;GET THE LINK TO NEXT TABLE
JUMPN AC4,RSTL11 ;LOOP IF NOT THE LAST TABLE
RSTL12: HRROS (AC1) ;MARK THIS FILE-TABLE GROUP DONE
RSTL20: SKIPN AC1,(AC2) ;ANY SUBPRGMS?
POPJ PP, ;NO -- BACK TO THE LAST SUBPRG OR EXIT
PUSH PP,AC2 ;SAVE POINTER TO SUBPROGRAM LIST
PUSHJ PP,RSTL10 ;GO LINK THE FILE-TABLES
POP PP,AC2 ;RETREIVE LIST POINTER
SKIPE 1(AC2) ;ANY MORE SUBPRGMS?
AOJA AC2,RSTL20 ;INCREMENT POINTER AND TRY AGAIN
RSTLNX: POPJ PP, ;[312];NO--DONE.
RSOVE1: OUTSTR [ASCIZ /?ONLY ONE MODULE IN A COBOL RUN-UNIT MAY HAVE SEGMENTATION
/] ;[453]
JRST KILL ;[453]
;ASSIGN THE BUFFER AREA. ***POPJ***
RSTAB.: PUSHJ PP,GCHAN ;FIND A FREE CHANNEL
PUSHJ PP,SETC1. ; ASSIGN TO IO UUOS
SETOM FS.IF ;IDX FILE
SETZM TEMP.1 ;ZERO THE ERROR COUNT
SETZM SHRDX. ;[556] CLEAR SHARED ISAM BUF AREA FLAG
HRRZ AC16,FILES. ;FIRST FILE TABLE
JUMPE AC16,RET.1 ;THERE ARE NO FILES
RSTIFI: SETZM TEMP. ;MAX SIZE OF BUF AREA
RSTIF1: MOVE AC15,F.WDNM(I16);IF THIS IS FIRST
TLNN AC15,BUFLOC ;[316] TIME THROUGH TABLE,
PUSHJ PP,RSTFLG ;REORGANIZE THE FLAGS
MOVE FLG,F.WFLG(I16) ;GET THE FLAGS
HRLOI AC15,4077 ;[316] #OF DEVICES,,LOC OF FIRST ONE
AND AC15,F.WDNM(I16) ;
TLZE AC15,BUFLOC ;IS BUFLOC SET?
JRST RSTNFL ; [377A] YES-NEXT FILE
MOVEM AC15,AC13 ;
TLC AC13,777777 ;MAKE
AOBJP AC13, .+1 ;KIND OF
HRR AC13,AC15 ;AN IOWD
MOVEM AC13,D.ICD(I16) ;%-<#OF DEVS>,,LOC OF FIRST DEVNAM
RSTDEV: MOVE AC3,(AC13) ;SIXBIT /DEVICE NAME/
IFN SIRUS,< MOVE AC1,AC3 ; [403] KEEP DEVICE >
DEVCHR AC3, ;DEVCHR UUO
TXNN AC3,DV.CDR!DV.LPT!DV.PTP!DV.PTR!DV.TTY ;SKIP IF A LPT,TTY,PTP,PTR,CDP, OR CDR
JRST RSTDE0 ;
TXC AC3,DV.DSK!DV.CDR ;[506] IF A DSK AND A CDR ...
TXCE AC3,DV.DSK!DV.CDR ;[506] THEN IT'S DEVICE NUL:
JRST RSTDV1 ;[506] NOT NUL:, CONTINUE
TXZ AC3,DV.MTA!DV.TTY ;[506] NUL:, SO NOT MTA OR TTY
LDB AC12,[POINT 3,FLG,14] ;[506] CORE DATA MODE
DPB AC12,[POINT 3,FLG,2] ;[506] MAKE DEV DATA MODE SAME
MOVEM FLG,F.WFLG(I16) ;[506] SAVE IT
JRST RSTDE0 ;[506] CONTINUE
RSTDV1: TLO FLG,DDMASC ;FORCE ASCII MODE
TLZ FLG,DDMBIN!DDMSIX!DDMEBC ; FOR THE ABOVE DEVICES
MOVEM FLG,F.WFLG(I16) ;
RSTDE0: JUMPN AC3,RSTDE2 ;
IFN SIRUS,<
MOVE AC3,(AC13) ; [403] GET DEVICE NAME
CAME AC3,SIRDEV ; [403] IS IT SIRUS DEVICE?
JRST RSTDE1 ; [403] NO-ERROR
MOVSI AC3,'NUL' ; [403] YES-MAKE IT NULL DEVICE
JRST RSTDEV+1 ; [403] TRY AGAIN
> ; END OF IFN SIRUS
RSTDE1: MOVE AC2,[BYTE(5)25,4,20,13,23,15,14];"NOT A DEVICE OR
PUSHJ PP,MSOUT. ;NOT AVAILABLE TO THIS JOB
AOS TEMP.1 ;COUNT THE ERRORS
JRST RSTLOO ;
RSTDE2: SETZM UOBLK. ;[411] MAKE SURE WE DONT GET ILLEGAL MODE IF ASCII DEV
MOVE AC12,.JBFF
SKIPN SHRDX. ;[556] IF ISAM SHARED BUF, D.BL ALREADY SET
HRLM AC12,D.BL(I16) ;SET BUFFER LOCATION
IFN SIRUS,< MOVE AC12,AC1 ; [403] GET BACK DEVICE >
IFE SIRUS,< MOVE AC12,(AC13) ;SIXBIT /DEVNAM/>
MOVEM AC12,UOBLK.+1 ;FOR THE INIT BLOCK
HRLZI AC12,D.OBH(I16) ;LOC OF OBUF HDR
TLNE FLG,OPNIO ;SKIP IF NOT IO
HRRI AC12,D.IBH(I16) ;LOC OF IBUF HDR
MOVEM AC12,UOBLK.+2 ;INIT BLOCK
IFN ISAM,<
MOVEI AC1,.IODMP ;DUMP MODE
TLNE FLG,IDXFIL ;INDEX-FILE?
HRRZM AC1,UOBLK. ;YES
>
IFN TOPS20,<
TLNE FLG,IDXFIL ;ISAM FILE?
JRST RSTD21 ;YES
>
XCT UOPEN. ;********************
JRST RSTDE1 ;INIT FAILED, ERROR RETURN
RSTD21: PUSH PP,.JBFF ;
TLNE FLG,IDXFIL ;
JRST RSTIDX ;SETUP FOR AN INDEX FILE
TXNN AC3,DV.MTA ;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 **************
HLLZ AC6,D.F1(I16) ; GET SECOND FLAG WORD
RSTDE5:
; THIS IS STUFF FOR VERSION 4 OF TOPS20, TO TAKE
; CARE OF TAPE HANDLING BY MOUNTR , INCLUDING LABEL
; PROCESSING.
IFN TOPS20,<
TXNN AC3,DV.MTA ; SKIP IF MTA
JRST RSTD5A ; ELSE GO ON
MOVE AC5,AC3 ;SAVE AC3, CLOBERED LATER
LDB AC2,[POINT 4,UOPEN.,12] ;GET CHANNEL NUM
HRLZ AC2,AC2 ;GET CHAN NUM IN LEFT,AS ARG TO COMPT.
HRRI AC2,CMPJFN ;SET COMPT. FUNCTION NUM FOR CHAN TO JFN
MOVE AC1,[1,,2] ;INDICATE 1 ARG IN ADDR 2
COMPT. AC1, ;GET JFN *************
JRST [OUTSTR [ASCIZ/RESET GET JFN /] ;ERROR, ISSUE MESSAGE
JRST OCPERR ] ;MORE MESS AND KILL
;GET AND CLEAR A TEMP TABLE AREA FOR MTOPR
;PUT TABLE LENGTH IN FIRST WORD,AS MTOPR WANTS
MOVE AC3,AC1 ;SAVE JFN IN CASE OF OPENF ERROR
MOVE AC2,[440000,,200000] ;INDICATE SIMPLE 36 BIT BYTE,INPUT
OPENF ;OPEN THE JFN***************
ERCAL OPNFER ;ERROR?, THEN GO CHECK IT (RETURNS IF OK)
MOVE AC3,.JBREL ;GET ADDR OF LAST AVAILABLE LOWSEG SPACE
SUBI AC3,MTOSIZ ;DECREMENT BY SIZE OF MTOPR TABLE SIZE
; THIS GETS A TEMP SPACE IN ALLOCATED LOWSEG
MOVE AC2,AC3 ;GET TEMP TAB ADDR
HRL AC2,AC2 ;MAKE BLT PTR
SETZM (AC2) ;ZERO FIRST WORD
ADDI AC2,1 ;FROM THERE TO THERE+1
BLT AC2,MTOSIZ(AC3) ;ZERO TEMP AREA,TO MAKE SURE NO INFO FROM
;MTOPR WILL BE STUCK IN A BAD PLACE
MOVEI AC2,MTOSIZ ;GET MTOPR SIZE
MOVEM AC2,(AC3) ;INITIALIZE TAB LENGTH
MOVEI AC2,MORLI ;SET MTOPR FUNCTION CODE FOR READING LABELS
MTOPR ;GET LABEL INFO ***************
ERJMP MTOPER ;ERROR, CHECK FOR ILLEGAL FUNCTION
;INDICATING MOUNTR NOT AROUND
SOSE 1(AC3) ;SKIP IF NO LABELING,WORD 1=1 IF NO LABELING
JRST MTLABL ;LABELING, GO SET NO INTERNAL LABELING
TLO AC6,MTNOLB ;SET MOUNTR WITH NO LABELING FLAG
HLLM AC6,D.F1(I16) ;IN FILTAB
JRST MTOXXX ;CONT
MTLABL: TLZ AC6,STNDRD!NONSTD ;CLEAR LABEL BITS IN D.F1
TLO AC6,MSTNDR ;INDICATE MONITOR IS LABELING
HLLM AC6,D.F1(I16) ;RESET IN FILTAB
TLNN FLG,DDMEBC ; SKIP IF EBCDIC EXTERNAL MODE
JRST MTOXXX ; ELSE CONT
MOVEI AC2,MONTR ; INDICATE SET NO TRANSLATE FUNCTION
MTOPR ; SET IT SO ALL EBCDIC DATA NOT TRANSLATED
ERJMP MTOERR ; ERROR RETURN
JRST MTOXXX ;CONT
MTOPER: MOVEI AC1,.FHSLF ;INDICATE CURRENT PROCESS
GETER ;GET LAST ERROR NUM IN AC1 (RT HALF)
CAMN AC2,[.FHSLF,,MTOX1] ;IF AN INVALID FUNCTION ERROR (VER. 4)
;THEN THIS INDICATES THAT NO MOUNTR IS RUNNING
;, NOTHING SPECIAL TO DO
JRST MTOXXX ;SO CONT
JRST MTOERR ;ELSE MTOPR ERROR, ISSUE MESSAGE AND QUIT
MTOXXX: MOVE AC3,AC5 ;RESTORE AC3
>;END IFN TOPS20
RSTD5A: HLRZ AC12,D.BL(I16) ;CALCULATE
SUB AC12,.JBFF ;THE SIZE
POP PP,.JBFF ;
MOVNS AC12 ;OF THE
RSTDE3: CAML AC12,TEMP. ;BUFFER AREA
MOVEM AC12,TEMP. ;SAVE SIZE OF LARGER
;LOOP AGAIN
RSTLOO:
IFN ISAM,<TLNN FLG,IDXFIL >
AOBJN AC13,RSTDEV ;JUMP IF MORE DEV/FILTAB
RSTLO1: MOVSI AC15,BUFLOC ;[316];NOTE WE ARE DONE
IORM AC15,F.WDNM(I16);WITH THIS FILE TABLE
HLRZ AC1,F.LSBA(I16) ;SEE IF ANY SHARING OF BUFFERS
JUMPE AC1,RSTNFL ;GET THE NEXT FILE TABLE
MOVEM AC1,AC16 ;
JRST RSTIF1 ;SHARES THE SAME BUFFER AREA
RSTNFL: MOVE AC12,TEMP. ;INCREASE .JBFF BY
ADDM AC12,.JBFF ;THE BUFFER AREA SIZE
SETZM SHRDX. ;[556] CLEAR ISAM SHARED BUF FLAG
HRRZ AC16,F.RNFT(I16);LOCATE THE NEXT FILE TABLE
JUMPN AC16,RSTIFI ;AND JUMP IF THERE IS ONE.
SKIPE TEMP.1 ;ANY ERRORS ?
JRST KILL ;YES
XCT URELE. ;RELEASE THE CHANNEL
IFN ISAM,<
;GRAB SPACE FOR THE AUX BLOCK
SKIPE MXBUF ;EXIT IF NO INDEXED FILES
SKIPE KEYCV. ;SKIP IF RESET UUO
JRST RSTXIT ;EXIT - ITS A SORT CALL
MOVE AC0,MXBUF ;SIZE OF AUX BLOCK
MOVE AC1,.JBFF ;
HRRZM AC1,AUXBUF ;LOCATION OF AUX BLK
PUSHJ PP,GETSPC ;
JRST GETSPK ;ERROR RETURN
;SPACE FOR DATA-RECORD-TABLE FOR SPLITTING BLOCKS
MOVE AC0,MXBF ;MAX-BLOCKING FACTOR OF ALL IDXFIL'S
ADDI AC0,1 ;TERMINATOR
MOVE AC1,.JBFF ;
HRRZM AC1,DRTAB ;
PUSHJ PP,GETSPC ;
JRST GETSPK ;ERROR RETURN
;SPACE FOR INDEX ENTRY WHEN SPLITTING TOP INDEX BLOCK
MOVE AC0,MXIE ;SIZE OF LARGEST INDEX ENTRY
MOVE AC1,.JBFF ;
HRRZM AC1,IESAVE ;LOC OF SAVE AREA
PUSHJ PP,GETSPC ;
JRST GETSPK
>
RSTXIT: LDB AC2,[POINT 4,UOPEN.,12] ;FREE THE CHANNEL
PUSHJ PP,FRECH2 ; AND POPJ
HRLZI AC0,577774 ;[342]TURN OFF CHAN 1
SKIPN TEMP.2 ;ANY RERUNS?
POPJ PP, ;NO
ANDM AC0,OPNCH. ;YES, DOIT
SETOM RRFLG.## ;REMEMBER
POPJ PP,
;SETUP FOR NONSTD BUFFERS OR DUMP MODE
RSTDE4: LDB AC5,F.BBKF ;BLOCKING FACTOR
JUMPN AC5,RSTD40 ; IF BLK-FTR = 0
TLNE FLG,DDMEBC ; AND DEVICE DATA MODE IS EBCDIC
TXNN AC3,DV.MTA ; AND DEVICE IS A MTA
JRST RSTD40 ;
MOVEI AC5,1 ; THEN BLK-FTR DEFAULTS TO 1
DPB AC5,F.BBKF ;
RSTD40: PUSH PP,AC13 ; SAVE AC13,OPNWPB ASSUMES DEVICE CHAR IN AC13
MOVE AC13,AC3 ; GET DEVICE CHAR
PUSHJ PP,OPNWPB ;AC10= WODRS PER LOGICAL BLOCK
POP PP,AC13 ; RESTORE AC13
JUMPE AC5,RSTDE7 ;JUMP IF BLOCKING FACTOR IS 0
TXNN AC3,DV.MTA ;SKIP IF A MTA
JRST RSTDE6 ;JUMP ITS NOT A MTA
CAIL AC10,MXTPRC ;SKIP IF LOG. BLK NOT TOO LARGE
JRST MXTPER ;JUMP IF TOO LONG
ADDI AC10,3 ; PLUS 3 FOR BOOKEEPING WORDS
HLLZ AC6,D.F1(I16) ;SECOND FLAG REG
TLNN AC6,STNDRD ;SKIP IF STANDARD LABELS
JRST RSTD41 ;MTA W/NONSTD OR OMITTED LABELS
CAIGE AC10,^D16+4 ;SKIP IF RECORD IS GE THE LABEL RECORD
MOVEI AC10,^D16+4 ;ENSURE LABEL REC WILL FIT IN REC AREA
RSTD41: TLNN FLG,DDMEBC ;SKIP IF EBCDIC
JRST RSTDE8 ;ITS NOT
SKIPGE D.F1(I16) ; VARIABLE LENGTH EBCDIC?
ADDI AC10,1 ; YES - ADD IN ONE FOR BLOCK DESCRIPTOR WORD
RSTD42: TLNN AC6,STNDRD ; LABELS STANDARD?
JRST RSTDE8 ;NO - MUST BE OMITTED
CAIGE AC10,^D20+4 ;
MOVEI AC10,^D20+4 ;LABEL RECORD IS THE LARGEST RECORD
RSTDE8: TLNN AC6,NONSTD ;SKIP IF NON-STANDARD LABELS
JRST RSTDE9 ;
HLRZ AC1,F.LNLS(I16) ;NONSTD LABEL SIZE
JUMPGE FLG,RSTD10 ;JUMP IF NOT ASCII
ADDI AC1,2 ;ADD IN "CR-LF" CHARS
IDIVI AC1,5 ;
RSTD10: TLNN FLG,DDMASC ;SKIP IF ASCII
IDIVI AC1,6 ;
SKIPE AC2 ;
ADDI AC1,1 ;CONVERT CHARS TO WORDS
CAIGE AC10,3(AC1) ;
MOVEI AC10,3(AC1) ;ENSURE LABEL REC WILL FIT IN REC AREA
RSTDE9: MOVEI AC1,-3(AC10) ;
HRRM AC1,D.LRS(I16) ;SAVE IT FOR OPNNSB
LDB AC12,F.BNAB ;NUMBER OF ALTERNATES
CAIN I12,77 ; [414] REALLY WANTS ONE?
SETOI I12, ; [414] YES ONE BUFFER.
IMULI AC10,2(I12) ;REC TIMES NUMBER OF ALTERNATE BUFFERS
JRST RSTD11 ;
RSTDE6: TXNN AC3,DV.DSK ;SKIP IF DEV IS A DSK
JRST RSTER0 ;COMPLAIN
TRZE AC10,DSKMSK ;ALLOCATE FULL DISK BLKS
ADDI AC10,DSKBSZ ;ROUND UP TO NEXT DISK BLK
ADDI AC10,12 ;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: OUTSTR [ASCIZ /ONLY DSK MAY BE USED FOR RANDOM, IO OR INDEX-SEQ PROCESSING/]
RSTERR: MOVE AC2,[BYTE (5)10,31,20]
PUSHJ PP,MSOUT.
MXTPER: OUTSTR [ASCIZ /MAG TAPE LOGICAL BLOCK SIZE TOO LARGE/]
MOVE AC2,[BYTE (5) 25,4,10,31,20] ;INDICATE WHICH FILE AND
;WHICH DEVICE HAS TROUBLE
PUSHJ PP,MSOUT. ;THEN QUIT
IFE ISAM,<
RERIT.: OUTSTR [ASCIZ /REWRITE ?/]
SKIPA
DELET.: OUTSTR [ASCIZ /DELETE ?/]
RSTIDX: OUTSTR [ASCIZ /
TO PROCESS ISAM FILES CBLIO MUST BE REASSEMBLED WITH THE CONDITIONAL
ASSEMBLY SWITCH,ISAM, EQUAL TO A NON-ZERO VALUE./]
JRST KILL
>
IFN ISAM,<
;SETUP FOR AN INDEX FILE
RSTIDX: ; IF THERE ARE ANY FILES THAT SHARE THE SAME BUFFER AREA
; THEN ALLOCATE THE SPACE FOR THE "SAVE" AREAS NOW.
; THE "SAVE" AREAS, ONE PER FILE, ARE LOCATED DIRECTLY
; BEFORE THE SHARED BUFFER AREA AND ARE POINTED TO BY D.IBL.
HLRZ AC12,F.LSBA(I16); [377A] GET LINK TO FILE TBL THAT SHARES
JUMPE AC12,RSTI05 ; [377A] [556] JUMP IF NONE
HRRZ AC6,D.IBL(I16) ; [377A] GET ADR OF "SAVE" AREA
JUMPN AC6,RSTI05 ; [377A] [556] JUMP IF ALREADY DONE
SETOM SHRDX. ;[556] SET SHARED ISAM BUF FLAG,INDICATING THAT
;[556] ALL FILES IN THIS SHARE CHAIN WILL HAVE
;[556] THEIR D.BL LOCATIONS SET BELOW AT RSTI04
MOVE AC12,I16 ; [377A] GET FIRST LINK
HLRZ AC4,D.BL(I16) ; [377A] ADR OF SBA (SHARED BUFFER AREA)
RSTI01: MOVEI AC0,ISMCLR+1 ; [377A] GET SIZE OF "SAVE" AREA
PUSHJ PP,GETSPC ; [377A] GET THE CORE SPACE
JRST GETSPK ; [377A] OOPS
HRRM AC4,D.IBL(AC12) ; [377A] SAVE ADR OF "SAVE" AREA
HRLZI AC6,ISMCLR+1 ; [377A] SIZE OF "SAVE" AREA
ADDM AC6,D.BL(I16) ; [377A] MOVE SBA TO OTHER SIDE OF "SAVE" AREA
MOVEI AC6,ISMCLR+1 ; [377A] SIZE OF "SAVE" AREA
ADDM AC6,(PP) ; [377A] UPDATE SAVED .JBFF
RSTI02: HLRZ AC12,F.LSBA(AC12);[377A] GET LINK TO NEXT FILE TBL
CAMN AC12,I16 ; [377A] HAVE WE CIRCLED THE CHAIN?
JRST RSTI03 ; [377A] YES - THEN DONE
LDB AC0,[POINT 2,F.WFLG(AC12),17]; [377A] GET ACCESS MODE
CAIE AC0,2 ; [377A] IS THIS AN ISAM FILE?
JRST RSTI02 ; [377A] NO - TRY NEXT LINK
HRRZ AC4,.JBFF ; [377A] GET ADR OF NEXT FREE LOC
JRST RSTI01 ; [377A] LOOP
;[556] NOW UPDATE BUF LOCATIONS FOR ALL THAT SHARE WITH THIS
;[556] INDEX FILE,SINCE ALLOCATION OF SAVE AREAS HAS MOVED IT
;[556] DOWN AT LEAST ONCE.
; [556] THIS CROCK UPDATES MORE THAN NECESSARY,SINCE THOSE IN
; [556] CHAIN FOLLOWING THE FIRST ISAM FILE WILL BE UPDATED
; [556] AT RSTDE2+2. THIS IS EASIEST WAY TO GET AT ALL
; [556] THAT MAY HAVE COME BEFORE THE FIRST ISAM FILE.
RSTI03: MOVE AC0,D.BL(I16) ;[556] GET NEW BUF LOC FOR ALL THIS SHARE CHAIN
RSTI04: HLRZ AC12,F.LSBA(AC12) ;[556] GET FILTAB OF NEXT FILE THAT SHARES
CAMN AC12,I16 ;[556] ALL WHO SHARE UPDATED?
JRST RSTI05 ;[556] YES,CONT.
HLLM AC0,D.BL(I12) ;[556] NO,UPDATE BUF LOC OF NEXT THAT SHARES
JRST RSTI04 ;[556] CONT. AROUND CHAIN
RSTI05: ;[556]
PUSHJ PP,OPNLIX ;IDXFIL FILENAME
IFE TOPS20,<
XCT ULKUP. ;***************
JRST RSTID1 ;
>
IFN TOPS20,<
PUSH PP,.JBFF ;SAVE IT
MOVEI AC0,ICHAN ;MAKE SURE WE HAVE CORE
PUSHJ PP,GETSPC ;GO SEE
JRST GETSPK ;NO CORE RETURN SO COMPLAIN
POP PP,.JBFF ;RESTORE JOBFF
PUSH PP,AC13 ;SAVE AC13
HLRZ I12,D.BL(I16) ;GET BUFFER LOCATION
LDB AC0,[POINT 4,UFRST.,12] ;[467] USE ALREADY ALLOCD CHAN
MOVEM AC0,ICHAN(I12) ;SAVE IT AWAY
PUSHJ PP,OCPT ;USE TOPS20 COMPT. UUO
JRST [CAIE AC1,600130 ;INVALID SMU ACCESS?
JRST [OUTSTR [ASCIZ /RESET TIME /]
JRST OCPERR ]
HRRZI AC0,OF%THW ;YES - SO TRY A VALID ACCESS
ANDCAM AC0,CP.BK3 ;TURN OFF THAWED (ON FROZEN)
MOVE AC1,[10,,CP.BLK];COUNT,,ADR OF ARG-BLK
COMPT. AC1, ;OPEN FILE IN FROZEN MODE
JRST [OUTSTR [ASCIZ /RESET TIME /]
JRST OCPERR ]
JRST .+1]
POP PP,AC13 ;RESTORE AC13
MOVE AC3,(AC13) ;GET DEVICE NAME
DEVCHR AC3, ;RESTORE DEVICE CHARACTERISTICS
>
MOVEI AC0,ITABL ;
HRR AC1,.JBFF ;
PUSHJ PP,GETSPC ;
JRST GETSPK ;ERROR RETURN
HRLI AC1,-STABL ;
SUBI AC1,1 ;DUMP MODE IOWD
SETZ AC2, ;TERMINATOR
MOVEI AC6,1 ;LOCATION OF
HRRM AC6,UIN. ; IOWD
XCT UIN. ;READ IN STATISTICS BLOCK
SKIPA AC2,1+MXLVL(AC1);[442] GET ORIGINAL # OF IDX LEVELS
JRST RSTIER ;
HLRZ I12,D.BL(I16) ;[442] GET BUFFER LOCATION
MOVNM AC2,OMXLVL(I12) ;[442] SAVE FOR OPNI22
MOVE AC12,1+ISPB(AC1);[442] INDEX SECTORS / BLK
HLRZ AC2,1(AC1) ;GET FILE FORMAT CODE
CAIN AC2,401 ;COMPLAIN IF NOT 401
JRST RSTID7 ;OK
PUSHJ PP,MSVID ;OUTPUT VALUE-OF-ID
OUTSTR [ASCIZ/ IS NOT THE INDEX FOR ISAM/]
PUSHJ PP,MSFIL. ;OUTPUT FILE NAME AND VID
PUSHJ PP,KILL ;KILL NEVER RETURNS
;HERE IF LOOKUP FAILURE
RSTID1: HLLZ AC1,D.F1(I16) ;[377] GET FLG1 PARMS
TLNN AC1,FILOPT ;[374] OPTIONAL FILE?
JRST RSTID8 ;[323] NO, FATAL
HRRZ AC1,ULBLK.+1 ;GET THE ERROR CODE
TRZ AC1,777740 ;WAS IT FILE NOT FOUND?
JUMPN AC1,LUPERR ;EXIT HERE IF OTHER
POP PP,.JBFF ;RESTORE THE STACK
SETOM D.OPT(I16) ;FILE NOT FOUND - REMEMBER THAT
JRST RSTLOO ; AND SHOOT HIM DOWN AT OPEN TIME
RSTID8: PUSHJ PP,MSFIL. ; [323]OUTPUT FILE NAME
OUTSTR [ASCIZ/ NOT FOUND AT RESET TIME/]
PUSHJ PP,KILL ;[323] FATAL ERROR
RSTID7: HLLZS UIN. ;CLEAR IOWD POINTER
IMULI AC12,200 ;WRDS / SECTOR
CAMLE AC12,MXBUF ;LARGER THAN LARGEST?
MOVEM AC12,MXBUF ;YES, SAVE AS NEW LARGEST
MOVE AC6,1+MXLVL(AC1) ;NUMBER OF INDEX LEVELS
ADDI AC6,2 ;PLUS ONE FOR SAT BLK & ONE FOR SPLITING TOP-LEVEL
IMUL AC12,AC6 ;
;FIND THE LARGEST INDEX ENTRY SIZE
MOVE AC2,1+IESIZ(AC1)
CAMLE AC2,MXIE ;
MOVEM AC2,MXIE ;
;FIND THE MAX BLOCKING-FACTOR
MOVE AC2,DBF+1(AC1) ;
LDB AC6,F.BBKF ;[515] BLOCKING FACTOR IN PROGRAM
CAMLE AC2,AC6 ;[535] [515] IF NOT LESS OR EQUAL ERROR
JRST RSTER1 ;[515] TELL USER AND GET OUT
CAMLE AC2,MXBF ;
MOVEM AC2,MXBF ;
MOVE AC4,KEYDES+1(AC1) ;[515] GET ISAM KEY DESCRIPTION
; FOLLOWING TEST UNNESSARY, AND DESTRUCTIVE;
; SAME TEST IN OPEN AT OPNI07+4.
; CAME AC4,F.WIKD(I16) ;[515] COMPARE WITH PROGRAM KEY
; SETZM F.WIKD(I16) ;[535] FLAG ERROR WITH ILLEGAL VALUE
MOVEM AC4,OKEYDS+1(AC1) ;[515] SAVE KEY FOR OPEN CHECKING
MOVE AC4,RECBYT+1(AC1) ;[515] GET SIZE OF DATA BLOCK IN BYTES
MOVEM AC4,ORCBYT+1(AC1) ;[515] SAVE IT FOR CHECKING AT OPEN
MOVE AC4,EPIB+1(AC1) ;[515] GET NUM OF ENTRIES/INDEX BLOCK
MOVEM AC4,OEPIB+1(AC1) ;[515] SAVE IT FOR CHECKING AT OPEN
LDB AC6,KY.TP ; GET KEY TYPE
JUMPN AC6,RSTID2 ;BRANCH IF NON-NUMERIC-DISPLAY
MOVE AC4,1+IESIZ(AC1) ;INDEX ENTRY BLOCK SIZE
SUBI AC4,1 ;-2 HDR WRDS, +1 WRD FOR WRAP-AROUND
IMULI AC4,3 ;RESERVE 3 KEY AREAS
JRST RSTID3 ;
RSTER1: OUTSTR [ASCIZ/ RESET BLOCKING FACTOR FOR/] ;[515]
PUSHJ PP,MSFIL. ;[515] OUTPUT FILE NAME
OUTSTR [ASCIZ/ DIFFERS FROM USER'S PROGRAM /] ;[515]
PUSHJ PP,KILL ;[515] FATAL ERROR
RSTER2: PUSH PP,AC1 ;[515] SAVE IT FOR LATER
PUSH PP,AC4 ;[515] SAVE IT FOR LATER
OUTSTR [ASCIZ/ RESET KEY DESCRIPTOR FOR/] ;[515]
PUSHJ PP,MSFIL. ;[515] GIVE HIM FILE NAME
OUTSTR [ASCIZ/ DIFFERS FROM PROGRAM KEY DESCRIPTOR
/]
POP PP,AC4 ;[515] GET AC4 BACK
POP PP,AC1 ;[515] GET AC1 BACK
POPJ PP, ;[515] PROCEED AT YOUR OWN RISK
RSTID2: 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
DEVCHR AC2, ;DEVCHR
TXNE AC2,DV.DSK ;DATA FILE
TXNN AC3,DV.DSK ;IDX FILE
JRST RSTER0 ;MUST BE A DSK
LDB AC5,KY.MD ; GET DATA MODE FROM STS-BLOCK
XCT RSTID4(AC5) ; SAME AS FILE TABLE DATA MODE?
JRST RSTID5 ; YES
OUTSTR [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. ;
;NOW SAVE INITIAL CONDITIONS FOR OPEN LOGIC
HRRZ AC4,D.IBL(I16) ; [377A] GET ADR OF "SAVE" AREA
HRLI AC4,ISCLR1+1(AC1); [377A] ADR OF AREA TO BE SAVED
MOVEI AC2,ISMCLR(AC4) ; [377A] END OF AREA TO BE SAVED
TRNE AC4,-1 ; [377A] SKIP IF NOTHING TO SAVE
BLT AC4,(AC2) ; [377A] DOIT
JRST RSTDE5 ;RETURN
RSTIER: XCT UGETS. ;INPUT ERROR DURING RESET UUO
TXNE AC2,IO.EOF ;[376] EOF?
OUTSTR [ASCIZ/ UNEXPECTED EOF ON ISAM INDEX FILE/] ;[376]
PUSHJ PP,IOERM1 ;
MOVE AC2,[BYTE (5)35,4,10,31,20,2]
JRST KILL ;&KILL
>
;GET CORE SPECIFIED BY (AC0)
GETSPC: PUSH PP,.JBFF ;INCASE THE CORE UUO FAILS
ADDB AC0,.JBFF ;ASSUME WE'LL GET IT
CAMG AC0,.JBREL ;IS THERE ENOUGH IN FREE CORE
JRST GETSP1 ;YEP
CORE AC0, ;NO, GET SOME MORE CORE
JRST GETSP2 ;ERROR RETURN
GETSP1: POP PP,(PP) ;.JBFF IS GOOD
JRST RET.2 ;NORMAL EXIT
GETSP2: POP PP,.JBFF ;RESTORE .JBFF, CORE UUO FAILED
POPJ PP,
GETSP9: OUTSTR [ASCIZ/INSUFICIENT CORE FOR BUFFER REQUIREMENTS/]
POPJ PP,
GETSPK: PUSHJ PP,GETSP9
JRST KILL
IFE TOPS20,<
;SEE IF MONITOR HAS AUTO LABELING FACILITY.
;SET SUTOLB TO NON-ZERO IF IT DOES.
SETALB: SETZM AUTOLB ; INIT TO NO AUTO FACILITY
MOVE AC1,[%SITLP]
GETTAB AC1,
SETZ AC1, ; ERROR SO OLD STYLE PROCESSING
SKIPE AC1 ; WHAT IS IT?
SETOM AUTOLB ; AUTO FACILITY!
POPJ PP,
>
;SUBROUTINE TO SET UP OVERLAY FILE
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
SETO AC0, ;DSK = -1
SKIPN AC3,RN.DEV ;[333]IF DEVICE SPECIFIED, GET IT
HRLZI AC3,'DSK'
SETOV1: MOVEI AC2,IO.SYN+.IOBIN ;SET UP DEVICE
HRRZI AC4,OVRBF. ;
OPEN 1,AC2 ;[342]INIT
JRST SETOV4 ;
MOVSI AC2,'OVR'
SETZB AC3,AC4 ;
SKIPE AC0 ;[333]IF NOT TRYING SYS
MOVE AC4,RN.PPN ;[333]GET OVERLAY PPN
LOOKUP 1,AC1 ;[342]
JRST SETOV5 ;LOOKUP FAILED
INBUF 1,2 ;GET 2 BUFFERS
MOVE AC1,.JBFF ;GET NEXT FREE WORD
MOVEM AC1,OVRIX. ;WHERE INDEX BLOCK WILL BE
MOVEI AC0,400 ;SIZE WE NEED
PUSHJ PP,GETSPC ;GET IT
JRST GETSPK ;FAILED
MOVE AC1,OVRIX. ;
PUSHJ PP,SETOV2 ;
MOVE AC1,OVRIX.
ADDI AC1,200
SETOV2: IN 1, ;[342]
SKIPA AC2,OVRBF. ;
JRST SETOV6 ;
MOVSI AC2,2(AC2) ;
HRR AC2,AC1 ;
BLT AC2,177(AC1) ;
POPJ PP,
SETOV4: OUTSTR [ASCIZ "CANNOT INITIALIZE OVERLAY"] ;[536]
JRST SETOV7 ;[536]
SETOV5: HRLZI AC3,'SYS' ;[536]TRY SYS IF DSK FAILS
AOJE SETOV1
OUTSTR [ASCIZ "CANNOT FIND OVERLAY FILE "]
SKIPN AC3,RN.DEV ;[536]
MOVSI AC3,'DSK' ;[536]
PUSHJ PP,MSDEV1 ;[536] PRINT DEVICE PART
PUSHJ PP,COLON ;[536] PRINT ":"
MOVE AC3,OVRFN. ;[536] FILE NAME
PUSHJ PP,MSDEV1 ;[536] PRINT IT
OUTSTR [ASCIZ /.OVR/] ;[536] EXT
SKIPE AC3,RN.PPN ;[536] ANY PPN?
PUSHJ PP,MSDIR. ;[536] YES, PRINT IT
JRST KILL
SETOV6: OUTSTR [ASCIZ "INPUT ERROR ON OVERLAY"]
SETOV7: SKIPN AC3,RN.DEV ;[536]
MOVSI AC3,'DSK' ;[536]
MOVEI AC1,AC3 ;[536] POINT TO WHERE IT IS
PUSHJ PP,MSDEVA ;[536] PRINT DEVICE PART
JRST KILL
;ROUTINE TO REORGANIZE THE FLAGS
RSTFLG: MOVE FLG,F.WFLG(I16) ;GET FLAGS
MOVX AC15,BR%IO!BR%RER!BR%RRC
AND AC15,FLG ;RRUNER & RRUNRC
LDB AC1,[POINT 3,FLG,9]
HLLZ AC2,FLGTAB(AC1) ;DEVICE DATA MODE
TLZ AC2,037777 ;
IOR AC15,AC2 ;
MOVEI AC0,SASCII ; GET STANDARD ASCII FLAG
CAIN AC1,4 ; AND SET IT IF REQUESTED
IORM AC0,D.RFLG(I16) ; DOIT
LDB AC1,[POINT 2,FLG,15]
HLLZ AC2,FLGTAB(AC1) ;CORE DATA MODE
TLZ AC2,777707 ;
IOR AC15,AC2 ;
LDB AC1,[POINT 2,FLG,17]
HLLZ AC2,FLGTAB(AC1) ;ACCESS MODE
TLZ AC2,777770 ;
IOR AC15,AC2 ;
TXNE FLG,BR%OPF ;FILOPT?
TRO AC15,FILOPT ;
TXNE FLG,BR%NSL ;NONSTD?
TRO AC15,NONSTD ;
TXNE FLG,BR%STL ;STNDRD?
TRO AC15,STNDRD ;
TLNN AC15,DDMEBC ;ONLY EBCDIC HAS VAR-LEN RECORDS
JRST RSTFL1 ;
TXNE FLG,BR%VLE ;VARIABLE LENGTH EBCDIC RECORDS?
TRO AC15,VLREBC ;
RSTFL1: HLLM AC15,F.WFLG(I16);SAVE IT
HRLM AC15,D.F1(I16) ;FLG1
TLNE FLG,RRUNER!RRUNRC ;RERUNING?
SETOM TEMP.2 ;YES, REMEMBER TO TURN OFF CHAN 17
POPJ PP, ;
;BITS 0-3 DEVICE DATA MODE
; 12-14 CORE DATA MODE
; 15-17 ACCESS MODE
FLGTAB: 200022,,0
040001,,0
400044,,0
100010,,0
400000,,0 ; STANDARD ASCII
Z
Z
Z
;TRAP INTERUPT ROUTINE
TRAP.: MOVE AC0,.JBCNI ;APR STATUS
TXNE AC0,AP.ILM
OUTSTR [ASCIZ/MEMORY PROTECTION VIOLATION AT USER LOC /]
TXNE AC0,AP.NXM
OUTSTR [ASCIZ/NON-EX-MEM REQUEST AT USER LOC /]
TXNE AC0,AP.POV
JRST TRAP1 ;PDLOV
TRAP0: PUSHJ PP,OUTBF1 ;REINIT THE TTY BUFFER
HRLO AC12,.JBTPC ;THE GUILTY LOCATION
PUSHJ PP,PPOUT4 ;OUTPUT THE LOC
HRRZ AC0,.JBTPC ;[312];SEE IF ERROR IS
CAIL AC0,RSTLNK ;[312]; IN RSTLNK
CAIL AC0,RSTLNX ;[312]; ROUTINE.
JRST KILL ;[312];NO
OUTSTR [ASCIZ /$FAILING ROUTINE IS RSTLNK IN CBLIO
MACRO ROUTINE LOADED IN PLACE OF COBOL SUBROUTINE?/]
JRST KILL ;AND KILL
TRAP1: OUTSTR [ASCIZ/PUSH-DOWN-LIST OVERFLOW AT /]
JRST TRAP0
;GOTO IS THE ERROR EXIT FOR UNALTERED "GOTO"
;STATEMENTS WHICH DID NOT PROVIDE AN OBJECT PARAGRAPH NAME.
GOTO.: OUTSTR [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.:
IFN LSTATS, SETOM MRKILL ;NOTE PROGRAM WAS ABORTED
PUSHJ PP,VEROUT ;TYPE THE VERSION NUMBER
OUTSTR [ASCIZ /
?/]
SKIPE TRAC1. ;[270] IS THIS A PRODUCTION PROGRAM (I.E. /P)?
PUSHJ PP,@TRAC1. ;NO, CALL BTRAC. IN TRACE ROUTINE
PUSHJ PP,PPOUT. ;TYPE THE LOCATION OF LAST COBOL VERB
HRRZ AC16,FILES. ;[444] GET START OF FILE TABLES
JUMPE AC16,STOPR2 ;[444] NO FILES, DON'T BOTHER
KILL1: MOVE FLG,F.WFLG(I16) ;[444] GET FLAGS FOR THIS FILE
TLNN FLG,OPNIN!OPNIO ;[444] OPEN FOR INPUT
TLNN FLG,OPNOUT ;[444] NO, OPEN FOR OUTPUT
JRST KILL4 ;[444] NO, CHECK NEXT ONE
MOVE AC13,D.DC(I16) ;[444] GET DEV CHARACTERISTICS
TXNN AC13,DV.DSK ;[444] DISK?
JRST KILL4 ;[444] NO, TRY NEXT FILE
SETZB AC2,AC3 ;[444]
MOVE AC10,[POINT 6,2] ;[444] SET UP TO PUT VID IN 2 AND 3
MOVE AC5,F.WVID(I16) ;[444] GET PTR TO VALUE OF ID
PUSHJ PP,OPNVID ;[444] GET IT INTO AC2 AN AC3
HRRZ AC1,FILES. ;[444] SET UP FOR SUB-LOOP
KILL2: CAIN AC16,(AC1) ;[444] COMPARING AGAINST ITSELF
JRST KILL3 ;[444] YES, DON'T BOTHER
MOVE AC13,D.DC(AC1) ;[444] GET DEV CHARS
TXNN AC13,DV.DSK ;[444] IS IT A DISK?
JRST KILL3 ;[444] NO, IGNORE
MOVE FLG,F.WFLG(AC1) ;[444] GET FLAGS
TLNN FLG,OPNIN ;[444] IS IT OPEN FOR INPUT
JRST KILL3 ;[444] NO, CAN'T BE SUPERSEDING
SETZB AC14,AC15 ;[444]
MOVE AC10,[POINT 6,14] ;[444] PUT VID IN 14 AND 15
MOVE AC5,F.WVID(AC1) ;[444] BYTE PTR TO VALUE OF ID
PUSHJ PP,OPNVID ;[444] GET IT
CAMN AC2,AC14 ;[444] FILENAMES EQUAL?
CAME AC3,AC15 ;[444] YES, EXTENSIONS EQUAL?
JRST KILL3 ;[444] NO, FORGET IT
LDB AC4,DTCN. ;[444] GET CHANNEL NUMBER
LSH AC4,27 ;[444] POSITION IT
MOVE AC5,[CLOSE CL.RST] ;[444] SET UP A CLOSE
ADD AC5,AC4 ;[444] ADD CHANNEL
XCT AC5 ;[444] CLOSE FILE, DELETING NEW
;[444] FILE, LEAVING OLD INPUT
JRST KILL4 ;[444] GO CHECK ANOTHER ONE
KILL3: HRRZ AC1,F.RNFT(AC1) ;[444] GET ANOTHER FILE FOR SUB-LOOP
JUMPN AC1,KILL2 ;[444] GO CHECK, IF ANY LEFT
KILL4: HRRZ AC16,F.RNFT(AC16) ;[444] GET ANOTHER FILE TO CHECK
JUMPN AC16,KILL1 ;[444] GO CHECK IF ANY LEFT
JRST STOPR2
;TYPE OUT SOME ERROR INFORMATION
TYPSTS: OUTSTR [ASCIZ /
$ ERROR-NUMBER = /]
TYPST1: MOVE AC0,FS.EN ;ERROR-NUMBER
PUSHJ PP,PUTDEC ;TYPE IT
MOVE AC0,FS.BN ;BLOCK-NUMBER
JUMPE AC0,TYPST2 ;
OUTSTR [ASCIZ / BLOCK-NUMBER = /]
PUSHJ PP,PUTDEC ;
TYPST2: MOVE AC0,FS.RN ;RECORD-NUMBER
JUMPE AC0,RET.1 ;
OUTSTR [ASCIZ / RECORD-NUMBER = /]
JRST PUTDEC ;RETURN
;STOPR. IS CALLED WITH A "PUSHJ PP,STOPR." ALL FILES ARE
;CLOSED VIA COBOL CLOSE UUOS AND A CALLI EXIT IS EXECUTED.
STOPR.: HRRZ AC16,FILES. ;LOOP THROUGH THE FILE TABLES
JUMPE AC16,STOPR2 ;DONE
STOPR1: HRLI AC16,001040 ;STANDARD CLOSE UUO
MOVE FLG,F.WFLG(I16) ;GET THE FLAGS
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
OUTSTR [ASCIZ /% /] ;
PUSHJ PP,PUTDEC ; TYPE NUMBER
OUTSTR [ASCIZ/ ERRORS IGNORED/]
STOPR3: PUSHJ PP,@HPRT.## ; PRINT HISTORY REPORT IF ANY
IFN CSTATS,<
SKIPE METR.## ;WERE METER POINTS ENABLED?
PUSHJ PP,WRTMET ;YES, WRITE THE FILE
>
IFN LSTATS,<
PUSHJ PP,MRDMPT ;DUMP ALL LSTATS DATA
>
IFN DBMS,<
SKIPE DBSTP. ;IGNORE IF BEFORE VERSION 12A
PUSHJ PP,@DBSTP. ;CLEANUP DBMS
>
EXIT ;CALLI EXIT
;TYPE THE VERSION NUMBER "LIBOL N(M)"
VEROUT: MOVE AC12,LIBVR. ;GET VERSION NUMBER
LSH AC12,3 ;GET RID OF WHO FIELD
IFN ANS68,<
OUTSTR [ASCIZ /
LIBOL /]
>
IFN ANS74,<
OUTSTR [ASCIZ /
C74OTS /]
>
MOVEI AC0,3 ;
PUSHJ PP,NUMOUT ;THE VERSION NUMBER
LDB AC1,[POINT 6,LIBVR.,17] ;GET MINOR VERSION
JUMPE AC1,VEROU0 ;DON'T OUTPUT IF NULL
SUBI AC1,1 ;^D26="Z", ^D27="AA"
IDIVI AC1,^D26 ;GET TWO LETTERS
JUMPE AC1,.+5 ; DON'T OUTPUT FIRST IF NULL
PUSH PP,AC2 ;SAVE 2ND
MOVEI C,100(AC1) ;GET 1ST LETTER
PUSHJ PP,OUTCH. ;OUTPUT IT
POP PP,AC2
MOVEI C,101(AC2) ;GET 2ND LETTER
PUSHJ PP,OUTCH. ;OUTPUT IT
VEROU0: MOVEI AC0,6 ;
HRLZ AC12,LIBVR. ;
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: LDB AC1,[POINT 3,LIBVR.,2] ;GET WHO FIELD
JUMPE AC1,VEROU2 ;DON'T OUTPUT IF NULL
MOVEI C,"-" ;SEPARATE BY HYPHEN
PUSHJ PP,OUTCH.
MOVEI C,"0"(AC1) ;TURN INTO ASCII
PUSHJ PP,OUTCH.
VEROU2: 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: OUTSTR [ASCIZ /
$ TYPE CONTINUE TO PROCEED .../]
EXIT 1, ; 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.: OUTSTR [ASCIZ /LAST COBOL VERB CALLED FROM /]
HLRO AC12,PP ; FIND THE BEG OF THE STACK
ADD AC12,PUSHL. ; --
SUBI AC12,(PP) ; --
MOVNS AC12 ; --
SKIPE AC11,SBPSA. ; THIS A SUBPROGRAM OR OVERLAY?
HLRZ AC12,AC11 ; YES - GET FIRST ENTRY FROM HERE
ADDI 12,1 ; 12 HAS POINTER TO FIRST ENTRY ON STACK
MOVEI AC1,0 ; ASSUME NO COBDDT
SKIPE CB.DDT ; ANY COBDDT?
MOVEI AC1,2 ; YES - THERE ARE 2 ENTRIES ON LIST
MOVE AC2,LIBSW. ; GET MULTIPLE PERFORM FLAG
TRNE AC2,MPWC.S ; MULTIPLE-PERFORMS?
ADDI AC1,1 ; YES - ANOTHER ENTRY ON PDLIST
IMUL AC1,LEVEL. ; ENTRIES PER LEVEL.
ADD AC12,AC1 ; SKIP OVER COBDDT+PERF. STUFF
HRRZ AC12,(AC12) ; GET RETURN ADR MINUS ONE
MOVEI AC2,5 ; LOOK BACK 5 LOCS FOR A PUSHJ
MOVEI AC1,-1(AC12) ; START AT THE RETURN ADR-1
PPOUT1: HLRZ AC3,(AC1) ; GET THE PUSHJ TO THE RIGHT HALF
SUBI AC1,1 ; SET UP FOR NEXT COMPARE
CAIE AC3,(PUSHJ PP,) ; WHAT IS IT?
SOJG AC2,PPOUT1 ; NOT A PUSHJ SO LOOP
JUMPE AC2,PPOUT2 ; NOT THERE SO GIVE RET ADR-1
HRRI AC12,1(AC1) ; THE PUSHJ'S ADR
PPOUT2: SKIPN AC11,SBPSA. ; IF SUBPROGRAM
MOVE AC11,%F.PTR ; NO - MAIN PROGRAM
HLRZ AC11,-2(AC11) ; GET START ADR
TRZ AC11,400000 ; TURN OFF BIT18 IF ON
SUB AC12,AC11 ; GET OFFSET FROM HERE
HRLOI AC12,(AC12) ; XWD ADR,,-1
PPOUT4: MOVEI C,6 ; HALF OF AN ASCII ZERO-60
LSHC C,3 ; APPEND THE OCTAL NUMBER
PUSHJ PP,OUTCH. ; DEPOSIT IT IN THE TTY BUFFER
TRNE AC12,-1 ; HAVE WE SEEN SIX NUMBERS?
JRST PPOUT4 ; NO, LOOP
PUSHJ PP,OUTBF. ; DUMP IT NOW
PPOT4.: OUTSTR [ASCIZ/ IN PROGRAM /]
SKIPN AC3,SBPSA. ; SKIP IF ANY SUBPRGMS
JRST PPOUT6 ; NONE
PPOUT5: OUTSTR [ASCIZ /
/]
HRRI AC1,(AC3) ; GET ADR OF SUBPRG NAME
HRL AC1,-2(AC1) ;
TLNE AC1,-1 ;
HLRZS AC1 ; IF IT'S ZERO
SUBI AC1,1 ; ITS SAME AS ENTRY POINT
HRLI AC1,(POINT 6) ; MAKE A BYTE-PTR
MOVEI AC4,6 ; ONLY 6 CHARS PER NAME
PUSHJ PP,MSVID4 ; TYPE IT
OUTSTR [ASCIZ / ENTRY /]
HRRI AC1,-1(AC3) ; MAKE BYTE-PTR TO ENTRY POINT
HRLI AC1,(POINT 6) ; FINISH BYTE-POINTER
MOVEI AC4,6 ; 6 IS MAX
PUSHJ PP,MSVID4 ; TYPE IT
OUTSTR [ASCIZ / CALLED FROM/]
MOVS AC3,AC3 ; ANY MORE SUBPRGMS?
SKIPE AC3,(AC3) ; SKIP IF NOT
JRST PPOUT5 ; THERE ARE
PPOUT6: MOVE AC1,%F.PTR ; GET THE PROGRAM NAME
MOVEI AC1,-1(AC1) ; THIS IS IT
HRLI AC1,(POINT 6) ; MAKE BYTE POINTER
MOVEI AC4,6 ; NAME HAS 6 CHARS
PUSHJ PP,MSVID4 ; DUMP THE NAME
JRST DSPL1. ; APPEND "CRLF", THEN EXIT
; SUSPC: A SUBROUTINE THAT DETERMINES THE AMOUNT OF SPACE REQUIRED
; FOR SIMULTANEOUS UPDATE, AND GETS IT. IT ALSO INITIALIZES THE
; GLOBAL VARIABLES SU.RRT, SU.EQT, SU.DQT, SU.MQT,
; AND SU.FBT TO POINT TO THE RETAINED RECORDS TABLE, THE ENQUEUE
; TABLE, THE DEQUEUE TABLE, THE MODIFY TABLE, AND THE FILL/FLUSH
; BUFFER TABLE.
;
; ARGUMENTS:
;
; AC14 CONTAINS THE ADDRESS OF A WORD CONTAINING THE
; STARTING ADDRESS OF THE MAIN PROGRAM.
;
; CHANGES:
;
; AC0
; AC1
; AC2
; AC3
; WHATEVER GETSPC CHANGES
;
; CALLS:
;
; SUSPC1
; GETSPC
;
; ERRORS:
;
; NOT ENOUGH SPACE AVAILABLE FOR SIMULTANEOUS UPDATE
; REQUIREMENTS. IF THIS OCCURS, A MESSAGE IS SENT
; TO TTY AND A JRST KILL. IS EXECUTED.
EXTERN SU.RRT, SU.EQT, SU.FBT, SU.DQT, SU.MQT
SUSPC: HRRZ AC1,0(AC14) ;GET STARTING ADDRESS OF MAIN PROGRAM
SETZM SU.RRT ;INITIALIZE GLOBAL VARIABLES
SETZM SU.EQT
SETZM SU.FBT
PUSHJ PP,SUSPC1 ;EXAMINE THE MAIN PROGRAM AND ALL ITS
;SUBPROGRAMS TO DETERMINE THE MAXIMUM
;REQUIREMENTS FOR SIMULTANEOUS UPDATE
;SPACE
MOVE AC0,SU.EQT ;[437]
IMULI AC0,4 ;[437]
ADD AC0,SU.RRT ;[437] (THERE ARE FOUR ENQ/DEQ TABLES)
ADD AC0,SU.FBT
JUMPE AC0,RET.1 ;RETURN IF NO SPACE REQUIRED
PUSH PP,.JBFF ;SAVE .JBFF ON THE STACK
PUSHJ PP,GETSPC ;GET THE SPACE, IF POSSIBLE
JRST SUERR ;JUMP IF NOT POSSIBLE
POP PP,AC1
MOVE AC2,AC1
ADD AC2,SU.RRT
MOVEM AC1,SU.RRT ;PUT RETAINED RECORDS TABLE AT ADDRESS
;OF FORMER .JBFF
MOVE AC1,AC2 ;PUT ENQ/DEQ TABLES AT END OF THE
;RETAINED RECORDS TABLE
ADD AC2,SU.EQT
MOVEM AC2,SU.DQT
ADD AC2,SU.EQT
MOVEM AC2,SU.MQT
ADD AC2,SU.EQT
MOVEM AC1,SU.EQT
MOVEM AC2,SU.FBT ;PUT THE FILL/FLUSH BUFFER TABLE AT THE
;END OF THE ENQ/DEQ TABLES
POPJ PP, ;WE'RE ALL DONE
SUERR: OUTSTR [ASCIZ"NOT ENOUGH SPACE AVAILABLE TO MEET THE REQUIREMENTS OF SIMULTANEOUS UPDATE. PLEASE RELINK TO PROVIDE MORE SPACE."]
JRST KILL.
; SUSPC1: A SUBOUTINE TO DETERMINE THE MAXIMUM REQUIREMENT FOR SIMULTANEOUS
; UPDATE SPACE OF A PROGRAM AND ITS SUBPROGRAMS
;
; ARGUMENTS:
;
; AC1: THE STARTING ADDRESS OF THE PROGRAM
;
; IN THE %FILES AREA OF THE PROGRAMS THERE ARE THESE QUANTITIES:
;
; %SURRT: THE SPACE REQUIRED BY THE PROGRAM FOR
; THE RETAINED RECORDS TABLE
;
; %SUEQT: THE SPACE REQUIRED BY THE PROGRAM FOR
; EACH OF THE ENQ/DEQ TABLES
;
; %SUFBT: THE SPACE REQUIRED BY THE PROGRAM FOR
; THE FILL/FLUSH BUFFER TABLE
;
; RESULTS:
;
; SU.RRT IS SET TO THE MAX OF SU.RRT AND %SURRT IN THE
; PROGRAM AND EACH OF ITS SUBPROGRAMS
;
; SU.EQT IS SET TO THE MAX OF SU.EQT AND %SUEQT IN THE
; PROGRAM AND EACH OF ITS SUBPROGRAMS
;
; SU.FBT IS SET TO THE MAX OF SU.FBT AND %SUFBT IN THE
; PROGRAM AND EACH OF ITS SUBPROGRAMS
;
; CHANGES:
;
; AC1
; AC2
; AC3
;
; ASSUMPTIONS:
;
; SU.RRT, SU.EQT, SU.FBT ARE INITIALIZED BEFORE THIS
; ROUTINE IS CALLED THE FIRST TIME
;
; NOTES:
;
; THE ROUTINE CALLS ITSELF RECURSIVELY.
SUSPC1: HRRZ AC2,(AC1) ;CHECK TO SEE IF THIS SUBROUTINE IS IN
JUMPN AC2,RET.1 ; A LINK-10 OVERLAY AREA.
; ((AC1)) = SKIPA 0,0 <==> IT ISN'T
; ((AC1)) = JSP 1,MUMBLE <==> IT IS.
HRRZ AC2,1(AC1) ;ADDRESS OF %FILES TO AC2
HLRZ AC3,(AC2) ;HAVE WE BEEN HERE BEFORE?
JUMPE AC3,RET.1 ;YES, LEAVE.
MOVE AC3,%SURRT(AC2) ;SET SU.RRT TO MAX OF SU.RRT AND %SURRT
CAMLE AC3,SU.RRT
MOVEM AC3,SU.RRT
MOVE AC3,%SUEQT(AC2) ;SET SU.EQT TO MAX OF SU.EQT AND %SUEQT
CAMLE AC3,SU.EQT
MOVEM AC3,SU.EQT
MOVE AC3,%SUFBT(AC2) ;SET SU.FBT TO MAX OF SU.FBT AND %SUFBT
CAMLE AC3,SU.FBT
MOVEM AC3,SU.FBT
HRRZS (AC2) ;MARK THIS SUBPROGRAM AS DONE.
HLRZ AC2,1(AC1) ;GET ADDRESS OF SUBPROGRAM LIST
SUSPCX: SKIPN AC1,0(AC2)
POPJ PP, ;RETURN IF NO MORE SUBPROGRAMS
PUSH PP,AC2 ;SAVE AC2 ON STACK
PUSHJ PP,SUSPC1 ;CALL OURSELVES TO PROCESS SUBPROGRAM
POP PP,AC2 ;RESTORE AC2
AOJA AC2,SUSPCX ;POINT TO NEXT SUBPROGRAM
SUBTTL SEEK VERB
;A SEEK VERB LOOKS LIKE:
;FLAGS,,ADR ADR = FILE TABLE ADDRESS
;CALL+1: ;POPJ RETURN
SEEK.: MOVE FLG,F.WFLG(I16) ;FLAG REGISTER
TLNE FLG,RANFIL ;SKIP IF NOT A RANDOM FILE
TLNN FLG,OPNIN!OPNOUT ;SKIP IF RANDOM FILE IS OPEN
POPJ PP, ;EXIT TO ***ACP***
HLRZ I12,D.BL(I16) ;SET UP FOR FLIMIT
PUSHJ PP,FLIMIT ;CHECK THE FILE LIMITS
;INVALID KEY RETURNS TO ***ACP***
MOVE AC1,AC4 ;ACTUAL KEY
PUSHJ PP,SETCN. ;SET UP CHANNEL NUMBER
XCT USETI. ;
XCT USEEK. ;SEEK UUO
POPJ PP, ;EXIT TO ***ACP***
;FORCE A CALL TO RRDMP
RENDP: SETOM REDMP. ;
JRSTF @.JBOPC ;CONTINUE
;RESTORE .JBSA, .JBREN - DESTROYED BY RERUN'S GETSEG
RSAREN: HRR AC2,RESET1
HRRM AC2,.JBSA
MOVEI AC2,RENDP
MOVEM AC2,.JBREN
POPJ PP,
SUBTTL DISPLAY VERB
;CALLING SEQUENCE IS PUSHJ PP,DSPLY. WITH THE CALLING ARG-LIST IN AC 16.
;THE AC16'S EFFECTIVE ADDRESS CONTAINS A MODIFIED BYTE POINTER TO THE
;ASCII CHARACTER STRING. MODIFICATIONS FOLLOW:
; IF BIT 6 IS SET LEADING SPACES AND HOR-TABS ARE SUPPRESSED.
; IF BIT 7 IS SET A "CRLF" IS APPENDED TO THE CHARACTER STRING.
; BITS 8-17 CONTAIN THE NUMBER OF CHARACTERS TO BE DISPLAYED.
;THE ONLY ERROR EXIT IS A CALL TO C.STOP CAUSED BY "TELETYPE OUTPUT
;ERROR". A NORMAL RETURN IS A POPJ PP,.
;MODIFIED ACS ARE: 15,11,7,6,AND 1.
;AC16= ;THE CALLING ARG-LIST
;AC15= ;BYTE POINTER
;AC6= ;CHARACTER COUNT
;AC1= ;TOPS-20 ONLY (LSTATS ALSO)
;AC2= ;LSTATS ARG REGISTER
;AC4= ;BLANK COUNTER (TO SUPPRESS TRAILING BLANKS)
;AC12 ;MUST NOT BE USED
DOPFS.: POINT 10,(I16),17 ;DISPLAY OPERAND FIELD SIZE
DSPLY.:
IFN LSTATS,<
MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT
PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2)
>
SKIPE TTYOPN ;IS THERE A TTY FILE OPEN?
PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING
MOVE AC15,(I16) ;GET DISPLAY OPERAND
MOVE FLG,AC15 ;SAVE IT FOR THE FLAGS
LDB AC6,DOPFS. ;NUMBER OF CHARS. TO BE DISPLAYED
TLZ AC15,7777 ;
TLO AC15,700 ;(AC15) IS BYTE POINTER TO CHARS.
SETZ AC4, ;CLEAR BLANK COUNTER
TXNN FLG,DIS%NM ;NUMERIC?, SUPPRESS LEADING SPACES AND TABS
JRST DSPL4 ;NO
DSPL2: ILDB C,AC15 ;GET A CHARACTER.
JUMPE C,DSPL3 ;DON'T PASS NULLS BUT COUNT THEM
CAIE C," " ;SPACE
CAIN C," " ;OR TAB?
JRST DSPL3 ;YES
JRST DSPL5 ;NO, FIRST OUTPUT CHAR FOUND
DSPL3: SOJG AC6,DSPL2 ;LOOP
JRST DSPL7 ;END OF INPUT
DSPL4: ILDB C,AC15 ;GET A CHARACTER
JUMPE C,DSPL6 ;COUNT NULLS BUT DON'T OUTPUT THEM
CAIN C," " ;BLANK?
AOJA AC4,DSPL6 ; YES, DON'T OUTPUT IF TRAILING BLANK
JUMPE AC4,DSPL5 ;JUMP IF NO ACCUMULATED BLANKS
PUSH PP,C ; SAVE THIS NON-BLANK
MOVEI C," " ;THE BLANKS WE SAW WERE NOT TRAILING BLANKS
PUSHJ PP,OUTCH. ; SO OUTPUT THEM
SOJG AC4,.-1
POP PP,C ;RESTORE THE CHARACTER AFTER THE BLANKS
DSPL5: IDPB C,TTOBP. ;DEPOSIT CHARACTER IN BUFFER
SOSG TTOBC. ;BUFFER FULL?
PUSHJ PP,OUTBF. ;YES
DSPL6: SOJG AC6,DSPL4 ;LOOP
DSPL7: TXNN FLG,DIS%LF ;LAST FIELD?, APPEND CR-LF AT END?
JRST DSPL8 ;[533] NO, JUST OUTPUT WHAT WE HAVE
DSPL1.: MOVEI C,15 ;APPEND CR-LF
PUSHJ PP,OUTCH. ; .
MOVEI C,12 ; .
PUSHJ PP,OUTCH. ; .
PUSHJ PP,OUTBF. ;DUMP BUFFER
IFN LSTATS,<
MRTME. (AC1) ;END METER TIMING
>
POPJ PP, ; AND EXIT.
DSPL8: JUMPE AC4,DSPL8A ;[533] IF NO MORE TRAILING SPACES, EXIT
MOVEI C," " ;[533] GET ONE
PUSHJ PP,OUTCH. ;[533] AND OUTPUT IT
SOJG AC4,.-1 ;[533] LOOP BACK FOR ALL SPACES
DSPL8A: PUSHJ PP,OUTBF. ; OUTPUT BUFFER AND EXIT
IFN LSTATS,<
MRTME. (AC1) ;END METER TIMING
>
POPJ PP,
;HERE FOR DISPLAY OF SIXBIT DATA
DSPL.6:
IFN LSTATS,<
MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT
PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2)
>
SKIPE TTYOPN ;IS THERE A TTY FILE OPEN?
PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING
MOVE AC15,(I16) ;GET DISPLAY OPERAND
MOVE FLG,AC15 ;SAVE IT FOR THE FLAGS
LDB AC6,DOPFS. ;NUMBER OF CHARS. TO BE DISPLAYED
TLZ AC15,7777 ;
TLO AC15,600 ;(AC15) IS BYTE POINTER TO CHARS.
SETZ AC4, ;CLEAR BLANK COUNTER
TXNN FLG,DIS%NM ;NUMERIC?, SUPPRESS LEADING SPACES AND TABS
JRST DSPL64 ;NO
DSPL62: ILDB C,AC15 ;GET A CHARACTER.
JUMPN C,DSPL65 ;OUTPUT FIRST NON-SPACE
SOJG AC6,DSPL62 ;LOOP
JRST DSPL7 ;END OF INPUT
DSPL64: ILDB C,AC15 ;GET A CHARACTER
DSPL65: ADDI C," " ;CONVERT TO ASCII
CAIN C," " ;A BLANK?
AOJA AC4,DSPL67 ; YES, DON'T OUTPUT TRAILING BLANKS
JUMPE AC4,DSPL66 ;CHECK FOR BLANKS FOLLOWED BY NON-BLANKS
PUSH PP,C ; (YUP) OUTPUT BLANKS IN THE MIDDLE
MOVEI C," "
PUSHJ PP,OUTCH.
SOJG AC4,.-1
POP PP,C ;GET THE NON-BLANK CHAR BACK
DSPL66: IDPB C,TTOBP. ;DEPOSIT CHARACTER IN BUFFER
SOSG TTOBC. ;BUFFER FULL?
PUSHJ PP,OUTBF. ;YES
DSPL67: SOJG AC6,DSPL64 ;LOOP
JRST DSPL7 ;SEE IF CR-LF NEEDED
;HERE FOR ASCIZ TEXT
DSPL.7:
IFN LSTATS,<
MOVEI AC2,MB.DSP ;INDICATE DISPLAY METER POINT
PUSHJ PP,MRACDP ;SET METER POINT (CLEARS AC2)
>
SKIPE TTYOPN ;IS THERE A TTY FILE OPEN?
PUSHJ PP,DSPTO ;YES, DUMP THE BUFFER BEFORE DISPLAYING
;IFE TOPS20,<
OUTSTR (I16) ;OUTPUT THE TEXT STRING
;>
REPEAT 0,< ;ALTMODE COMES OUT AS DOLLAR SIGN
IFN TOPS20,<
MOVEI 1,(I16)
HRLI 1,(POINT 7,) ;BUILD BYTE PTR
PSOUT ;OUTPUT THE STRING
>;END IFN TOPS20
>;END REPEAT 0
MRTME. (AC1) ;END METER TIMING
POPJ PP,
DSPTO: PUSH PP,AC16 ;SAVE AC16
MOVE AC16,TTYOPN ;GET FILE-TABLE ADR FOR ERROR ROUTINES
PUSHJ PP,SETCN. ;SETUP IO CHANNEL
PUSHJ PP,WRTOUT ;DUMP THE BUFFER
POP PP,AC16 ;RESTORE
POPJ PP, ;EXIT
OUT6B.: ADDI C," " ;CONVERT A SIXBIT CHAR
OUTCH.: IDPB C,TTOBP. ;DEPOSIT CHAR. IN BUFFER.
SOSLE TTOBC. ;DUMP THE BUFFER?
POPJ PP, ; NO.
;OUTPUT A TTY BUFFER. ***POPJ***
OUTBF.: SETZ C, ;ASCIZ TERMINATOR
IDPB C,TTOBP. ;
;IFE TOPS20,<
OUTSTR TTOBF. ;DUMP THE BUFFER
;>
REPEAT 0,< ;*** FIX DURING FIELD TEST ***
IFN TOPS20,<
PUSH PP,1
MOVE 1,[POINT 7,TTOBF.]
PSOUT ;DUMP THE BUFFER
POP PP,1
>
>;END REPEAT 0
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.: INCHWL C ;[267] INPUT A LINE, FIRST CHAR TO C
CAIN C,15
JRST GETCH.
CAIN C,33
JRST GETCH1
CAIG C,14
CAIGE C,12
AOSA (PP)
GETCH1: MOVEI C,12
POPJ PP,
SUBTTL OPEN VERB
;AN OPEN VERB LOOKS LIKE:
;FLAGS,,ADR WHERE ADR = FILE TABLE ADDRESS
;OPN%OU OPEN FOR OUTPUT
;OPN%IN OPEN FOR INPUT
;OPN%NR DON'T REWIND
;OPN%EX [74] OPEN EXTENDED (APPEND FILOP.)
;OPN%RV [74] OPEN REVERSED
;CALL+1: POPJ RETURN
;MAKE PRELIMINARY CHECKS: ALREADY OPEN, OPTIONAL FILE PRESENT,
;ANOTHER FILE USING SHARED BUFFER AREA ***OPNDEV***
C.OPEN:
IFN LSTATS,< ;LIBOL METER TIMING
SKIPE F.WSMU(I16) ;SKIP TIME START IF SIM. UPDATE
JRST C.OMRX ;SKIP
MRTMS. (AC1) ;START OPEN TIMING
C.OMRX:>;END IFN LSTATS
TXO AC16,V%OPEN ;OPEN VERB
IFN TOPS20,<
TXZE AC16,OPN%EX ;OPEN EXTEND DOES NOT WORD ON TOPS-20
OUTSTR [ASCIZ /%OPEN EXTEND does not work on TOPS-20, file opened normally.
/]>
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
LDB AC0,F.BBLC ;[346] CHECK FLAG TO SEE IF THIS
JUMPE AC0,OOVLER ; FILE TABLE HAS BEEN LINKED TO THE CHAIN.
TLNE FLG,OPNIN+OPNOUT ;IS THE FILE OPEN?
JRST OPNFAO ;YES, ERROR
SETZM D.RP(I16) ;INITIALIZE THE RECORD SEQUENCE NUMBER
LDB AC5,F.BLF ;IS THE FILE IS LOCKED?
JUMPN AC5,OPNFAL ;YES, ERROR
TXNE AC16,OPN%OU ;SKIP IF NOT OUTPUT
TLO FLG,OPNOUT ;
TXNE AC16,OPN%IN ;SKIP IF NOT INPUT
TLO FLG,OPNIN ;
TLNE FLG1,FILOPT ;IS FILE OPTIONAL?
JRST OPNOP ;YES. RETURNS ONLY IF PRESENT
OPNSBA: PUSHJ PP,DEVIOW ;RESET THE DEVICE IOWD
IFN ANS68,<
TLNE FLG,RANFIL ;SKMFILE
PUSHJ PP,OPNSFL ;STORE THE FILE LIMITS SO HE CAN'T DIDDLE
>
HLRZ AC4,F.LSBA(I16) ;FILTAB THAT SHARES THE SAME BUFFER
OPNSB1: JUMPE AC4,OPNDEV ;JUMP IF NO ONE SHARES
CAIN AC4,(I16) ;HAVE WE CHECKED ALL "SBA" FILTAB'S
JRST OPNDEV ;YES
HLL AC4,F.WFLG(AC4) ;GET THE FLAGS
TLNE AC4,OPNIN!OPNOUT ;SKIP IF ANY FILES ARE NOT OPEN
JRST OPNSB2 ;GIVE AN ERROR MESSAGE
HLRZ AC4,F.LSBA(AC4) ;GET NEXT "SBA FILTAB"
JRST OPNSB1 ;+LOOP
OPNSB2: MOVEI AC0,^D12 ;ERROR NUMBER
PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS
MOVE AC5,AC4 ;MSOUT. USES AC4
MOVE AC2,[BYTE (5)10,31,20,2,1,14]
PUSHJ PP,MSOUT.
HRLZI AC2,(BYTE (5)10,31,20)
HRR AC16,AC5
JRST MSOUT. ;SOME OTHER FILE IS USING OUR BUFFER AREA
OOVLER: HRRZ AC0,HLOVL. ;[346] GET START OF OVERLAY AREA
CAIG AC0,(I16) ;[346] IF FILE-TABLE IN OVL AREA
JUMPN AC0,OOVLE1 ;[346] COMPLAIN
MOVEI AC0,^D30 ;ERROR NUMBER
PUSHJ PP,OXITP ;POPJ TO MAIN LINE IF IGNORING ERRORS
OUTSTR [ASCIZ "ATTEMPT TO DO I/O FROM A SUBROUTINE CALLED BY A NON RESIDENT SUBROUTINE."] ;[346]
JRST OOVLE2 ;[346]
OOVLE1: MOVEI AC0,^D31 ;ERROR NUMBER
PUSHJ PP,OXITP ;POPJ IF IGNORING ERRORS
OOVLE2: OUTSTR [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
PUSHJ PP,$SIGN ;[277] OUTPUT "$" FOR .OPERATOR
OUTSTR [ASCIZ /IS /] ;OPTIONAL FILE PRESENT?
PUSHJ PP,MSFIL.
OUTSTR [ASCIZ / PRESENT? .../]
PUSHJ PP,YES.NO ;SKIP RETURN IF "NO" ANSWER
JRST OPNOP1 ;YES
TLO FLG,NOTPRS ;NO, "NOT PRESENT"
TLZ FLG,OPNIN ;NOTE THAT IT'S NOT OPEN
MOVEM FLG,F.WFLG(I16) ;%SAVE THE FLAG WORD
POPJ PP, ;RETURN TO MAIN LINE *EXIT************
OPNOP1: TLNN FLG,IDXFIL ;ISAM FILE?
JRST OPNSBA ;NO
MOVE AC1,D.OPT(I16) ;WERE THE BUFFERS SETUP AT RESET TIME?
AOJN AC1,OPNSBA ;EXIT HERE IF THEY WERE
MOVEI AC0,^D29 ;ERROR NUMBER
PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS
OUTSTR [ASCIZ /EITHER THE ISAM FILE DOES NOT EXIST OR
THE VALUE OF ID CHANGED DURING THE PROGRAM/] ;[374]
PUSHJ PP,KILL ;AND DONT RETURN
YESNO: CLRBFI ;CLEAR THE BUFFER
OUTSTR [ASCIZ /$ TYPE YES OR NO
/]
YES.NO: MOVE AC5,[POINT 7,[ASCIZ /ES/],]
PUSHJ PP,GETCH.
JRST .-1
CAIE C,"Y"
JRST YESNO2
YESNO1: PUSHJ PP,GETCH.
POPJ PP, ;IS THE "YES" RETURN
ILDB AC4,AC5
JUMPE AC4,YSNOFN ;[564] [V10] YES FOUND, EAT INPUT UNTIL EOL
CAMN AC4,C
JRST YESNO1
JRST YESNO
YESNO2: MOVE AC5,[POINT 7,[ASCIZ /NO/],]
YESNO3: ILDB AC4,AC5
JUMPN AC4,YESNO4 ;[564] [V10] CHECK NEXT 'NO' CHAR,IF GOT ONE
AOS (PP) ;[564] ELSE, GIVE SKIP RETURN
YSNOFN: PUSHJ PP,GETCH. ;[564] GET ANOTHER CHAR
POPJ PP, ;[564] GOT EOL, RETURN
JRST YSNOFN ;[564] EAT CHARS UNTIL EOL
YESNO4: CAME AC4,C ;[564]
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, ;
IFN ANS68,<
;SET THE FILE LIMIT CLAUSES IN THE FILE-TABLE. ***POPJ***
OPNSFL: LDB AC5,F.BNFL ;NUMBER OF FILE LIMIT CLAUSES
JUMPE AC5,RET.1 ;RETURN IF NONE
MOVNS AC5 ;
HRL AC1,AC5 ;
HRRI AC1,F.WLHL(I16) ;IOWD NUMBER OF,, FILE LIMIT
HLR I12,D.BL(I16) ;PICK UP THE BUFFER LOCATION
MOVEM AC1,R.FLMT(I12) ;
OPNSF1: MOVE AC5,(AC1) ;LIMIT,,LIMIT
MOVE AC6,(AC5) ;
MOVSS AC5 ;
MOVE AC4,(AC5) ;
CAMLE AC4,AC6 ;SKIP IF AC4 IS THE LOW LIMIT
EXCH AC4,AC6 ;
MOVEM AC4,1(AC1) ;LOW LIMIT
MOVEM AC6,2(AC1) ;HIGH LIMIT
ADDI AC1,2 ;ACCOUNT FOR TWO WORDS
AOBJN AC1,OPNSF1 ;GO AGAIN IF YOU CAN
POPJ PP, ;
>
;GET DEVICE CHARACTERISTICS AND CHECK IF DEVICE CAN DO
;REQUESTED IO FUNCTIONS ***OPNCHN***
;ENTRY POINT FOR READ GENERATED CLOSE GENERATED OPEN. ***READEF+N***
OPNDEV: SETZM D.OE(I16) ;CLEAR NUMBER OF OUTPUTS
SETZM D.IE(I16) ; NUMBER OF INPUTS
PUSHJ PP,DEVCHR ;GET THE DEVICE CHAR.
TXNN AC13,DV.AVL ;SKIP IF AVAILABLE TO JOB
JRST OPNDNA
TXNN AC13,DV.DSK ;SKIP IF A DSK
TRNN AC13,DV.ASP ;SKIP IF DEV IS INITED
JRST OPNDE5
MOVE AC2,[BYTE (5)10,2,4,20,16] ;FCBO,DIATAF.
MOVEI AC0,^D14 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
OPNDE5:
IFE TOPS20,<
TXNE AC13,DV.MTA ;MTA?
TXNN AC16,OPN%EX ;APPEND MODE?
JRST OPNDE6 ;NO
TLZ FLG1,STNDRD!NONSTD ;YES, DON'T CREATE A NEW LABEL
>
OPNDE6: TLNE FLG,OPNIO ;SKIP UNLESS IO IS REQUESTED
JRST OPNDE7 ;IO REQUESTED
IFE TOPS20,<
TXNN AC16,OPN%EX ;MUST BE ABLE TO DO BOTH
>
TLNE FLG,OPNIN ;SKIP IF NOT AN INPUT REQUEST
TXNE AC13,DV.IN ;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:
IFE TOPS20,<
TXNN AC16,OPN%EX ;MUST BE ABLE TO DO BOTH
>
TLNE FLG,OPNOUT ;SKIP IF NOT AN OUTPUT REQUEST
TXNE AC13,DV.OUT ;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
OPNDE7: TXNE AC13,DV.DSK ;SKIP IF DEVICE IS NOT A DSK
JRST OPNCHN ;FIND A FREE CHANNEL
MOVE AC2,[BYTE (5)10,2,4,20,17]
MOVEI AC0,^D15 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
DEVCHR: MOVE AC13,D.ICD(I16) ;ADR OF DEV. NAME
MOVE AC13,(AC13) ;SIXBIT/DEVICE NAME/
MOVEM AC13,UOBLK.+1 ;FOR OPEN
DEVCHR AC13, ;DEVCHR UUO
;[506] TLNN FLG,OPNIO+OPNIN ;[330]IF NOT INPUT THEN IGNORE
;[506] JRST DEVCH1 ;[330]
TXC AC13,DV.DSK!DV.CDR ;[330]IF A DSK AND A CDR
TXCN AC13,DV.DSK!DV.CDR ;[330]THEN ITS DEVICE 'NUL'
TXZ AC13,DV.MTA!DV.TTY ;[506]SO ITS NOT A MTA OR TTY
DEVCH1: MOVEM AC13,D.DC(I16) ;[330]SAVE THE CHARACTERISTICS
JUMPN AC13,RET.1
MOVE AC2,[BYTE (5)10,2,4,20,13] ;FCBO,DINAD.
POP PP,(PP) ;POP OFF THE RETURN
MOVEI AC0,^D18 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
;FIND A FREE DEVICE CHANNEL AND SETUP THE BUFFERS
;XCT OPEN, INBUF AND/OR OUTBUF ***OPNBSI***
OPNCHN: PUSHJ PP,GCHAN ;LOAD AC5 WITH A CHANNEL NUMBER
DPB AC5,DTCN. ;SAVE IT
IFN ISAM,<
TLNN FLG,IDXFIL ;INDEX FILE ?
JRST OPNCH1 ;NO
PUSHJ PP,GCHAN ;
HLRZ I12,D.BL(I16) ;
HRRZM AC5,ICHAN(I12) ;SAVE INDEX FILE CHAN NO.
>
OPNCH1: PUSHJ PP,SETC1. ;DISTRIBUTE THE CHANNEL NUMBER
TLNE FLG,DDMASC ;SKIP IF NOT ASCII
TDZA AC6,AC6 ;ASCII MODE AND SKIP
MOVEI AC6,.IOBIN ;PERHAPS BINARY
TLNE FLG,RANFIL!OPNIO!IDXFIL ;SKIP IF BUFFERED IO
MOVEI AC6,.IODMP ;DUMP MODE
HRRM AC6,UOBLK. ;UOBLK.+1 SET AT DEVCHR
IFE TOPS20,<
PUSHJ PP,OPNCKP ;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
HRLI AC6,D.OBH(I16) ;OUTPUT BUFFER HEADER
HRRI AC6,D.IBH(I16) ;INPUT BUF HDR
MOVEM AC6,UOBLK.+2
IFN ISAM,<
TLNN FLG,IDXFIL ;ISAM ?
JRST OPNCH3 ;NO
MOVE AC1,F.WDNM(I16) ;ADR
MOVE AC1,(AC1) ;IDX DEVICE NAME
MOVEM AC1,UOBLK.+1 ;
OPNCH3:>
SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE?
IFE TOPS20,<
TXNE AC16,OPN%EX ;OPEN EXTENDED?
TRNA ; YES, NEED FILOP.
>
JRST OPNC31 ; NO
IFE TOPS20,<
PUSHJ PP,OPNFOP ; [431] YES OPEN FILE VIA FILOP
JRST OFERRI ; [576] [431] ERROR RETURN
>; [431] END IFE TOPS20
IFN TOPS20,<
PUSHJ PP,OCPT ; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
TRNA ;ERROR, CHECK FOR FNF
>; [431] END IFN TOPS20
JRST OPNC41 ;
IFN TOPS20,<
TLNE FLG,IDXFIL ;IS IT AN ISAM FILE
JRST OCPER ;YES, GIVE THE ERROR
CAIG AC1,GJFX21 ;IS IT ONE OF FILE NOT FOUND
CAIGE AC1,GJFX17
CAIN AC1,GJFX24
JRST OPNFNF ;YES FNF!!
CAIE AC1,GJFX32 ;STILL MORE FNF POSSIBILITIES
CAIN AC1,OPNX2 ;LAST ONE TO CHECK FOR
JRST OCPER ;NOT FNF, SCREW IT
OPNFNF: HRLZI AC1,(1B17) ;DO FILE CREATE OPEN
MOVEM AC1,CP.BK1
MOVE AC1,[10,,CP.BLK]
COMPT. AC1, ;DO IT
JRST OCPER ;FAILED AGAIN, SCREW IT
JRST OPNC41 ;GOOD CONTINUE WITH NEW FILE
>;END IFN TOPS20
OPNC31: PUSHJ PP,SETBM ;SET BYTE MODE IF REQUIRED
XCT UOPEN. ;OPEN THE DEVICE ***************
JRST OERRIF ;OPEN FAILED
OPNC41: PUSHJ PP,OPNWPB ;RETS LOGICAL BLOCK SIZE IN AC10, BLKFTR IN AC5
LDB AC6,F.BNAB ;NUMBER OF ALTERNATE BUFFERS (FOR INBUF X,2(AC6))
IFE TOPS20,< ;[561]
TXNE AC13,DV.MTA ;SKIP IF NOT A MTA
> ;[561]
IFN TOPS20,<
TXNN AC13,DV.MTA ;[561] MTA??
JRST OPNC4X ;[561] NO,SKIP FOLLOWING ENTER/LOOKUP
PUSH PP,AC5 ;[561] YES,SAVE REGS
PUSH PP,AC6 ;[561]
PUSH PP,AC10 ;[561]
TLNN FLG,OPNIN ;[561] OPEN FOR INPUT?
JRST OPNC4A ;[561] NO
PUSHJ PP,OPNLID ;[561] YES,SET UP FOR LOOKUP
XCT ULKUP. ;[561] LOOKUP
JRST OLERR ;[561] ERROR IN LOOKUP
JRST OPNC4F ;[561] RESTORE AND CONT
OPNC4A: PUSHJ PP,OPNEID ;[561] SET UP FOR ENTER
XCT UENTR. ;[561] ENTER
JRST OEERR ;[561] ERROR IN ENTER
OPNC4F: POP PP,AC10 ;[561] RESTORE AC'S
POP PP,AC6 ;[561]
POP PP,AC5 ;[561]
>;END IFN TOPS20
JUMPN AC5,OPNNSB ;[561] NON STANDARD BUFFER SETUP
OPNC4X: ;[561]
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.
IFE TOPS20,<
TXNE AC16,OPN%EX ;APPEND?
JRST OPNC45 ;YES, DO FILOP NOW
>
TLNE FLG,OPNIN ;INPUT?
XCT UIBUF. ;**********
TLNE FLG,OPNOUT ;OUTPUT?
XCT UOBUF. ;**********
IFE TOPS20,<
JRST OPNC46
OPNC45: MOVEI AC1,2(AC6) ;GET NO. OF BUFFERS
HRLZM AC1,FOP.BN## ;SET FOR OUTPUT
MOVE AC1,UOBLK.+2 ;GET BUFFER HEADERS
MOVEM AC1,FOP.BH## ;STORE IN FILOP. BLOCK
MOVE AC1,[7,,FOP.BK]
FILOP. AC1,
JRST OFERR ;FAILED
JUMPL FLG,OPNC46 ;JUMP IF ASCII
TLNE FLG,DDMBIN
JRST OPNC46 ;DON'T CHANGE IF BINARY
HLRZ AC6,FOP.BH ;GET OUTPUT BUFFER HEADER
MOVEI AC1,6 ;ASSUME SIXBIT
TLNE FLG,DDMEBC
MOVEI AC1,9 ;EBCDIC
DPB AC1,[POINT 6,1(AC6),11] ;RESET BYTE SIZE
TLNE FLG,DDMEBC
MOVEI AC1,4 ;4 BYTES PER WORD
IMULM AC1,2(AC6) ;ADJUST BYTE COUNT
OPNC46:>
HLRZ AC2,F.LSBA(I16) ;[507] FILTAB THAT SHARES SAME BUFFER
JUMPN AC2,ZROBUF ;[507] CLEAR ANY POSSIBLE PREVIOUS JUNK
POP PP,.JBFF ;RESTORE .JBFF
OPNCH2:
IFN ANS74,<
TLNN FLG,IDXFIL!RANFIL!OPNIO!OPNIN
TLNN FLG,OPNOUT ;TEST FOR SEQ. OUTPUT
JRST OPNC21 ;NO
SKIPN F.LCP(I16) ;LINAGE-COUNTER?
JRST OPNC21 ;NO
MOVEI AC6,1
MOVEM AC6,F.LCP(I16) ;YES, SET TO 1
OPNC21:>
TXNE AC13,DV.DIR ;SKIP IF NON-DIRECTORY DEVICE
TLNE FLG1,STNDRD ;SKIP IF NOT STANDARD LABELS
JRST OPNBSI ;SET THE BYTE SIZE
TXNE AC13,DV.CDR ;[531] IF DIRECTORY AND CDR
JRST OPNBSI ; THEN ITS NUL: WHICH IS OK
PUSHJ PP,RCHAN ;RELEASE DEVICE AND CHANNEL
MOVEI AC0,^D19 ;ERROR NUMBER
PUSHJ PP,OXITP ;RETURN TO CBL-PRG IF IGNORING ERRORS
MOVE AC2,[BYTE (5)10,2,4,26] ;FCBO,DDMHSL
JRST MSOUT.
;[507] ZERO BUFFERED I/O BUFFER AREA.
ZROBUF: HLRZ AC3,D.BL(I16) ;[507] ORIGINAL BUFFER LOCATION
MOVE AC1,AC3 ;[507] SET UP FOR LOOP
ZRBUF2: SETZM (AC1) ;[507] INITIALIZE FILE STATUS
HLRZ AC2,1(AC1) ;[507] SIZE OF DATA BUFFER ( +1 )
HRRZ AC4,1(AC1) ;[507] ADDR 2ND WORD NEXT BUFFER
HRRZI AC1,2(AC1) ;[507] 3RD WORD OF HEADER
SETZM (AC1) ;[507] THE ZERO
ADDI AC2,-1(AC1) ;[507] UNTIL...
HRLS AC1 ;[507] FROM...
ADDI AC1,1 ;[507] TO...
BLT AC1,(AC2) ;[507] CLEAR THE BUFFER
HRRZI AC1,-1(AC4) ;[507] TOP OF NEXT BUFFER
CAME AC3,AC1 ;[507] AT BEGINNING OF RING?
JRST ZRBUF2 ;[507] NO, LOOP
POP PP,.JBFF ;[507] RESTORE
JRST OPNCH2 ;[507] CONTINUE
;SET UP NON-STD MTA BUFFERS (SIZE OF LOGICAL BLOCK). ***OPNCH2***
OPNNSB: CAIN AC6,77 ;[477] REALLY WANTS ONE BUFFER?
SETO AC6, ;[477] YES, SET TO DEFAULT TO 1
ADDI AC6,2 ;ALTERNATE PLUS 2 DEFAULT BUFFERS
TLNE FLG1,STNDRD+NONSTD ;SKIP IF OMITTED LABELS
HRRZ AC10,D.LRS(I16) ;IN CASE LABEL IS GE TO REC AREA
HLRZ AC4,D.BL(I16) ;BUFFER LOCATION
ADDI AC4,1 ;BUF1+1
HRLI AC4,(BF.VBR) ; AND NEVER WAS REFERENCED
MOVEM AC4,D.IBH(I16) ;INPUT HEADER
MOVEM AC4,D.OBH(I16) ;OUTPUT HEADER
HRR AC2,AC4 ;BUF1+1
HRLI AC2,1(AC10) ;SIZE+1,,BUF1+1
SKIPA AC3,AC4 ;BUF1+1
OPNNS1: ADDI AC3,3(AC10) ;LOCATION OF NEXT LINK
ADDI AC2,3(AC10) ;SIZE+2,,<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...
IFE TOPS20,<
TXNN AC16,OPN%EX ;APPEND?
JRST OPNCH2 ;NO
SETZM FOP.BN ;DON'T CHANGE BUFFER ALLOCATION
MOVE AC1,UOBLK.+2 ;GET BUFFER HEADERS
LDB AC3,[POINT 6,1(AC1),11] ;GET BYTE SIZE (FILOP. CHANGES IT)
MOVEM AC1,FOP.BH ;STORE IN FILOP. BLOCK
MOVE AC1,[7,,FOP.BK]
FILOP. AC1,
JRST OFERR ;FAILED
MOVE AC1,UOBLK.+2 ;GET BUFFER HEADERS AGAIN
MOVE AC2,D.BPW(I16) ;BYTES PER WORD
DPB AC3,[POINT 6,1(AC1),11] ;RESET
IMULM AC2,2(AC1) ;ADJUST BYTE COUNT
MOVS AC1,AC1 ;BO FOR BOTH
DPB AC3,[POINT 6,1(AC1),11] ;RESET
IMULB AC2,2(AC1) ;ADJUST BYTE COUNT
CAIE AC3,6 ;SIXBIT?
JRST OPNCH2 ;NO
HLRZ AC3,@(AC1) ;GET BUFFER SIZE IN WORDS
SUBI AC3,1 ;DATA WORDS
IMUL AC3,D.BPW(I16) ;CHARACTERS
CAIE AC3,(AC2) ;BUFFER EMPTY?
JRST OPNNS2 ;NO
XCT UGETS. ;YES, MUST READ LAST BUFFER
PUSH PP,AC2 ;SAVE CURRENT STATUS
MOVEI AC2,.IODMP ;CHANGE TO DUMP MODE
XCT USETS.
XCT MBSPR. ;BACKSPACE OVER IT
XCT MWAIT. ;WAIT
HLRZ AC3,@(AC1) ;GET SIZE IN WORDS
MOVNI AC3,-1(AC3) ;- DATA WORDS
MOVE AC1,(AC1) ;ADDRESS OF BUFFER
ADDI AC1,1 ;POINT TO DATA -1
HRL AC1,AC3 ;SETUP IOWD
SETZ AC2, ;TERMINATOR
MOVE AC3,UIN. ;GET IN CH,0
HRRI AC3,1 ;POINT TO ARG BLOCK
XCT AC3 ;DO INPUT
POP PP,AC2
XCT USETS. ;PUT BACK MODE
OPNNS2: HLRZ AC3,1(AC1) ;GET RECORD COUNT
ADDI AC3,1 ;SET TO NEXT
MOVEM AC3,D.RP(I16) ;SET IT
>
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
MOVE AC6,AC10 ;GET WDS/LBLK
TRZE AC6,DSKMSK ;FILL TO DISK BLK SIZE,
ADDI AC6,DSKBSZ ;ROUNDING UP IF NECESSARY
MOVN AC6,AC6 ;GET 0,,-N
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
HLRZ AC2,F.LSBA(I16) ;[507] FILTAB THAT SHARES SAME BUFFER
SKIPE AC2 ;[507] SHARES BUFFER?
PUSHJ PP,ZDMBUF ;[507] YES, CLEAR IT
JRST OPNCON ;RET
IFN ISAM,<
;SETUP INDEX FILE BUFFER AND TABLE AREAS
OPNIDX: SETZM USOBJ(I12) ;[377] CLEAR THE FIRST WORD OF INDEX TABLE
HRRI AC0,USOBJ+1(I12);TO
HRLI AC0,USOBJ(I12) ;FROM,,TO
HRRZI AC1,ITABL-15+ICHAN(I12) ;UNTIL
BLT AC0,(AC1) ;CLEAR REST OF INDEX TABLE
HRLZ AC0,D.IBL(I16) ; [377] SEE IF WE HAVE A SAVE AREA
JUMPE AC0,OPNIX1 ; [377] NO- GO ON
HRRI AC0,ISCLR1(I12) ; [377] SET UP TO
HRRZI AC1,ISCLR2(I12) ; [377] MOVE ISAM SAVE AREA TO
BLT AC0,(AC1) ; [377] TO SHARED BUFFER AREA
OPNIX1: PUSHJ PP,OPNLIX ;INDEX FILE-NAME TO LOOKUP BLOCK
SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE?
JRST OPNIX2 ; YES
;IFN TOPS20,< ;[570]
; TLNE FLG,OPNIO!OPNOUT ;[570] OPEN READ ONLY?
; JRST ONIX1A ;[570] NO, DO LOOKUP
; PUSHJ PP,OCPT ;[570] YES, OPEN IN THAWED MODE
; JRST OCPER ;[570] ERROR IN THAWED OPEN
; JRST OPNIX2 ;[570] OK,CONT
;ONIX1A: >;[570] END IFN TOPS20
XCT ULKUP. ;LOOKUP
JRST OLERRI ;LOOKUP AND(OR) COMPT. FAILED
OPNIX2: TLNN FLG,OPNOUT ;OPEN FOR UPDATING?
JRST OPNI01 ;NO
OPNI00: TLO FLG1,EIX ;ENTER OF .IDX FILE IN PROGRESS
PUSHJ PP,OPNEIX ;INDEX FILE-NAME TO ENTER BLOCK
SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE?
JRST OPNIX3 ; YES
XCT UENTR. ;ENTER, FOR UPDATING
JRST OEERRI ;ENTER FAILED
OPNIX3: TLZ FLG1,EIX ;FREE THIS BIT FOR "RIVK" FLAG
OPNI01: HRLZI AC1,STABL ;STATISTICS BLOCK LEN
MOVNS AC1 ;
HRR AC1,I12 ;
SUBI AC1,1 ;DUMP MODE IOWD
MOVEM AC1,IOWRD+14(I12) ;SAVE IN IOWRD TABLE
SETZ AC2, ;TERMINATOR
MOVEI AC0,1 ;
HRRM AC0,UIN. ;
IFN ISTKS,<AOS INSSSS+14(I12)>
XCT UIN. ;READ THE STATISTICS BLOCK
JRST OPNI02 ;
MOVE AC0,[E.MINP+E.FIDX+E.BSTS] ;ERROR NUMBER
PUSHJ PP,IGMIR ;IGNORE THE ERROR?
JRST RCHAN ;YES - RELEASE THE IO CHANNELS
OUTSTR [ASCIZ /OPEN FAILED - CANNOT READ STATISTICS BLOCK/]
PUSHJ PP,SETIC ;SET UP IGETS CHANNEL NO.
JRST IINER
;OPEN THE DATA FILE
OPNI02: HLLZS UIN. ;CLEAR THE IOWR POINTER
MOVEI AC0,.IODMP ;DUMP MODE
HRRM AC0,UOBLK. ;SETUP OPEN BLOCK
IFE TOPS20,<
PUSHJ PP,OPNCKP ;SEE IF WE WANT TO OPEN FILE IN CHECKPOINT MODE
>
MOVE AC1,F.WDNM(I16) ;
MOVE AC1,1(AC1) ;[522] GET STRUCTURE
MOVEM AC1,UOBLK.+1 ;
SETZM UOBLK.+2 ;
PUSHJ PP,SETCN. ;SET DATA FILE CHANNEL
SKIPN F.WSMU(I16) ; SIMULTANEOUS UPDATE?
JRST OPNI21 ; NO
IFE TOPS20,<
PUSHJ PP,OPNFPD ; [431] OPEN FILE VIA FILOP UUO
JRST OFERR ; [576] [431] ERROR RETURN
>; [431] END IFE TOPS20
IFN TOPS20,<
PUSHJ PP,OCPTD ; [431] OPEN FILE VIA DEC-SYS-20 COMPT.
JRST OCPERI ; [431] ERROR RETURN
>; [431]END IFN TOPS20
JRST OPNI22 ; SKIP THE OPEN UUO
OPNI21: XCT UOPEN. ;OPEN THE DATA FILE
JRST OERRDF ;ERROR RETURN
;SETUP IOWRD TABLE
OPNI22: MOVEI AC3,BA(I12) ;
MOVE AC1,ISPB(I12) ;SECTORS PER BLOCK
IMULI AC1,200 ;WORDS PER SECTOR
MOVN AC2,AC1 ;-LEN
HRLZS AC2 ;-LEN,,0
HRRI AC2,-1(AC3) ;IOWD, -LEN,,LOC-1
MOVE AC4,OMXLVL(I12) ;[442] USE ORIGINAL # OF INDEX LEVELS
;[V10] SKIPN CORE0(I12) ; SKIP IF NOT FIRST OPEN FOR THIS FILE
SUBI AC4,1 ;PLUS ONE FOR SPLITTING THE TOP LEVEL
HRLZS AC4 ;
HRRI AC4,IOWRD+1(I12) ;
SKIPN (AC4) ;IF IOWRD'S ALREADY SETUP
MOVEM AC2,(AC4) ;
ADD AC2,AC1 ;
AOBJN AC4,.-3 ;LOOP
MOVN AC5,MXLVL(I12) ;SEE IF ANY NEW INDEX LEVELS WERE
SUB AC5,OMXLVL(I12) ; CREATED SINCE LAST TIME FILE WAS OPEN
JUMPGE AC5,OPNI06 ;[504] SKIP THE FOLLOWING IF NOT
HRL AC4,AC5 ;NEW LEVEL(S)
HRRZ AC5,ISPB(I12) ;[306] SECTORS PER BLOCK
IMULI AC5,200 ;[306] WORDS PER SECTOR
MOVN AC6,AC5 ;[306] NEGATE THE LENGTH
HRLZS AC6 ;[306] -LENGTH,,0
HRR AC6,.JBFF ; SO MAKE
SUBI AC6,1 ; ANOTHER IOWD
OPNI03: SKIPE (AC4) ;USE ONLY IF
JRST OPNI04 ; ANOTHER JOB MADE THE NEW LEVEL
SKIPE KEYCV. ;ARE WE SORTING?
JRST OPNIR0 ;YES - CANT HANDLE THAT
HRRZ AC0,AC5 ;[306] SET UP AC0
PUSHJ PP,GETSPC ;GET MORE CORE
JRST OPNIR1 ;TOO BAD
HRRZ AC0,HLOVL. ;DOES THE SPACE WE GOT
CAMGE AC0,.JBFF ; EXTEND INTO THE OVL-AREA?
JUMPN AC0,WOVLR1 ;GO COMPLAIN IF IT DOES
MOVEM AC6,(AC4) ;USE IT
ADD AC6,AC1 ;SET UP FOR NEXT IOWD
OPNI04: AOBJN AC4,OPNI03 ;LOOP IF YOU MUST
OPNI06: SKIPN IOWRD+13(I12) ; SKIP IF ALREADY DONE
MOVEM AC2,IOWRD+13(I12);SAT BLOCK
ADD AC2,AC1 ;
;IOWRD0, USOBJ0, CNTRY0, NNTRY0 - SET TO INDEX ON LVL
HRLZI AC0,LVL ;HOLDS CURRENT LEVEL OF INDEX
HRRI AC0,IOWRD(I12) ;
MOVEM AC0,IOWRD0(I12) ;
HRRI AC0,USOBJ(I12) ;
MOVEM AC0,USOBJ0(I12) ;
HRRI AC0,CNTRY(I12) ;
MOVEM AC0,CNTRY0(I12) ;
HRRI AC0,NNTRY(I12) ;
MOVEM AC0,NNTRY0(I12) ;
;SET BRISK FLAG OUTPUT ONLY WHEN YOU MUST
LDB AC5,F.BDIO ;GET DEFERRED ISAM OUTPUT FLAG
JUMPE AC5,OPNI61 ; 0 = NO DEFERRED OUTPUTS
SKIPN F.WSMU(I16) ; NO DEFERRED OUTS IF SIMU-UPDATE
SETOM BRISK(I12)
;CHECK FILTAB BLKFTR VS STAT-BLK BLKFTR
OPNI61: LDB AC0,F.BMRS ;[371] GET PROGRAMS MAX REC SIZE
CAMN AC0,RECBYT(I12) ;[371] SEE IF SAME AS ISAM PARM
JRST OPNI07 ;[371] IT DOES- OF
CAML AC0,RECBYT(I12) ; [375] WHICH WAY IS FD DIFFERENT?
JRST OPNGR ; [375] FD GT ISAM
TLNN FLG,OPNIN+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]
OUTSTR [ASCIZ /USERS MAXIMUM RECORD SIZE /] ; [371]
PUSHJ PP,PUTDEC ;[371] TYPE IT
OUTSTR [ASCIZ / DIFFERS FROM ISAM PARAMETER /] ;[371]
MOVE AC0,RECBYT(I12) ;[371] GET ISAM MAX REC SIZE
PUSHJ PP,PUTDEC ;[371] TYPE IT
JRST OPNERX ;[371] FINISH UP MSG AND STOP RUN
OPNI07: ;[371]
MOVE AC6,ORCBYT(I12) ;[515] GET BLOCKFTR AT RESET
CAMGE AC6,RECBYT(I12) ;[535] [515] MUST = OR LESS THAN FILE OPENED
JRST OPNER2 ;[515] NOT THE SAME TROUBLE
MOVE AC6,F.WIKD(I16) ;[535] [515] GET KEY DESC. FROM PROG
CAMN AC6,KEYDES(I12) ;[515] MUST BE THE SAME AS FILE OPENED
JRST OPNI7A ; ELSE CONT NEXT TEST
OUTSTR [ASCIZ / [KEY DESCRIPTOR OF /]
PUSHJ PP,MSFIL. ; PRINT FILE NAME
OUTSTR [ASCIZ / DIFFERS FROM PROGRAM]
/] ;[535] YOUR ON YOUR OWN AFTER THIS
OPNI7A: MOVE AC6,F.WBRK(I16) ;[574] GET PROGRAM KEY POINTER
CAMN AC6,DBPRK(I12) ;[574] MUST BE SAME AS FILE OPENED
JRST OPNI7B ; ELSE CONT
OUTSTR [ASCIZ / [KEY POINTER OF /]
PUSHJ PP,MSFIL. ; PRINT FILE NAME
OUTSTR [ASCIZ / DIFFERS FROM PROGRAM]
/] ;[574]
OPNI7B: 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
OUTSTR [ASCIZ /USERS BLOCKING FACTOR /] ; [371]
MOVE AC0,AC5 ;[371] GET USER BF
PUSHJ PP,PUTDEC ;[371] TYPE IT
OUTSTR [ASCIZ / DIFFERS FROM ISAM PARAMETER /] ;[371]
MOVE AC0,AC6 ;[371] GET ISAM BF
PUSHJ PP,PUTDEC ;[371] TYPE IT
OPNERX: ;[371]
OUTSTR [ASCIZ/
/] ; [371]
MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT.
OPNER2: OUTSTR [ASCIZ /RESET MAXIMUM RECORD SIZE /] ;[515]
MOVE AC0,AC6 ;[515] GIVE HIM RESET VALUE
PUSHJ PP,PUTDEC ;[515] TYPE IT
OUTSTR [ASCIZ / DIFFERS FROM OPEN MAXIMUM SIZE /] ;[515]
MOVE AC0,RECBYT(I12) ;[515] GET OPEN VALUE
PUSHJ PP,PUTDEC ;[515] TYPE IT
JRST OPNERX ;[515] FINISH UP AND GET OUT
OPNER4: OUTSTR [ASCIZ /ENTRIES PER INDEX BLOCK AT OPEN /]
PUSHJ PP,PUTDEC ;[515] TYPE OPEN VALUE
OUTSTR [ASCIZ / DIFFERS FROM RESET VALUE /]
MOVE AC0,OEPIB(I12) ;[515] GET RESET VALUE
PUSHJ PP,PUTDEC ;[515] TYPE VALUE
JRST OPNERX ;[515] AND GET OUT
;IOWRD(I12) - SET DATA BLOCK IOWD POINTER
OPNI05: MOVN AC5,AC10 ;
HRL AC2,AC5 ;
SKIPN IOWRD(I12) ;SKIP IF ALREADY SETUP BY PREVIOUS OPEN
MOVEM AC2,IOWRD(I12) ;DATA BLOCK
ADDI AC2,1(AC10) ;AC2 POINT AT NEXT FREE AREA
;IBLEN - LEN OF INDEX BLOCK FOR BINARY SEARCH
MOVE AC0,EPIB(I12) ;
CAMLE AC0,OEPIB(I12) ;[535] [515] IS IT THE SAME AS RESET?
JRST OPNER4 ;[515] NO TROUBLE
IMUL AC0,IESIZ(I12) ;NO. OF WRDS IN IDX BLK
MOVEM AC0,IBLEN(I12) ;IDX BLK LEN
;SINC - SEARCH INCREMENT FOR BINARY SEARCH
MOVE AC1,IESIZ(I12) ;THE INCREMENT TO BE
IMULI AC1,2 ;
CAMG AC1,AC0 ;INC GT INDEX LENGTH?
JRST .-2 ;NO
MOVEM AC1,SINC(I12) ;SAVE THE SEARCH INCREMENT
;DAKBP - BYTE POINTER TO DATA ADJUSTED KEY
MOVE AC1,DBPRK(I12) ;START WITH RELATIVE DATA KEY BP
HRRI AC1,(AC2) ;
MOVEM AC1,DAKBP(I12) ;DATA ADJUSTED KEY BYTE POINTER
SETZM (AC1) ;ZERO THE FIRST DATA REC-KEY WRD
ADDI AC1,1 ;
MOVEM AC1,DAKBP1(I12) ;POINTER TO SECOND REC-KEY WRD
ADD AC1,IESIZ(I12) ;KEY SIZE PLUS 2 WRD HDR
SUBI AC1,2 ;PERMIT 1 EXTRA WRD FOR WRAP-AROUND
SETZM -1(AC1) ;ZERO LAST DATA REC-KEY WRD
;RESERVE AREA FOR INDEX ENTRY
ADDI AC1,2 ;LOC FOR BLOCK # AND VERSION #
IFN ISTKS,<
MOVE AC0,[INSSSS(LVL)]
ADD AC0,I12
MOVEM AC0,INSSS0(I12)
MOVE AC0,[OUTSSS(LVL)]
ADD AC0,I12
MOVEM AC0,OUTSS0(I12)
>
;IAKBP - BYTE POINTER TO INDEX ADJUSTED KEY
TLZ AC1,770000 ;
TLO AC1,440000 ;
MOVEM AC1,IAKBP(I12) ;INDEX ADJUSTED KEY BP
ADDI AC1,1 ;
MOVEM AC1,IAKBP1(I12) ;POINTER TO SECOND IDX-KEY WRD
ADD AC1,IESIZ(I12) ;
SUBI AC1,2 ;
SETZM -1(AC1) ;ZERO LAST IDX-KEY WRD
;AC1 POINTS TO NEXT FREE AREA
HRLI AC1,-1(AC1) ;UNTIL
HRRI AC1,ICHAN(I12) ;UNTIL,,FROM
SKIPN CORE0(I12) ; SKIP IF NOT THE FIRST OPEN
MOVEM AC1,CORE0(I12) ;CLOSE CLEARS THIS CORE AREA
;AUXIOW - SETUP THE IOWD
MOVN AC0,MXBUF ;MAX BUFFER SIZE
HRL AC0,AC0 ;
HRR AC0,AUXBUF ;
SUBI AC0,1 ;LOC-1
MOVEM AC0,AUXIOW ;SAVE IT
;KWCNT - NUMBER OF WORDS IN THE KEY
MOVE AC1,IESIZ(I12) ;SETUP KWCNT
SUBI AC1,2 ;
;HRRM AC1,IKWCNT(I12) ;
;HRRM AC1,DKWCNT(I12) ;
MOVNS AC1 ;
HRLM AC1,IKWCNT(I12) ;-CNT,,CNT
;FWMASK, LWMASK - CREATE 2 MASK WORDS FOR FIRST AND LAST DATA-KEY WORDS
LDB AC0,KY.TYP ; GET KEY TYPE
JUMPN AC0,OPNBPS ; JUMP IF NOT NON-NUMERIC DISPLAY
LDB AC1,KY.SIZ ; GET KEY SIZE
MOVN AC2,AC1 ;
HRLZS AC2 ;
MOVE AC3,DBPRK(I12) ;RELATIVE DATA-RECORD-KEY POINTER
OPNMSK: IBP AC3
AOBJN AC2,.+1
TLNE AC3,760000 ;STAY WITH IN THE FIRST WORD
JUMPL AC2,OPNMSK ;UNLESS WE RUN OUT OF BYTES
LDB AC4,[POINT 6,DBPRK(I12),5]
SETZ AC5, ;
SETO AC6, ;
LSHC AC5,(AC4) ;
MOVEM AC5,FWMASK(I12) ;007777 FIRST WORD MASK
TLNN AC3,760000 ;
JRST OPNMS1 ;
LDB AC4,[POINT 6,AC3,5] ;THE KEY IS LESS THAN ONE WORD
MOVNS AC4 ;
LSH AC5,(AC4) ;
MOVNS AC4 ;
LSH AC5,(AC4) ;
JRST .+2 ;007700 AC5 HAS MASK
OPNMS1: JUMPL AC2,OPNMS2 ;IS KEY GREATER THAN ONE WRD?
SETZM FWMASK(I12) ;NO, ONE WRD OR LESS
MOVEM AC5,LWMASK(I12) ;
JRST OPNBPS ;DONE
OPNMS2: LDB AC4,KY.MOD ; GET MODE OF KEY
HRRZ AC4,RBPTB1(AC4) ; GET BYTES PER WORD
HLRES AC2 ;
MOVMS AC2 ;MAKE IT POSITIVE
IDIV AC2,AC4 ;
SKIPN AC3 ;REMAINDER?
SKIPA AC3,AC4 ;NO--BYTES PER WORD
ADDI AC2,1 ;YES
LDB AC4,[POINT 6,DBPRK(I12),11]; GET BITS PER BYTE
MOVNS AC2 ;
HRLM AC2,DKWCNT(I12) ;NUMBER OF REC-WRDS -1 THAT CONTAIN THE KEY
IMUL AC3,AC4 ;
SETO AC6, ;
SETZ AC5, ;
MOVNS AC3
ROTC AC5,(AC3) ;
MOVEM AC5,LWMASK(I12) ;MASK FOR THE LAST REC-DATA-KEY WRD
;BPSB - NUMBER OF BITS PER SAT BLOCK
OPNBPS: MOVE AC0,FILSIZ(I12) ;TOTAL NUMBER OF DATA BLOCKS IN FILE
IDIV AC0,SBTOT(I12) ; WILL GIVE NUMBER PER SAT BLOCK
MOVEM AC0,BPSB(I12) ;SAVIT
;ICMP, DCMP - SETUP DISPATCH ADR FOR COMPARE ROUTINES
;0 = DCDNN, 1 = DC1S/U, 2 = DC2S/U
OPNDSP: LDB AC2,KY.TYP ; GET KEY TYPE
JUMPE AC2,OPNDS1 ; ZERO STAYS A ZERO
TRNE AC2,1 ;
TRZA AC2,-2 ; ODD BECOMES 1
HRRZI AC2,2 ; EVEN BECOMES 2
OPNDS1: HRRZ AC0,KEYDES(I12) ; GET KEY SIGN
TRNE AC0,100000 ;
SKIPA AC3,ICTAB(AC2) ;UNSIGNED
MOVS AC3,ICTAB(AC2) ;SIGNED
HRRZM AC3,ICMP(I12) ;INDEX COMPARE ROUTINE
TRNE AC0,100000 ;
SKIPA AC3,DCTAB(AC2) ;
MOVS AC3,DCTAB(AC2) ;
HRRZM AC3,DCMP(I12) ;DATA COMPARE ROUTINE
LDB AC5,KY.TYP ; GET KEY TYPE
CAIGE AC5,3 ; 0 THRU 8
JUMPN AC5,OPNDS2 ; 0, 1, 2
CAIGE AC5,7 ; 0, 3, 4, 5, 6, 7, 8
JRST OPNRSB ; 0, 3, 4, 5, 6
;HERE IF NUMERIC DISPLAY OR COMP-3
;SETUP CONVERT TO BINARY ROUTINES
OPNDS2: HLLZ AC1,F.WBRK(I16) ;POSITION IN DATA-REC
TRNE AC0,100000 ;
TLZA AC1,4000 ;UNSIGNED
TLO AC1,4000 ;SIGNED ???
LDB AC2,KY.SIZ ; GET KEY SIZE
DPB AC2,[POINT 11,AC1,17] ;
MOVEM AC1,GDPRK(I12) ;GD PARAMETER FOR REC-KEY
HRR AC1,F.WBSK(I16) ;ADR OF SYMKEY
TLZ AC1,770000 ;MASK
HLLZ AC2,F.WBSK(I16) ;
TLZ AC2,7777 ;
IOR AC1,AC2 ;SYM-KEY BYTE RESIDUE
MOVEM AC1,GDPSK(I12) ;GD PARAMETER FOR SYM-KEY
LDB AC2,[POINT 2,FLG,14] ; GET KEY MODE
HRRZ AC1,GDTBL(AC2) ; GET CONVERSION ROUTINE
CAIL AC5,7 ; IF COMP-3
HRRZI AC1,GC3. ; USE THIS ROUTINE
MOVEM AC1,GDX.I(I12) ; SYM-KEY VS INDEX ENTRY
LDB AC2,KY.MOD ; GET KEY MODE
HLRZ AC1,GDTBL(AC2) ; GET CONVERSION ROUTINE
CAIL AC5,7 ; IF COMP-3
HRRZI AC1,GC3. ; USE THIS ROUTINE
MOVEM AC1,GDX.D(I12) ; SYM-KEY VS DATA FILE KEY
;DCMP,DCMP1 - SETUP TO CONVERT THEN COMPARE
HRRZM AC3,DCMP1(I12) ;COMPARE ROUTINE
HRRZI AC3,DGD67 ;CONVERSION ROUTINE
MOVEM AC3,DCMP(I12) ;CONVERT THEN COMPARE
;RSBP - BR TO SIXBIT/ASCII RECORD SIZE
OPNRSB: MOVE AC1,[POINT 12,-1(AC4),35]
TLNN FLG,DDMSIX!DDMEBC;
MOVE AC1,[POINT 12,-1(AC4),34]
MOVEM AC1,RSBP(I12)
SUBI AC1,-1
MOVEM AC1,RSBP1(I12)
;GETSET - SETUP KEY FOR SEARCH ROUTINES
OPNGST: LDB AC1,KY.TYP ; GET KEY TYPE
JUMPN AC1,.+2 ;
MOVEI AC2,ADJKEY ;DNN
CAIE AC1,1 ;
CAIN AC1,2 ;
MOVEI AC2,GD67 ;DN
CAIL AC1,3 ;
MOVEI AC2,FPORFP ;FP
CAIE AC1,7 ; COMP-3?
CAIN AC1,10 ; ?
MOVEI AC2,GD67 ; YES
MOVEM AC2,GETSET(I12) ;DISPATCH FOR SEARCH INITIALIZING
;RECBP - SETUP REC AREA BYTE-POINTER
LDB AC2,[POINT 2,FLG,14]; GET MODE OF RECORD AREA
HLL AC2,RBPTB1(AC2) ; GET A BYTE-PTR
HRR AC2,FLG ;ADR OF REC
MOVEM AC2,RECBP(I12) ;
;NOW CLEAR SOME IDX BUFFER AREAS
MOVEI AC6,IOWRD+2(I12); START WITH SECOND IDX LEVEL
OPNZBF: SKIPN AC2,(AC6) ; GET THE IOWRD TO AC2
JRST OPNZB1 ; THERE IS NONE FOR THIS LEVEL
HRLI AC1,1(AC2) ; THE "FROM" ADDR
HRRI AC1,2(AC2) ; THE "TO" ADDR
SETZM -1(AC1) ; ZERO FIRST WORD
HLRO AC2,AC2 ; GET THE LENGTH
HRRZI AC3,-2(AC1) ; GET "FROM"-1
SUB AC3,AC2 ; GET "UNTIL" ADDR
BLT AC1,(AC3) ; SMEAR THE ZERO
OPNZB1: CAIE AC6,IOWRD+13(I12);SKIP WHEN DONE
AOJA AC6,OPNZBF ; ELSE LOOP
JRST OPNCH2 ;
OPNIR0: MOVEI AC0,^D30 ;PERMANENT ERROR
MOVEM AC0,FS.FS ;LOAD FILE-STATUS
MOVE AC0,[E.FIDX+^D7] ;ERROR NUMBER
PUSHJ PP,IGCVR ;IGNORE ERROR?
JRST RCHAN ;YES - RELEASE IO CHANNELS
OUTSTR [ASCIZ /CANNOT EXPAND CORE WHILE SORT IS IN PROGRESS/]
JRST OMTA99
OPNIR1: MOVEI AC0,^D30 ;PERMANENT ERROR
MOVEM AC0,FS.FS ;LOAD FILE-STATUS
MOVE AC0,[E.FIDX+^D8] ;ERROR NUMBER
PUSHJ PP,IGCVR ;IGNORE ERROR?
JRST RCHAN ;YES - RELEASE IO CHANS
PUSHJ PP,GETSP9 ;CORE UUO FAILED
JRST OMTA99
;DISPATCH FOR INDEX COMPARE ROUTINES
ICTAB: XWD ICDNN, 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
JUMPE AC5,.+2 ; SKIP IF 0 BLK-FACTOR
TXNN AC13,DV.MTA ; SKIP IF MTA
POPJ PP, ; ELSE CONTINUE
CAIGE AC10,MINMTA ; SKIP IF LOG BLK NOT TOO SMALL
MOVEI AC10,MINMTA ; ELSE USE MINIMUM MTA SIZE
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 ;[372] INDEX FILE?
JRST OPNWP5 ;[372] YES USE DIFFERENT CALC
>
TLNE FLG,RANFIL ; SKIP IF NOT DUMP MODE RANDOM IO
TLNN FLG,DDMASC!DDMEBC ; SKIP IF ASCII OR EBCDIC FILE
JRST OPWP6A ; ELSE GO ON
; EBCDIC AND ASCII RAN/IO RECS ARE WORD BLOCKED
ADDI AC10,-1(AC6) ; ROUND UP
IDIVI AC10,(AC6) ; GET WRDS PER REC
HRRZM AC10,D.WPR(I16) ; SAVE WRDS-PER-RECORD
IMUL AC10,AC5 ; GET WRDS PER BLOCK
MOVEM AC10,AC6 ; SETUP AC6
JRST OPNWP8 ; NOW GO ON
OPWP6A: IMUL AC10,AC5 ;[372] NO. OF CHARS IN LOGIGAL BLOCK
PUSH PP,AC10 ; SAVE CPL
ADDI AC10,-1(AC6) ;[372] ROUND UP
IDIVI AC10,(AC6) ;[372] NO. OF WORDS PER LOGICAL BLOCK
POP PP,AC6 ; RESTORE CHARS-PER-LOGI-BLK
OPNWP8: 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 ;[431] VAR-LEN EBCDIC FILE?
ADDI AC10,1 ; YES - ADD 1 FOR BDW
JUMPE AC5,.+2 ; SKIP IF 0 BLK-FACTOR
TXNN AC13,DV.MTA ; SKIP IF MTA
POPJ PP, ; ELSE CONTINUE
CAIGE AC10,MINMTA ; SKIP IF LOG BLK NOT TOO SMALL
MOVEI AC10,MINMTA ; ELSE USE MINIMUM MTA SIZE
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
TXNN AC13,DV.MTA ; 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, ;[431] ERROR RET - ASSUME ITS OK (IE 9TRK)
TRNE AC1,MT.7TR ; 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,(TRN) ; 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,(TRN) ; NO CONVERSION
MOVEM AC3,D.WCNV(I16) ; SAVE FOR LATER - WRITE
MOVEI AC0,DSKBSZ ;DSK BUFFER SIZE
TLNE FLG,OPNIO!RANFIL!IDXFIL ;SKIP IF NOT RANDOM OR IO
JRST OPNBP3 ;
TXNN AC13,DV.MTA ;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: TXNE AC13,DV.MTA ;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: TXNN AC16,V%OPEN ;OPEN UUO SKIPS
JRST OPNLO1 ;
MOVEI AC0,' 01' ;SIXBIT REEL NUMBER '01'
TXNN AC16,CLS%B8 ;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
TXNN AC13,DV.DIR ;SKIP IF DIRECTORY DEVICE
JRST OPNRLB ;READ LABEL INTO RECORD AREA
SKIPE F.WSMU(I16) ; SIMULTANEOUS UPDATE?
JRST OPNLU2 ;[565] YES
IFN ANS74,<
TLNN FLG,OPNIN!IDXFIL; SKIP IF ISAM OR INPUT FILE
PUSHJ PP,OPNENT ; SUPERSEDE THE EXISTING FILE
>
;IFN TOPS20,< ;[570]
; TLNE FLG,OPNIO!OPNOUT ;[570] OPEN READ ONLY?
; JRST ONCLPA ;[570] NO, DO LOOKUP
; LDB AC1,DTIBS. ;[570] GET I-O BYTE SIZE
; PUSH PP,AC1 ;[570] SAVE IT
; ;[570] THIS IS NECESSARY BECAUSE
;*** IF THIS IS EVER USED AGAIN,THE INPUT BUFFER CONTROL
;*** BLOCK (D.IBH,D.IBB,D.IBC) MUST BE SAVED HERE
;*** AND LATER RESTORED.
; ;[570] THE COMPT. UUO CRUNCHES IT
; PUSHJ PP,OCPTNW ;[570] YES, OPEN IN THAWED MODE
; JRST [POP PP,(PP) ;[570] GET RID OF BYTE SIZE
; JRST OCPER] ;[570] ERROR IN THAWED OPEN
; POP PP,AC1 ;[570] GET I-O BYTE SIZE
; DPB AC1,DTIBS. ;[570] RESTORE INPUT BYTE SIZE
; DPB AC1,DTOBS. ;[570] RESTORE OUTPUT BYTE SIZE
; JRST OPNLU2 ;[570] CONT WITHOUT LOOKUP
;ONCLPA: >;[570] END IFN TOPS20
XCT ULKUP. ;*** LOOKUP ***************
JRST OPNLER ;ERROR RETURN FOR LOOKUP AND COMP.
OPNLU1: TLNE FLG,OPNIO!RANFIL ;[475] IF DUMP MODE I-O
PUSHJ PP,OPNEL1 ;[565] CALC D.LBN
;IF METERING STORE SIZE OF FILE RETURNED BY LOOKUP
IFN LSTATS,<
TLNE FLG,OPNIO!OPNOUT ; OPEN READ ONLY?
JRST OPNLU3 ; NO, GO ON
LDB AC1,DTCN. ; YES,GET CHANNEL NUMBER
MOVE AC1,MROPTT(AC1) ; GET FILE BLOCK ADDRESS
HLRE AC2,ULBLK.+LKPSIZ ; GET FILE SIZE RETURNED BY LOOKUP
MOVEM AC2,MB.FSZ(AC1) ; SAVE LOOKUP TIME FILE SIZE
>;END IFN LSTATS
JRST OPNLU3 ;[565] AND-OR CONT
OPNLU2: LDB AC0,F.QOPN ;[565] GET SMU OPEN FLAG
JUMPN AC0,OPNLU3 ;[565] JUMP IF OPEN AFTER LFENQ. OPEN
PUSHJ PP,OPNEL2 ;[565] NO SMU OR SMU WITH LFENQ. OPEN,
;[565] SET D.LBN
OPNLU3: ;[565]
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
IFN BIS,<
DMOVE AC0,ULBLK. ;FILE NAME & EXTENSION
>
IFE BIS,<
MOVE AC0,ULBLK. ;FILE NAME
MOVE AC1,ULBLK.+1 ;EXTENSION
>
IFE TOPS20,<
TXNE AC13,DV.DTA ;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,'HDR' ;LABEL TYPE
IORI AC1,'1 '
MOVEM AC1,STDLB. ;
LDB AC4,[POINT 12,ULBLK.+2,35] ;GET LOW ORDER CREA DATE
LDB AC1,[POINT 3,ULBLK.+1,20] ;[274] GET HIGH ORDER
DPB AC1,[POINT 3,AC4,23] ;[274] MERGE THE ORDERS
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
; [576] ALL OF THIS OPNEL1 ROUTINE TAKEN OUT
;IFE TOPS20,< ;[565] ELIMINATE EXTENDED LOOKUP FOR TOPS20
;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
;
;
;>;[565] END IFE TOPS20
;
;IFN TOPS20,< ;[565]
OPNEL1: HLRE AC5,ULBLK.+LKPSIZ ;[565] GET FILE SIZE RETURNED
;IF METERING STORE SIZE OF FILE RETURNED BY LOOKUP
IFN LSTATS,<
LDB AC1,DTCN. ;GET CHANNEL NUMBER
MOVE AC1,MROPTT(AC1) ;GET FILE BLOCK ADDRESS
MOVEM AC5,MB.FSZ(AC1) ;PUT SIZE INTO FILE BLOCK BUCKET
>;END IFN LSTATS
JUMPGE AC5,OPNEL4 ;[565] SKIP AHEAD IF LOOKUP RETURNS BLKS
MOVNS AC5 ;[565] NEGATE LOOKUP NUMBER OF WRDS
ADDI AC5,177 ;[565] DIVIDE WORDS WRITTEN BY
IDIVI AC5,200 ;[565] WRDS/BLK AND ROUND UP
JRST OPNEL4 ;[565] CONT CALC.
;>;END IFN TOPS20 ;[576] [565]
OPNEL2: MOVE AC5,ARGBK.+.RBSIZ ; GET LAST BLOCK OF FILE
;IF METERING STORE SIZE OF FILE RETURNED BY EXTENDED LOOKUP
IFN LSTATS,<
LDB AC1,DTCN. ;GET CHANNEL NUMBER
MOVE AC1,MROPTT(AC1) ;GET FILE BLOCK ADDRESS
MOVNM AC5,MB.FSZ(AC1) ;PUT SIZE INTO FILE BLOCK BUCKET
;MAKE NEGATIVE TO SHOW ITS WORDS
>;END IFN LSTATS
ADDI AC5,177 ; DIVIDE WORDS WRITTEN BY
IDIVI AC5,200 ; WRDS/BLK AND ROUND UP
OPNEL4: MOVE AC6,D.BPL(I16) ;[565] GET NUMBER OF FIRST
;***;[475] ADDI AC5,-1(AC6) ; SECTOR OF THE LAST
IDIV AC5,AC6 ; LOGICAL BLOCK
IMUL AC5,D.BPL(I16) ;[475] SIZE IN PHYSICAL BLOCKS
SKIPE AC6 ;[475] IF REMAINDER WE HAVE
AOJA AC5,OPNL2A ;[475] PART LAST BLOCK
MOVE AC6,D.BPL(I16) ;[475] LAST BLOCK FULL
SUBI AC6,1 ;[475] CALC FIRST PHYSICAL BLOCK
SUB AC5,AC6 ;[475] OF LAST LOGICAL BLOCK
SKIPG AC5 ;[475] IF FILE DOESN'T EXIST
MOVEI AC5,1 ; ONE IS THE FIRST BLOCK
OPNL2A: 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
PUSHJ PP,OPNENT ;YES, SO MAKE A NULL FILE
JRST OPNLUP ;OK TRY THE LOOKUP AGAIN
;HERE TO CREATE A NULL FILE FOR USER
OPNENT: PUSHJ PP,OPNEID ;SETUP FOR AN ENTER
XCT UENTR. ;CREATE A NULL FILE
JRST OEERR ;ERROR RETURN
XCT UCLOS.
POPJ PP,
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
LDB AC0,DTCN. ;[576] GET CHANNEL NUMBER
OPNFP2: HRRZ AC5,F.RPPN(I16) ;[576] GET POINTER TO PPN
SKIPE AC5 ;[576] USE DEFAULT PPN IF NONE
MOVE AC5,(AC5) ;[576] GET THE PPN
MOVEM AC5,ARGBK.##+.RBPPN ;[576]
MOVE AC5,[ULBLK.,,ARGBK.+.RBNAM];[576] GET FILE NAME
BLT AC5,ARGBK.+.RBEXT ;[576] AND EXTENSION
HLLZS ARGBK.+.RBEXT ;[576] ZERO DATE FIELD
SETZM ARGBK.+.RBPRV ;[576] AND PRIVILIGE FIELD
SETZM ARGBK.+.RBSIZ ;[576] AND SIZE FIELD
;[576] TLNN FLG,OPNIO ;[576] IF EXTENDED LOOKUP MUST BE DONE
;[576] JRST OPNFP1 ;[576] NO
;[576] XCT UOPEN. ;[576] DO IT BEFORE THE FILOP. UUO
;[576] JRST OERRIF ;[576] SO WE DONT GET
;[576] PUSHJ PP,OPNEL1 ;[576] [457] ILLEGAL SEQUENCE OF UUO'S ERROR
HRLI AC0,.FORED ;[576] DO EXTENDED LOOKUP TO SEE IF THERE
IFE TOPS20,<
TXNE AC16,OPN%EX ; OR OPEN EXTENDED
HRLI AC0,.FOAPP ; APPEND
>
MOVSM AC0,FOP.BK ; SAVE IN FILOP BLOCK
MOVE AC0,UOBLK.+1 ; GET DEVICE NAME
MOVEM AC0,FOP.DN ;
MOVEI AC0,ARGBK. ;[576] GET ADR OF LOOKUP BLOCK
MOVEM AC0,FOP.LB ;
IFE TOPS20,<
TXNE AC16,OPN%EX ; IF APPEND
JRST RET.2 ; DELAY UNTIL BUFFERS SET UP
>
MOVE AC1,[7,,FOP.BK] ; SET UP FILOP'S AC
FILOP. AC1, ;[576] DO THE LOOKUP
JRST [SKIPN AC1 ;[576]SKIP IF ERROR CODE NON-0
TLNE FLG,IDXFIL ;[576]FILE NOT FOUND,SKIP IF NOT ISAM
POPJ PP, ;[576] GIVE ERROR RETURN
MOVE AC1,[7,,FOP.BK] ;[576]RESTORE FILOP ARG
JRST .+1 ] ;[576]NON ISAM FILE NOT FOUND,WILL CREATE ONE
IFN ISAM,<TLZ FLG1,FOPIDX> ;[576] CLEAR FLAG
MOVEI AC0,.FOMAU ;[576] NOW SET FOR
HRRM AC0,FOP.BK ;[576] SIMULTANEOUS UPDATE
FILOP. AC1, ;[576] DO IT *************
POPJ PP, ;[576] ERROR RETURN
JRST RET.2 ;[576] ALL OK,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
> ; [431] END IFE TOPS20
JRST LUPERR ; NO
IFN TOPS20,<
EXTERN CP.BLK,CP.BK1,CP.BK2,CP.BK3,CP.BK4,CP.BK5,CP.BK6,CP.BK7,FID.PT
EXTERN FID.BK,TMP.BK,TMP.PT
E.MCPT==^D8000000 ; [431] MONITOR COMPT. UUO ERROR
; [431]HERE IF THIS IS A DECSYSTEM-20 TO OPEN FILE FOR SIMULTANEOUS UPDATING
; [431]INIT THE CMPT. JSYS ARG BLOCK
OCPT: TLNN FLG,IDXFIL ; [431] ISAM FILE?
JRST OCPTD ; [431] NO
PUSHJ PP,OPNLIX ; [431] YES, GET VID TO LOOKUP BLOCK
TLOA FLG1,FOPIDX ; [431] AN IDX FILE
OCPTD: ; [431]ENTRY POINT FOR ISAM.IDA FILES
PUSHJ PP,OPNLID ; [431] NO, GET VID...
OCPTNW: ;[570] ENTRY POINT FOR THAWED ACCESS FOR READ ONLY
SETZM CP.BK1 ; [431] AC1 GTJFN BITS
;BUILD A TOPS20 FILE-DESCRIPTOR STRING - AC2 GTJFN BITS
;FIRST JUST MOVE THE DEVICE NAME
HRLI AC1,FID.BK ; CLEAR ALL STUFF
HRRI AC1,FID.BK
ADDI AC1,1
SETZM FID.BK
BLT AC1,FID.BK+14
HRLI AC1,TMP.BK
HRRI AC1,TMP.BK
ADDI AC1,1
SETZM TMP.BK
BLT AC1,TMP.BK+14
MOVE AC5,TMP.PT ; GET POINTER TO TEMP FILE-DESCRIPTOR
MOVEM AC5,CP.BK2 ; INIT COMPT. ARG BLOCK
MOVE AC0,UOBLK.+1 ; GET THE DEVICE NAME
MOVEM AC0,CP.BK3 ; SET UP FOR COMPT. FUNCT 3--MAYBE
;CONVERT PPN TO <DIRECTORY>
HRRZ AC1,F.RPPN(I16) ; GET ADR OF PPN
JUMPE AC1,OCPT4 ; JUMP IF YOU HAVN'T GOT ONE
SKIPN @AC1 ; [463] SKIP IF YOU REALLY GOT ONE
JRST OCPT4 ; [463] PPN PROVIDED WAS [0,0]
MOVE AC1,(AC1) ; GET PPN FROM ADR
MOVEM AC1,CP.BK1 ; PPN TO THE ARG-BLOCK
MOVEI AC0,3 ; FUNCTION 3
MOVEM AC0,CP.BLK ;
MOVE AC0,[4,,CP.BLK] ; SETUP FOR COMPT.
COMPT. AC0, ; MOVE DIR # TO STRING
POPJ PP, ;
;SETUP THE CP.BK? ARGUMENT BLOCK FOR COMPT. UUO
OCPT4: MOVE AC5,TMP.PT ; GET STRING PTR BACK
MOVEI AC1,7 ; CHECK FOR STR RETURNED
OCPT1: ILDB C,AC5 ; VER 1B RETURNED ONLY THE DIRECTORY
; VER 2 RETURNS STR:<DIR>
JUMPE C,OCPT1X ; NO COMPT. DONE, GET DEV NAME
CAIN C,":" ; IT IS ALSO POSSIBLE THAT WHEN
JRST OCPT2A ; HERE WE DID NOTHING AND NOW
SOJG AC1,OCPT1 ; NEED TO INSERT DEVICE NAME FOR OPENF.
OCPT1X: MOVE AC0,[POINT 6,UOBLK.+1] ; WE DIDN'T DO COMPT. OR IT WAS A VER 1B
MOVEI AC1,6 ; SO WE MUST NOW PUT IN STR:
MOVE AC5,FID.PT ; GET REAL STRING PTR
OCPT1A: ILDB C,AC0
JUMPE C,OCPT2 ; GO SEE IF <DIRECTORY> IS NEEDED
ADDI C,40 ; PA1050 WANTS IT IN ASCII
IDPB C,AC5
SOJG AC1,OCPT1A
OCPT2: MOVEI C,":"
IDPB C,AC5
HRRZ AC1,F.RPPN(I16) ; DID USER SUPPLY A PPN?
JUMPE AC1,OCPTV2 ; NO, WE'RE FINALLY DONE
SKIPN @AC1 ; HE GAVE ONE, BUT IS IT REALLY 0
JRST OCPTV2 ; IT WAS 0, SO WE'RE DONE
MOVEI C,"<" ; MOVE IT FROM TEMP STRING TO
IDPB C,AC5 ; REAL STRING
MOVE AC0,TMP.PT
OCPT1B: ILDB C,AC0
JUMPE C,OCPT1C
IDPB C,AC5
JRST OCPT1B
OCPT1C: MOVEI C,">"
IDPB C,AC5
JRST OCPTV2 ; WE NOW HAVE A COMPLETE STRING OF THE FORM
; STR:<DIRECTORY>
OCPT2A: MOVE AC5,FID.PT ; VER 2 SUPPLIED THE <DIR>
MOVE AC1,TMP.PT ; SO WE NEED TO MOVE IT TO THE
MOVEI AC0,^D90 ; REAL STRING AREA AND GET AC5 CORRECT
OCPT2B: ILDB C,AC1 ; MOVE FROM TMP.BK TO FID.BK
JUMPE C,OCPTV2
IDPB C,AC5
SOJG AC0,OCPT2B
OCPTV2:
MOVX AC0,GJ%OLD+GJ%SHT ; SPECIFY THE SHORT FORM OF
MOVEM AC0,CP.BK1 ; [431] OPENF. JSYS
MOVE AC0,FID.PT ; [431] GET POINTER TO FILE DESCRIPTOR STRING
MOVEM AC0,CP.BK2 ; [431] FOR OPENF. ARGUMENT
; [431]MOVE VALUE OF ID TO F-D STRING
TLNE FLG,IDXFIL ; [431] SKIP IF NOT ISAM FILE
TLNE FLG1,FOPIDX ; [431] SKIP IF ISAM .IDA FILE
SKIPA AC4,F.WVID(I16) ; [431] BYTE-PTR TO VALUE OF ID
MOVE AC4,[POINT 6,DFILNM(I12)]; [431] .IDA - SO VALUE-ID IS HERE
MOVEI AC0,11 ; [431] MAX OF 11 CHARS
OCPT5: ILDB C,AC4 ; [431] GET A CHAR
TLNN AC4,600 ; [431] IS VID IN EBCDIC?
LDB C,PTR.96##(C) ; [431] YES - CONVERT IT
TLNN AC4,100 ; [431] HOW BOUT SIXBIT?
ADDI C,40 ; [431] YES
CAIE C," " ; [431] SPACES ARE IGNORED IN FILENAME
IDPB C,AC5 ; [431] STUFF IT AWAY
CAIE AC0,4 ; [431] IS IT TIME FOR A "."?
SOJN AC0,OCPT5 ; [431] NO - LOOP TILL DONE
JUMPE AC0,OCPT6 ; [431] JUMP IF DONE
MOVEI C,"." ; [431] TERMINATE THE FILENAME
IDPB C,AC5 ; [431]
SOJN OCPT5 ; [431] BACK FOR THE EXTENSION
OCPT6: SETZB C,AC0 ; [431] A NULL
IDPB C,AC5 ; [431] TERMINATE THE STRING
; [431]INIT AC2 OPENF BITS
TLNE FLG,DDMASC ; [431] DEVICE DATA MODE ASCII?
TLO AC0,(7B5) ; [431] YES
TLNE FLG,DDMSIX ; [431] SIXBIT?
TLO AC0,(6B5) ; [431] YES
TLNE FLG,DDMBIN ; [431] BINARY?
TLO AC0,(44B5) ; [431] YES
TLNN FLG,DDMEBC ; [431] EBCDIC?
JRST OCPT10 ; [431] NO
TLO AC0,(10B5) ; [431] ASSUME DEVICE IS A MAG-TAPE
TXNN AC13,DV.MTA ; [431] DEVICE A MTA?
TLO AC0,(11B5) ; [431] NO, ITSA DSK
OCPT10: TLNE FLG,OPNIO!RANFIL!IDXFIL ; [431] RANDOM, INDEXED OR IO FILES
TLO AC0,(17B9) ; [431] ARE DUMP MODE
TLNE FLG,OPNIO!RANFIL!IDXFIL!OPNIN; [431] OPEN FOR INPUT?
TRO AC0,OF%RD ; [431] YES
TLNE FLG,OPNOUT ; [431] OPEN FOR OUTPUT?
TRO AC0,OF%WR ; [431] YES
TRO AC0,OF%THW ; [431] THAWED I.E. SIMULTANEOUS UPDATE
MOVEM AC0,CP.BK3 ; [431] INIT AC2 OPENF BITS
; [431]INITIALIZE TO TOPS-10 OPEN MODE
TLNE FLG,DDMASC ; [431] DATA-MODE ASCII?
TDZA AC0,AC0 ; YES
MOVEI AC0,.IOBIN ; [431] NOT ASCII
TLNE FLG,RANFIL!IDXFIL!OPNIO ; [431] THESE FILES ARE NOT BUFFERED
MOVEI AC0,.IODMP ; [431] DUMP MODE
MOVEM AC0,CP.BK4 ; [431] OPEN MODE
; [431]LOCATE THE BUFFER HEADERS AND EXTENDED LOOKUP BLOCK
MOVEI AC0,D.IBH(I16) ; [431]
MOVEM AC0,CP.BK5 ; [431] INPUT BUFFER HEADER
MOVEI AC0,D.OBH(I16) ; [431]
MOVEM AC0,CP.BK6 ; [431] OUTPUT BUFFER HEADER
MOVEI AC0,ARGBK. ; [431]
MOVEM AC0,CP.BK7 ; [431] ADR OF EXTENDED LOOKUP BLOCK
; [431]SET UP EXTENDED LOOKUP BLOCK
HRRZ AC1,F.RPPN(I16) ; [431] GET ADR OF PPN
SKIPE AC1 ; [431] USE DEFAULT PPN IF ZERO
MOVE AC1,(AC1) ; [431] GET PPN
MOVEM AC1,ARGBK.##+.RBPPN ; [431] SETUP PPN
MOVE AC1,[ULBLK.,,ARGBK.+.RBNAM]; [431] COPY FILE-NAME.EXT
BLT AC1,ARGBK.+.RBEXT ; [431] FROM LOOKUP BLOCK
HLLZS ARGBK.+.RBEXT ; [431] CLEAR RIGHT HALF
SETZM ARGBK.+.RBPRV ; [431] AND PRIV
SETZM ARGBK.+.RBSIZ ; [431] AND SIZE
TLNE FLG1,FOPIDX ; [431] IF AN ISAM.IDX FILE GET CHAN #
SKIPA AC1,ICHAN(I12) ; [431] FROM HERE
LDB AC1,DTCN. ; [431] ELSE FROM HERE
HRLI AC1,1 ; [431] THE FUNCTION
MOVSM AC1,CP.BLK ; [431] ARG ,, FUNCTION
MOVE AC1,[10,,CP.BLK] ; [431] COUNT,,ADR FOR ARG-BLOCK
COMPT. AC1, ; [431] OPEN FILE FOR SIMULTANEOUS UPDATE
POPJ PP, ; [431] ERROR RETURN
IFN ISAM,<TLZ FLG1,FOPIDX> ; [431] CLEAR FLAG
JRST RET.2 ; [431] 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] ; [431]
PUSHJ PP,IGCVR ; [431] IGNORE ERROR?
JRST RCHAN ; [431] YES
OCPERR: OUTSTR [ASCIZ /COMPT. UUO /]
JRST JSYSER ;PRINT REST OF MESSAGE
MTOERR: OUTSTR [ASCIZ /MTOPR /]
JRST JSYSER ;PRINT REST OF MESSAGE
CLSERR: OUTSTR [ASCIZ /CLOSF /]
JRST JSYSER ;PRINT REST OF MESSAGE
RLDERR: OUTSTR [ASCIZ /RELD /]
JRST JSYSER ;PRINT REST OF MESSAGE
OJFERR: OUTSTR [ASCIZ /OPENF /]
JRST JSYSER ;PRINT REST OF MESSAGE
STDERR: OUTSTR [ASCIZ /STDEV /]
JSYSER: OUTSTR [ASCIZ/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. ; [431] FATAL ERROR MESSAGE
>; [431]END OF IFN TOPS20
;READ A LABEL FROM A NON DIRECTORY DEVICE. ***OPNBBF***
OPNRLB: TXNN AC13,DV.LPT!DV.TTY!DV.PTR!DV.PTP!DV.CDR ;[575]SKIP IF DEVICE IS ONE OF THESE
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 ;
IFE TOPS20,<
TXNN AC16,OPN%EX ;NOT REQUIRED IF FILOP. DONE
>
TLNN FLG,OPNOUT ;[301] SKIP IF OUTPUT
JRST OPNBB1 ;[301] NOT OUTPUT,SKIP ENTER
IFN TOPS20,< ;[561]
TXNN AC13,DV.MTA ;[561] SKIP IF MTA, ENTER DONE AT OPNC4A
> ;[561]
TXNE AC13,DV.DIR ;[315] DIRECTORY DEVICE?
JRST OPNBB2 ;[315] YES, SKIP ENTER
PUSHJ PP,OPNEID ;[301] SET UP ID FOR ENTER
XCT UENTR. ;[301] DO AN ENTER
JRST OEERR ;[301] ERROR RETURN
OPNBB2: XCT UOUT. ;[315] DUMMY OUTPUT*******************
OPNBB1:
IFN ANS68,< ; ONLY IN ANS68 COBOL
MOVEI AC1,1 ;2 WORD CALL,
PUSHJ PP,USEPRO ;TO GET THE USE PRO. ADDRESS
>;END IFN ANS68
TXNN AC13,DV.LPT!DV.PTR!DV.PTP!DV.TTY ;NO LABELS - NO CHECKS
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:
IFN ANS68,<
MOVEI AC1,2 ;TWO WORD CALL
PUSHJ PP,USEPRO ;TO GET USE PRO. ADR.
>;END IFN ANS68
TLNN FLG,OPNOUT ;OUTPUT SKIPS
JRST OPNDVC
TXNE AC13,DV.DIR ;SKIP IF NOT DIR. DEV.
JRST OPNENR
TXNN AC13,DV.LPT!DV.PTP!DV.PTR!DV.TTY!DV.DIR ;SKIP IF LPT,TTY,PTR,PTP,OR DTA,DSK.
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)
IFE TOPS20,<
TXNN AC16,OPN%EX ; APPEND 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
DEVCHR AC13, ;THE FINAL DEVCHR
TXC AC13,DV.DSK!DV.CDR ;[330] IF A DSK AND A CDR
TXCN AC13,DV.DSK!DV.CDR ;[330] THEN ITS DEVICE 'NUL'
TXZ AC13,DV.MTA!DV.TTY ;[506] SO ITS NOT A MTA OR TTY
OPNDV1: MOVEM AC13,D.DC(I16) ;[330]
MOVEM FLG,F.WFLG(I16) ;UPDATE THE FLAGS
TXNE AC13,DV.TTY ;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
PUSHJ PP,CLRSTS ;[601] CLEAR FILE STATUS WORD
IFN ANS74,<
TLNN FLG,IDXFIL!RANFIL!OPNIO!OPNIN
TLNN FLG,OPNOUT ;TEST FOR SEQ. OUTPUT
JRST OPNDV3 ;NO
SKIPN F.LCP(I16) ;LINAGE STUFF?
JRST OPNDV3 ;NO
HLRZ AC6,F.LAT(I16) ;LINES AT TOP?
JUMPE AC6,OPNDV3 ;ZERO
PUSHJ PP,WRTCR ;THERE ARE SOME
PUSHJ PP,WRTLF
SOJG AC6,.-2 ;LOOP
OPNDV3:>;END IFN ANS74
TXNN AC16,FL%WRC ;RESTORE THE REC-AREA IF A WRITE REEL CHANGE
JRST OPNDVR ;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
OPNDVR:
IFN ANS74,<
TXNE AC16,OPN%RV ;WANT READ BACKWARDS
TXNN AC13,DV.MTA ; AND HAVE A MTA
JRST OPNDVX ;NO, EXIT
XCT MADVF. ;GO TO END OF FILE
XCT MWAIT. ;WAIT FOR COMPLETION
XCT MBSPF. ;BACKSPACE OVER EOF
XCT MWAIT.
MOVSI AC3,2 ;LENGTH,,ADDRESS
MOVEI AC0,.TFSET+.TFRDB ;FUNCTION
MOVE AC1,UOBLK.+1 ;DEVICE NAME
TAPOP. AC3,
JFCL ;CAN NOT HAPPEN
OPNDVX: >
IFN LSTATS,<
LDB AC1,DTCN. ;GET CHAN #
MOVE AC5,AC1 ;SAVE IN AC5
PUSHJ PP,MRDMP ;WRITE OUT ANY EXISTING BUCKETS
MOVE AC0,MROPTT(AC5) ;GET BASE ADDR OF BKT BLK
MOVE AC1,AC0 ;SAVE IN AC1
ADDI AC0,MB.BAS ;ADD OFFSET TO HEADER START
HRLI AC0,-1(AC16) ;AC0= FILTAB-1,,BKT BLK
BLT AC0,MB.FTB(AC1) ;BLT FILTAB BLK TO BUCKET AREA
HRRI AC0,MB.VID(AC1) ;ADDR "VALUE OF ID" IN BKT BLK
HRL AC0,F.WVID(I16) ;ADDR OF "VAL OF ID"
BLT AC0,MB.FG1-1(AC1) ;BLT TO BUCKET BLOCK
HLL AC5,FLG1 ;GET FLG1 FLAGS
MOVEM AC5,MB.FG1(AC1) ;SAVE FLG1 AND CHAN #
HLLM AC16,MB.OCF(AC1) ;SAVE AC16 OPEN FLAG BITS
MOVEI AC1,MB.OTM(AC1) ;GET ADDR OPEN TIME BUCKET
MOVEM AC1,MRTMB. ;SAVE FOR TIMING
SETZM (AC1) ;CLEAR OPEN TIME BUCKET
SKIPE F.WSMU(I16) ;SKIP TIMING STOP IF SMU
JRST OPMRXX ;SMU SKIP
MRTME. (AC1) ;END TIMING
OPMRXX:>;END IFN LSTATS
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
PUSHJ PP,RCAEC ;[542] EBCDIC
MOVS C,CHTAB(C) ; SIXBIT
RCEBC: LDB C,PTR.97## ; EBCDIC TO ASCII
TRN ; EBCDIC
LDB C,PTR.96## ; SIXBIT
RCSIX: ADDI C,40 ; SIXBIT TO ASCII
LDB C,PTR.69## ; EBCDIC
TRN ; SIXBIT
WCTBL: WCASC(AC1) ; ASCII TO ?
RCEBC(AC1) ; EBCDIC TO ?
RCSIX(AC1) ; SIXBIT TO ?
WCASC: TRN ; ASCII TO ASCII
LDB C,PTR.79## ; EBCDIC
MOVS C,CHTAB(C) ; SIXBIT
;[542] FOR ASCII TO EBCDIC WE NEED TO RETURN 1B0 FOR E-O-L CHARACTERS
RCAEC: SKIPGE CHTAB(C) ;[542] CHECK FOR E-O-L CHARACTER
JRST [LDB C,PTR.79 ;[542] YES, GET CONVERSION
TLO C,(1B0) ;[542] SET SIGN BIT
POPJ PP,] ;[542] RETURN
LDB C,PTR.79## ;[542] NORMAL, JUST GET CONVERSION
POPJ PP, ;[542] AND RETURN
;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
OUTSTR [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: OUTSTR [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. ;
OUTSTR [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.
OUTSTR [ASCIZ /THE FILE TABLE DATE DIFFERS FROM THE FILE LABEL DATE/]
JRST KILL
;CHECK THE REEL NUMBER IF THE DEVICE IS A MAGTAPE
OPNCRN: TXNN AC13,DV.MTA ;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. ;
OUTSTR [ASCIZ /
$/]
MOVE AC2,[BYTE(5)10,31,20,2,4,34,14] ;FODC.R#
PUSHJ PP,MSOUT. ;
OUTSTR [ASCIZ/ WAS MOUNTED, PLEASE MOUNT /]
PUSHJ PP,MSDTRN
OUTSTR [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,'1 ' ;FIRST LABEL
MOVEM AC0,STDLB.+1 ;FILE
HLLM AC1,STDLB.+2 ;DESCRIPTOR
TXNE AC16,V%OPEN!CLS%BV
HRLI AC1,'HDR' ;BEGINNING FILE LABEL
TXNE AC16,CLS%EF
HRLI AC1,'EOF' ;END OF FILE LABEL
TXNE AC16,CLS%EV
HRLI AC1,'EOV' ;END OF VOLUME LABEL
MOVEM AC1,STDLB. ;
IFN EBCLBL,<
TLNE FLG,DDMEBC ;EBCDIC?
PUSHJ PP,DAY.SK## ;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
ROT AC2,6 ;
IDIVI AC0,^D10 ;
ADDM AC1,AC2 ;
JUMPN AC0,.-3 ;CONVERTED TO DECIMAL
ADD AC2,['0000'] ;SIXBITIZED
LDB AC1,DTRN. ;DEVTAB MAG-TAPE REEL NUMBER
ROT AC2,14 ;
ROTC AC1,-6 ;
ADDI AC1,'00 ' ;
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,LIBVR.
ROTC AC0,14
ROT AC1,3
ROTC AC0,3
ROT AC1,3
ROTC AC0,3
ADDI AC1,'000'
HRLZM AC1,STDLB.+13 ;PDP10 VER
JRST SLBREC ;MOVE STD-LABEL TO RECORD AREA AND EXIT
OPNMTA: ;SET MAGTAPE DENSITY & PARITY
;POSITION MAGTAPE VIA FILE TABLE FILE POSITION. ***OPNLO***
IFE TOPS20<
; IF PULSAR LABEL PROCESSOR IS UP AND WE'RE NOT BYPASSING
; LABELS THEN LET PULSAR DO THE LABELING. IF BYPASS LABELS
; IS ON THEN LIBOL WILL DO LABELING AS ALWAYS.
SKIPN AUTOLB ; DO WE HAVE AUTO LABEL PROCESSING?
JRST OMTA01 ; NO
HRLZI AC3,2 ; LENGTH ,, ADDRESS
MOVEI AC0,.TFLBL ; FUNCT - LABEL PROCESSING
MOVE AC1,UOBLK.+1 ; SIXBIT /DEVICE NAME/
TAPOP. AC3, ; GET TYPE OF LABEL PROCESSING
JRST OMTA96 ; OOPS - COMPLAIN
CAIN AC3,.TFLBP ; IF BYPASS LABELS
JRST OMTA01 ; LEAVE IT AS IT IS, NOTE DO NOT REMOVE THIS INST
; AS FLG1 MAY NOT BE THE SAME AS D.F1 IF OPEN EXTEND
TLZ FLG1,STNDRD!NONSTD ; THEN LET PULSAR DO LABELS
HLLM FLG1,D.F1(I16) ; SAVE IT FOREVER
> ;END OF IFE TOPS20
OMTA01: TLNN FLG,DDMEBC ; RECORDING MODE EBCDIC?
JRST OMTA10 ; NO
IFE TOPS20,<
TLNE FLG1,NONSTD!STNDRD!MSTNDR; LABELS OMITTED?
>
IFN TOPS20,<
TLNE FLG1,NONSTD!STNDRD ; LABELS OMITTED?
>
JRST OMTA98 ; NO - ERROR
HRRZ AC1,F.WDNM(I16) ;[431] GET THE SIXBIT
MOVE AC1,(AC1) ;[431] DEVICE NAME AND
MTCHR. AC1, ;[431] GET CHARACTERISTICS
SETZ AC1, ;[431] ERROR RET - ASSUME 9TRK
TRNE AC1,MT.7TR ;[431] 9 TRACKS?
JRST OMTA10 ;[431] NO - 7 TRK
HRLZI AC3,3 ;[431] LENGTH ,, ADDR
MOVEI AC0,.TFSET+.TFMOD ;[431] FUNCTION
MOVE AC1,UOBLK.+1 ;[431] DEVICE NAME
MOVEI AC2,.TFM8B ;[431] INDUSTRY-COMPATIBLE MODE
TAPOP. AC3, ;[431] DOIT
JRST OMTA93 ;[431] 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,.TFD16 ; SKIP IF 1600 OR 6250 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
IFN ANS74,<
TXNN AC16,OPN%RV ;READ BACKWARDS REQUIRES TM02/TX01/TX02
>
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
IFN ANS74,<
TXNN AC16,OPN%RV ; READ BACKWARDS?
JRST OMTA22 ; NO
CAIE AC3,.TFKTX ; YES, NEED TX01(TU70/TU71)
CAIN AC3,.TFKTM ; OR TM02(TU16/TU45)
JRST OMTA22 ; OK
CAIE AC3,LTFKD2 ; SKIP IF DX20/TX02 CONTROLLER (OK TOO)
JRST OMTA97 ; NO
OMTA22:>
CAIE AC5,.TFD62 ; SKIP IF 6250 BPI
JRST OMTA25 ; ELSE CONT
CAIE AC3,LTFKD2 ; DX20/TX02 CONTROLLER
JRST OMT92A ; ERROR, WRONG CONTROLLER
IFE TOPS20,<
HRLZI AC3,2 ; LENGTH ,, ADDR
MOVEI AC0,.TFPDN ; FUNCTION
MOVE AC1,UOBLK.+1 ; DEVICE NAME
TAPOP. AC3, ; GET POSSIBLE DENSITIES
JFCL ; CAN'T GET IT, ASSUME OK FOR NOW
TXNN AC3,TF.DN5 ; SKIP IF 6250 ALLOWED
JRST OMT92A ; ELSE, ERROR
>
OMTA25: TRNN AC6,SASCII ; STD-ASCII REQUEST?
JRST OMTA23 ; NO
CAIE AC3,.TFKTX ; TX01 CONTROLLER (TU70/TU71)?
CAIN AC3,.TFKTM ; [431] OR TM02(TU16/TU45)
JRST OMTA24 ; [431] YES
CAIE AC3,LTFKD2 ; SKIP IF DX20/TX02 CONTROLLER (OK TOO)
JRST OMTA91 ; ERROR - WRONG TYPE
;SET STANDARD ASCII MODE
OMTA24: HRLZI AC3,3 ; LENGTH ,, ADDR
MOVEI AC0,.TFSET+.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
CAIGE AC5,.TFD80 ; SKIP IF 800 (OR GTR) BPI
JRST OMTA94 ; IF NOT COMPLAIN
OMTA26: CAIG AC5,.TFD62 ; SKIP IF GTR 6250 BPI
JRST OMTA30 ; ELSE GO SET BPI
JRST OMTA9A ; ERROR, WRONG BPI CODE
OMTA23: CAIGE AC5,.TFD16 ; 1600 OR 6250 BPI?
JRST OPNPMT ; NO
CAIE AC5,.TFD16 ; SKIP IF 1600
JRST OMTA26 ; ELSE GO CHECK CODE
CAIE AC3,.TFKTC ; TC10C - TU43 CONTROLLER?
CAIN AC3,.TFKTX ; TX01 - TU70/71?
JRST OMTA30 ; OK
CAIE AC3,.TFKTM ; [431] TM02 - TU16/45 ?
JRST OMTA92 ; NO COMPLAIN
;SET DENSITY
OMTA30: HRLZI AC3,3 ; LENGTH,,ADR
MOVEI AC0,.TFSET+.TFDEN ; 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,.TFDEN ; 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
OUTSTR [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
OUTSTR [ASCIZ / DENSITY OF 1600 BPI REQUIRES A TU16, TU43, TU45, OR TU70/]
JRST OMTA99 ;
;6250 BPI WANTS A TU72
OMT92A: MOVE AC0,[E.FIDX+^D38]; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE ERROR?
JRST RCHAN ; YES
OUTSTR [ASCIZ / DENSITY OF 6250 BPI REQUIRES A TU72 WITH DX20-TX02 CONTROLLER/]
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
OUTSTR [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
OUTSTR [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
OUTSTR [ASCIZ / CANNOT SET THE REQUESTED DENSITY/]
JRST OMTA99
IFE TOPS20,<
;TAPOP. FAILED, CAN'T GET LABEL TYPE
OMTA96: MOVE AC0,[E.FIDX+^D48];ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE?
JRST RCHAN ; YES
OUTSTR [ASCIZ / TAPOP. FAILED - UNABLE TO GET LABEL TYPE/]
JRST OMTA99
> ;END OF IFE TOPS20
IFN ANS74,<
;HERE IF READ BACKWARDS NOT SUPPORTED ON SPECIFIED MTA
OMTA97: MOVE AC0,[E.FIDX+^D48]; ERROR NUMBER
PUSHJ PP,IGCVR ; IGNORE THE ERROR?
JRST RCHAN ; YES
OUTSTR [ASCIZ " READ BACKWARDS REQUIRES A TX01/TM02/TX02"]
JRST OMTA99
>
;FOR NOW EBCDIC FILES MUST HAVE OMITTED LABELS
OMTA98: OUTSTR [ASCIZ / EBCDIC MTA FILES MUST HAVE OMITTED LABELS /]
OMTA99: MOVE AC2,[BYTE (5) 10,31,20,2]
PUSHJ PP,MSOUT. ;DOESN'T RETURN
OMTA9A: OUTSTR [ASCIZ /?INTERNAL ERROR,MTA DENSITY CODE PAST 6250/]
JRST OMTA99 ; FINISH IT
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.
MOVX AC5,DB.HF ;"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:
IFN TOPS20,<
TXNN AC16,CLS%B8 ;SKIP IF A CLOSE REEL GENERATED OPEN
TLNN FLG1,MTNOLB ;SKIP IF MOUNTR WITH NO LABELING
JRST OPNRWA ;OTHERWISE, GO ON
PUSH PP,AC3 ;SAVE SOME REGS
PUSH PP,AC5 ;
SETZ AC4, ;INDICATE GET FIRST REEL
PUSHJ PP,VOLSWT ;MAKE SURE FIRST REEL UP
POP PP,AC5 ;RESTORE SOME REGS
POP PP,AC3 ;
OPNRWA: >;END IFN TOPS20
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,
SETBM: LDB AC5,F.BBM ;GET BYTE MODE FLAG
JUMPE AC5,RET.1 ;NOT WANTED
IFE TOPS20,<
TRNN AC13,DV.M3 ;CAN IT SUPPORT MODE 3?
JRST SETBME ;NO
MOVEI AC5,.IOBYT ;YES
DPB AC5,[POINT 4,UOBLK.,35] ;[541] RESET MODE
POPJ PP, ;SUCCESSFUL RETURN
SETBME: MOVE AC2,[BYTE (5) 20,14] ;NO
PUSHJ PP,MSOUT. ;DEVICE
OUTSTR [ASCIZ / DOES NOT SUPPORT BYTE MODE
/]
POPJ PP, ;IGNORE
>
IFN TOPS20,<
OUTSTR [ASCIZ /
TOPS-20 DOES NOT SUPPORT BYTE MODE
/]
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:
IFN TOPS20,<
TLNE FLG1,MSTNDR ;SKIP IF NOT MONITOR LABELS
JRST OPNFW1 ;ELSE, SKIP THIS POSITIONING
>
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: TXNE AC16,OPN%NR ;REWIND REQ ?
JRST OPNFW1 ;NO
JRST OPNREW ;YES
OPNRE1: OUTSTR [ASCIZ /$ UNEXPECTED BOT MARKER/] ;[277]
SKIPA
OPNFW2: OUTSTR [ASCIZ /$ UNEXPECTED EOT MARKER/] ;[277]
PUSHJ PP,SAVAC.
OUTSTR [ASCIZ /$ ENCOUNTERED WHILE POSITIONING /]
MOVE AC2,[BYTE (5)10,31,20,14] ;FILE ON DEVICE.
PUSHJ PP,MSOUT.
OPNFW4: TXNN AC13,DV.DTA!DV.MTA ;SKIP IF A REEL DEVICE
JRST KILL ;
OUTSTR [ASCIZ /
IF WRONG REEL PLEASE MOUNT CORRECT REEL THEN /]
OPNF04: PUSHJ PP,C.STOP ;TYPE CONTINUE TO RETRY
PUSHJ PP,RSTAC.
MOVX AC5,DB.HF ;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
JUMPE AC5,[HRROI C,.GTPRG ;MONITOR TABLE FOR PROGRAM NAME
GETTAB C,
MOVE C,RN.NAM ;USE PROGRAM NAME INSTEAD
MOVEM C,UEBLK. ;FOR ENTER
SETZM ULBLK. ;0 FOR LOOKUP
JRST OPNEI2]
PUSHJ PP,OPNVID ;[447]
OPNEI2: 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
IFN SIRUS,<
MOVSI AC5,015000 ; [403] SET PROTECTION CODE TO ALLOW
MOVEM AC5,UEBLK.+2 ; [403] SIRUS PROJ USERS TO WRITE
>
IFE SIRUS,<
SETZM UEBLK.+2 ;CLEAR PROTECTION AND DATE
>
OPNPPN: HRRZ AC5,F.RPPN(I16) ;ADR OF PROJ,,PROG
JUMPE AC5,RET.1 ;USE DEFAULT
MOVE AC5,(AC5) ;PROJECT,,PROGRAMER
IFE TOPS20,<
TLNE AC5,-1 ;[544] PROJECT#
TRNN AC5,-1 ;[544] OR PROGRAMMER # ZERO?
SKIPN AC5 ;[560] BUT NOT BOTH
JRST OPNPP1 ;[560] NO, DON'T DEFAULT
PUSH PP,AC5 ;[544] SAVE THIS PPN
GETPPN AC5, ;[544] GET DEFAULT
TRN ;[544] INCASE OF .JACCT
EXCH AC5,0(PP) ;[544] GET BACK THE USER NUMBER GIVEN
TLNN AC5,-1 ;[544] ZERO PROJ#?
HLL AC5,0(PP) ;[544] YES, FILL IN DEFAULT
TRNN AC5,-1 ;[544] ZERO PROG#?
HRR AC5,0(PP) ;[544] YES, FILL IN DEFAULT
POP PP,(PP) ;[544] FIXUP STACK
OPNPP1:>
MOVEM AC5,ULBLK.+3
MOVEM AC5,UEBLK.+3
POPJ PP, ;AND RETURN
OPNVID: MOVEI AC6,9 ;[444] ID HAS 9 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
HLLZ AC6,-1(AC10) ;[563] GET LHS OF FILE NAME
JUMPN AC6,RET.1 ;[563] IF ZERO IT COULD BE CONFUSED WITH EXTENDED ENTER/LOOKUP ON TOPS-10
PUSHJ PP,DSPL1. ;[563] DUMP CURRENT BUFFER, APPEND CR-LF
OUTSTR [ASCIZ /?ILLEGAL VALUE OF ID FOR/] ;[563]
MOVSI AC2,(BYTE (5) 10) ;[563] PRINT FILE NAME
PUSHJ PP,MSOUT1 ;[563] NEVER RETURNS
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
TXNE AC16,CLS%EV!CLS%BV ;SKIP IF NOT A REEL PRO
JRST USEPR1 ;
LDB AC0,F.BPMT ;FILE POSITION ON MTA
JUMPN AC0,USEPR2 ;JUMP IF MULTI FILE REEL
TXNE AC16,CLS%EF ;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
TXNN AC16,CLS%EV!CLS%BV ;EXIT IF A REEL PRO
SKIPN -1(PP) ;OR AN ERROR PRO
JRST RSTAC1 ;EXIT
PUSHJ PP,USESUP ;SETUP
TXNN AC16,CLS%EF ;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.
TRNA
;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
TRNA ;[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.
OUTSTR [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
;FILE ALREADY OPEN
OPNFAO: HRLZI AC2,(BYTE (5)10,2,3) ;FCBO,AO.
MOVEI AC0,^D10 ;ERROR NUMBER
JRST OXITER ;ONLY CLOSED FILES MAY BE OPENED
;FILE ALREADY LOCKED
OPNFAL: MOVEI AC0,^D11 ;ERROR NUMBER
PUSHJ PP,OXITP ;DOESN'T RETURN IF IGNORING ERRORS
OUTSTR [ASCIZ /LOCKED /]
HRLZI AC2,(BYTE(5)10,2,4)
JRST MSOUT. ;EXIT, THE FILE IS LOCKED
;DEVICE NOT AVAILABLE TO JOB
OPNDNA: MOVE AC2,[BYTE (5)10,2,4,20,15] ;FCBO,DINATTJ.
MOVEI AC0,^D13 ;ERROR NUMBER
JRST OXITER ;COMPLAIN
;IF CHECKPOINT MODE IS REQUIRED SET BIT IN OPEN BLOCK
IFE TOPS20,<
OPNCKP: SKIPN M7.00 ;IS IT 7.00 OR LATER?
POPJ PP, ;NO
LDB AC1,F.BCKP ;IS RIB UPDATE REQUIRED
JUMPE AC1,RET.1 ;NO
MOVX AC1,UU.RRC ;OPEN RIB UPDATE FUNCTION
IORM AC1,UOBLK. ;YES, SET IT
POPJ PP,
>
SUBTTL WRITE OUT THE BUFFER
;ALL BUFFERED OUTPUTS ARE DONE HERE. ***POPJ***
WRTOUT: SKIPG D.OE(I16) ;[470] FIRST OUTPUT?
JRST CHKLOK ;[470] YES, CHECK IF DEVICE WRITE-LOCKED
WRTOT1: AOS D.OE(I16) ;BUMP OUTPUT COUNT
XCT UOUT. ;DO THE OUTPUT
PUSHJ PP,CKFOD ;NORMAL RETURN, SEE IF CHECKPOINT REQUIRED
WRTWAI: XCT UWAIT. ;FOR ALL THE ERRORS
XCT UGETS. ;
TXNE AC2,IO.ERR ;ERRORS?
JRST WRTERR ;THERE ARE ERRORS.
WRTFIN: MOVE AC13,D.DC(I16) ; GET DEVICE CHARACTERISTICS
TXNE AC13,DV.MTA ;MTA?
TXNN AC2,IO.EOT ;EOT?
JRST WRTXIT ;NOT A MAGTAPE EOT
TXNE AC16,V%READ!CLS%EF!CLS%EV ;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
TXO AC16,FL%EOT ;EOT FLAG
JRST WRTXIT ;
WRTMFR: MOVE AC0,[E.MOUT] ;OUTPUT ERROR
PUSHJ PP,IGMDR ;IGNORE ERROR?
JRST WRTXIT ;YES
OUTSTR [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"
;IFN ANS74,< ;[601]
TXNN AC16,V%READ ;SKIP IF ITS A READ
JRST WRTRS1 ;DON'T SET ERROR STATUS IF A WRITE
PUSHJ PP,ENDSTS ;SET FILE-STATUS IF REQUIRED
TRN
;> ;[601]
WRTRS1: AOS (PP) ;SKIP EXIT VIA WRITE EXIT
WRTXIT: XCT UGETS. ;GET STATUS
TXNE AC13,DV.MTA ;MAGTAPE?
TXZA AC2,IO.ERR!IO.EOF!IO.EOT ;MAGTAPE.
TXZ AC2,IO.ERR!IO.EOF ;OTHER.
XCT USETS. ;SET STATUS
POPJ PP, ;RETURN
;[470] HERE TO CHECK IF DEVICE IS WRITE-LOCKED ON FIRST OUTPUT
CHKLOK: TXNN AC13,DV.MTA ;[470] MTA?
JRST WRTOT1 ;[470] NO
XCT MERAS. ;[470] TO DETERMINE IF TAPE IS WRITE-LOCKED
XCT MWAIT. ;[525] CHECK FOR WRITE LOCK ERROR
XCT UGETS. ;[470] GET STATUS
TXNN AC2,IO.IMP ;[470] WRITE-LOCKED?
JRST WRTOT1 ;[470] NO, OK TO DO OUTPUT
WRTERR: TXNE AC13,DV.MTA ;MTA?
TXNN AC2,IO.IMP ;WRITE-LOCKED?
JRST WRTER1 ;NO
TXC AC2,IO.ERR ;
TXCN AC2,IO.ERR ; IS THIS A MTA LABEL PROCESSING ERROR?
JRST WRTER1 ; YES - CATCH IT AT IOERMS
PUSHJ PP,SAVAC. ;IT'S A WRITE-LOCKED MAGTAPE
OUTSTR [ASCIZ /$ /]
MOVE AC2,[BYTE(5)22,27,10,31,20,4,14]
PUSHJ PP,MSOUT. ;"CANNOT DO OUTPUT TO <DEVICE><FILE>
OUTSTR [ASCIZ/IS THE DEVICE WRITE ENABLED?/]
PUSHJ PP,C.STOP ;"TYPE CONTINUE TO PROCEDE"
PUSHJ PP,RSTAC. ;RESTORE THE ACS
TXZ AC2,IO.ERR!IO.EOF ;TURN OFF THE ERROR BITS
XCT USETS. ;SET STATUS
JRST WRTOUT ;[525] TXY 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: TXC AC2,IO.ERR ;
TXCE AC2,IO.ERR ; IS THIS A MTA LABEL PROCESSING ERROR?
JRST IOERM2 ; NO
HRLZI AC3,2 ; LENGTH ,, ADDRESS
MOVEI AC0,.DFRES ; FUNCT - EXTENDED IO ERRORS
MOVE AC1,D.ICD(I16) ; ADDRESS OF
MOVE AC1,(AC1) ; SIXBIT /DEVICE/
DEVOP. AC3, ; GET ERROR CODE
SETZ AC3, ; "ERROR" GETTING ERROR CODE!
OUTSTR [ASCIZ / MONITOR LABEL PROCESSING FAILED /]
PUSHJ PP,ERCODE ; OUTPUT ERROR STATUS
MOVEI C," "
OUTCHR C ; TYPE A SPACE
CAIG AC3,LTCLEN ; SKIP IF NO TEXT FOR THIS CODE
JRST IOERM3 ;
OUTSTR [ASCIZ / THERE IS NO TEXT FOR THIS ERROR CODE/]
POPJ PP,
IOERM3: OUTSTR @LTCTBL(AC3) ; EXPLAIN THE CODE
POPJ PP,
IOERM2: PUSHJ PP,ERCODE ;OUTPUT ERROR STATUS
TXNE AC2,IO.IMP
OUTSTR [ASCIZ/ IMPROPER MODE/]
TXNE AC2,IO.DER
OUTSTR [ASCIZ/ DEVICE ERROR/]
TXNE AC2,IO.DTE
OUTSTR [ASCIZ/ DATA ERROR/]
TXNN AC2,IO.BKT
POPJ PP,
TXNE AC13,DV.DSK ;DSK?
OUTSTR [ASCIZ / QUOTA EXCEEDED, FILE STRUCTURE OR RIB FULL/]
IFE TOPS20,<
TXNE AC13,DV.DTA ;DTA?
OUTSTR [ASCIZ / BLOCK NUMBER TOO LARGE OR DEC-TAPE IS FULL/]
>
TXNN AC13,DV.DSK!DV.DTA ;ONLY ONE MESSAGE
OUTSTR [ASCIZ/ BLOCK TOO LARGE/]
POPJ PP,
;OUTPUT CONTENTS OF AC2 BITS 18-35 (ERROR STATUS)
ERCODE: MOVEI C,"(" ;
OUTCHR 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
OUTCHR C ;OUTPUT IT
SOJG AC1,ERCOD1 ;LOOP
MOVEI C,")" ;
OUTCHR C ;OUTPUT )
POPJ PP,
; EXTENDED ERROR CODE/TEXT
LTCTBL: [ASCIZ /DEVOP. FAILED WHILE GETTING ERROR CODE!/]
[ASCIZ /THE PAGE LIMIT WAS EXCEEDED/]
[ASCIZ /VFU FORMAT ERROR/]
[ASCIZ /LABEL TYPE ERROR/]
[ASCIZ /HEADER LABEL ERROR/]
[ASCIZ /TRAILER LABEL ERROR/]
[ASCIZ /VOLUME LABEL ERROR/]
[ASCIZ /HARD DEVICE ERROR/]
[ASCIZ /PARITY ERROR/]
[ASCIZ /WRITE LOCKED/]
[ASCIZ /ILLEGAL POSITIONING ATTEMPT/]
; [ASCIZ /BEGINNING OF TAPE/]
; [ASCIZ /ILLEGAL IO OPERATION/]
[ASCIZ /CODE 13/]
[ASCIZ /CODE 14/]
LTCLEN==.-LTCTBL
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: XCT UGETS. ; GET THE STATUS
MOVE AC13,D.DC(I16) ; AND DEVICE CHARACTERISTICS
TXNN AC13,DV.MTA ; MTA ?
JRST READC1 ; NO
TXNE AC2,IO.EOT ;SKIP IF NOT AN "EOT"
TXO AC16,FL%EOT ;"EOT" FLAG FOR READEF+N
READC1: TXNN AC2,IO.ERR!IO.EOF ;SKIP IF ANY ERRORS IN THE CURRENT BUFFER
JRST WRTXIT ;CLEAR THE ERRORS AND POPJ
IFN ANS74,<
MOVE AC0,[E.MINP] ;INPUT ERROR
>
TXNN AC2,IO.EOF ;SKIP IF AN EOF
JRST REAERR ;REAL ERRORS!
TXNN AC16,V%OPEN!CLS%EF!CLS%EV!CLS%BV ;SKIP IF OPEN OR CLOSE
JRST WRTRSX ;JUMP, IT'S READ OR WRITE "EOF"
JRST WRTRS1 ;EXIT BUT DONT SET ATEND
REAERR:
IFN ANS68,<
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:
IFE TOPS20,<
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
>;END IFE TOPS20
IFN TOPS20,<
PUSHJ PP,READIN ;GET A BUFFER
POPJ PP, ;RETURN NORMALLY
JRST RET.2 ;EOF RETURN
>;END IFN TOPS20
SUBTTL ERROR MESSAGES 5-JAN-70
;MOVE AC2,[BYTE (5),1,2,3,4] ;CALLING
;JRST MSOUT. ;SEQUENCE
MSOUT.: PUSH PP,AC2 ;INCASE DISPLAY DESTROYS IT
PUSHJ PP,DSPL1. ;OUTPUT BUFFER AND "CRLF"
POP PP,AC2
MSOUT1: MOVE AC0,[POINT 5,AC2] ;[563] 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 OSHOOT ;[530] 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,(TY.SPL) ; [407] IF SPOOLED FORGET IT
JRST MSDEVA
OUTSTR [ASCIZ/ LOGICAL/] ;[536] [407]
PUSHJ PP,MSDEVA ;[536] TYPE LOGICAL DEVICE
OUTSTR [ASCIZ/; PHYSICAL DEVICE /] ; [407]
MOVE AC3,AC6 ; [407] PHYSICAL DEVICE
PUSHJ PP,MSDEV1 ;[536] [407] TYPE AND RETURN
JRST COLON ;[536] PRINT ":"
MSDEVA: OUTSTR [ASCIZ/ DEVICE /]
MOVE AC3,(AC1) ;DEVICE NAME
PUSHJ PP,MSDEV1 ;[536] PRINT IT
COLON: MOVEI C,":" ;[536] GET COLON
OUTCHR C ;[536] PUT IT OUT AT END
POPJ PP, ;[536] AND RETURN
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
OUTSTR [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,-1 ;[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: OUTSTR [ASCIZ/ [/] ;[323]
MSVID1: ILDB C,AC1
TLNN AC1,100 ;[304] SKIP IF ASCII
ADDI C,40 ;[304] CONVERT SIXBIT TO ASCII
TLNN AC1,600 ; EBCDIC?
LDB AC1,PTR.97##(AC1) ; YES
PUSHJ PP,OUTCH. ;[304] OUTPUT TO BUFFER
SOJG AC4,MSVID1 ;LOOP 9 TIMES
PUSHJ PP,OUTBF. ;DUMP THE BUFFER
OUTSTR [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: OUTSTR [ASCIZ/ REEL /]
ROT AC3,-14
JRST MSDEV1
;[277] ROUTINE TO PRECEDE MESSAGES TO TTY WITH "$"
$SIGN: OUTSTR [ASCIZ/
$ /] ;[277]
POPJ PP, ;[277]
;[536] TYPE OUT A DIRECTORY
MSDIR.: OUTSTR [ASCIZ /[/] ;[536]
IFE TOPS20,<
TLNE AC3,-1 ;[536] CHECK FOR SFD PATH
JRST MSPPN. ;[536] NO
ADDI AC3,2 ;[536] POINT TO PPN
HLRZ AC0,(AC3) ;[536] LHS
PUSHJ PP,PUTOCT ;[536] TYPE OCTAL
OUTSTR [ASCIZ /,/] ;[536]
HRRZ AC0,(AC3) ;[536] RHS
PUSHJ PP,PUTOCT ;[536] TYPE OCTAL
AOS AC6,AC3 ;[536] ADVANCE TO SFD
HRLI AC6,-5 ;[536] MAX LENGTH OF SFDS
MSSFD: SKIPN AC3,(AC6) ;[536] GET NEXT
JRST MSPPNE ;[536] AT END
OUTSTR [ASCIZ /,/] ;[536]
PUSHJ PP,MSDEV1 ;[536] OUTPUT IT
AOBJN AC6,MSSFD ;[536] LOOP
JRST MSPPNE ;[536] JUST IN CASE
>
MSPPN.: JUMPL AC3,[PUSHJ PP,MSDEV1 ;[536] TYPE AS SIXBIT
JRST MSPPNE] ;[536]
HLRZ AC0,AC3 ;[536] LHS
PUSHJ PP,PUTOCT ;[536] TYPE OCTAL
OUTSTR [ASCIZ /,/] ;[536]
HRRZ AC0,AC3 ;[536] RHS
PUSHJ PP,PUTOCT ;[536] TYPE OCTAL
MSPPNE: OUTSTR [ASCIZ /]/] ;[536] CLOSE PPN
POPJ PP, ;[536] AND RETURN
;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES [371]
PUTDEC: JUMPGE AC0,PUTDC1 ;IF NEGATIVE, [371]
OUTSTR [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]
OUTCHR C ; TYPE DIGIT [371]
POPJ PP, ; [371]
; [536] TYPE OUT AN OCTAL NUMBER
PUTOCT: IDIVI AC0,8 ;[536] DIVIDE BY RADIX
HRLM AC1,(PP) ;[536] SAVE RADIX DIGIT
SKIPE AC0 ;[536] DONE ?
PUSHJ PP,PUTOCT ;[536] NO-- LOOP
HLRZ C,(PP) ;[536] GET SAVED DIGIT
ADDI C,"0" ;[536] CONVERT TO ASCII
OUTCHR C ;[536] TYPE DIGIT
POPJ PP, ;[536] AND RETURN
;THE FOLLOWING 40 LOC TABLE IS "XCT"ED FROM MSOUT.
MSAGE: JRST KILL ;0
OUTSTR [ASCIZ/ SHARES BUFFER AREA WITH /] ;1
OUTSTR [ASCIZ/ CANNOT BE OPENED/] ;2
OUTSTR [ASCIZ/, ALREADY OPEN/] ;3
OUTSTR [ASCIZ/
/] ;4
OUTSTR [ASCIZ/ TOO MANY OPEN FILES/] ;5
OUTSTR [ASCIZ/ IS NOT OPEN/] ;6
OUTSTR [ASCIZ/ FOR INPUT/] ;7
PUSHJ PP,MSFIL. ;30 CHARACTER FILENAME ;10
OUTSTR [ASCIZ/ FOR OUTPUT/] ;11
OUTSTR [ASCIZ/ IS AT END/] ;12
OUTSTR [ASCIZ/ IS NOT A DEVICE/] ;13
POPJ PP, ;RETURN ;14
OUTSTR [ASCIZ/ IS NOT AVAILABLE TO THIS JOB/] ;15
OUTSTR [ASCIZ/ IS ASSIGNED TO ANOTHER FILE/] ;16
OUTSTR [ASCIZ . CANNOT DO INPUT/OUTPUT.] ;17
PUSHJ PP,MSDEV. ;6 CHARACTER DEVICE NAME;20
OUTSTR [ASCIZ/ CANNOT DO INPUT/] ;21
OUTSTR [ASCIZ/ CANNOT DO OUTPUT/] ;22
OUTSTR [ASCIZ/ OR /] ;23
PUSHJ PP,C.STOP ;24
OUTSTR [ASCIZ/INIT TOOK THE ERROR RETURN/] ;25
OUTSTR [ASCIZ/DIRECTORY DEVICES MUST HAVE STANDARD LABELS/] ;26
OUTSTR [ASCIZ/ TO/] ;27
PUSHJ PP,MSDTRN ;DEVICE TABLE REEL NUMBER;30
OUTSTR [ASCIZ/ ON/] ;31
OUTSTR [ASCIZ/LABELS MAY NOT BE OMITTED FROM DTA OR DSK FILES/] ;32
OUTSTR [ASCIZ/ BECAUSE IT IS NOT OPEN/] ;33
PUSHJ PP,MSSLRN ;STANDARD LABEL REEL NUMBER;34
OUTSTR [ASCIZ/ INPUT ERROR/] ;35
OUTSTR [ASCIZ/ OUTPUT ERROR/] ;36
OUTSTR [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: TXNN AC16,V%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]
MOVE AC13,D.ICD(I16) ;[277] DEVICE NAME
DEVCHR AC13, ;[277] DEVCHR UUO
TXNE AC13,DV.DTA!DV.MTA ;[277] A REEL DEVICE?
PUSHJ PP,$SIGN ;[277] YES, OUTPUT "$"
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. /]
OUTSTR (AC2) ; LOOKUP, ENTER, RENAME OR FILOP
OUTSTR [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: OUTSTR @LEMESS(AC2) ;TYPE A MESSAGE
SKIPN (PP) ;KILL IF ENTER
TXNN AC13,DV.DTA!DV.MTA ;A REEL DEVICE?
JRST KILL ;NO
JUMPN AC2,KILL ;KILL IF NOT UNFOUND FILE
OUTSTR [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/]
IFE TOPS20,<
[ASCIZ / protection failure/]
>
IFN TOPS20,<
[ASCIZ / protection failure or DTA directory full/]
>
[ASCIZ / file being modified/]
[ASCIZ / RENAME file already exists/]
[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/]
[ASCIZ \ can't supersede (enter) an existing directory \]
[ASCIZ \ can't delete (rename) a non-empty directory \]
[ASCIZ \ SFD not found \]
[ASCIZ \ search list empty \]
[ASCIZ \ SFD nested too deeply \]
[ASCIZ \ no-create on for specified SFD path \]
[ASCIZ \ segment not on swap space \]
[ASCIZ \ can't update file \]
[ASCIZ \ low segment overlaps high segment \]
LELAST: [ASCIZ / LOOKUP, ENTER or RENAME error/]
LEMLEN==LELAST-LEMESS
[ASCIZ / illegal filename/]
SUBTTL CLOSE VERB
PURGE.: TLZ AC16,(Z 17,)
TLO AC16,(Z 1,) ;MAKE PURGE BE A CLOSE VERB
SETOM PRGFLG ;REMEMBER TO RENAME TO ZERO
;A C.CLOS VERB LOOKS LIKE:
;FLAGS,,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)
;BIT13 =1 UNLOAD
;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:
IFN LSTATS,<
MRTMS. (AC1) ;START METER TIMING
LDB AC1,DTCN. ;GET CHANNEL NUMBER
MOVE AC1,MROPTT(AC1) ;GET FILE BLOCK ADDRESS
HLRM AC16,MB.OCF(AC1) ;SAV CLOSE AC16 FLAG BITS
>;END IFN LSTATS
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.
TXNN AC13,DV.DIR ;A DIRECTORY DEVICE?
SETZM PRGFLG ;NO - SO WE CAN'T PURGE
TXNE AC13,DV.TTY ;A TTY FILE?
SETZM TTYOPN ;YES, NOTE THAT IT'S CLOSED
LDB AC5,F.BPMT ;FILE POSITION ON TAPE
TXNE AC16,CLS%CR ;SKIP IF NOT CLOSE REEL
TXOA AC16,CLS%EV ;% CLOSE REEL
TXOA AC16,CLS%EF ;% CLOSE FILE
JUMPN AC5,CLOSF5 ;CLOSE "REEL" A MULTI-FILE-REEL - AN ERROR
CLOS02: TXNE AC16,CLS%EV ;CLOSE REEL?
IFN TOPS20,<
JRST [TXNN AC13,DV.MTA ;CLOSE REEL AND NOT MTA?
JRST .+2 ;YES,ERROR
TLNE FLG1,MSTNDR ;IS MOUNTR DOING LABELING?
POPJ PP, ;YES, THEN CLOSE REEL IS NOOP
JRST CLOS00 ] ;NO CONT
>;END IFN TOPS20
IFE TOPS20,<
TXNE AC13,DV.MTA ;CLOSE REEL AND NOT MTA?
>
JRST CLOS00 ;NO
MOVEI AC0,^D33 ;ERROR NUMBER
PUSHJ PP,IGCVR ;IGNORE ERROR?
JRST CLOS00 ;YES
OUTSTR [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: SKIPGE D.OBB(I16) ;[460] 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:
IFN ANS68,<
MOVEI AC1,3 ;
PUSHJ PP,USEPRO ;BEFORE ENDING FILE/REEL
>;END IFN ANS68
TLNN FLG,OPNIN ;SKIP IF INPUT
JRST CLOSE6 ;JUMP IF OUTPUT
TLNE FLG1,STNDRD ;SKIP IF NOT STD LABELS
TXNN AC16,CLS%EV ;SKIP IF CLOSE REEL
JRST CLOSE7 ;
PUSHJ PP,CLSEOV ;CHECK FOR EOV
JRST CLOSE7 ;
OUTSTR [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:
IFN ANS68,<
MOVEI AC1,4 ;
PUSHJ PP,USEPRO ;AFTER ENDING FILE/REEL
>;END IFN ANS68
TLNE FLG,OPNOUT ;SKIP IF NOT OUTPUT
PUSHJ PP,CLSWEL ;WRITE ENDING LABEL MAYBE
CLOSE8: TXNE AC16,CLS%CR ;SKIP IF CLOSE FILE
JRST CLOSR1 ;CLOSE REEL
TXNN AC16,CLS%LK ;LOCK THE FILE?
JRST CLOSF1 ;NO
SETO AC0, ;SET THE LOCK FLAG
DPB AC0,F.BLF ;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: TXNE AC16,CLS%NR ;REWIND REQUEST?
JRST CLOSF3 ;NO
IFN TOPS20,< ;YES
TLNN FLG1,MTNOLB ;SKIP IF MOUNTR WITH NO LABELING
JRST CLSF1X ;ELSE GO ON
SETZ AC4, ;INDICATE GET FIRST REEL
PUSHJ PP,VOLSWT ;GET FIRST REEL IF MOUNTR AND NO LABELING
;NOW WE WILL ALSO REWIND TO MAKE SURE
;WE ARE AT BOT IF NO REEL SWITCH HAPPENED
CLSF1X: >;END IFN TOPS20
PUSHJ PP,OPNRWD ;REWIND UUO
IFN ANS74,<
TXNE AC16,CLS%UN ;UNLOAD?
XCT MREWU. ;YES
>;END IFN ANS74
CLOSF2: MOVX AC0,DB.HF
ANDCAM AC0,D.HF(I16) ;CLEAR HUF FLAG
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
IFN TOPS20,<
TLNN FLG1,MSTNDR ;SKIP IF MOUNTR DOING LABELING
>
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:
IFN TOPS20,< ;IF MOUNTR WITH LABELS WE ARE
;AT THE BEG OF THE NEXT FILE
;,NOT IN THE CURRENT ONE
;(BECAUSE THE MONITOR POSITIONS
;TO THE BEGINING OF THE NEXT FILE
;AFTER THE JFN IS CLOSED)
TLNE FLG1,MSTNDR ;IS MOUNTR DOING LABELING AND
TLNE FLG,OPNOUT!ATEND ;OPEN INPUT AND NOT ATEND ?
JRST CLSF8X ;NO,GO RELEASE
MOVX AC5,DB.HF ;YES, GET HEAD UNDER FLAG BIT
TDNN AC5,D.HF(I16) ;SKIP IF HEAD HERE
JRST CLSF8X ;IF NOT GO ON
ANDCAM AC5,D.HF(I16) ;CLEAR CURRENT HEAD POS
LDB AC1,F.BPMT ;GET CURRENT POSITION NUMBER
MOVE AC2,AC1 ;GET HERE
ADDI AC2,1 ;PLUS ONE FOR LOOP TEST
MOVE AC10,I16 ;START SEARCH FOR NEXT FILE HERE
CLSF8B: HRRZ AC10,F.RFSD(AC10) ;GET NEXT FILTAB ADDR
CAIN AC10,(I16) ;ARE WE BACK AT START?
JRST CLSF8X ;YES,NO NEXT FILE, SO GO ON WITH HUF FLG OFF
LDB AC3,FLPS10 ;GET FILE POSITION AT THIS FILE
CAIE AC3,(AC2) ;IS THIS THE NEXT FILE ON THE TAPE?
JRST CLSF8B ;NO, LOOP BACK
ORM AC5,D.HF(AC10) ;YES,SET HEAD UNDER THIS FILE
JRST CLSF8X ;NOW GO RELEASE
CLSF8X:
>;END IFN TOPS20
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**************
PUSHJ PP,CLRSTS ;CLEAR FILE STATUS WORD
IFN LSTATS,<
PUSHJ PP,MTRCLS ;END CLOSE METERING
>
JRST FRECHN ;EXIT TO THE ***"ACP"***
IFN LSTATS,<
MTRCLS: LDB AC2,DTCN. ;GET CHAN NUMBER
MOVE AC2,MROPTT(AC2) ;GET METER BLOCK BASE ADDRESS
;NO. OF INPUTS & OUTPUTS EXECUTED
MOVE AC1,D.IE(I16) ;GET NO. OF INPUTS
MOVEM AC1,MB.NIN(AC2) ;PUT # INPUTS INTO FILE BLOCK
MOVE AC1,D.OE(I16) ;GET NO. OF OUTPUTS
MOVEM AC1,MB.NOU(AC2) ;PUT # OUTPUTS INTO FILE BLOCK
MOVEI AC2,MB.CTM(AC2) ;GET ADDRESS OF CLOSE BUCKET
MOVEM AC2,MRTMB. ;SAVE FOR TIMING
SETZM (AC2) ;CLEAR CLOSE TIME BUCKET
MRTME. (AC2) ;END METER TIMING
;CLEAR ENTRIES IN FILE/BLOCK TABLE (SORT OF "FLUSHING THE CACHE")
PUSHJ PP,CLRFBT
POPJ PP, ;RETURN
>;END IFN LSTATS
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.
OUTSTR [ASCIZ/
THE CLOSE "REEL" OPTION MAY NOT BE USED WITH A MULTI-FILE-TAPE./]
JRST KILL
CLOS75: LDB AC1,DTCN. ;GET THE CHANNEL NUMBER
TXNE AC13,DV.DIR ; DIRECTORY DEVICE ? [373]
TXNE AC13,DV.DSK ; 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 & WRITE-REEL-CHANGE FLAGS
TXO AC16,V%OPEN!CLS%BV!CLS%B8 ;OPEN WITH A REWIND + FLAG THE REEL CHANGE
TLNN FLG,RRUNER ;RERUN ON END OF REEL?
JRST CLOSR2 ;NO
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!!?
CLOSR2: TXZN AC16,CLS%NR ;SKIP IF NO REWIND
XCT MREWU. ;REWIND AND UNLOAD
TLZ FLG,ATEND ; [604] TURN OFF THE EOF FLAG
MOVEM FLG,F.WFLG(I16) ; [604] ALSO IN THE FILE TABLE
PUSHJ PP,INCRN. ;INCREMENT THE DEVTAB REEL NUMBER
PUSHJ PP,FRECHN ;NOTE THE CHAN IS FREE
LDB AC0,F.BNDV ;GET NUMBER OF DEVICES SELECTED
SOJE AC0,CLSR2A ;JUMP IF ONLY ONE
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
JRST CLOSR4 ; GO ON
IFN TOPS20,<
;
; VOLSWT IS A ROUTINE TO SWITCH MTA REELS WHEN UNDER
; MOUNTR CONTROL,BUT WITH NO MONITOR LABELING.
;
; ARG: AC4= 0 IF MOUNT FIRST REEL
; VSMRV IF MOUNT NEXT REEL
;
; USES: AC1,AC2,AC3,AC4,AC5
;
VOLSWT: LDB AC2,DTCN. ;GET CHANNEL NUMBER
HRLZ AC2,AC2 ;GET CHAN NUM IN LEFT,AS ARG TO COMPT.
HRRI AC2,CMPJFN ;SET COMPT. FUNCTION NUM FOR CHAN TO JFN
MOVE AC1,[1,,2] ;INDICATE 1 ARG IN ADDR 2
COMPT. AC1, ;GET JFN *************
JRST [OUTSTR [ASCIZ/REEL CHANGE GET JFN /] ;ERROR, ISSUE MESSAGE
JRST OCPERR ] ;MORE MESS AND KILL
;NOW MUST DO OPENF TO MAKE SURE THE JFN IS OPEN
MOVE AC3,AC1 ;SAVE JFN IN CASE OF OPENF ERROR
MOVE AC2,[440000,,200000] ;INDICATE SIMPLE 36 BIT BYTE,INPUT
OPENF ;OPEN THE JFN***************
ERCAL OPNFER ;ERROR?, THEN GO CHECK IT (RETURNS IF OK)
VOLSW1: MOVEI AC2,MOVLS ;INDICATE VOLUME SWITCH MTOPR
JUMPE AC4,VOLSW2 ;JUMP IF GET FIRST REEL
MOVEI AC3,3 ;INDICATE THAT THERE ARE 3 ARGS,BEGINING
;AT LOCATION 3.
MOVEI AC5,1 ;INDICATE GET RELATIVE REEL 1 (NEXT)
JRST VOLSW3 ;GO DO IT
VOLSW2: MOVEI AC4,2 ;INDICATE 2 ARGS
MOVEI AC3,4 ;INDICATE ARGS IN AC4,AC5
MOVEI AC5,VSFST ;INDICATE GET FIRST REEL FUNCTION
VOLSW3: MTOPR ;DO SWITCH****************
ERJMP MTOERR ;MTOPR ERROR, MESSAGE AND QUIT
TLO AC1,(CO%NRJ) ;INDICATE NOT TO RELEASE JFN
CLOSF ;CLOSE THE JFN
ERJMP CLSERR ;ERROR GO DO IT
POPJ PP, ;RETURN
; THIS ROUTINE CHECKS FOR OPENF ERROR WHERE FILE IS
; ALREADY OPEN. IT RETURNS IN THIS CASE.ALL OTHER OPEN
; ERRORS DIE WITH ERROR MESSAGE.
; ASSUMES: AC3 SAVES JFN
; AC1 CONTAINS OPENF ERROR CODE
; CALLED WITH ERCAL JSYS
OPNFER: CAIE AC1,OPNX1 ;SKIP IF JFN ALREADY OPEN
JRST OJFERR ;OTHER ERROR,MESS AND QUIT
MOVE AC1,AC3 ;RESTORE JFN
POPJ PP, ; RETURN TO CALLER WITH JFN RESTORED
>;END IFN TOPS20
CLSR2A:
IFN TOPS20,<
TLNN FLG1,MTNOLB ;MOUNTR AND NO LABELING?
JRST CLSR2X ;NO, GO ON
MOVEI AC4,VSMRV ;YES,INDICATE GET NEXT REEL
PUSHJ PP,VOLSWT ;SWITCH
JRST CLOSR4 ;RELEASE AND REOPEN
>;END IFN TOPS20
CLSR2X:
OUTSTR [ASCIZ/
$ MOUNT/]
TLNN FLG,OPNIN ;SKIP IF INPUT
JRST CLOSR3 ;JUMP IF OUTPUT
PUSHJ PP,MSDTRN ;"REEL N"
OUTSTR [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: OUTSTR [ASCIZ/ SCRATCH TAPE ON/]
PUSHJ PP,MSDEV. ;DEVICE
IFN LSTATS,<
PUSHJ PP,MTRCLS ;END CLOSE TIMING
>
PUSHJ PP,C.STOP ;TYPE CONT TO PRO
CLOSR4: XCT URELE. ;RELEASE THE DEVICE
MRTMS. (AC1) ;START OPEN TIMING
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, ;
TXNE AC13,DV.MTA ;SKIP IF NOT A MAGTAPE
TLNN FLG1,NONSTD+STNDRD ;SKIP IF NOT OMITTED LABELS
POPJ PP, ;ZERO THE RECORD AREA
IFE TOPS20,< ;[561]
XCT UCLOS. ;[561] CLEAR THE EOF
> ;[561]
PUSHJ PP,READSY ;READ A LABEL
JRST BUFREC ;NORMAL RETURN
CLSRL0: MOVEI AC0,^D32 ;ERROR NUMBER
PUSHJ PP,IGCV ;IGNORE ERROR?
JRST CLSRL2 ;NO
TXNE AC16,V%READ ;YES READ UUO?
POPJ PP, ;YES, JUST RETURN
TXNN AC16,V%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
TXO AC16,CLS%NR ;REWIND CAUSE WE'RE LOST
JRST CLOSE8 ;FINISH UP
CLSRL2: OUTSTR [ASCIZ/ READ AN "EOF" INSTEAD OF A LABEL/] ;
MOVE AC2,[BYTE(5)30,10,31,20,37] ;CLOSE
TXNE AC16,V%OPEN ;OPEN?
MOVE AC2,[BYTE(5) 30,10,31,20,2] ;YES
TXNE AC16,V%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,'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:
IFN ISTKS,< ;TYPE OUT # OF IN'S AND OUT'S
MOVEI AC3,INSSSS(I12)
MOVEI AC2,OUTSSS(I12)
OUTSTR [ASCIZ /IN'S OUT'S
/]
CLSID0: MOVE AC0,(AC3)
SETZM (AC3)
PUSHJ PP,PUTDEC
MOVEI C," "
OUTCHR C
MOVE AC0,(AC2)
SETZM (AC2)
PUSHJ PP,PUTDEC
OUTSTR [ASCIZ /
/]
ADDI AC3,1
ADDI AC2,1
CAIE AC3,INSSSS+15(I12)
JRST CLSID0
OUTSTR [ASCIZ /FAKER.:=/]
MOVE AC0,(AC2)
PUSHJ PP,PUTDEC
SETZM (AC2)
OUTSTR [ASCIZ /
FORCR.:=/]
MOVE AC0,(AC3)
PUSHJ PP,PUTDEC
SETZM (AC3)
OUTSTR [ASCIZ /
/]
>
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
TXNE AC2,IO.ERR ;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: TXNE AC13,DV.MTA ;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: SKIPE PRGFLG ;[576] SKIP IF NOT CLOSE WITH DELETE
JRST CLSWL1 ;[576] SKIP BUFFER SAVES,DELETE FOLLOWS
IFE TOPS20,<
SKIPN F.WSMU(I16) ;[576] SKIP IF RETAINED RECORDS
JRST CLSWLX ;[576] NOT RETAINED, GO ON
LDB AC0,DTCN. ;[576] GET CHANNEL NUMBER
HRLM AC0,FUSCP. ;[576] SET CHAN NUMBER IN ARG BLK
MOVE AC0,[1,,FUSCP.] ;[576] INDICATE CHECKPOINT ARG BLK
FILOP. AC0, ;[576] DO .FOURB CHECKPOINT FILOP,CLEARING OUT FILE
PUSHJ PP,CKPTER ;[576] ERROR IN CHECK POINT FILOP
PUSHJ PP,CLWSMU ;[576] FREE ALL RETAINED BLOCKS
TLNN FLG,IDXFIL ;[576] SKIP IF INDEX FILE
JRST CLSWLX ;[576] NOT INDEX, GO ON
MOVE AC0,ICHAN(I12) ;[576] GET INDEX FILE CHAN NUMBER
HRLM AC0,FUSCP. ;[576] SET CHAN NUMBER
MOVE AC0,[1,,FUSCP.] ;[576] INDICATE ARG BLK
FILOP. AC0, ;[576] CHECKPOINT INDEX FILE
PUSHJ PP,CKPTER ;[576] ERROR IN FILOP
;[603] PUSHJ PP,CLWSMU ;[576] FREE ALL RETAINED BLOCKS
JRST CLSWLX ;[576] CONTINUE
CKPTER: MOVE AC0,[E.VCLO+E.MFOP] ;[576] INDICATE CLOSE FILOP ERROR
TLNN FLG,IDXFIL ;[576] INDEX FILE?
JRST CKPTR1 ;[576] NO, SKIP AHEAD
PUSHJ PP,IGMI ;[576] IGNORE ERROR?
JRST CKPTR2 ;[576] NO, GIVE ERROR MESS
JRST CLRIS ;[576] YES,CLEAR ERROR STATUS AND RETURN TO CALL
CKPTR1: PUSHJ PP,IGMD ;[576] NON-INDEX FILE ,IGNORE ERROR?
JRST CKPTR2 ;[576] NO
JRST CLRDS ;[576] YES, CLEAR ERROR STATUS AND CONTINUE
CKPTR2: XCT UWAIT. ;[576] WAIT ON ERRORS
MOVE LVL,D.DC(I16) ;[576] SET DEVICE CHARACTERISTICS
PUSHJ PP,IOERMS ;[576] SET ERROR CODES
MOVE AC2,[BYTE(5) 10,37,31,20,4] ;[576] INDICATE MESSAGE
JRST MSOUT. ;[576] MESSAGE AND KILL
CLSWLX:>;[576] END IFE TOPS20
XCT UCLOS. ;[576] DUMP ALL THE BUFFERS
CLSWL1: PUSHJ PP,WRTWAI ;[576] WAIT FOR ERROR CHECKING
IFN TOPS20,<
SKIPN F.WSMU(I16) ;[576] [571] ANY RETAINED RECORDS?
JRST CLSWLA ;[576] SKIP AHEAD IF NOT SMU
PUSHJ PP,CLWSMU ;[576] FREE RETAINED BLOCKS
>;[576] END IFN TOPS20
CLSWLA: TXNE AC13,DV.MTA ;[573] 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
;[576] GO DEQUEUE AND RETAINED RECORDS AFTER SAVING FLG REGS
CLWSMU: PUSH PP,FLG ;[576] [573] SAVE FLG, SU.CL KILLS IT
PUSH PP,FLG1 ;[576] [573] SAVE THIS TOO
PUSHJ PP,SU.CL ;[576] [571] YES, DEQUEUE THEM
POP PP,FLG1 ;[576] [573] RESTORE FLG1 AND
POP PP,FLG ;[576] [573] NOW GET FLG BACK
POPJ PP, ;[576] RETURN
;TO KEEP OUR MTA BUFFERS STRAIGHT. ***POPJ***
IFE TOPS20,<
CLSYNC: XCT UGETS. ;SET OR CLEAR
TRC AC2,IO.SYN ; THE SYNCHRONOUS
XCT USETS. ; MODE STATUS BIT
POPJ PP, ; FOR MAGTAPE
>;END IFE TOPS20
;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 VERB
;HERE FOR WRITE VARIABLE LENGTH RECORDS.
; ROUTINES WADVV. AND WRITV. CORRESPOND TO WADV. AND WRITE.
; EXCEPT THE RECORD SIZE IS GIVEN IN AC15
WADVV.: TXOA AC16,V%WADV ;WRITE ADVANCE
WRITV.: MRTMS. (AC1) ;START METER TIMING HERE
TXO AC16,V%WRITE ;WRITE
PUSH PP,AC15 ;SAVE RECSIZE
SETZM NOCR. ;CLEAR NO CARRIAGE RET FLAG
MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
BLT AC0,FS.IF ; STATUS WORDS.
SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS?
PUSHJ PP,SU.WR ; YES
HRRZ AC15,-1(PP) ;OPERAND OR RETURN ADR (UOCAL.)
MOVE AC15,(AC15) ;
PUSHJ PP,WRTSUP ;SETUP
POP PP,AC3
DPB AC3,WOPRS. ;PUT RECORD SIZE IN AC15
JRST WRTGT3 ;GO JOIN REGULAR WRITE CODE
SUBTTL WRITE VERB
;A WRITE. VERB LOOKS LIKE:
;FLAGS,,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. VERB LOOKS LIKE:
;FLAGS,,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.: TXO AC16,V%WADV ; WRITE ADVANCE VERB
SETOM NOCR. ;REPORT-WRITER ENTRY
JRST WRITE1 ;
WADV.: TXOA AC16,V%WADV ;WRITE ADVANCE
WRITE.: TXO AC16,V%WRITE ;WRITE
SETZM NOCR. ;CLEAR NO CARRIAGE RET FLAG
WRITE1: MRTMS. (AC1) ;START METER TIMING HERE
MOVE AC0,[FS.ZRO,,FS.FS];ZERO THE ERROR
BLT AC0,FS.IF ; STATUS WORDS.
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
WRTGT3:
IFN LSTATS,<
MOVE AC1,AC3 ;GET RECORD LENGTH
PUSHJ PP,BUCREC ;SET AC2 TO REC BUCKET
L.METR (MB.WRT(AC2),I16) ;CNT WRT BUCKET
>;END IFN LSTATS
TLNN FLG,OPNOUT ;SKIP IF OPEN FOR OUTPUT
JRST ERROPN ;ERROR MESSAGE
IFN ISAM,<
TLNE FLG,IDXFIL ;
JRST IWRITE ;WRITE AN INDEX-FILE
>
IFN ANS68,<
TLNE FLG,RANFIL+OPNIO ;SKIP IF NOT RANDOM OR I/O
JRST RANDOM ;RANDOM AND IO EXIT HERE
>
IFN ANS74,< ;SEQ AND REL/SEQ WRITE ALLOW OPN OUTPUT ONLY
TLNN FLG,RANFIL ;RANDOM FILE ?
JRST WRITE3 ;NO, SEQ
LDB AC0,F.BFAM ;YES,GET ACCESS MODE
SKIPN AC0 ;RANDOM OR DYNAMIC SKIPS
TLNN FLG,OPNIO ;SEQ, OPEN FOR I-O?
JRST RANDOM ;NO, DO RANDOM OR I-O
JRST ERROPN ;YES, ERROR-WRITE OUTPUT ONLY
WRITE3: TLNE FLG,OPNIO ;SEQ. ORGAN.,OPEN I-O?
JRST ERROPN ;YES, ERROR ALSO
>
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
TXNE AC13,DV.MTA ;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
TXNE AC16,V%WADV ;SKIP IF WRITE.
PUSHJ PP,WRTADV ;SEE IF NOW IS THE TIME TO ADVANCE
IFN ANS74,<
TRNA ;NORMAL RETURN
AOS (PP) ;COPY END OF PAGE SKIP RETURN
>
JUMPE AC3,WRTZRE ;TRYING TO WRITE A NULL REC?
; SUPPRESS TRAILING BLANKS FOR ASCII OUTPUT FILES
IFN SUPP, <
JUMPGE FLG,WRTSIX ; [403] IF NOT ASCII DO REGULAR WRITE
SETZB AC4,AC5 ; [403] SET UP SIXBIT BLANK AND BLANK CNT
TLNN FLG,CONNEC ; [403] IF CONVERSION NOT NEEDED IT IS ASCII RECORD
MOVEI AC4," " ; [403] ASCII BLANK
WRTRE1: ILDB C,AC6 ;CHAR FROM THE RECORD AREA
CAIE C,(AC4) ; [403] IS IT BLANK?
JRST WRTRA1 ; [403] NO
AOS AC5 ; [403] YES CNT NO OF THEM IN SUCCESSION
SOJG AC3,WRTRE1 ; [403] GET NEXT CHAR
LDB AC4,WOPRS. ; [403] END OF RECORD- GET BACK RECORD SIZE
SUB AC4,AC5 ; [403] GET NUMBER OF CONSECUTIVE BLANKS
JUMPG AC4,WRTRA3 ; [403] WROTE AT LEAST ONE CHAR FINISH UP
MOVEI C," " ; [403] RECORD ALL BLANKS; MUST OUTPUT ONE
JRST WRTRAA ; [403] INSERT ONE BLANK AND FINISH
WRTRA1: JUMPE AC5,WRTRA2 ; [403] NO INTERVENING BLANKS GO ON
MOVEI AC1," " ; [403] ASCII BLANK
BLKINS: IDPB AC1,D.OBB(I16) ; [403] INSERT A BLANK
SOSG D.OBC(I16) ; [403] BUFFER FULL?
PUSHJ PP,WRTBUF ; [403] NO WRTIE IT OUT
SOJG AC5,BLKINS ; [403] WRITE NEXT BLANK
WRTRA2: XCT AC10 ;CONVERT IF NECESSARY
WRTRAA: 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
WRTRA3: 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.
IFN ANS74,<
TRNA ;NORMAL RETURN
AOS (PP) ;COPY END OF PAGE SKIP RETURN
>
JRST WRTRE6 ;
; WRITE SIXBIT FILES HERE-NO TRAILING BLANK SUPPRESSION
WRTSIX: 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,WRTSIX ;LOOP TILL A COMPLETE RECORD IS PASSED
> ; END OF IFN SUPP- BLANK SUPPRESS CODE
IFE SUPP,<
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.
IFN ANS74,<
TRNA ;NORMAL RETURN
AOS (PP) ;COPY END-OF-PAGE SKIP RETURN
>;END IFN ANS74
JRST WRTRE6 ;
>;END IFE SUPP
;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:
IFN ANS74,<
SETZM NRSAV.+4 ; CLEAR SAVED ACTUAL KEY
>
PUSHJ PP,CLRSTS ;[601] CLEAR FILE STATUS WORD
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:
IFN LSTATS,<
TXNE AC16,V%STRT ;IS THIS START?
JRST WRTRWT ;YES,SO SKIP THIS MESS
TXNN AC16,V%READ ;SKIP IF READ
JRST WRTRWT ;WRITE JUMPS
MOVE AC1,D.CLRR(I16) ;GET CHAR LENGTH OF REC READ
PUSHJ PP,BUCREC ;SET AC2 TO REC BUCKET OFFSET
TXNE AC16,V%RNXT ;IS IT READ NEXT ?
JRST WRTRNX ;YES, JUMP
L.METR (MB.RDD(AC2),I16) ;NO, CNT BUCKET FOR READ
JRST WRTRWT ;FINISH
WRTRNX: L.METR (MB.RNX(AC2),I16) ; METER READ NEXT BUCKET
WRTRWT: MRTME. (AC1) ;END TIMING, UPDATE TIME BUCKET
;THIS ENDS TIMING FOR READ,READ NEXT,
;WRITE AND START
>;END IFN LSTATS
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
IFN LSTATS,<
JFFO AC2,.+1 ;AC3=# ZEROS TO LEFT OF AC2'S LEFT 1
MOVEI AC1,RRBITS ;GET NUMBER OF INTERESTING BITS ON LEFT
SUB AC1,AC3 ;CALC BUCKET PAIR POSITION
CAILE AC1,RR.NUM ;LS= UPPER BOUND?
MOVEI AC1,RR.NUM ;NO, MAKE IT UPPER BOUND
JUMPGE AC1,.+2 ;SKIP IF GTR= ZERO
SETZ AC1, ;MAKE ZERO
MRTMS. (AC3) ;START RERUN TIMING
LSH AC1,1 ;MULTILY BY 2 (COUNTING TIMING BKTS)
L.METR (MB.RRN(AC1),AC16) ;SET RERUN METER POINT
>;END IFN LSTATS
JRST WRTR16
WRTR15: SKIPL REDMP. ;SKIP IF A FORCED DUMP
JRST WRTR11 ;NEITHER
WRTR16: PUSHJ PP,RRDMP ;DUMP
PUSHJ PP,RSAREN ;RESTORE .JBSA, .JBREN
MRTME. (AC1) ;END RERUN METER TIMING
WRTR11: TLNN FLG,RANFIL ;DONT MESS WITH OLD KEY (D.RP) IF RANFIL
AOS D.RP(I16) ;BUMP THE RECORD COUNT
IFN ANS68,<
TXNN AC16,V%READ ;SKIP IF READ
>
IFN ANS74,<
TXNN AC16,V%READ!V%DLT ;SKIP IF READ OR DELETE
>
AOS (PP) ;
TXNN AC16,FL%EOT ;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,(V%CLOS!CLS%B8!CLS%CR!FL%WRC) ;CLOSE REEL WITH REWIND AND FL%WRC 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: OUTSTR [ASCIZ /NOT ENOUGH FREE CORE BETWEEN .JBFF AND OVERLAY AREA/]
WOVLRY: MOVE AC2,[BYTE (5)10,31,20,21,4]
TXNN AC16,V%READ ;GET THE RIGHT MESSAGE
MOVE AC2,[BYTE (5)10,31,20,22,4]
TXNE AC16,V%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: PUSH PP,AC2 ;SAVE PAD BUFF COUNT
TXNN AC16,V%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 ;[343] IF BINNARY LET NXT WRITE/CLOSE OUTPUT IT
PUSHJ PP,WRTBUF ;[343] OUTPUT A BUF
WRTR18: POP PP,AC2 ; RESTORE PAD BUFF COUNT
TLZE FLG,ATEND ;[343] EOF?
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) ;[343] IF THIS IS THE LAST RECORD
CAIN AC2,1 ;[343] IN THIS LOGICAL BLOCK
SETZM D.OBC(I16) ;[343] NOTE THAT THE BUFFER IS FULL
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)
TXNN AC13,DV.MTA ; 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,(TRN) ;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
IFN ANS74,<
JUMPN C,WAD2 ;GIVE UP IF NOT JUST LINE FEED
SKIPE F.LCP(I16) ;DO WE HAVE LINAGE STUFF?
MOVEI C,5 ;YES, USE DC3 INSTEAD
>
JRST WAD2 ;
WAD1: MOVEI AC4,1 ; ASSUME ONE CHAR TO OUTPUT
LDB C,[POINT 7,(AC15),35] ;[500] ONLY TAKE NEEDED 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"
SETZ C, ; GET A "LF"
WAD2: TLNE FLG,RANFIL+OPNIO; SKIP IF NOT A RANDOM FILE
JRST WAD3 ;
IFN ANS74,<
SKIPN F.LCP(I16) ;LINAGE-COUNTER?
JRST WAD2C ;NO
CAIN C,1 ;YES, IS IT PAGE?
JRST WAD2P ;YES
PUSH PP,C
PUSH PP,AC4 ;NEED 2 ACS
ADDB AC4,F.LCP(I16) ;INCREMENT BY NO. OF LINES
HLRZ C,F.LPP(I16) ;GET LINES PER PAGE
CAIG AC4,(C) ;OVERFLOW?
JRST WAD2A ;NO
AOS -2(PP) ;GIVE SKIP RETURN
WAD2D: MOVEI AC4,1 ;YES
MOVEM AC4,F.LCP(I16) ; RESET IT TO 1
HRRZ AC4,F.LAB(I16) ;LINES AT BOTTOM?
JUMPE AC4,WAD2E ;NO
PUSHJ PP,WRTDC3 ;YES
SOJG AC4,.-1 ;LOOP
WAD2E: MOVE C,-1(PP)
MOVE AC4,0(PP) ;RESTORE ACCS, BUT LEAVE ON STACK
PUSHJ PP,WAD2C ;OUTPUT ADVANCING CHAR.
HRRZ AC4,F.LCI(I16) ;NEED TO INITIALIZE FOR NEXT PAGE
JUMPE AC4,WAD2F ;NO
PUSHJ PP,SAVAC. ;SAVE THE CURRENT ACCS
PUSHJ PP,(AC4) ;GO TO USER ROUTINE
PUSHJ PP,RSTAC. ;RESTORE STATE
WAD2F: HLRZ AC4,F.LAT(I16) ;LINES AT TOP?
JUMPE AC4,WAD2G ;NO
PUSHJ PP,WRTDC3 ;YES
SOJG AC4,.-1 ;LOOP
WAD2G: POP PP,AC4
POP PP,C
POPJ PP,
WAD2P: HLRZ AC4,F.LPP(I16) ;GET LINES PER PAGE
SUB AC4,F.LCP(I16) ;CURRENT COUNT
ADDI AC4,1 ;ONE FOR THIS ADVANCING
MOVEI C,5 ;DC3
PUSH PP,C
PUSH PP,AC4
JRST WAD2D ;OUTPUT SOME BLANK LINES + BOTTOM AND TOP OF PAGE
WAD2A: HRRZ C,F.WFA(I16) ;GET FOOTING LIMIT
JUMPE C,WAD2B ;NO LIMIT
CAIL AC4,(C) ;DID WE OVERFLOW INTO FOOTING?
AOS -2(PP) ;YES, GIVE ERROR RETURN (BUT DON'T RESET COUNT)
WAD2B: POP PP,AC4
POP PP,C
WAD2C:>
MOVE C,WADTBL(C) ; GET CHAR FROM TABLE
PUSHJ PP,WRTCH ;
SOJG AC4,.-1 ;
POPJ PP, ;
WAD3: MOVE C,WADTBL(C) ; GET CHAR FROM TABLE
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
IFN ANS74,<
WRTDC3: PUSHJ PP,WRTCR ;CR
MOVEI C,23 ;DC3
JRST WRTCH ;WRITE AND RETURN
>
WRTLF: SKIPA C,WADTBL ;"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
OUTSTR [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
TRNA
ERROP1: MOVEI AC0,^D34 ;THE "INPUT" MESS
SETOM FS.IF ;IDX FILE
TLNE FLG,IDXFIL ;ISAM FILE?
ADD AC0,[E.FIDX] ;YES
SETZ AC2,
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"
TXNN AC16,V%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
TRNA
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
OUTSTR [ASCIZ/NOT A LEGAL SIXBIT FILE OR INCORRECT BLOCK FACTOR... ASCII?
/]
ERRMRS: OUTSTR [ASCIZ /THE MAXIMUM RECORD SIZE MAY NOT BE EXCEEDED/]
ERRMR: TXNE AC16,V%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 VERB
;A READ VERB LOOKS LIKE:
;FLAGS,,ADR WHERE ADR = FILE TABLE ADDRESS
;CALL+1: NORMAL RETURN
;CALL+2: "AT-END" OR "INVALID-KEY" RETURN
RDNXT.: TXO AC16,V%RNXT ;[-74] TURN ON READ NEXT FLAG
READ.: MRTMS. ;START LIBOL METER TIMING
SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS?
PUSHJ PP,SU.RD ; YES
IFN ISTKS,<JRST FAKER1>
FAKER.:
IFN ISTKS,<HLRZ I12,D.BL(I16)
AOS OUTSSS+15(I12)
FAKER1:>
TXO AC16,V%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
TLNE FLG,NOTPRS ;JUMP IF OPTIONAL AND NOT PRESENT
JRST RERE7 ;
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
TXNN AC13,DV.MTA ;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
MOVEM AC4,D.CLRR(I16) ;[545] SAVE THE CHARACTER COUNT
HRRZ AC3,AC4 ;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: SETZ AC5, ; [577] CLEAR AC5, INDICATING NOT MTA EOR
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
IFE SIRUS, < JUMPL C,READ4 ;JUMP IF EOL CHAR>
MOVE AC5,AC3 ;SAVE ACTUAL RECORD SIZE FOR ZERO FILL
MOVEM AC5,RELEN. ;[332] INITIAL RELEASE SIZE
MOVEM AC5,D.CLRR(I16) ;[545] SAVE THE CHARACTER COUNT INCASE TOO BIG
IFN SIRUS,< JUMPL C,READ5A ; [403] EMPTY RECORD-TREAT AS ALL BLANKS >
;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]
MOVEM AC5,D.CLRR(I16) ;[545] SAVE THE CHARACTER COUNT
EXCH AC5,RELEN. ;[332]
IFN SIRUS,<
PUSHJ PP,READ52 ; [403] FILL OUT REST OF REC WITH SPACES
JRST READ8 ; [403] FINISHED
>
READ52: MOVEI C," " ;ASCII SPACE
TLNN FLG,CDMASC ;
SETZ C, ;SIXBIT SPACE
IDPB C,AC6 ;TRAILING SPACES
SOJG AC3,.-1 ;FILL OUT THE RECORD WITH SPACES
IFE SIRUS,< JRST READ8 ; [403] >
IFN SIRUS,< POPJ PP, ; [403] FINISHED >
READ51: LDB AC3,F.BMRS ;GET MAX RECORD SIZE
SUB AC3,AC5 ;NUMBER OF ZEROS TO FILL
IFE SIRUS,< JUMPG AC3,READ52 ;DOIT >
IFN SIRUS,< JUMPLE AC3,READ6 ; [403] GO LOOK FOR EOL
PUSHJ PP,READ52 ; [403] FILL BLANKS
>
;RECORD IS FULL. PASS CHAR TILL AN "EOL" CHAR IS ENCOUNTERED.
READ6: JUMPGE FLG,READ8 ;JUMP SIXBIT HAS NO "EOL"
READ7: TXNN AC13,DV.MTA ; [577] SKIP IF MTA
JRST READ7B ; [577] ELSE GO ON
LDB AC0,F.BBKF ; [577] GET BLOCKING FACTOR
SOJN AC0,.+2 ; [577] SKIP IF NOT BLOCKED 1
SETO AC5, ; [577] ELSE INDICATE MTA BLK-1 EOR
READ7B: PUSHJ PP,READCH ; [577]
XCT AC10 ; [577] CONVERT IF NECESSARY
TLZE FLG,ATEND ; [577] SKIP IF NOT AT END
JRST READ8 ; [577] ELSE CLEAR IT AND CONT
SKIPE D.IBC(I16) ; [577] SKIP IF NO CHARS READ(ITS MTA EOR)
JRST READ7A ; [577] ELSE GO ON
SETO C, ; [577] NEGATE C TO FAKE EOL
HLLZ FLG1,D.F1(I16) ; [577] GET FLAGS
TLNE FLG1,NOCRLF ; [577] SKIP IF MESSAGE NOT OUT YET
JRST READ7A ; [577] ELSE CONT
OUTSTR [ASCIZ/%RECORD FROM/] ; [577]
MOVE AC2,[BYTE (5)10,14 ] ; [577] FILENAME AND RETURN
PUSHJ PP,MSOUT1 ; [577]
OUTSTR [ASCIZ/ DOESN'T END IN CR-LF
[THIS MESSAGE APPEARS ONLY ONCE PER OPEN]
/]
TLO FLG1,NOCRLF ; [577] SET NOCR FLAG SO MESSAGE PRINTS ONCE
HLLM FLG1,D.F1(I16) ; [577] RESTORE FLAGS
SETO C, ; [577] NEGATE C TO FAKE EOL
READ7A: TLZN FLG,ATEND ; [577]
JUMPGE C,READ7B ;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"***
; [577] HERE IF NO CRLF AT END OF MULTI RECORD MTA BLOCK,ERROR
SPNERR: OUTSTR [ASCIZ /?NO CR-LF AT END OF RECORD IN MULTI RECORD BLOCK.
/]
MOVE AC2,[BYTE (5)10,31,20,21,4]
PUSHJ PP,MSOUT. ; [577] "FILE ON DEV CAN'T DO INPUT" STOP0
;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
MOVEM AC11,D.CLRR(I16) ;SAVE LENGTH OF REC READ
MOVEI AC12,6 ;ASSUME DATA RECORD IS SIXBIT
TLNE FLG,CDMASC ;IS IT ACTUALLY ASCII?
MOVEI AC12,5 ;YES--5 BYTES PER WORD
TLNE FLG,CDMEBC ;[555] IS IT EBCDIC?
MOVEI AC12,4 ;[555] YES--4 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, ; CLEAR NULL CHAR COUNT
MOVEM AC4,D.CLRR(I16) ;[545] SAVE THE CHARACTER COUNT
;[435] 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:
SETZ AC0, ; CLEAR NULL CHAR COUNT
;[435] MOVE AC5,D.IBB(I16) ; GET BYTE-PTR TO AC5
SOS D.IBC(I16) ; DECREMENT THE BYTE-COUNT
RER74:;[435] ILDB C,AC5 ; GET CHAR
ILDB C,D.IBB(I16) ;[435] GET CHAR
JUMPN C,RER75 ; EXIT IF NON-NULL
ADDI AC0,1 ; COUNT THE NULLS
;[435] SOJG AC4,RER74 ; LOOP FOR A RECORD
SOJG AC4,RER71 ;[435] LOOP FOR A RECORD
;GOT A NULL RECORD
LDB AC4,F.BMRS ; RESTORE RECORD SIZE
;[435] 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
;[435] LDB C,AC5 ; REGET THE LAST CHAR
LDB C,D.IBB(I16) ;[435] 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
;[435] MOVE AC5,D.IBB(I16) ; GET BYTE-PTR TO AC5
SOS D.IBC(I16) ; DECREMENT THE BYTE-COUNT
RER81:
;[435] ILDB C,AC5 ; GET CHAR
ILDB C,D.IBB(I16) ;[435] GET CHAR.
RER82: XCT AC10 ; CONVERT
IDPB C,AC6 ; PUT CHAR
SOJG AC4,RER8 ; LOOP
;[435] MOVEM AC5,D.IBB(I16) ; SAVE THE BYTE-POINTER
JRST WRTR10 ; GO HOME
;GET A CHARACTER
RECH:
;[435] SOSGE D.IBC(I16) ; BUFFER EMPTY?
;[435] PUSHJ PP,READBF ; YES - FILL IT
SOSL D.IBC(I16) ; [435] BUFFER EMPTY?
JRST RECH1 ; [435] NO.
PUSHJ PP,READBF ; [435] YES, GO FILL IT.
SOS D.IBC(I16) ; [435] KEEP THE CHAR COUNT RIGHT.
RECH1: ILDB C,D.IBB(I16) ; [435] GET CHAR
TLNN FLG,ATEND ; EOF?
AOSA (PP) ; 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
TRNE C,777677 ;[476] IF NOT BLANK (100) OR ZERO (0)
PUSHJ PP,RERE6 ; ERROR
PUSHJ PP,RECH ; SKIP LAST CHAR
JUMPN AC4,RERE0 ; COMPLAIN IF EOF AND DATA
TRNE C,777677 ;[476] IF NOT BLANK (100) OR ZERO (0)
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
OUTSTR [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
OUTSTR [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
OUTSTR [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
OUTSTR [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
OUTSTR [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
OUTSTR [ASCIZ "THE TWO LOW ORDER BYTES OF A BLOCK/RECORD WORD MUST BE ZERO"]
JRST ERRMR ; NO, COMPLAIN
;HERE IF FILE OPTIONAL AND NOT PRESENT
RERE7: TLOE FLG,ATEND ;SET "AT END" PATH TAKEN
JRST REAAEE ;FATAL THE SECOND TIME
MOVEM FLG,F.WFLG(I16) ;SAVE FLG
;IFN ANS74,< ;[601]
PUSHJ PP,ENDSTS ;SET FILE STATUS TO 10
;> ;[601]
JRST RET.2 ;SKIP EXIT
RNULER: SKIPE AC0,D.LBN(I16) ; GET LAST BLK NUMBER,IF THERE IS ONE
CAME AC0,D.CBN(I16) ; SKIP IF LAST BLOCK
JRST RNRNUA ; NO(T) LAST BLOCK,ERROR
SETZM R.WRIT(I12) ; ZERO THE WRITE FLAG
TLO FLG,ATEND ; SET ATEND FLAG
JRST RANXI0 ; TAKE ATEND RETURN
RNRNUA: OUTSTR [ASCIZ/READ NULL RECORD WITHIN V FORMAT SEQUENTIAL FILE
/]
JRST ERRMR ; EXIT WITH ERROR
;READ AN "EOF". TAKE "AT-END" PATH. ***POPJ***
READEF: PUSHJ PP,ENDSTS ;[601]SET ATEND 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
TXNE AC13,DV.MTA ;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: PUSHJ PP,CLRSTS ;[601]CLEAR FILE STATUS
HRLI AC16,440 ;CLOSE REEL
PUSHJ PP,C.CLOS ;A READ GENERATED CLOSE
HRLI AC16,2100 ;READ
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***
;[577] HAM 7-JUN-79
;[577] THE FOLLOWING KLUDGE CHECKS FOR THE NO CRFL AT END OF MTA
;[577] RECORD. IN CASE WHEN THIS IS DETECTED, A SIMPLE RETURN TO CALLER
;[577] IS MADE. THIS ASSUMES THAT THIS CASE WILL ONLY OCCUR AFTER
;[577] THE ACTUAL RECORD BODY HAS BEEN READ IN, AND THAT THE SEARCH FOR
;[577] 'EOL' CHARS IS ON. THUS ONLY AT THE RETURN FROM READCH AT READ7:
;[577] IS THE CHECK FOR THIS CASE MADE.
;[577] AC5 NEGATIVE INDICATES THE MTA EOR CASE
READCH: SOSLE D.IBC(I16) ;[577] DECREMENT BYTE COUNT,SKIP IF BUFFER EMPTY
JRST REDCHB ;[577] GO ON IF MORE DATA IN BUFFER
JUMPGE AC5,REDCHA ;[577] GET ANOTHER BUFFER IF NOT MTA EOR
POPJ PP, ;[577] RETURN IF MTA END OF BUFFER ALREADY READ
REDCHA: PUSHJ PP,READBF ;[577] INPUT IF YOU MUST
REDCHB: TLNE FLG,ATEND ;[577] SKIP IF NOT AT END ("EOF")
POPJ PP, ;
ILDB C,D.IBB(I16) ;RETURN WITH A CHAR IN C
IFE SIRUS,<
SKIPN C ;SKIP IF NOT A NULL CHAR
JUMPL FLG,READCH ;IGNORE IT IF IT IS A ASCII NULL
POPJ PP, ;
>
IFN SIRUS,<
JUMPGE FLG,READCX ; [403] IF NOT ASCII FILE RETURN
SKIPE 11 ; [403] OTHER WISE SKIP NULLS
CAIN 11,15 ; [403] OR <CR>
JRST READCH ; [403]
READCX: POPJ PP, ; [403] RETURN
>
READBF: PUSHJ PP,READIN ;GET A BUFFER
TRN
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
OUTSTR [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
OUTSTR [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
OUTSTR [ASCIZ /RECORD-SEQUENCE-NUMBER /]
HRLO AC12,AC4 ;RSN
PUSHJ PP,PPOUT4 ;TYPE IT
OUTSTR [ASCIZ / SHOULD BE /]
HRLO AC12,D.RP(I16) ;RECORD COUNT
PUSHJ PP,PPOUT4 ;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,(TRN) ;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 START VERB
;A START VERB LOOKS LIKE:
;FLAGS,,ADR WHERE ADR = FILE TABLE ADDRESS
;STA%EQ EQUAL TO
;STA%NL NOT LESS THAN
;STA%GT GREATER THAN
;CALL+1 NORMAL RETURN
;CALL+2 "INVALID KEY" RETURN
C.STRT: TXO AC16,V%STRT ;SET FAKE READ BIT
IFN LSTATS,<
SETZ AC1, ;ASSUME = TEST
TXNE AC16,STA%GT ;IS IT .GT. TEST ?
AOJA AC1,.+3 ;YES,INDICATE AND GO
TXNE AC16,STA%NL ;IS IT .GE. TEST ?
MOVEI AC1,2 ;YES, MARK THIS
LSH AC1,1 ;MULTIPLY BY 2
L.METR (MB.STE(AC1),AC16) ;METER THE START MARKED BY AC1
;START METER TIMING BEGINS IN READ
>;END IFN LSTATS
JRST READ. ;AND DO FAKE READ
STRT.0: TXNN AC16,STA%EQ ;TEST FOR =
JRST STRT.I ;YES, FAIL FIRST TIME
HRRZ AC1,F.RACK(I16) ;GET POINTER TO RELATIVE KEY
JUMPE AC1,STRT.I ;NO KEY
AOS (AC1) ;INCREMENT
JRST RANDOM ;TRY AGAIN
STRT.I: PUSHJ PP,NRESTS ; SET REC NOT FOUND (23)
JRST RET.2 ;AND GIVE ERROR RETURN
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, ; [431] 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 ;
IFN ANS68,<
PUSHJ PP,FLIMIT ;CHECK ACTUAL KEY VS. FILE LIMITS
>
IFN ANS74,<
PUSHJ PP,SETKEY ;SET AND CHECK RELATIVE KEY
>
; THE FOLLOWING CALCULATES THE DISTANCE BETWEEN RANDOM I/O
;REQUESTS AND INCREMENTS THE APPROPRIATE BUCKET.
IFN LSTATS,<
JUMPE AC4,RDKYDX ;SKIP ALL THIS IF KEY ZERO
MOVE AC1,AC4 ;GET KEY
SUB AC1,D.RP(I16) ;GET DISTANCE FROM CURRENT RECORD
MOVEI AC2,3 ;ASSUME DIST. SMALL POS.
JUMPL AC1,RDKYD0 ;SKIP AHEAD IF NEG DISTANCE
CAIGE AC1,^D100 ;DIST. LS 100?
JRST RDKYD2 ;YES,GO CHECK 0-99 RANGE
CAIL AC1,^D1000 ;DIST. GTR= 1000?
ADDI AC2,1 ;YES,INCREMENT TO GET 5
ADDI AC2,1 ;NO, INCREMENT TO GET 4
JRST RDKYD1 ;GO COUNT BUCKET
RDKYD0: MOVN AC1,AC1 ;MAKE POS
CAIG AC1,^D100 ;DIST FARTHER THAN 100?
SOJA AC2,RDKYD1 ;NO,INDICATE OFFSET 2 AND GO BUCKET
CAILE AC1,^D1000 ;DIST FARTHER THAN 1000?
SUBI AC2,1 ;YES,SUB TO GET 0 OFFSET
SUBI AC2,2 ;NO,SUB TO GET 1 OFFSET
RDKYD1: LDB AC1,DTCN. ;GET CHANNEL NUMBER
ADD AC2,MROPTT(AC1) ;ADD BUCKET BLK ADDR TO OFFSET
AOS MB.KYD(AC2) ;INCREMENT BUCKET
JRST RDKYDX ;FINISHED NOW
RDKYD2: SOJG AC1,RDKYD3 ;JUMP IF GRT THAN 1
AOS AC2,AC1 ;ELSE SET AC2=AC1+1
JRST RDKYD4 ;AND GO INCR BUCKET
RDKYD3: CAIGE AC1,5 ;SKIP IF GTR = 6 (REMBER -1 ABOVE)
SOJA AC2,RDKYD4 ;ELSE SET AC2=2 AND GO BUCKET
CAILE AC1,^D24 ;SKIP IF LS = 25
ADDI AC2,1 ;ELSE SET AC2=4
RDKYD4: LDB AC1,DTCN. ;GET CHANNEL NUMBER
ADD AC2,MROPTT(AC1) ;ADD BUCKET BLK ADDR TO OFFSET
AOS MB.KY2(AC2) ;INCREMENT BUCKET
RDKYDX:>;END IFN LSTATS
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 ;[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,SEQIOZ ;[461] 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 ;[273] EOF
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,DDMBIN ;IF BINARY,
JRST RANDO7 ; GO TO SPECIAL ROUTINE
JUMPL FLG,RANA01 ;JUMP IF ASCII
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
RNDO20: JUMPN AC2,RANWRZ ;ONWARD IF NOT A ZERO LENGTH RECORD
TXNN AC16,V%READ!V%RWRT ;READ OR REWRITE?
JRST RANWR0 ;WRITE OR DELETE!
IFN ANS68,<
MOVE AC1,F.RACK(I16) ;GET THE
MOVE AC1,(AC1) ; ACTUAL KEY
>
IFN ANS74,<
TXNE AC16,V%STRT ;START VERB?
JRST STRT.0 ;YES, NON-EXISTENT RECORD
LDB AC1,F.BFAM ;GET ACCESS MODE
>
TLNE FLG,RANFIL ;A RANDOM FILE?
IFN ANS68,<
JUMPN AC1,RANDO3 ;YES - NEXT RECORD?
>
IFN ANS74,<
JUMPN AC1,[TXNE AC16,V%RNXT ;YES, BUT READ NEXT IS OK
JRST .+1 ;READ NEXT WINS
JRST RANDO3] ;RANDOM LOSES
>
SKIPN NRSAV. ;[426] IF WE ALREADY HAVE START OF NULL STRING
SKIPN AC1,D.LBN(I16) ;[426] OR IF NOT AN IO FILE
JRST RNDO21 ;[426] JUMP
CAMLE AC1,D.CBN(I16) ;[426] IS THIS THE LAST BLOCK OF FILE?
JRST RNDO21 ;[426] NO
MOVE AC1,[-5,,NRSAV.-1] ;[426] SAVE PTRS TO LAST REAL REC
PUSH AC1,R.BPNR(I12) ;[426]
PUSH AC1,FS.RN ;[426]
PUSH AC1,D.RP(I16) ;[426]
PUSH AC1,D.RCL(I16) ;[426]
RNDO21: MOVE AC0,R.BPNR(I12) ;[426] YES - HERE TO GET NEXT NON-0-RECORD
MOVEM AC0,R.BPLR(I12) ; BUT FIRST UPDATE
AOS R.BPNR(I12) ; THE POINTERS
HRRZ AC0,D.WPR(I16) ; GET WORDS PER RECORD
SUBI AC0,1 ; DECREMENT FOR AOS ABOVE
JUMPGE FLG,RNDO22 ; JUMP IF NOT ASCII
TLNE FLG,RANFIL ; SKIP IF NOT A RANDOM FILE I.E.SEQ
ADDM AC0,R.BPNR(I12) ; POSITION TO NEXT RECORD
RNDO22: AOS D.RP(I16) ;COUNT 0LEN RECORDS
AOS FS.RN ;BUMP THE RECORD NUMBER
IFN ANS74,<
HRRZ AC1,F.RACK(I16) ;GET POINTER TO RELATIVE KEY
SKIPE AC1
AOS (AC1) ;POINT TO RECORD WE WILL GET NEXT TRY
>
AOJA AC5,SQIO2 ;FIND THE NEXT ONE
;HERE IF RECORD NOT FOUND
RANDO3: PUSHJ PP,NRESTS ;[601]SET FILE STATUS TO 23
TLNE FLG,RANFIL ;SKIP IF NOT A RANDOM FILE
JRST RANDO4 ;RANDOM JUMPS
SOS D.RP(I16) ;DONT COUNT THIS ONE
AOS D.RCL(I16) ;DONT COUNT "EOF" AS A RECORD
TLO FLG,ATEND ;SET "EOF" FLAG
RANDO4: MOVE AC0,R.BPNR(I12) ;UPDATE POINTERS IN CASE HE WANTS TO
TLNE FLG,RANFIL ;RANDOM FILE?
HRRI AC0,(AC5) ;YES, USE THIS REC POINTER
MOVEM AC0,R.BPLR(I12) ; WRITE AFTER "EOF"
HRRM AC5,R.BPNR(I12) ;MAKE THIS THE NEXT RECORD
AOS R.BPNR(I12) ; NEXT
HRRZ AC0,D.WPR(I16) ; GET WORDS PER RECORD
SUBI AC0,1 ; DECREMENT FOR AOS ABOVE
;IFN ANS74,<
; TXNN AC16,V%RNXT ; READ NEXT AND
; TLNN FLG,RANFIL ; SEQUENTIAL FILES GET
; PUSHJ PP,ENDSTS ; NO NEXT RECORD (10) STATUS
;>
JUMPGE FLG,RNDO41 ; JUMP IF NOT ASCII
TLNE FLG,RANFIL ; SKIP IF NOT A RANDOM FILE I.E.SEQ
ADDM AC0,R.BPNR(I12) ; POSITION TO NEXT RECORD
RNDO41: JRST RANXI3 ;RETURN
;HERE TO POSITION TO ASCII REC WITHIN LOGICAL BLOCK
RANA01: TLNN FLG,RANFIL ; SKIP IF A RANDOM FILE
SKIPN (AC5) ; SKIP IF SEQIO NON-NULL RECORD
TRNA ; RANDOM OR NULL RECORD SKIPS
JRST RANA09 ; WE DONT HAVE TO POSITION
HRRZ AC10,D.WPR(I16) ; GET WORDS PER RECORD
IMUL AC10,AC2 ; GET OFFSET TO FIRST REC WRD
ADDI AC5,(AC10) ; POINT BYTE-PTR AT RECORD
MOVEM AC5,R.BPNR(I12) ; SAVE IT AWAY
RANA09: MOVE AC2,(AC5) ;GET FIRST RECORD WORD
JRST RNDO20 ;
;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
TXNN AC16,V%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
IFN ANS74,<
TXNN AC16,V%DLT ; IS THIS DELETE??
JRST RAND10 ; NO,GO ON
HRLS AC5 ; YES,SET SO IT WILL BLT TO ITSELF
SETZM (AC5) ; CLEAR FIRST WORD
ADDI AC5,1 ; SET TO BLT . TO .+1
SUBI AC10,1 ;DECREMENT THIS TO MAKE UP FOR ADD ABOVE
>;END IFN ANS74
RAND10: ADDI AC10,(AC5) ;FINAL DESTINATION PLUS 1
BLT AC5,-1(AC10) ;BLAT!!
TXNE AC16,V%READ ;IS IT READ?
MOVSS AC5 ;YES,RESET AC5 TO GET BUFFER ADDR IN RIGHT HALF
JRST RANXIT
;SEQUENTIAL IO READ AND WRITE ARE PROCESSED HERE
SEQIOZ: SETZM NRSAV. ;[461] CLEAR SO WRONG BYTE POINTERS
;[461] DON'T GET POP'D
SEQIO:
IFN ANS74,<
HRRZ AC5,F.RACK(I16) ;IF THERE IS A RELATIVE KEY
JUMPE AC5,SEQIO0 ;NOT
PUSH PP,D.RP(I16) ;THEN UPDATE IT
POP PP,0(AC5) ;WITH NEW VALUE
SEQIO0:>
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
IFN ANS68,<
TXNN AC16,V%WRITE!V%WADV ;SKIP IF WRITE AFTER READ
>
IFN ANS74,<
TXNN AC16,V%RWRT!V%DLT ;SKIP IF REWRITE OR DELETE AFTER READ
>
SQIO2: SKIPA AC1,D.RCL(I16) ;NUMBER OF REC TO FILL CURRENT LOGBLK
JRST SQIO20 ;
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
MOVE AC0,R.BPLR(I12) ; NOW, MAKE THE NEXT RECORD SLOT
MOVEM AC0,R.BPNR(I12) ; BE THE SAME AS THE LAST 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
PUSHJ PP,ENDSTS ; [601] NO NEXT REC STATUS (10)
IFN ANS74,<
HRRZ AC4,F.RACK(I16) ; GET POINTER TO RELATIVE KEY
JUMPE AC4,RANXI0 ; DONT RESTORE NONEX KEY
MOVE AC0,NRSAV.+4 ; GET ORIGINAL KEY
MOVEM AC0,(AC4) ; AND RESTORE IT
>
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
TXNN AC16,V%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 ;[273]
;HERE ON WRITE AFTER READ
SQIO20:
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!DDMASC ;[526] NO REC-CNT IF EBC
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: JUMPG FLG,SQIO33 ;JUMP IF NOT ASCII
TLNN FLG,SEQFIL ;SKIP IF SEQ FILE
JRST RANA09 ; NOT SEQ,GO ON
JRST RANWRT ; SEQ, SKIP WORD CHECKS
SQIO33:
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: HRRZ AC10,D.WPR(I16) ; GET WORD OFFSET TO NEXT RECORD
IMUL AC10,AC2 ; GET NUMBER OF WORDS BEFORE THE DESIRED RECORD
ADDI AC5,(AC10) ; ADD THIS OFFSET TO BYTE-PTR
MOVEM AC5,R.BPNR(I12) ; UPDATE NEXT RECORD POINTER
;ENTRY POINT FOR SEQIO EBCDIC FILES
RNES: TXNN AC16,V%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: MOVE AC1,AC5 ; GET COPY SOURCE PTR
MOVE AC0,AC3 ; GET COUNT OF CHARS IN REC
RNR01A: ILDB C,AC1 ; GET A CHAR
JUMPN C,RNER06 ; EXIT HERE IF NOT NULL
SOJG AC0,RNR01A ; LOOP
TLNN FLG,RANFIL ; NULL RECORD,SKIP IF RANDOM FILE
MOVE AC5,AC1 ; RESET AC5 TO NEXT RECORD FOR SEQ
;GOT A NULL RECORD SEE WHAT TO DO WITH IT
RNRNUL:
IFN ANS74,<
TXNE AC16,V%STRT ; SKIP IF NOT START
JRST STRT.0 ; BACK TO START WITH NO FIND
>
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: SKIPL D.FCPL(I16) ; SKIP IF NULL BLOCK (SET AT RNIN1A)
JRST RNER2A ; JUMP AHEAD IF NON-NULL BLOCK
; IN NULL CASE SET UP SO AS TO
; SKIP AHEAD TO THE NEXT BLOCK
MOVE D.RCL(I16) ; GET NUMBER RECORDS LEFT IN BLK
ADDM AC0,D.RP(I16) ; ADVANCE RECORD COUNTERS
ADDM AC0,FS.RN ; SO AS TO INDICATE BEGINING OF NEXT BLK
SETZM D.RCL(I16) ; CLEAR THIS TO GET NEXT BLK
RNER2A: LDB AC3,F.BMRS ; RESTORE RECORD SIZE
TLNN FLG,RANFIL ; SKIP IF RANDOM FILE
JRST RNER2B ; ELSE, NULL RECORD IN SEQUENTIAL FILE
HRRZ AC0,D.WPR(I16) ; GET WORDS PER RECORD
ADD AC5,AC0 ; ADVANCE AC5 TO 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
RNER2B: 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
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:
IFN ANS74,<
TXNE AC16,V%STRT ; SKIP IF NOT START
JRST RNRSTT ; START, GO ON WITHOUT FINISHING READ
>
SETZM NRSAV. ; ZERO WHEN REAL REC IS FOUND
ILDB C,AC5 ; REGET FIRST CHAR
JRST RNER21 ; NOW GET REST OF RECORD
;HERE IF GOT NON-NULL FOR START
RNRSTT: SETOM R.STRT(I12) ; INDICATE START DONE
JRST RNER40 ; RETURN TO USER (EVENTUALLY)
;READ - VAR-LEN RECORDS SO CHECK THE SIZE
RNER10: PUSHJ PP,RNDW ; GET RDW INTO AC1 AND AC0
JUMPN AC1,RNR10A ; JUMP IF NOT NULL RECORD
TLNN FLG,RANFIL ; SKIP IF RANDOM FILE
JRST RNULER ; ELSE,ERROR NULL RECORD IN SEQ VARIABLE FILE
JRST RNRNUL ; NOW GO CHECK WHAT TO DO WITH NULL
RNR10A:
IFN ANS74,<
TXNE AC16,V%STRT ; SKIP IF NOT START
JRST RNRSTT ; JUMP IF START
>
CAIGE AC3,-4(AC1) ; WILL IT FIT INTO RECORD AREA
PUSHJ PP,ERRMR1 ; NO - COMPLAIN
ADDI AC5,1 ; ADVANCE AC5 PAST RDW
MOVEI AC3,-4(AC1) ; USE ACTUAL ,NOT MAX SIZE
;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
IFN ANS74, JUMPGE FLG1,RNR30A ; JUMP IF FIXED LEN RECORDS
IFN ANS68, JUMPGE FLG1,RNER33 ; JUMP IF FIXED LEN RECORDS
PUSHJ PP,RNDW ; GET RDW INTO AC1
IFN ANS74, JUMPN AC1,RNR30C ; IT WILL BE 0 IF WE ARE APPENDING
IFN ANS68, JUMPN AC1,RNER31 ; IT WILL BE 0 IF WE ARE APPENDING
IFN ANS74,<
TXNE AC16,V%DLT!V%RWRT ;DELETE OR REWRITE?
JRST RNDLER ;YES, ERROR NULL RECORD
>
PUSHJ PP,MAKRDW ; GO WRITE AN RDW
JRST RNER32 ; GO WRITE RECORD
MAKRDW: HRLZI AC1,4(AC3) ; SO MAKE A RDW
MOVNI AC0,4(AC3) ; NEGATE THE COUNT
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 ;
POPJ PP, ; RETURN
IFN ANS74,<
;CHECK FOR NULL RECORD ERRORS
RNR30A: MOVE AC1,AC5 ; GET COPY DESTINATION PTR
ADDI AC1,1 ; ADVANCE PTR PAST RDW
ILDB AC1,AC1 ; GET A BYTE
JUMPE AC1,RNR30B ; SKIP AHEAD IF NULL RECORD
PUSHJ PP,WRTNUL ; GO CHECK FOR RANDOM WRITE TO NON-NULL REC
; DOESN'T RETURN IF ERROR
JRST RNER33 ; OK, GO DO IT
RNR30B: TXNE AC16,V%WRIT ; IS THIS WRITE?
JRST RNR33A ; YES, ALL OK GO ON
JRST RNDLER ; NO,TROUBLE-REWRITE OR DELETE WITH NULL REC
RNR30C: PUSHJ PP,WRTNUL ; GO CHECK FOR RANDOM WRITE TO NON-NULL REC
; DOESN'T RETURN IF ERROR
>;END IFN ANS74
RNER31:
IFN ANS74,<
TXNE AC16,V%DLT ;DELETE?
JRST RNRDLV ;YES, JUMP
>
CAIN AC1,4(AC3) ; SIZE OF EXISTING RECORD SAME AS NEW?
AOJA AC5,RNER32 ; SIZES EQUAL,GO WRITE RECORD
; AFTER ADANCING AC5 PAST RDW
LDB AC1,F.BMRS ; GET MAXIMUM RECORD SIZ
; ,RANDOM SPACED BY MAX REC SIZE
CAIGE AC1,4(AC3) ; WILL NEW RECORD FIT IN OLD PLACE?
JRST RERE5 ; NO,SIZE ERROR
PUSHJ MAKRDW ; YES,MAKE NEW RDW
RNER32:
RNER33:
IFN ANS74,<
TXNE AC16,V%DLT ;DELETE?
JRST RNERDL ;YES, JUMP
>
RNR33A: ILDB C,AC6 ; GET CHAR
XCT AC10 ; CONVERT
IDPB C,AC5 ; PUT CHAR
SOJG AC3,RNR33A ; LOOP
SETOM R.DATA(I12) ; NOTE ACTIVE DATA IN BUFFER
SETOM R.WRIT(I12) ; AND WRITE WAS LAST
;FINISH UP AND EXIT
RNER40: TLNN FLG,RANFIL ; RANDOM FILE?
JRST RNR40A ; NO
HRRZ AC5,D.WPR(I16) ; YES,GET DISTANCE TO NEXT RECORD
ADD AC5,R.BPNR(I12) ; THEN PTR IT TO NEXT RANDOM RECORD
RNR40A: EXCH AC5,R.BPNR(I12) ; UPDATE NEXT-RECORD AND
MOVEM AC5,R.BPLR(I12) ; LAST-RECORD POINTERS
TLNN FLG,RANFIL ; RANFIL FILE?
JRST RANXI0 ; NO - SEQIO FILE!
TXNN AC16,V%READ ; READ OR ?
JRST RANXI2 ; WRITE
JRST RANXI1 ; READ
IFN ANS74,<
;RESET RDW WORD TO INDICATE NULL RECORD
RNRDLV: MOVE AC1,AC5 ;GET POINTER TO RDW
SETZ C, ;GET NULL
IDPB C,AC1 ;ZERO FIRST BYTE
IDPB C,AC1 ;AND SECOND
ADDI AC5,1 ; ADVANCE AC5 TO RECORD START(AFTER RDW)
JRST RDERD1 ;GO DELETE RECORD
;DELETE A FIXED LENGTH RECORD
;FIRST CHECK THAT THERE IS NOT A NULL RECORD ALREADY THERE
RNERDL: MOVE AC1,AC5 ;GET BUFFER POINTER
ILDB C,AC1 ;GET A CHAR
JUMPN C,RDERD1 ;GO ON IF A NON NULL
JRST RNDLER ;ERROR, NULL RECORD
;NOW DELETE WHAT IS THERE
RDERD1: SETZ C, ;SET NULL CHAR
IDPB C,AC5 ;DELETE ONE CHAR
SOJG AC3,.-1 ;LOOP TILL ALL GONE
SETOM R.DATA(I12) ;NOTE ACTIVE DATA
SETOM R.WRIT(I12) ;AND NOT LAST READ
JRST RNER40 ;CLEAN UP
>;END IFN ANS74
;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
JRST RET.1 ; 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***
RANWRZ:
IFN ANS74,<
PUSHJ PP,WRTNUL ; CHECK FOR WRITE ON NULL (NO RETURN ON ERROR)
JRST RANWR0 ; ALL OK,GO ON
WRTNUL: TLNE FLG,RANFIL
TXNN AC16,V%WRITE ;RANDOM WRITE ?
POPJ PP, ; NO,OK- GO BACK
PUSHJ PP,DPLSTS ;YES, THEN ITS ILLEGAL
MOVEM AC5,R.BPLR(I12) ; UPDATE LAST RECORD POINTER
TLNN FLG,DDMSIX ; DEVICE DATA MODE SIXBIT?
JRST WRTNLA ; NO
ADDI AC2,5+6 ; ROUND UP - ACCOUNT FOR HEADER WORD
IDIVI AC2,6 ; CONVERT TO WORDS
ADD AC5,AC2 ; UPDATE POINTER TO NEXT RECORD
JRST RANWRX ; FINISH
WRTNLA: ADD AC5,D.WPR(I16) ; POSITION TO NEXT RECORD
RANWRX: JUMPGE FLG1,.+2 ; SKIP IF NOT VAR-LEN EBCDIC
SUBI AC5,1 ; OTHERWISE BACK AC5 TO ADDRESS RDW
MOVEM AC5,R.BPNR(I12) ; UPDATE THE POINTER
POP PP,(PP) ; KILL RETURN TO CALL POINT
JRST RET.3 ;BYPASS WRITE PARAMETERS & GIVE ERROR RETURN
>;END IFN ANS74
RANWR0: TLNN FLG,DDMASC ; ASCII SKIPS - HAS NO HEADER WORD
ADDI AC5,1 ;POINT AT DATA NOT RECSIZ
RANWRT:
IFN ANS68,<
TXNN AC16,V%WRITE!V%WADV ;IF IT'S WRITE,
>
IFN ANS74,<
TXNE AC16,V%DLT ;DELETE?
JRST RANDEL ;YES, ITS SPECIAL
TXNN AC16,V%WRITE!V%WADV!V%RWRT ;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!DDMASC ;SKIP IF CONVERSION IS NECESSARY
JUMPGE FLG,RANRB ;SIXBIT, GO BLT THE DATA
MOVE AC10,D.WCNV(I16) ;SETUP AC10
TXNE AC16,V%WADV ;IF IT'S WADV,
PUSHJ PP,WRTADV ;GO ADVANCE
IFN ANS74,<
TRNA ;NORMAL RETURN
AOS (PP) ;COPY END OF PAGE SKIP RETURN
>
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"
IFN ANS74,<
TLNE FLG,SEQFIL ;SEQ FILE?
JRST RANWR3 ;YES,DO NON-WORD ALIGNED CASE
>
PUSHJ PP,RANCR ;ALL ASCII RECORDS GET "CR"
TXNE AC16,V%WADV ;IF IT'S WRITE ADVANCE,
PUSHJ PP,WRTADV ;TRY TO
IFN ANS74,<
TRNA ;NORMAL RETURN
AOS (PP) ;COPY END OF PAGE SKIP RETURN
>
TXNE AC16,V%WRITE!V%RWRT ;IF IT'S WRITE OR REWRITE,
PUSHJ PP,RANLF ;GIVE HIM A "LF"
IFN ANS68,<
TLNE FLG,SEQFIL ;SEQ FILE?
JRST RANWR3 ;YES,DO NON-WORD ALIGNED CASE
>
ADDI AC5,1 ; POINT TO FIRST WORD OF NEXT RECORD
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
RANWR3: EXCH AC5,R.BPNR(I12) ;UPDATE NXT REC PTR
MOVEM AC5,R.BPLR(I12) ;UPDATE LAST REC PTR
SETOM R.DATA(I12) ;BUFFER DIRTY
SETOM R.WRIT(I12) ;WRITE LAST I-O
JRST RANXI0 ;FINISH AND EXIT
IFN ANS74,<
RANDEL: TLNN FLG,DDMSIX ;SIXBIT?
JRST RANDLA ;NO, ASCII
HRRZ AC3,-1(AC5) ;GET THE RECORD SIZE
JUMPE AC3,RNDLER ;NO RECORD--SO INVALID KEY
SETZ AC3, ;NO DATA JUST HEADER
PUSHJ PP,RANSHF ;MOVE EXISTING RECORDS DOWN
AOJA AC5,RANWR2 ;UPDATE THE RECORD POINTER & SIGNAL ACTIVE DATA
RANDLA: HRRZ AC1,AC5 ; GET ADR OF FIRST REC WORD
SKIPN (AC5) ; SKIP IF NOT A NULL RECORD
JRST RNDLER ; NULL! SO INVALID KEY RETURN
LDB AC10,F.BMRS ; GET MAX-RECORD SIZE
ADDI AC10,2+4 ; INCLUDE CRLF AND ROUND UP
IDIV AC10,D.BPW(I16) ; CONVERT TO REC SIZE IN WRDS
ADDI AC5,(AC10) ; POINT BYTE-PTR AT NEXT RECORD
HRL AC1,AC1 ; MAKE A BLT XWD
SETZM (AC1) ; ZERO THE FIRST RECORD WORD
ADDI AC1,1 ; NOW ITS A BLT XWD
HLRZ AC0,AC1 ; GET ADR OF FIRST REC WORD
CAIGE AC0,-1(AC5) ; SKIP BLT IF REC ONLY 1 WRD
BLT AC1,-1(AC5) ; CLEAR THE RECORD
JRST RANWR2 ; FINISH UP
RNDLER: JRST RANDO3 ;[601]EXIT WITH INVALID KEY
>;END IFN ANS74
;MOVE THE RANDOM/IO BUFFER AREA TO THE RECORD AREA. ***RANXIT***
RANREA:
IFN ANS74,<
TXNE AC16,V%STRT ;JUST DOING START?
JRST [SETOM R.STRT(I12) ;YES, SET FLAG
JRST RANXIT] ;AND EXIT
>
TLC FLG,DDMASC+SEQFIL ;SEQ ASCII FILE?
TLCN FLG,DDMASC+SEQFIL ;IFSO
JRST RANRE5 ;DO NON-WORD ALIGNED CASE
MOVE AC1,AC3 ;SAVE MAX RECORD SIZE IN CHARS
TLNE FLG,DDMSIX ;IF A SIXBIT FILE
HRRZ AC3,-1(AC5) ; USE THE ACTUAL SIZE
MOVEM AC3,D.CLRR(I16) ;SAVE LENGTH OF REC TO BE READ
TLNN FLG,CONNEC!DDMASC ;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
HRRZ AC2,AC5 ;SAVE RECORD ORIGIN
RANRE0: ILDB C,AC5 ;PICK UP A CHARACTER
XCT AC10 ;CONVERT IF NECESSARY
JUMPL C,RANRE0 ;IGNORE LEADING EOL CHARS
JUMPG C,RANRE1 ;[300] IF NOT NULL , CONTINUE
SOJG AC3,RANRE0 ;[300] IF MORE CHARS. THEN LOOP
JUMPE AC4,RANDOM ;[300] JUMP IF SEQ
MOVEI AC1,^D23 ; READ INVALID KEY
MOVEM AC1,FS.FS ; LOAD FILE-STATUS
AOS (PP) ;[300] SET UP SKIP RETURN
JRST RANRE2 ;[300] GO SET FLAGS
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 ;
JRST .+3 ;SKIP PAST D.CLRR UPDATE
RANRE4: SUB AC0,AC3 ;SET AC0 TO SIZE READ
MOVEM AC0,D.CLRR(I16) ;SAVE SIZE ACTUALLY READ
MOVEI C," " ;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
JUMPGE FLG,RANXIT ; JUMP IF FILE NOT ASCII
ADD AC2,D.WPR(I16) ; POINT TO FIRST WRD OF NEXT REC
MOVE AC5,AC2 ; PUT IT IN AC5
JRST RANXIT ;FINISH AND EXIT
RANRE5: MOVE AC10,D.RCNV(I16) ;GET CONVERSION INSTR
RANRE6: SOJL AC3,RANRE9 ;CNT CHAR,JUMP END OF REC
RANRE8: ILDB C,AC5 ;GET CHAR
XCT AC10 ;CONVERT
JUMPLE C,RANRE6 ;SKIP LEAD NULL AND EOR CHARS
JRST RANRE7 ;GOT REAL CHAR,GET REC
RANRE9: SKIPE D.RCL(I16) ;LAST REC IN LBLK?
JRST RANR12 ; NO
MOVE AC1,D.LBN(I16) ; YES,GET LAST LBLK #
CAMLE AC1,D.CBN(I16) ;LAST LBLK?
JRST RANR10 ; NO,GET NEXT LBLK
TLO FLG,ATEND ; YES,SET ATEND
SETOM R.WRIT(I12) ;SET NO READ LAST I-O
;IFN ANS74,< ;[601]
PUSHJ PP,ENDSTS ;SET NO NEXT REC STATUS
;> ;[601]
JRST RANXI0 ;EXIT WITH ATEND SKIP
RANR10: HRRZ AC1,D.BPL(I16) ;GET BUFF/LBLK
ADD AC1,D.CBN(I16) ;INDICATE CURRENT BUF #
PUSHJ PP,RANIN ;DO INPUT,WRITE IF BUF DIRTY
JRST RANR11 ;SUCCESS,CONT
OUTSTR [ASCIZ/?EOF IN RANRE5, INTERNAL ERROR/] ;EOF
JRST KILL. ;COMPLAIN AND EXIT
RANR11: MOVE AC5,R.BPNR(I12) ;SET NEXT REC PTR
RANR12: SOS D.RCL(I16) ;CNT THIS REC
LDB AC3,F.BMRS ;SET MAX REC SIZE
MOVE AC10,D.RCNV(I16) ;GET CONVERSION INSTR
JRST RANRE8 ;CONT SCAN FOR REC
;FIRST BACK UP ONE CHAR
RANRE7: MOVE AC1,AC5 ; GET COPY CURRENT POS PTR
SUBI AC1,1 ; BACK TO PREV. WORD
IBP AC1 ; SKIP AHEAD
IBP AC1 ; SKIP AHEAD
IBP AC1 ; SKIP AHEAD
IBP AC1 ; SKIP AHEAD
MOVEM AC1,R.BPLR(I12) ; SET LAST PTR TO CHAR JUST
; BEFORE REC START
LDB AC3,F.BMRS ;GET MAX REC SIZE
MOVE AC0,AC3 ;SAVE MAX REC SIZE
MOVEM AC0,D.CLRR(I16) ;SAVE HERE TOO
RANR13: SOJL AC3,.+2 ;CNT CHAR,SKIP PUT IF ALL MOVED
IDPB C,AC6 ;PUT CHAR
ILDB C,AC5 ;GET ANOTHER
XCT AC10 ;CONVERT
JUMPGE C,RANR13 ;LOOP TIL EOR
JUMPLE AC3,RANR14 ;REC FILLED? JUMP IF SO
SUB AC0,AC3 ;GET SIZE ACTUALLY READ
MOVEM AC0,D.CLRR(I16) ;UPDATE CHAR LENGTH OF REC READ
MOVEI C," " ; NO, GET BLANK
IDPB C,AC6 ; WRT BLANK IN REC
SOJG AC3,.-1 ; BLANK FILL REC
RANR14: MOVEM AC5,R.BPNR(I12) ;UPDATE NEXT REC PTR
SETZM R.WRIT(I12) ;READ WAS LAST I-O
JRST RANXI0 ;FINISH AND EXIT
;SETUP FLAG WORDS AND EXIT. ***WRTRE7***
RANXIT: MOVE AC0,R.BPNR(I12) ;CURRENT RECORD
MOVEM AC0,R.BPLR(I12) ;LAST RECORD
HRRI AC0,(AC5) ; ADR OF 1ST WRD OF NEXT ASCII REC
TLNE FLG,DDMSIX ; SKIP IF NOT SIXBIT
HRRI AC0,-1(AC5) ;ADR OF NEXT RECORD
MOVEM AC0,R.BPNR(I12) ;BP TO NEXT RECORD
RANXI0: TLNE FLG,RANFIL ;[273] IF A RANDOM FILE
JRST RANXI1 ;[273] ZERO ATEND FLAG
TXNN AC16,V%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
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
SETOM R.WRIT(I12) ;READ NOT SUCCESSFUL
JRST RANXI2 ;
RANXI8: MOVE AC0,R.BPNR(I12) ;[273] KEEP THE RECORD POINTERS
MOVEM AC0,R.BPLR(I12) ;[273] UP TO DATE
IFN ANS74,<
PUSHJ PP, NRESTS ; REC NOT FOUND STATUS (23)
SKIPE NRSAV.+4 ; EXIT IF ACTUAL KEY NOT SAVED
TXNN AC16,V%STRT ; SKIP IF START FAILED
JRST RANXI1 ; ELSE EXIT
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
MOVE AC0,R.BPLR(I12) ; NOW, MAKE THE NEXT RECORD SLOT
MOVEM AC0,R.BPNR(I12) ; BE THE SAME AS THE LAST RECORD SLOT
SETZM NRSAV. ; ZERO NULL-REC-IN-LAST-BLOCK FLAG
SETZM R.WRIT(I12) ; ZERO THE WRITE FLAG
HRRZ AC4,F.RACK(I16) ;GET POINTER TO RELATIVE KEY
MOVE AC2,NRSAV.+4 ; GET KEY
SKIPE AC4 ; SKIP IF NO KEY POINTER
MOVEM AC2,(AC4) ; SAVE IT FOR INVALID KEY CONDITION
>
JRST RANXI1 ;[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. ;
TXNE AC16,V%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
TXNE AC16,V%DLT ;IS THIS DELETE??
SUBI AC3,1 ;YES, DO THIS TO MAKE UP FOR AC5=BUFF,,BUFF+1
;NOT AC5=REC,,BUFF
BLT AC5,(AC3) ;ZRAPPP!
MOVE AC5,TEMP. ;
TLNN FLG,DDMBIN ;SKIP IF BINARY FILE
ADDI AC5,1 ;POINT TO NEXT RECORD
TXNN AC16,V%READ ;SKIP IF IT'S A READ
JRST RANBR2 ;NOP, A WRITE
TLNE FLG,DDMBIN ;IS DEVICE BINARY?
JRST RANRE2 ;YES,NO FILL NEEDED,FINISH UP
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
IFN ANS74,<
TXNN AC16,V%DLT ; IS THIS DELETE??
JRST RANBNA ; NO,GO ON
HRLS AC5 ; YES,SET SO IT WILL BLT TO ITSELF
SETZM (AC5) ; CLEAR FIRST WORD
ADDI AC5,1 ; SET TO BLT . TO .+1
RANBNA:>;END IFN ANS74
TXNE AC16,V%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
HLLZS D.IBL(I16) ;[475] TURN FLAG OF IN CASE
CAML AC1,D.LBN(I16) ;[475] IF WE ARE READING LAST BLOCK
HLLOS D.IBL(I16) ;[475] IT MAY BE A PART BLOCK REMEMBER
TLNN FLG,RANFIL ;SKIP THE USETI IF SEQIO
JRST RANI00 ;SKIP
IFN LSTATS,< ;CALL I/O HISTOGRAM ROUTINE TO RECORD
; THIS BLOCK REFERENCE
IFN ANS74,<
LDB AC5,F.BFAM ;GET ACCESS MODE
JUMPE AC5,RANMRX ;IF SEQ ACCESS SKIP THIS
>
MOVEM AC1,MRBNUM ;BLOCK NUMBER STORED HERE
PUSHJ PP,IOHSTR ;CALL HISTOGRAM ROUTINE
RANMRX:
>;END IFN LSTATS
TLNE AC1,-1 ; IF GREATER THAN 777777
PUSHJ PP,FUSI ; DO A FILOP. TYPE USETI
XCT USETI. ;*****************
RANI00: HRRM AC12,UIN. ;DUMP MODE IOWD
LDB AC5,F.BBKF ;BLOCKING FACTOR
IFN ANS68,<
TXNN AC16,V%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
AOS D.IE(I16) ;COUNT INPUT EXECUTED
HRRZ AC10,D.IBL(I16) ;[475] IF WE ARE ABOUT TO READ LAST
SKIPN AC10 ;[475] BLOCK IT MAY BE PART
JRST RNIN0A ;NOT LAST,SO SKIP CLEARING
PUSH PP,AC4 ;SAVE AC4 FOR EBCDIC READ
PUSHJ PP,ZDMBUF ;[475] SO CLEAR BUFFER OF OLD GARBAGE
POP PP,AC4 ;GET BACK AC4
RNIN0A: XCT UIN. ;********************
JRST RANIN1 ;NORMAL 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
JUMPN AC0,RNIN1A ; JUMP IF NOT NULL BLOCK
TXNN AC16,V%READ ; SKIP IF READ,WHEN D.FCPL WILL BECOME =-4
PUSHJ PP,MAKBDW ; CREATE BDW
RNIN1A: 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,R.IOWD(I12) ;GET IOWD TO BUFFER
SKIPE 1(AC2) ; SKIP IF A 0 SEEN
JRST .+3 ;SOMETHING THERE
AOBJN AC2,.-2 ;LOOP UNTIL NON-ZERO WORD SEEN
JRST RANIN4 ; NOTHING WAS INPUT - IT IS REALLY EOF
MOVE AC2,TEMP.1 ;RESTORE AC2
TLZ FLG,ATEND ;YES, SO TURN OFF THE EOF
JRST RANIN1 ; AND MAKE BELEIVE IT DIDN'T HAPPEN
RANIN4: MOVE AC2,TEMP.1 ;RESTORE AC2
TXNN AC16,V%READ ;READ UUO?
TLZA FLG,ATEND ; WRITE UUO SO CLEAR "ATEND"
AOSA (PP) ; READ GETS A SKIP EXIT
JRST RANIN5 ; TAKE NORMAL RETURN
IFN ANS68,<
HRRZ AC4,F.RACK(I16)
MOVE AC4,(AC4) ;GET ACTUAL KEY AGAIN
>
IFN ANS74,<
LDB AC4,F.BFAM ;GET FILE ACCESS MODE
>
TLNE FLG,RANFIL ; SKIP IF SEQUENTIAL FILE
SKIPE AC4 ; [601]ACTUAL-KEY IS 0, FILE IS SEQ?
JRST RANN4A ; [601]NO,"RECORD NOT FOUND" GOES HERE
PUSHJ PP,ENDSTS ; [601]YES,SET NO NEXT RECORD
JRST RANIN5 ; [601]GO ON
RANN4A: PUSHJ PP,NRESTS ; [601]SET NO RECORD FOUND STATUS
;IF VAR LEN RECS MAKE A BLOCK DESCRIPTOR WORD
RANIN5: JUMPGE FLG1,RANIN1 ; JUMP IF FIXED LEN RECS
PUSHJ PP,MAKBDW ; MAKE BDW FOR NEW BLOCK
JRST RANIN1 ; CONTINUE WITH NORMAL RETURN
;ROUTINE TO MAKE BDW AT FIRST WORD IN BLK
MAKBDW: HRRZ AC10,R.BPFR(I12); GET POINTER TO BDW (POINTS AFTER BDW)
HRRZ AC0,D.TCPL(I16) ; GET BLOCK SIZE
ADDI AC0,4 ; PLUS 4 FOR BDW
MOVSM AC0,-1(AC10) ; SAVE AS BDW
POPJ PP, ; 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
TLNE AC1,-1 ; IF GREATER THAN 777777
PUSHJ PP,FUSO ; DO A FILOP. TYPE USETO
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)
SKIPN AC4,(AC4) ;ACTUAL KEY
POPJ PP, ;OK IF 0, HE WANTS TO READ SEQ FROM HERE
TRNA
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 ;
TXNN AC16,V%READ!V%WRITE!V%WADV ;SKIP IF NOT A SEEK UUO
POPJ PP, ;SEEK, RETURN TO ***ACP***
POP PP,(PP) ;POP OFF RETURN ADR
TXNN AC16,V%READ ;INVALID-KEY EXITSKIP IF READ
AOS (PP) ;SKIP OVER THE OPERAND
MOVEI AC1,^D24 ;BOUNDRY VIOLATION
MOVEM AC1,FS.FS ;LOAD FILE-STATUS
PUSHJ PP,IVKSTS ;[601]BOUNDARY VIOLATION, SET 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, ;
IFN ANS74,<
;IF ACCESS MODE IS SEQUENTIAL
; SET AC4 = 0 IF NO RELATIVE KEY
; ELSE SET AC4 TO NEXT RECORD AND UPDATE KEY
;IF ACCESS MODE IS RANDOM MAKE SURE KEY IS VALID (GREATER THAN 0)
;F.BFAM 0 = SEQUENTIAL, 1 = RANDOM, 2 = DYNAMIC
SETKEY: LDB AC1,F.BFAM ;GET ACCESS MODE
HRRZ AC4,F.RACK(I16) ;GET POINTER TO RELATIVE KEY
SKIPN AC2,AC4 ; SKIP IF KEY PTR EXISTS
JRST SETKE1 ; NO KEY PTR SO 0 KEY
SKIPN AC2,NRSAV.+4 ; GET SAVED KEY IF ANY
MOVE AC2,(AC4) ; GET KEY
SETKE1: MOVEM AC2,NRSAV.+4 ; SAVE IT FOR INVALID KEY CONDITION
JUMPE AC4,SETKSA ;NO KEY SPECIFIED, READ SEQUENTIALLY
TXC AC16,V%READ!V%RNXT ;READ NEXT RECORD?
TXCN AC16,V%READ!V%RNXT
JRST [SKIPL R.STRT(I12) ;YES
JRST SETKSA ;THEN ITS SEQUENTIAL
JRST .+1] ;UNLESS START WAS LAST IO
TXNE AC16,V%READ
TXNN AC16,V%STRT ;IS IT START?
JRST @[EXP SETKYS,SETKYR,SETKYD](AC1)
TXZN AC16,STA%GT ;GREATER THAN?
JRST @[EXP SETKSS,SETKYR,SETKYD](AC1)
TXO AC16,STA%NL ;YES, MAKE NOT LESS THAN
AOS (AC4) ;AND INCREMENT THE KEY
JRST @[EXP SETKSS,SETKYR,SETKYD](AC1)
;SEQUENTIAL
SETKSS: SKIPE AC4,(AC4) ;GET KEY FOR START
POPJ PP,
SETKYS: SKIPN R.BPLR(I12) ;FIRST TIME?
SETZM (AC4) ;YES, START AT FRONT OF FILE
TXNN AC16,V%DLT ;DELETING LAST RECORD READ?
SKIPE R.STRT(I12) ; OR LAST IO WAS A START
TRNA ;NO
AOSA (AC4) ;NO, INCREMENT KEY
SKIPA AC4,(AC4) ;YES
SETKSA: SETZ AC4, ;SIGNAL SEQUENTIAL
SETZM R.STRT(I12) ;ONLY ONCE
POPJ PP,
;RANDOM
SETKYR: SETZM R.STRT(I12) ;CLEAR LAST IO WAS START
SKIPE AC4,(AC4) ;RELATIVE KEY
POPJ PP, ; RETURN WITH KEY SET UP
POP PP,(PP) ;POP OFF RETURN ADR
TXNN AC16,V%READ!V%DLT ;INVALID-KEY EXITSKIP IF READ
AOS (PP) ;SKIP OVER THE OPERAND
PUSHJ PP,IVKSTS ;BOUNDRY VIOLATION - LOAD FILE-STATUS
JRST RET.2 ; AND TAKE A SKIP EXIT ***ACP***
;DYNAMIC
SETKYD: JRST SETKYR ;SEQUENTIAL TAKEN CARE OF, MUST BE RANDOM
>
;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
TLNE AC1,-1 ; IF GREATER THAN 777777
PUSHJ PP,FUSI ; DO A FILOP. TYPE USETI
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:
IFN ISTKS,<HLRZ I12,D.BL(I16)
AOS INSSSS+15(I12)>
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
POPJ PP, ; 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
IFN ANS74,<
TXNN AC16,V%STRT ; SKIP IF START
JRST IREAD1 ; CHECK FOR SIMULTANEOUS UPDATE
TXNN AC16,STA%GT ; SKIP IF START AT .GT. CURRENT RECORD
SETOM NNTRY(I12) ; NOTE THAT CNTRY POINTS TO NEXT RECORD
>
IREAD1: 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
TLOE FLG1,RIVK ;[466] SET INVALID-KEY, FIRST TIME?
JRST RRDIV4 ;[466] NO
TLNN FLG,OPNOUT ;[466] IS FILE OPEN FOR OUTPUT
JRST IBSTO1 ;[466] NO, REPEAT
;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) ;[275] CLEAR NNTRY SO CNTRY POINTS TO CURRENT ENTRY
RRDIV1: POP PP,AC0 ;
TXNN AC16,V%READ ;READ?
AOS (PP) ;NO, RERITE OR DELET
SKIPE F.WSMU(I16)
PUSHJ PP,LRDEQX## ;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE
PUSHJ PP,NRESTS ;[601] SET NO RECORD ERROR
IFN ANS74,<
TXNE AC16,V%DLT ;; RERITE AND READ SKIP
POPJ PP, ;; DELETE ALREADY HAS A SKIP EXIT
>
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
SKIPN SU.FRF
JRST MOVBR ;JUMP IF NOT FAKE READ TO MOVE RECORD
; HERE IF FAKE READ TO GET BLOCK NUMBER
HRRZ AC2,CNTRY(I12) ;[447] GET CURRENT REC ADDR IN BUFFER
ADD AC2,DBPRK(I12) ;[447] ADD RELATIVE DATA-REC-KEY PTR
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 ;
JUMPE LVL,RET.1 ;
AOJA AC4,RET.1 ;CURRENT ENTRY OR REC
UPDOW1: POP PP,AC0 ;POPOFF THE RETURNS
SOJG LVL,.-1 ;
;IFN ANS74,< ;[601]
PUSHJ PP,ENDSTS ;SET STATUS
;> ;[601]
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
; [502] CHANGE AC15 TO AC2 FOR CALL TO PD6. OR PD7. BECAUSE PD USES 15.
TSO AC2,AC1 ;[502] INCLUDE THE KEY SIZE
HRRZI AC16,AC2 ;[502] 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 ;[307] IF TOP INDEX BLOCK WAS SPLIT - TRY AGAIN
TRN ;
TLOE FLG1,VERR ;
JRST LV2SK3 ;[307] NO - GIVE ERROR MESSAGE AND QUIT
MOVE LVL,MXLVL(I12) ;[307] OK - TAKE IT FROM THE TOP
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
SKIPN 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.: MRTMS. (AC1) ;START METER TIMING
SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS?
PUSHJ PP,SU.DL ; YES
TXO AC16,V%DLT ;
JRST RERIT1 ;
;HERE TO REWRITE AN EXISTING RECORD
RERIT.: MRTMS. (AC1) ;START METER TIMING
SKIPE F.WSMU(I16) ;ANY RETAINED RECORDS?
PUSHJ PP,SU.RW ; YES
TXO AC16,V%RWRT
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 ;
TXNN AC16,V%DLT ;IS IT DELET?
LDB AC3,WOPRS. ;NO,GET ACTUAL REC SIZE
TLNN FLG,OPNOUT ;FILE OPEN FOR OUTPUT?
JRST ERROPN ;NO
IFN LSTATS,<
MOVE AC1,AC3 ;GET RECORD SIZE
PUSHJ PP,BUCREC ;SET AC2 TO REC BUCKET OFFSET
TXNE AC16,V%DLT ;DELETE?
JRST RERITN ;YES,JUMP
L.METR (MB.RWT(AC2),I16) ;NO, METER REWRITE BUCKET
JRST RERITO ;FINISH
RERITN: L.METR (MB.DEL(AC2),I16) ;METER DELETE BUCKET
RERITO:>;END IFN LSTATS
IFN ANS74,<
LDB AC0,F.BFAM ;GET ACCESS MODE
JUMPN AC0,RERIT4 ;IF NOT SEQ, SKIP OVER I-O CHECK
TLNE FLG,OPNIO ;OPEN FOR I-O?
JRST RERIT3 ; YES,NEXT CHECK
MOVE AC2,[BYTE(5)10,31,20,6,14]; NO,ERROR
PUSHJ 17,MSOUT. ; OUTPUT MESS,I-O REQUIRED FOR
OUTSTR [ASCIZ/ FOR I-O/] ;THIS VERB
JRST KILL.
RERIT3: HLRZ I12,D.BL(I16) ; GET BUFFER POINTER
SKIPN R.WRIT(I12) ;READ LAST I-O ?
JRST RERIT4 ; YES,CHECKS OK
OUTSTR [ASCIZ/?READ MUST PRECEDE DELETE OR REWRITE FOR SEQUENTIAL ACCESS FILES
/];
JRST KILL ;GIT
RERIT4:
TLNN FLG,IDXFIL ;ISAM?
JRST RANDOM ;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
TXNE AC16,V%DLT ;DELET ?
JRST DEL01 ;YES
PUSHJ PP,MOVRB ;MOVE THE RECORD
RERIT2: PUSHJ PP,WDBK ;WRITE THE DATA BLOCK
SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE?
PUSHJ PP,LRDEQX## ; YES
MRTME. (AC1) ;END REWRITE TIMING
PUSHJ PP,CLRSTS ;[601] SET STATUS TO 00
IFN ANS74,<
TXNN AC16,V%DLT ;DON'T INCREMENT PC IF DELETE
AOS (PP)
POPJ PP, ;RETURN TO USER
>
IFN ANS68,<
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,IAKBP(I12) ;[276] BYTE POINTER TO DATA RECORD KEY
PUSHJ PP,LVTSTI ;TEST FOR LOW-VALUES
JRST DEL13 ;LOW-VALUES!
HRRZ AC1,@CNTRY0(I12) ;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 ;[307] INITIALIZE
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
TLZN FLG1,BVN ;[503] 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) ;[276] DATA BYTE-POINTER TO RECORD KEY
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
MOVE AC0,GDX.D(I12) ;[465] USE DATA MODE. NOT CORE MODE
PUSH PP,GDX.I(I12) ;[465] SAVE INDEX VS SYM-KEY
MOVEM AC0,GDX.I(I12) ;[465] AND USE DATA VS SYM-KEY
PUSH PP,GDPSK(I12) ;[276] SAVE IT
PUSH PP,F.WBSK(I16) ;[276] SAVE IT
MOVEM AC3,F.WBSK(I16) ;[276] FIRST KEY OF AUXBUF VS SYMKEY
MOVEM AC2,GDPSK(I12) ;[276]
TLO FLG1,NOTEST ;[276] SKIP THE CONVERSION AT ADJKEY
PUSHJ PP,@GETSET(I12) ;PLACE FIRST KEY OF AUXBUF IN IAKBP
TLZ FLG1,NOTEST ;[276] RESTORE THE FLAG
POP PP,F.WBSK(I16) ;[276] RESTORE SYMKEK POINTER
POP PP,GDPSK(I12) ;[276] RESTORE
POP PP,GDX.I(I12) ;[465] RESTORE INDEX VS SYM-KEY
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
SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE?
PUSHJ PP,LRDEQX## ; YES
PUSHJ PP,CLRSTS ;SET STATUS TO 00
MRTME. (AC1) ; END METER TIMING
JRST RET.2
IWIVK: SKIPN BRISK(I12) ;[466] SKIP IF NOT SLOW MODE
TLO FLG1,WIVK ;[466] SET FLAG
IWIVK2: SUB AC4,DBPRK(I12) ;[276] POINT AT BEGINNING OF THIS ENTRY
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
SKIPE F.WSMU(I16)
PUSHJ PP,LRDEQX## ;CALL LRDEQX IF FILE OPEN FOR SIMULTANEOUS UPDATE
;IFN ANS74,< ;[601]
PUSHJ PP,DPLSTS ;SET STATUS TO 22
;> ;[601]
MRTME. (AC1) ;END WRITE TIMING
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
TLZE FLG1,BVN ;[552] [503] IS DATA IN SECOND NEW BLOCK?
HRRM AC0,@CNTRY0(I12) ;[503] YES - 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
IFE ANS74,<
;DELETE FOR NOW AS IT CAUSES NAVY TESTS IX104 & IX204 TO FAIL
SETOM FS.IF ;[462] TURN ON THIS IS ISAM FLAG
MOVE AC0,[E.FIDX+E.BIDX+^D27] ;[462] THE ERROR MESSAGE
PUSHJ PP,IGCVR ;[462] DO USE PRO IF ANY
JRST UDIF34 ;[462] IGNORE, NO MESSAGE
>
OUTSTR [ASCIZ /
$ /]
MOVE AC2,[BYTE (5)10,31,20,14]
PUSHJ PP,MSOUT.
OUTSTR [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
OUTSTR [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
SKIPE HLOVL. ;[474] ARE THERE OVERLAYS?
HRRZ AC1,HLOVL. ;[474] YES, ONLY CLEAR TO BOTTOM OF OVERLAY
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: OUTSTR [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. ;[271] DON'T DO BLT IF FIRST RECORD
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 ;
MOVEM 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,(TRN) ;
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 ;[311] END OF TABLE?
SKIPN (AC10) ;[311] NULL ENTRY?
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 ?
TXNN AC16,V%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) ;[276] FIRST KEY,FIRST REC
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)
TXNN AC16,V%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: TXNE AC16,V%WRITE ;
JRST IWIVK ;WRITE INVALID-KEY
DSXIT: SUB AC4,DBPRK(I12) ;[276] DATA BYTE-POINTER TO RECORD KEY
DSXIT1: MOVEM AC4,CNTRY(I12) ;
SETZM NNTRY(I12) ;SO SREAD WILL GET "NEXT" RECORD
POPJ PP,
DSLT: TXNE AC16,V%WRITE ;
JRST DSXIT ;NORMAL IWRITE EXIT
SUB AC4,DBPRK(I12) ;[276] DATA BYTE-POINTER TO RECORD KEY
JRST RRDIVK ;READ, RERIT, DELETE INVALID-KEY
;NO RECORDS IN THIS DATA BLOCK
DSNUL: TXNE AC16,V%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
IFN ISTKS,<AOS @INSSS0(I12) ;COUNT THE IN'S >
IFN LSTATS,<
MOVEM AC1,MRBNUM ;SAVE BLOCK NUMBER
PUSHJ PP,IOHSTR ;CALL HISTOGRAM ROUTINE
>
TLNE AC1,-1 ; IF BLOCK NUMBER GT 18 BITS
PUSHJ PP,FIUSI ; DO A FILOP. TYPE USETI
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 ;[307] IF TOP BLOCK WAS SPLIT TRY AGAIN
JRST GBVER ;[307] NO - SO ERROR MESSAGE AND QUIT
JRST IBSTOP ;[307] YES - TRY ONE MORE TIME
;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: OUTSTR [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: TLNE AC1,-1 ; IF A "BIG" BLOCK NUMBER
PUSHJ PP,FUSI ; DO A FILOP. TYPE USETI
XCT USETI.
HRRI AC0,CMDLST
HRRM AC0,UIN.
IFN ISTKS,<AOS @INSSS0(I12) ;COUNT THE IN'S >
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] HERE ON "VERSION NUMBER DISCREPANCY ERROR"
;[307] SEE IF THERE ARE MORE INDEX LEVELS THAN THE READER KNOWS ABOUT
;[307] I.E. WHEN A WRITER SPLITS THE TOP BLOCK AND CREATES A NEW
;[307] INDEX LEVEL.
;[307] IF SO GET ANOTHER BUFFER TO ACCOMMODATE THE NEW INDEX LEVEL(S)
;[307] AND TRY AGAIN.
;[307] POPJ IF OPNOUT OR NO NEW INDEX LEVEL OR SORT IN PROGRESS
;[307] OR NO MORE CORE.
;[307] ELSE TAKE A SKIP EXIT -- TRY AGAIN.
VNDE: TLZE FLG1,TRYAGN ;[307] BEEN HERE BEFORE ?
POPJ PP, ;[307] YES - CAN'T HELP
TLO FLG1,TRYAGN ;[307] REMEMBER YOU'VE BEEN HERE
; ENTRY POINT TO READ FRESH COPY OF STS BLOCK
VNDE1: PUSHJ PP,RSTBK ;[307] NO - GET FRESH COPY OF STATISTICS BLOCK
MOVN AC5,MXLVL(I12) ;[307] SEE IF SOMEONE HAS CREATED
SUB AC5,OMXLVL(I12) ;[307] A NEW INDEX LEVEL
JUMPE AC5,RET.1 ;[307] EXIT HERE IF NOT
HRRZ AC1,ISPB(I12) ;[307] BUILD AN IOWRD IN AC6
IMULI AC1,200 ;[307] AND GET THE LENGTH IN AC1
MOVN AC6,AC1 ;[307] --
HRLZS AC6 ;[307] --
HRR AC6,.JBFF ;[307] --
SUBI AC6,1 ;[307] --.
MOVEI AC4,IOWRD+1(I12);[307] GET LOCATION OF THE FIRST
SUB AC4,OMXLVL(I12) ;[307] UNUSED IOWRD POINTER
HRL AC4,AC5 ;[307] # OF NEW IOWRD'S REQUIRED
VNDE10: SKIPE (AC4) ;[307] IF IOWRD ALREADY EXIST
JRST VNDE20 ;[307] TRY TO LOOP
SKIPE KEYCV. ;[307] IF SORT IN PROGRESS
POPJ PP, ;[307] QUIT -- CAN'T HANDLE THAT
HRRZ AC0,AC1 ;[307] LENGTH OF THE BUFFER AREA
PUSHJ PP,GETSPC ;[307] GET SOME SPACE
POPJ PP, ;[307] NONE LEFT
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) ;[307] MAKE A NEW IOWRD
ADD AC6,AC1 ;[307] AND SET UP FOR NEXT ONE
VNDE20: AOBJN AC4,VNDE10 ;[307] LOOP IF MORE LEVELS
;[V10] MOVN AC0,MXLVL(I12) ;[307] UPDATE OMXLVL
;[V10] MOVEM AC0,OMXLVL(I12) ;[307] AND THEN
JRST RET.2 ;[307] TAKE SKIP EXIT + TRY AGAIN
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: MOVEM AC0,CMDLST ;
TLNE AC1,-1 ; IF GREATER THAN 18 BITS
PUSHJ PP,FUSO ; DO A FILOP. TYPE USETI
XCT USETO. ;
MOVEI AC2,CMDLST ;
HRRM AC2,UOUT. ;
SETZM LIVE(I12) ;CLEAR THE LIVE FLAG
AOS IOUUOS(I12) ;
IFN ISTKS,<AOS @OUTSS0(I12) ;COUNT THE OUT'S >
XCT UOUT. ;
JRST .+2 ;
PUSHJ PP,WDBER ;OUTPUT ERROR
HLLZS UOUT. ;
PUSHJ PP,CKFOD ;[523] DO CHECK POINT FILOP.(.FOURB)
;[530] RETURN TO CALLER IF OK
;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)
IFN ISTKS,<AOS @OUTSS0(I12) ;COUNT THE OUT'S >
WIBK1: MOVEM AC0,CMDLST ;
AOS IOUUOS(I12) ;
TLNE AC1,-1 ; IF BLOCK NUMBER GT 18 BITS
PUSHJ PP,FIUSO ; USE FILOP. TYPE USETO
XCT ISETO ;
XCT IOUT ;
PUSHJ PP,CKFOI ;[523] DO CHECK POINT FILOP.(.FOURB)
WIBK2: MOVE AC0,CMDLST ; RESTORE AC0
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)
IFN ISTKS,<AOS OUTSSS+13(I12) ;COUNT THE OUT'S >
JRST WIBK1 ;
;WRITE AUXILARY BLOCK
WABK: MOVE AC1,AUXBNO
MOVE AC0,AUXIOW
HLL AC0,IOWRD(I12)
JUMPE LVL,WWDBK1
HLL AC0,IOWRD+1(I12)
IFN ISTKS,<AOS @OUTSS0(I12) ;COUNT THE OUT'S >
JRST WIBK1
;WRITE STATISTICS BLOCK
WSTBK: MOVEI AC1,1
MOVE AC0,IOWRD+14(I12)
IFN ISTKS,<AOS OUTSSS+14(I12) ;COUNT THE OUT'S >
JRST WIBK1
;READ A STATISTICS BLOCK
RSTBK: MOVEI AC1,1 ;[307]
MOVE AC2,IOWRD+14(I12) ;[307]
MOVEM AC2,CMDLST ;[307]
IFN LSTATS,<
MOVEM AC1,MRBNUM ;SAVE BLOCK NUMBER
PUSHJ PP,IOHSTR ;CALL I/O HISTOGRAM ROUTINE
>
TLNE AC1,-1 ; IF BLOCK NUMBER GT 18 BITS
PUSHJ PP,FIUSI ; USE FILOP. TYPE USETI
XCT ISETI ;[307]
IFN ISTKS,<AOS INSSSS+14(I12) ;COUNT THE IN'S >
XCT IIN ;[307]
POPJ PP, ;[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
TXNE AC16,V%READ ;IF NOT IREAD OR SREAD
AOS (PP) ; SKIP EXIT
POPJ PP,
RSTBK1: OUTSTR [ASCIZ /CANNOT READ STATISTICS BLOCK/] ;[307]
JRST IINER ;[307]
;READ A SAT BLOCK
RSBK: MOVEM AC1,USOBJ+13(I12)
MOVE AC2,IOWRD+13(I12)
MOVEM AC2,CMDLST
AOS IOUUOS(I12)
IFN LSTATS,<
MOVEM AC1,MRBNUM ;BLOCK NUMBER
PUSHJ PP,IOHSTR ;CALL HISTOGRAM ROUTINE
>
TLNE AC1,-1 ; IF BLOCK NUMBER GT 18 BITS
PUSHJ PP,FIUSI ; USE FILOP. TYPE USETI
XCT ISETI
IFN ISTKS,<AOS INSSSS+13(I12) ;COUNT THE IN'S >
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: OUTSTR [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
TXZ AC2,IO.ERR ;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
TXZ AC2,IO.ERR ;TURN EM OFF
XCT USETS. ; AND RESET THEM
JRST CLRIS1
;MOVE BUFFER TO RECORD (READ)
MOVBR: LDB AC0,F.BMRS ;MAX-REC-SIZ
MOVEM AC0,D.CLRR(I16) ;SAVE LENGTH
MOVE AC6,RECBP(I12) ;REC BYTE-POINTER
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!
MOVEM AC3,D.CLRR(I16) ;UPDATE WITH LENGTH READ
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
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
MOVBXT:
IFN LSTATS,<
MOVE AC1,D.CLRR(I16) ;GET REC LENGTH
PUSHJ PP,BUCREC ;SET AC2 TO REC BUCKET OFFSET
L.METR (MB.RDD(AC2),I16) ;CNT READ BUCKET
MRTME. (AC1) ;END TIMING,UPDATE TIME BUCKET
>;END IFN LSTATS
SKIPE F.WSMU(I16) ; SIMULTANEOUS - UPDATE?
PUSHJ PP,LRDEQX## ; YES
JRST CLRSTS ;SET STATUS TO 00 AND POPJ
;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, MOVBXT ;[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]
JRST MOVBXT
;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: TXNE AC16,V%DLT ;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: TXNE AC16,V%DLT ;DELETING?
JRST SHFR20 ;YES
TXNN AC16,V%WADV!V%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) ;
;[600] SKIPLE D.RCL(I16) ;LAST REC THIS BLOCK?
;[600] 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]
MOVE AC6,[JRST SHFR30] ;[600]
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) ;
SHFR30: HRRZ AC2,LRW(I12) ;[600] GET LAST RECORD WORD
SKIPLE D.RCL(I16) ;[600] NOT IF LAST RECORD
SETZM 1(AC2) ;[600] OTHERWISE, ZERO NEXT WORD
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 ;[307] INIT THIS FLAG
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 ;[271] JUMP IF FOUND
;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) ;[271] # OF SAT BLOCKS
SUBI AC0,1 ;[271] ADJUST COUNT
IMUL AC0,ISPB(I12) ;[271] TIMES # SECTORS / SAT
ADD AC0,SBLOC(I12) ;[271] PLUS FIRST BLOCK #
CAMG AC0,USOBJ+13(I12) ;IS THERE A NEXT ONE?
JRST ALC20 ;NO, TRY AGAIN, SEE IF ANY WERE DELETED
TLZE FLG1,WSB ;[310] WRITE OUT THE SAT-BLK?
PUSHJ PP,WSBK ;YES
MOVE AC1,ISPB(I12) ;[271] SECTORS / SAT
ADDB AC1,USOBJ+13(I12) ;[271] NEW USETI/O POINTER
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 ;
SUB AC0,AC1 ;
ADDI AC0,1 ;
MOVE AC1,USOBJ+13(I12)
SUB AC1,SBLOC(I12) ;
PUSH PP,AC2 ;[271] NEED TO SAVE AC2
IDIV AC1,ISPB(I12) ;[271] / NUMBER OF SECTORS PER SAT
POP PP,AC2 ;[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
MOVEM AC0,NEWBK1 ;SAV THE FIRST BLKNO
TLZN FLG1,BLK2 ;A TWO BLOCK REQ?
JRST WSBK ;ALLOCATE! WRITE OUT THE SAT BLOCK
MOVEM 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.
OUTSTR [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) ;[271] TIMES SECTORS / SAT
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
IFN ANS74,<
TXC AC16,V%READ!V%RNXT ;READ NEXT RECORD?
TXCN AC16,V%READ!V%RNXT
POPJ PP, ;YES, THEN ITS SEQUENTIAL
LDB AC1,F.BFAM ;GET ACCESS MODE
TXNE AC16,V%READ ;READ?
JUMPE AC1,RET.1 ;SEQUENTIAL BY DEFINITION
>
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 ?
AOSA (PP) ;NO, SKIP RETURN
TRNE AC3,1 ;TWO WORDS ?
POPJ PP, ;NO, EXIT
CAME AC2,1(AC1) ;LV ?
AOS (PP) ;NO, SKIP RETURN
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
JUMPN 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
TXNE AC2,IO.EOF ;EOF?
OUTSTR [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
TXNE AC2,IO.EOF ;EOF?
OUTSTR [ASCIZ /FOUND AN EOF INSTEAD OF DATA BLOCK/]
JRST IINER1 ;MESSAGE AND KILL
LVSKER: TXNE AC16,V%RWRT
OUTSTR [ASCIZ /REWRITE, /]
TXNE AC16,V%DLT
OUTSTR [ASCIZ /DELETE, /]
TXNE AC16,V%WRITE
OUTSTR [ASCIZ /WRITE, /]
OUTSTR [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
TXNN AC2,IO.ERR
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
;[523] USER WANTS FILOP. (.FOURB)
;RETURNS
;ERROR TO CALLER +1
;OK TO CALLER'S CALLER +1
CKFOI:
IFE TOPS20,<
SKIPE M7.00 ;IF 7.00
JRST PPOPJ ;RIB UPDATE WILL BE DONE BY MONITOR
>
LDB AC0,F.BCKP ;SEE IF USER WANTS TO CHECKPOINT FILE
JUMPE AC0,PPOPJ ;NO, RETURN TO CALLER'S CALLER+1
MOVE AC0,ICHAN(I12) ;[523] GET CHANNEL FOR INDEX FILE
JRST CKFOC ;[523] DON'T GET CH FOR DATA FILE
CKFOD:
IFE TOPS20,<
SKIPE M7.00 ;IF 7.00
JRST PPOPJ ;RIB UPDATE WILL BE DONE BY MONITOR
>
LDB AC0,F.BCKP ;SEE IF USER WANTS TO CHECKPOINT FILE
JUMPE AC0,PPOPJ ;NO, RETURN TO CALLER'S CALLER+1
LDB AC0,DTCN. ;[523] GET CHANNEL FOR DATA FILE
CKFOC: HRLM AC0,FUSCP. ;[523] PUT CHANNEL IN ARG. BLOCK
MOVE AC0,[1,,FUSCP.] ;[523] POINT AT ARG BLOCK
FILOP. AC0, ;[523] DO FILOP (UPDATE EOF POINTERS)
POPJ PP, ;[523] ERROR RETURN
PPOPJ: POP PP,(PP) ;[523] POP OFF CALLER
POPJ PP, ;[523] GOOD RETURN
> ;END IFN ISAM
;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETI
FIUSI: MOVE AC0,ICHAN(I12) ; GET INDEX FILE'S CHANNEL
JRST .+2
FUSI: LDB AC0,DTCN. ; GET DATA FILE'S CHANNEL
HRLM AC0,FUSIA. ; SET IT IN THE ARG-BLOCK
MOVEM AC1,FUSIA.+1 ; SETUP THE BLOCK-NUMBER
MOVE AC0,[2,,FUSIA.] ; POINT AT ARG-BLOCK
FILOP. AC0, ; DO THE USETI
JRST RET.2 ; ERROR RETURN
JRST RET.2 ; DONE
;BLOCK NUMBER IS LARGER THAN 18 BITS SO DO A FILOP TYPE USETO
FIUSO: MOVE AC0,ICHAN(I12) ; GET INDEX FILE'S CHANNEL
JRST .+2
FUSO: LDB AC0,DTCN. ; GET DATA FILE'S CHANNEL
HRLM AC0,FUSOA. ; SET IT IN THE ARG-BLOCK
MOVEM AC1,FUSOA.+1 ; SETUP THE BLOCK-NUMBER
MOVE AC0,[2,,FUSOA.] ; POINT AT ARG-BLOCK
FILOP. AC0, ; DO THE USETO
JRST RET.2 ; ERROR RETURN
JRST RET.2 ; DONE
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
TXC AC2,IO.ERR ;
TXCN AC2,IO.ERR ;MTA LABEL PROCESSING ERROR?
JRST IGMD2 ;YES
TXNE AC2,IO.IMP ;IMPROPER MODE?
MOVEI AC1,^D18
TXNE AC2,IO.DER ;DEVICE ERROR
MOVEI AC1,^D19
TXNE AC2,IO.DTE ;DATA ERROR
MOVEI AC1,^D20
TXNE AC2,IO.BKT ;QUOTA EXCEEDED, FILE STR, OR RIB FULL
MOVEI AC1,^D21
TXNE AC2,IO.EOF ;EOF
MOVEI AC1,^D22
MOVEI AC3,^D34 ;ASSUME DSK FULL
TXNE AC2,IO.BKT ;IS IT?
JRST IGMD2 ;YES
SKIPN AC3,FS.FS ;NO CHANGE IF NON ZERO
MOVEI AC3,^D30 ;PERMANENT ERROR
IGMD2: ADD AC0,AC1 ;UPDATE THE ERROR NUMBER
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: TXNE AC16,V%OPEN
ADD AC0,[EXP E.VOPE]
TXNE AC16,CLS%EF!CLS%EV!CLS%BV
ADD AC0,[EXP E.VCLO]
TXNE AC16,V%WADV!V%WRIT
ADD AC0,[EXP E.VWRI]
TXNE AC16,V%RWRT
ADD AC0,[EXP E.VREW]
TXNE AC16,V%DLT
ADD AC0,[EXP E.VDEL]
TXNE AC16,V%READ
ADD AC0,[EXP E.VREA]
;FALL THROUGH TO IGTST
;BUT FIRST INCLUDE FILE TYPE IN ERROR STATUS
MOVE AC13,D.DC(I16) ;GET DEV CHARACTERISTICS
TXNN AC13,DV.MTA ;IS IT AN MTA?
JRST IGCVF1 ;NO, SO NO LABEL ERRORS
TXC AC2,IO.ERR ;
TXCE AC2,IO.ERR ; IS THIS A MTA LABEL PROCESSING ERROR?
JRST IGCVF1 ; NO
MOVE AC4,[2,,1] ; LENGTH ,, ADDRESS
MOVEI AC1,.DFRES ; FUNCT - EXTENDED IO ERRORS
MOVE AC2,D.ICD(I16) ; ADDRESS OF
MOVE AC2,(AC2) ; SIXBIT /DEVICE/
DEVOP. AC4, ; GET IO ERRORS
SETZ AC4, ; "ERROR" GETTING ERROR CODE!
ADD AC0,[E.FMTA] ; FLAG IT AS LABEL PROCESSING ERROR
ADDI AC0,(AC4) ; ADD IN THE LTC
JRST IGCVF2 ; SKIP OVER THE REST
IGCVF1: TLNE FLG,SEQFIL ;SEQUENTIAL?
ADD AC0,[E.FSEQ] ;YES
TLNE FLG,RANFIL ;RANDOM?
ADD AC0,[E.FRAN] ;YES
IGCVF2: MOVEM AC0,FS.EN ;SAVE THE ERROR-NUMBER
;AND THEN SETUP SEQ/IO FILE FS.BN AND FS.RN
IGBNRN: TXNE AC16,V%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,(POINT 6,) ;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,(POINT 6,) ;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:
IFN ANS74,<
MOVE AC1,FS.FS ;GET ERROR CODE
CAIN AC1,^D10 ;END-OF-FILE ONLY?
JRST IGTST2 ;YES
>
SKIPE FS.IGE ;ANY ERRORS IGNORED YET?
JRST IGTST2 ;YES - IGNORE ALL FOR DURATION OF THIS VERB
MOVE FLG,-7(PP) ;[501] RESTORE FLAG. NOTE ** THIS
;ASSUMES THAT A "PUSHJ SAVAC" HAS
;BEEN DONE PRIOR TO COMING HERE.
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-SRO 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
;SET FILE STATUS WORD (IF IT EXISTS) TO 00
CLRSTS: SKIPE AC1,F.WPFS(I16) ;FILE STATUS WORD?
SKIPE FS.FS ;YES AND OK STATUS?
POPJ PP, ;NO, ASSUME ITS ALREADY SET UP
LDB AC2,[POINT 2,AC1,11] ;GET BYTE SIZE TO FIND TYPE
MOVE AC2,[EXP 360,'0',"0"]-1(AC2) ;GET ZERO
TLZ AC1,77 ;CLEAR COUNT
IDPB AC2,AC1 ;STORE STATUS
IDPB AC2,AC1 ;BOTH CHARACTERS
POPJ PP,
;SET FILE STATUS WORD (IF IT EXISTS) TO 10
ENDSTS: MOVEI AC0,^D10 ; [601]READ INVALID KEY
MOVEM AC0,FS.FS ; [601]LOAD FILE-STATUS
SKIPN AC1,F.WPFS(I16) ;FILE STATUS WORD?
POPJ PP, ;NO
LDB AC2,[POINT 2,AC1,11] ;GET BYTE SIZE TO FIND TYPE
MOVE AC2,[EXP 361,'1',"1"]-1(AC2) ;GET TEN
TLZ AC1,77 ;CLEAR COUNT
IDPB AC2,AC1 ;STORE STATUS
SUBI AC2,1 ;ZERO
IDPB AC2,AC1 ;BOTH CHARACTERS
POPJ PP,
;SET FILE STATUS WORD (IF IT EXISTS) TO 22
DPLSTS: SKIPN AC1,F.WPFS(I16) ;FILE STATUS WORD?
POPJ PP, ;NO
LDB AC2,[POINT 2,AC1,11] ;GET BYTE SIZE TO FIND TYPE
MOVE AC2,[EXP 362,'2',"2"]-1(AC2) ;GET TEN
TLZ AC1,77 ;CLEAR COUNT
IDPB AC2,AC1 ;STORE STATUS
IDPB AC2,AC1 ;BOTH CHARACTERS
POPJ PP,
;SET FILE STATUS WORD (IF IT EXISTS) TO 23
NRESTS: MOVEI AC0,FSNRCF ;[601]GET FS.FS NUMBER FOR REC NOT FOUND
MOVEM AC0,FS.FS ;[601]SET IT
SKIPN AC1,F.WPFS(I16) ;FILE STATUS WORD?
POPJ PP, ;NO
LDB AC2,[POINT 2,AC1,11] ;GET BYTE SIZE TO FIND TYPE
MOVE AC2,[EXP 362,'2',"2"]-1(AC2) ;GET TEN
TLZ AC1,77 ;CLEAR COUNT
IDPB AC2,AC1 ;STORE STATUS
ADDI AC2,1 ;THREE
IDPB AC2,AC1 ;BOTH CHARACTERS
POPJ PP,
;SET FILE STATUS WORD (IF IT EXISTS) TO 24
IVKSTS: SKIPN AC1,F.WPFS(I16) ;FILE STATUS WORD?
POPJ PP, ;NO
LDB AC2,[POINT 2,AC1,11] ;GET BYTE SIZE TO FIND TYPE
MOVE AC2,[EXP 362,'2',"2"]-1(AC2) ;GET TEN
TLZ AC1,77 ;CLEAR COUNT
IDPB AC2,AC1 ;STORE STATUS
ADDI AC2,2 ;FOUR
IDPB AC2,AC1 ;BOTH CHARACTERS
POPJ PP,
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
IFN DBMS,<
SKIPE DBMLOK## ;[520] IS THIS A DBMS PROGRAM?
JRST RRDM10 ;[520] YES, ERROR
>;END IFN DBMS
SKIPN KEYCV. ; [431] ARE WE SORTING?
JRST RRDMP7 ; [431] NO
PUSHJ PP,RRERR0 ; [431] COMPLAIN
OUTSTR [ASCIZ / SORT IN PROGRESS.
/]
JRST RRXIT ; [431] THEN EXIT.
RRDMP7: SKIPN OVRFN. ;IF OVERLAY FILE IS OPEN
JRST RRDMP6 ;
PUSHJ PP,RRERR0 ; ABORT -- CHANNEL 1 IS IN USE
OUTSTR [ASCIZ/ OVERLAY/]
JRST RRDMP9 ;
RRDMP6: SYSPHY AC0, ;SYSPHY UUO ;XIT IF LEVEL C
JRST RSTAC1 ;EXIT
HRRZ AC16,FILES. ;POINT TO FIRST FILE TABLE
TRNA
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"
OUTSTR [ASCIZ / IO/]
JRST RRDMP9 ;EXIT, NO DUMP
;SCAN FOR OPEN OUTPUT FILES
RRDMP2: HRRZ AC16,FILES. ;FIRST FILE-TABLE
TRNA
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
TXC AC13,DV.DSK!DV.CDR ;[321];IF IT'S A DSK AND A CARD READER
TXCE AC13,DV.DSK!DV.CDR ;[321]; IT'S THE NULL DEVICE - SO SKIP
TXNN AC13,DV.DSK!DV.MTA ;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
TLNE AC1,-1 ; IF GREATER THAN 777777
PUSHJ PP,FUSI ; DO A FILOP. TYPE USETI
XCT USETI. ;
JRST RRDMP3 ;CONT LOOP
RRDMP5: TLNN FLG,OPNIN!OPNOUT
JRST RRDMP1 ;THIS FILE IS NOT OPEN = CONT
TXC AC13,DV.DSK!DV.CDR ;[321];
TXCN AC13,DV.DSK!DV.CDR ;[321];NULL DEVICE
JRST RRDMP1 ;[321];YES -- GO ON
SKIPE F.WSMU(I16) ; ENQ'ING?
JRST [PUSHJ PP,RRERR0 ; "DUMP ABORTED"
OUTSTR [ASCIZ/ SIMULTANEOUS UPDATE/]
JRST RRDMP9] ; "FILE IS OPEN"
TLNE FLG,IDXFIL ;ISAM FILE?
JRST RRDMP8 ;YES
; TXNN AC13,DV.CDR!DV.LPT!DV.PTP!DV.PTR!DV.DTA ;CDR, CDP, PTP, PTR, DTA?
TXNN AC13,DV.CDR!DV.PTP!DV.PTR!DV.DTA ;(REMOVED LPT:) 7/25/78
JRST RRDMP1 ;NO, CONT SCAN
RRDMP8: PUSHJ PP,RRERR0 ;DUMP ABORTED
TLNE FLG,IDXFIL ;INDEX-SEQ-ACCESS MODE?
OUTSTR [ASCIZ / ISAM/]
TXNE AC13,DV.CDR ;CARDS?
OUTSTR [ASCIZ / CARD/]
;
;7-25-78 /DAW REMOVED CHECK FOR LPT FILES.
;
; TXNE AC13,DV.LPT ;LINE-PRINTER?
; OUTSTR [ASCIZ / LPT/]
;
TXNE AC13,DV.PTP!DV.PTR ;PAPER TAPE?
OUTSTR [ASCIZ / PAPER-TAPE/]
IFE TOPS20,<
TXNE AC13,DV.DTA ;
OUTSTR [ASCIZ / DEC-TAPE/]
>
RRDMP9: OUTSTR [ASCIZ / FILE IS OPEN.
/]
JRST RRXIT ;EXIT NO DUMP
RRDM10: PUSHJ PP,RRERR0 ;[520] YES WE CAN'T RERUN SO DON'T DUMP
OUTSTR [ASCIZ / PROGRAM HAS CALLS TO DBMS.
/]
JRST RRXIT ;[520] THEN EXIT
;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
IFE TOPS20,<
TXNE AC13,DV.DTA ;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
TXNE AC13,DV.MTA ;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: TLNE AC1,-1 ; IF GREATER THAN 777777
PUSHJ PP,FUSO ; DO A FILOP. TYPE USETO
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
TXNN AC2,IO.EOF!IO.BOT ;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-PTX
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,'DSK'
HRLZM AC3,UOBLK.+1 ;DEVICE NAME
MOVEI AC3,.IODMP ;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,.GTPRG ;USER PROGRAN NAME
GETTAB AC3, ;PROGRAM NAME TO AC3
JRST RRERR3 ;ERROR RET ;HRLZI AC3,(SIXBIT /PKC/)
MOVEM AC3,UEBLK. ;LOW-SEG NAME
HRLZI AC3,'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 ;
CORE AC0, ;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
PUSH PP,2(AC1)
MOVE AC2,LIBSW. ;STORE VERSION #
MOVEM AC2,2(AC1) ;SO WE KNOW ITS V12 OR LATER
IFN TOPS20,<
HRRZ AC2,JSARR. ;GET POINTER TO START.
MOVE AC3,(AC2) ;GET JSP
CAMN AC3,[JFCL]
MOVE AC3,1(AC2) ;GET JSP!
MOVE AC2,2(AC3) ;GET POINTER TO JFN STRING
PUSH PP,3(AC1) ;JUST IN CASE
MOVEM AC2,3(AC1) ;STORE IT
HRLI AC1,-3 ;WRITE OUT 3 WORDS
>
IFE TOPS20,<
HRLI AC1,-2 ;WRITE OUT 2 WORDS
>
SETZ AC2, ;TERMINATOR
MOVE AC6,[OUT AC1] ;FIRST RECORD ;TEMP.,,(.JBREL)
DPB AC5,[POINT 4,AC6,12]
XCT AC6
TRNA
JRST RRERR2 ;OUTPUT ERROR
IFN TOPS20,<
POP PP,3(AC1) ;RESTORE
>
POP PP,2(AC1) ;RESTORE
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]
IFE LSTATS,<
XCT AC6
TRNA
JRST RRERR2 ;OUTPUT ERROR
>;END IFE LSTATS
IFN LSTATS,<
SKIPN MRRERN ;DID WE RESTART WITH RERUN BEFORE?
JRST MNORRN ;NO, OK TO SET AND CLEAR "RERUNNING" FLAG
;WE RESTARTED THE PROGRAM USING RERUN AND NOW WE ARE DOING ANOTHER DUMP.
; THE FLAG "MRRERN" MUST STAY SET TO -1, SO NO OUTPUT GETS DONE TO MTO FILE.
XCT AC6 ;DO OUTPUT
JRST RROUOK ;ALL OK
JRST RRERR2 ;OUTPUT ERROR
;THE PROGRAM HAS NOT BEEN "RERUN". SET THE FLAG MRRERN TO -1 SO
;THAT IF WE ^C AND RUN RERUN LATER, THE PROGRAM WILL NOT TRY AND WRITE
;BAD INFORMATION INTO THE .MTO FILE.
MNORRN: SETOM MRRERN ;WE'LL SET AND CLEAR FLAG THIS TIME
XCT AC6 ;DO OUTPUT
JRST [SETZM MRRERN ;ALL OK, CLEAR FLAG
JRST RROUOK]
JRST [SETZM MRRERN ;OUTPUT ERROR..BUT CLEAR FLAG ANYWAY
JRST RRERR2] ;SO WE GET THE INFO COLLECTED SO FAR
RROUOK:
>;END IFN LSTATS
POP PP,.JBFF ; RESTORE THE STACK AND JOBFF
MOVSI AC6,(CLOSE)
DPB AC5,[POINT 4,AC6,12]
XCT AC6
OUTSTR [ASCIZ /DUMP COMPLETED.
/]
RRXIT: AOSN AC15 ;SKIP IF NOT FORCED
EXIT 1, ;EXIT IF IT WAS FORCED
JRST RSTAC1 ;RESTORE ACS AND POPJ
RRERR0: OUTSTR [ASCIZ /DUMP ABORTED /]
POPJ PP, ;
;OPEN FAILED
RRERR: PUSHJ PP,RRERR0 ;
OUTSTR [ASCIZ /OPEN FAILED. /]
JRST RRXIT ;
;ENTER FAILED
RRERR1: PUSHJ PP,RRERR0 ;
OUTSTR [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
OUTSTR @LEMESS(AC2) ;COMPLAIN
JRST RRERRX ;ERROR EXIT
;OUTPUT FAILED
RRERR2: POP PP,.JBFF ; RESTORE THE STACK AND JOBFF
PUSHJ PP,RRERR0 ;
OUTSTR [ASCIZ /OUTPUT ERROR, /]
GETSTS RC,AC2 ;ERROR STATUS
PUSHJ PP,IOERM1 ;COMPLAIN
RRERRX: OUTSTR [ASCIZ /
/]
CLOSE RC,CL.RST ;CLOSE, BUT DONT SUPERCEDE
JRST RSTAC1 ;EXIT
;CAINT FIND THE PROGRAM NAME
RRERR3: PUSHJ PP,RRERR0 ;
OUTSTR [ASCIZ /CANNOT FIND PROGRAM NAME/]
JRST RRERRX ;
;CORE UUO FAILED
RRERR4: POP PP,.JBFF ; RESTORE THE STACK AND JOBFF
PUSHJ PP,RRERR0
OUTSTR [ASCIZ /CORE UUO FAILED/]
JRST RRERRX ;
;NO IO CHANNELS FOR THE DUMP FILE
RRERR5: PUSHJ PP,RRERR0
OUTSTR [ASCIZ /NO CHANNELS AVAILABLE/]
JRST RRERRX
SUBTTL POINTERS AND THINGS
FLPS10: POINT 6,F.WPMT(AC10),17 ;FILE POSITION USING AC10
WOPRS.: POINT 12,AC15,11 ;RECORD SIZE IN CHARS
WOPCN: POINT 3,AC15,17 ;LPT CHANNEL NUMBER
STDLBP: POINT 6,STDLB. ;STANDARD LABEL POINTER
OPNCBP:: POINT 1,OPNCH.,0 ;[342]POINTER TO CHAN. STATUS
IFN SIRUS<SIRDEV: SIXBIT/SIRS/ ; SIRUS ARCHIVE DEVICE >
;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 UNSIGNED
;NOTE: UNTIL V11, THIS WAS INCORRECTLY
;DOCUMENTED AS 'ONE IF SIGNED'
;REVERSING THE EFFECTS FOR COMP-3
;EBCDIC LOW-VALUE SYMBOLIC KEYS.
KY.SIZ: POINT 12,KEYDES(I12),35 ; KEY SIZE
>
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
F.QOPN: POINT 1,F.WSMU(I16),15 ;[565] LFENQ. OPEN FLAG
;[565] 0= NOT AFTER LFENQ. OPEN
;[565] 1= AFTER LFENQ. OPEN
F.BNDV: POINT 6,F.WNOD(I16),17 ;NUMBER OF DEVICES SELECTED
F.BLF: F%BLF ;LOCK FLAG
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
IFN ANS68,<
F.BNFL: F%BNFL ; NUMBER OF FILE LIMIT CLAUSES
>
IFN ANS74,<
F.BFAM: F%BFAM ; FILE ACCESS MODE
>
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
F.BBM: F%BBM ; BYTE MODE FLAG
F.BCKP: F%BCKP ; CHECKPOINT ISAM FLAG
;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
IFE SIRUS, < XWD 400000, 400015 ;CR >
IFN SIRUS, < XWD 0, 0 ;CR TREAT AS NULL-IE. IGNORE >
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
SUBTTL METERING STUFF
IFN CSTATS,<
IFE TOPS20,<
;TOPS10 CSTATS ROUTINE TO GET A FREE CHANNEL
; RETURNS .+1 IF NONE AVAILABLE, ELSE .+2 WITH NUMBER IN RH(AC5)
GMCHAN: SKIPN AC5,OPNCH. ;ANY CHANNELS AVAIL?
POPJ PP, ;NO
MOVE AC6,OPNCBP ;GET BYTE PTR
HRRI AC5,1 ;START WITH 1
MOVEI AC2,17 ; UPPER LIMIT
GMCHN2: ILDB AC11,AC6
SOJE AC11,GMCHN1 ; SEE GCHAN. ROUTINE
CAILE AC2,(AC5)
AOJA AC5,GMCHN2
GMCHN0: SETZB AC5,AC11 ;USE CHANNEL 0 IF NONE OTHER FREE
GMCHN1: DPB AC11,AC6 ;NOTE CHANNEL UNAVAILABLE
JRST RET.2 ;GIVE SKIP RETURN
>;END IFE TOPS20
>;END IFN CSTATS
;METER--ING STUFF
;CALL: MOVEI 16,NUMBER
; PUSHJ 17,METER.
; <RETURN HERE>
METER.:
IFE CSTATS,<
POPJ PP, ;JUST RETURN IF WE EVER GET HERE
>
IFN CSTATS,<
IFN TOPS20,<
EXCH 16,PBUKET ;GET PREVIOUS BUCKET IN 16, SAVE NEW
;PREVIOUS BUCKET
AOS MTRNUM(16) ;ANOTHER ONE OF THESE
PUSH PP,1 ;SAVE 1 AND 2
PUSH PP,2
MTRJS% ;GET NEW CLOCK TIME IN 1,2
ERJMP .+6 ;ERROR
DMOVE 14,1 ;SAVE IN 14, 15
DSUB 1,PCLOCK ; GET INCREMENTAL CLOCK TIME
ASHC 1,^D24 ; SHIFT INTO 36 BIT VALUE
ADDM 1,MTRTIM(16) ;INCREMENT TIME
DMOVEM 14,PCLOCK ;SAVE NEW "PREVIOUS" CLOCK TIME
POP PP,2
POP PP,1
POPJ PP, ;RETURN
>;END IFN TOPS20
IFE TOPS20,<
; WE CAN SMASH AC14 AT THE METER--JSYS STATEMENT (NOBODY ELSE CARES)
HRRZ AC14,METR. ;AC14 POINTS TO START OF THE METER BUCKETS
EXCH 16,PBUKET(AC14) ;GET PREVIOUS BUCKET, STORE NEW ONE
ADD 16,AC14 ; 16 POINTS TO COUNTER FOR OLD BUCKET
AOS (16) ; COUNT THIS OCCURANCE
POPJ PP, ;AND RETURN
>;END IFE TOPS20
IFN TOPS20,<
;THE TABLES
MTRST==. ;START OF INFO
; *** DANGER !!!! ENRAGED CROCK APPROACHING !!! ***
MTRNUM: BLOCK ^D500 ;NUMBER OF TIMES THINGS WERE DONE
EXP 1
BLOCK ^D499
EXP 1
BLOCK ^D499
EXP 1
BLOCK ^D499
EXP 1
BLOCK ^D498
EXP 1
MTRTIM: BLOCK ^D500 ; TIMINGS
EXP 1
BLOCK ^D499
EXP 1
BLOCK ^D499
EXP 1
BLOCK ^D499
EXP 1
BLOCK ^D499
;*** END OF CROCK ***
MTREND==.-1 ;END
MTRLEN==MTREND-MTRST ;LENGTH OF THINGS TO WRITE OUT
METRNM: BLOCK 3 ;ASCIZ NAME OF FILE
PCLOCK: BLOCK 2 ;PREVIOUS VALUE RETURNED BY METER JSYS
PBUKET: BLOCK 1 ;PREVIOUS BUCKET NUMBER
>;END IFN TOPS20
;ROUTINE TO DO SETUP IF METR. WAS SET
; CALLED BY RESET CODE
SETMTR:
IFN TOPS20,<
MOVEI MTRNUM ;MAKE METR. POINT
MOVEM METR.## ; TO THE COUNTER TABLE
>;END IFN TOPS20
IFE TOPS20,<
METRLN==^D2500 ;NUMBER OF BUCKETS TO WRITE OUT
MTRNM6==0+METRLN ;SIXBIT NAME OF FILE
METRNM==1+METRLN ;ASCIZ NAME OF FILE
PBUKET==4+METRLN ;PREVIOUS BUCKET NUMBER
METCLN==5+METRLN ; NUMBER OF LOWSEG LOCS WE NEED
;CALL FUNCT. TO GET CORE AT PAGE BOUNDARY
;STORE POINTER IN METR.
MOVEI 16,1+[-5,,0
XWD 0,FUN.A0##
XWD 0,[ASCIZ/LBL/]
XWD 0,FUN.ST##
XWD 0,FUN.A1##
XWD 0,FUN.A2##]
F.PAG==15
MOVEI 1,F.PAG ;FUNCTION WE WANT
MOVEM 1,FUN.A0## ;STORE FUNCTION
SETZM FUN.ST## ;CLEAR STATUS
SETZM FUN.A1## ; AND ADDRESS RETURNED
MOVEI 1,METCLN ;NUMBER OF WORDS TO ALLOCATE
MOVEM 1,FUN.A2## ;STORE AS ARG #2
PUSHJ PP,FUNCT.## ;CALL FUNCT. ROUTINE...
SKIPE FUN.ST## ; STATUS MUST BE 0...
JRST METNCR ; ? NOPE - NO CORE AVAIL
HRRZ 1,FUN.A1## ;GOT IT -- GET ADDRESS OF START
MOVEM 1,METR. ;STORE IN METR.
>;END IFE TOPS20
MOVEI MTRREE ;SET REENTER ADDRESS
MOVEM .JBREN ; (NOTE: RERUN DUMPS WON'T WORK)
IFN TOPS20,<
SETZM MTRNUM+^D500 ;GET RID OF THE 1'S
SETZM MTRNUM+^D1000
SETZM MTRNUM+^D1500
SETZM MTRNUM+^D2000
SETZM MTRTIM-1
SETZM MTRTIM+^D500
SETZM MTRTIM+^D1000
SETZM MTRTIM+^D1500
SETZM MTRTIM+^D2000
GETNM ;GET SIXBIT NAME OF PROGRAM
SKIPN 1
MOVE 1,[SIXBIT/METER/] ;DEFAULT NAME
>;END IFN TOPS20
IFE TOPS20,<
HRROI 1,.GTPNM
GETTAB 1,
TRNA ;IF GETTAB FAILS, USE DEFAULT
SKIPN 1
MOVE 1,[SIXBIT/METER/]
HRRZ 2,METR.
MOVEM 1,MTRNM6(2) ;STORE NAME
>;END IFE TOPS20
MOVE 0,1
SETZ 1, ;MAKE SURE LAST BYTE IS 0
MOVSI 2,(POINT 6,0)
MOVE 3,[POINT 7,METRNM]
IFE TOPS20,<
ADD 3,METR. ;ADD INDEX TO GET REAL ADDRESS
>;END IFE TOPS20
SETMT1: ILDB 4,2
JUMPE 4,SETMT2
ADDI 4,40
IDPB 4,3
JRST SETMT1
SETMT2: MOVE 2,[POINT 7,[ASCIZ/.DYN/]]
SETM2A: ILDB 4,2
JUMPE 4,SETMT3 ;DONE MAKING THE STRING
IDPB 4,3
JRST SETM2A
SETMT3: SETZ 4,
IDPB 4,3
POPJ PP, ;ALL DONE!
IFE TOPS20,<
; COME HERE IF COULDN'T GET CORE FOR METER--ING
METNCR: OUTSTR [ASCIZ/? NOT ENOUGH CORE FOR METER--ING
/]
SETZM METR.## ;CLEAR LOCATION
JRST KILL. ;PUNT!
>;END IFE TOPS20
;HERE IF HE DID A ^C REENTER
MTRREE: IFE TOPS20, JRST 1,.+1 ;PORTAL IF TOPS10
PUSHJ PP,WRTMET ;WRITE IT OUT
EXIT ;AND EXIT
;ROUTINE TO WRITE IT OUT
; CALL: PUSHJ PP,WRTMET
; <RETURN HERE, EVEN IF ERRORS>
WRTMET: SKIPN METR. ;IF METER--ING WAS DONE, WRITE THE FILE
POPJ PP,
OUTSTR [ASCIZ/[WRITING METER FILE: /]
IFN TOPS20, OUTSTR METRNM
IFE TOPS20,<
HRRZ 1,METR.
OUTSTR METRNM(1)
>
OUTSTR [ASCIZ/]
/]
IFN TOPS20,<
MOVX 1,GJ%FOU!GJ%SHT
HRROI 2,METRNM
GTJFN
ERJMP METRRR
MOVX 2,OF%WR
OPENF
ERJMP METRRR
MOVE 2,[444400,,MTRST]
MOVNI 3,MTRLEN
SOUT
CLOSF
ERJMP METRRR ;JSYS ERROR
POPJ PP,
METRRR: HRROI 1,[ASCIZ/?JSYS ERROR: /]
PSOUT
MOVEI 1,.PRIOU
HRLOI 2,.FHSLF
SETZ 3,
ERSTR
JFCL
JFCL
HRROI 1,[ASCIZ/ FOR METER FILE /]
PSOUT
HRROI 1,METRNM
PSOUT
HRROI 1,[ASCIZ/
/]
PSOUT
POPJ PP,
>;END IFN TOPS20
IFE TOPS20,<
;FIND A FREE CHANNEL, WRITE OUT THE FILE WITH DUMP MODE IO,
; RELEASE THE CHANNEL & POPJ
PUSHJ PP,GMCHAN ;GET A FREE CHANNEL TO USE
JRST [OUTSTR [ASCIZ/? NO FREE CHANNELS TO WRITE METER FILE
/]
POPJ PP,] ;JUST GIVE IT UP
ANDI AC5,17 ;JUST SAVE CHANNEL NUMBER
DPB AC5,[POINT 4,AC5,12] ;SAVE IN AC FIELD OF AC5
HLLZ AC5,AC5 ;FOR MAKING UUOS
;DO OPEN UUO
MOVEI AC1,.IODMP ;BINARY DUMP MODE
MOVSI AC2,'DSK' ; TO DEVICE "DSK"
SETZ AC3, ;NO BUFFER HEADERS
MOVE AC0,[OPEN AC1]
OR AC0,AC5 ;READY TO DO IT
XCT AC0
JRST GMOPNF ; ?OPEN UUO FAILED
;DO ENTER UUO
HRRZ AC1,METR.
MOVE AC1,MTRNM6(AC1)
MOVSI AC2,'DYN'
SETZB AC3,AC4
MOVE AC0,[ENTER AC1]
OR AC0,AC5
XCT AC0
JRST GMENTF ; ?ENTER UUO FAILED
;DO OUT UUO
MOVNI AC1,METRLN
HRLZ AC1,AC1 ;-NUMBER OF WORDS TO WRITE OUT,,0
HRR AC1,METR. ; GET RH= ADDRESS-1
SUBI AC1,1
SETZ AC2,
MOVE AC0,[OUT AC1]
OR AC0,AC5
XCT AC0
TRNA ;OK
JRST GMOUTF ; ?OUT UUO FAILED
;DO RELEAS UUO
GMRELS: MOVSI AC0,(RELEAS 0,)
OR AC0,AC5
XCT AC0
POPJ PP, ;AND RETURN FROM THIS ROUTINE
GMOPNF: OUTSTR [ASCIZ/? OPEN FAILED FOR METER FILE
/]
GMGIVU: OUTSTR [ASCIZ/% METER FILE NOT WRITTEN
/]
JRST GMRELS
GMENTF: OUTSTR [ASCIZ/? ENTER FILED FOR METER FILE
/]
JRST GMGIVU ;GIVE UP
GMOUTF: OUTSTR [ASCIZ/? OUT UUO FAILED FOR METER FILE
/]
JRST GMGIVU ;GIVE UP
>;END IFE TOPS20
>;END IFN CSTATS
IFN LSTATS,<
SUBTTL LSTATS - I/O HISTOGRAM ROUTINE
;THE I/O HISTOGRAM ROUTINE
;CALL WITH THE BLOCK NUMBER TO BE READ IN MRBLKO
; THE CHANNEL NUMBER OF THE FILE IS AVAILABLE BY
;EXTRACTING IT FROM THE "INPUT UUO", WHICH IS ABOUT TO BE XCT'D.
;
;ALL ACS ARE SAVED
;
; CALCULATE THE OVERHEAD TIME FOR METERING DISK USAGE
;BY SAVING THE TIME AT METERING BEGIN (IN LOCATION MRBLKO)
;AND THEN USING IT TO CALCULATE TIME SPENT IN METERING. THIS
;TIME IS ADDED TO ANY EXISTING LIBOL METER POINT START TIME
;(IN LOCATION MBTIM.) TO CANCEL OUT THIS OVERHEAD.
IOHSTR: PUSH PP,AC10 ;SAVE AC10 AND AC11
PUSH PP,AC11
IFN TOPS20,<
DMOVE AC10,AC1 ;SAVE AC1 AND AC2 IN AC10 AND AC11
MTRJS% ;GET FAST METER TIME IN AC1&AC2
ERJMP .+2 ;ERRORS SKIP
DMOVEM AC1,MRBLKO ;SAVE OVERHEAD START TIME
>;END IFN TOPS20
IFE TOPS20,<
SETZB AC10,AC11 ;CLEAR AC10 AND AC11
RUNTIME AC10, ;GET FAST 10 TIME IN AC10
>;END IFE TOPS20
;UPDATE MOST-RECENTLY USED TABLE OF FILE NUMBER AND PAGE NUMBER
PUSH PP,AC1 ;SAVE ACS USED
PUSH PP,AC2
PUSH PP,AC3
PUSH PP,AC4
;IF AN OLD ENTRY IS IN THE TABLE, UPDATE HISTOGRAM.
; THE ENTRY WILL ALWAYS END UP AT THE BOTTOM OF THE TABLE (MOST
; RECENTLY USED).
HRRZ AC2,MRTDBP ;ADDRESS OF TRAILER BLOCK
AOS MB.HTC(AC2) ; REMEMBER ROUTINE WAS DONE ANOTHER TIME
HRRZ AC4,MRBNUM ;GET BLOCK NUMBER
IFN TOPS20, LSH AC4,-2 ;(PAGE NUMBER IF TOPS20)
LDB AC3,[POINT 4,UIN.,12] ;GET CHANNEL NUMBER= FILE NUMBER
HRL AC4,AC3 ;LH(AC4) = FILE #, RH (AC4)= BLOCK NUMBER
;LOOK FOR ENTRY IN THE TABLE, BOTTOM-UP.
; IF NOT FOUND, MOVE THE WHOLE TABLE UP WITH A BLT AND
; ADD IT TO THE BOTTOM.
;IF ENTRY IS ALREADY IN TABLE, MOVE UP ENTRIES BELOW IN
;(ERASING THE OLD ENTRY) AND PUT NEW ENTRY AT THE BOTTOM;
;THEN INCREMENT THE APPROPRIATE HISTOGRAM BUCKET.
HRRZ AC2,MRFPGT ;POINT TO THE TABLE
MOVEI AC3,MBHISL-1(AC2) ; AC3 POINTS TO LAST ENTRY
MRFLUP: CAMN AC4,(AC3) ; FOUND ENTRY?
JRST MRFNDE ;YES, MOVE UP REST OF TABLE
SUBI AC3,1
CAIL AC3,(AC2) ;AT START OF TABLE YET?
JRST MRFLUP ;NO, KEEP SEARCHING
;ENTRY WAS NOT IN TABLE. BLT UP WHOLE TABLE, AND PUT IT
; AT THE BOTTOM.
MOVSI AC1,1(AC2) ;ST+1
HRRI AC1,(AC2) ;ST
ADDI AC2,MBHISL-1 ;POINT TO LAST ENTRY IN TABLE
BLT AC1,-1(AC2) ; MOVE UP TABLE, ERASE TOP ENTRY
MOVEM AC4,(AC2) ;STORE MOST RECENTLY USED ENTRY AT END
JRST NOHADD ; DONE--DON'T INCREMENT ANY HISTOGRAM BUCKETS
;ENTRY FOUND.. AC3 POINTS TO IT. MOVE UP TABLE SUCH THAT IT ERASES
; THIS ENTRY BUT LEAVES THE ONES ABOVE IT IN PLACE, THEN ADD NEW
; ENTRY TO THE BOTTOM. THE NET EFFECT IS TO HAVE THE SAME ENTRIES
; IN THE TABLE, BUT IN A DIFFERENT ORDER (MOST RECENTLY USED AT THE
; BOTTOM).
MRFNDE: HRLI AC1,1(AC3) ;FROM: THIS ENT+1
HRRI AC1,(AC3) ;TO: THIS ENT
BLT AC1,MBHISL-2(AC2); BLT TO LAST ENTRY-1
MOVEM AC4,MBHISL-1(AC2) ;STORE THIS ENTRY AT END.
HRRZ AC4,MRTDBP ;POINT TO TRAILER BLOCK
SUBI AC2,-MBHISL+1(AC3); END - ENTRY = HISTOGRAM BUCKET TO AOS
ADDI AC4,MB.HTO(AC2) ; POINT TO THE HISTOGRAM BUCKET
AOS (AC4) ;INCREMENT IT
NOHADD: POP PP,AC4 ;RESTORE ACS USED
POP PP,AC3
POP PP,AC2
POP PP,AC1
IFN TOPS20,<
MTRJS% ;GET FAST TIME IN AC1 AND AC2
ERJMP RST111 ;SKIP THE TIME CALC IF ERROR
DSUB AC1,MRBLKO ;SUB START TIME
DADD AC1,MRBKO. ;ADD IN FIXED OVERHEAD
DADD AC1,MBTIM. ;ADD TO METER POINT START TIME
DMOVEM AC1,MBTIM. ;RESTORE METER POINT START TIME
DMOVE AC1,AC10 ;RESTORE AC1 AND AC2
>;END IFN TOPS20
IFE TOPS20,<
RUNTIME AC11, ;GET FAST 10 TIME IN AC11
SUB AC11,AC10 ;SUB OUT START TIME
ADD AC11,MRBKO. ;ADD IN FIXED OVERHEAD TIME
ADDM AC11,MBTIM. ;UPDATE METER POINT START TIME
>;END IFE TOPS20
RST111: POP PP,AC11 ;RESTORE AC11 AND AC10
POP PP,AC10
POPJ PP, ;RETURN
;CLRFBT - ROUTINE TO CLEAR OUT ENTRIES OF THIS FILE IN THE
;FILE/BLOCK TABLE, BECAUSE WE ARE CLOSING THE FILE
;SAVES ALL ACS
CLRFBT: PUSH PP,AC1 ;SAVE ACS USED
PUSH PP,AC2
PUSH PP,AC3
HRRZ AC1,MRFPGT ;POINT TO THE TABLE
ADDI AC1,MBHISL-1 ;POINT TO LAST ENTRY
LDB AC2,DTCN. ;GET CHANNEL NUMBER= FILE NUMBER
CLRBFL: HLRZ AC3,(AC1) ;GET AN ENTRY
CAMN AC2,AC3 ; SAME FILE NUMBER?
SETZM (AC1) ;YES, DELETE IT
CAME AC1,MRFPGT ;REACHED TOP?
SOJA AC1,CLRBFL ;NO, LOOP
POP PP,AC3
POP PP,AC2
POP PP,AC1
POPJ PP, ;RETURN
SUBTTL LSTATS - TIMING ROUTINES
;LMETR. IS THE ROUTINE THAT INCREMENTS THE LIBOL BUCKET NUMBER
;INDICATED AND SAVES THE ADDRESS OF THE TIME BUCKET TO BE
;UPDATED.
; ARGUEMENTS: AC2= BUCKET OFFSET WITHIN THE BUCKET BLK
; AC1= ADDRESS OF THE PROPER FILTAB
;
; SETS: MRTMB. (THE ADDRESS OF THE TIME BUCKET)
LMETR.: LDB AC1,[POINT 4,D.CN(AC1),15] ;GET CHAN #
ADD AC2,MROPTT(AC1) ;ADD ADDRESS OF MTR BLK TO OFFSET
AOS (AC2) ;INCREMENT BUCKET
ADDI AC2,1 ;ADDRESS TIME BUCKET
MOVEM AC2,MRTMB. ;SAVE TIME BUCKET ADDRESS
POPJ PP, ;RETURN
; MRACDP IS THE METER POINT ROUTINE FOR ACCEPT AND
;DISPLAY. THESE METER BUCKETS ARE IN THE TRAILER BLOCK,
;SINCE THEY ARE IN NO WAY RELATED TO ANY PARTICULAR FILE.
;
;ARGUEMENT: AC2= THE OFFSET FOR THE BUCKET,RELATIVE TO
; THE BASE OF THE TRAILER BLOCK
;USES: AC1
;
MRACDP: MRTMS. (AC1) ;START METER TIMING
ADD AC2,MRTDBP ;ADD IN TRAILER BASE ADDRESS
AOS (AC2) ;INCREMENT BUCKET
ADDI AC2,1 ;ADDRESS TIME BUCKET
MOVEM AC2,MRTMB. ;SAVE TIME BUCKET ADDRESS
SETZ AC2, ;CLEAR AC2,USED IN DISPLAY AS A FLAG
POPJ PP, ;RETURN
;MRTM.S AND MRTM.E ARE THE LIBOL METERING TIME ROUTINES.
;MRTM.S SETS THE START TIME .
;MRTM.E ENDS THE TIMING AND UPDATES THE TIME BUCKET
;INDICATED BY MRTMB.
IFN TOPS20,<
IFNDEF METER%,< ;IF METER% JSYS UNDEFINED, THIS IS BEFORE RELEASE 4
MRTM.S: PUSH PP,AC1 ;SAVE AC1
PUSH PP,AC2 ;SAVE AC2
MTRJS% ;GET FAST CLOCK TIME IN AC1& AC2
ERJMP .+2 ;ERROR SKIP TIME SET
DMOVEM AC1,MBTIM. ;SAVE START TIME
POP PP,AC2 ;RESTORE AC2
POP PP,AC1 ;RESTORE AC1
POPJ PP, ;RETURN
MRTM.E: PUSH PP,AC1 ;SAVE AC1
PUSH PP,AC2 ;SAVE AC2
MTRJS% ;GET FAST CLOCK TIME IN AC1&AC2
ERJMP .+4 ;ERROR, SKIP TIME CALC
DSUB AC1,MBTIM. ;SUB START TIME
ASHC AC1,^D24 ;SHIFT TO SINGLE WORD
ADDM AC1,@MRTMB. ;ADD TO TIME BUCKET
POP PP,AC2 ;RESTORE AC2
POP PP,AC1 ;RESTORE AC1
POPJ PP, ;RETURN
>;END IFNDEF METER%
IFDEF METER%,< ;RELEASE 4 SYSTEM -- USE MONITOR JSYS
MRTM.S: PUSH PP,AC1 ;SAVE 3 ACS
PUSH PP,AC2
PUSH PP,AC3
MOVEI AC1,.MEREA ;READ E-BOX TICKS
METER% ;GET FAST CLOCK TIME IN AC2&AC3
ERJMP .+2 ;ERROR, SKIP TIME CALC
DMOVEM AC2,MBTIM. ;SAVE START TIME
POP PP,AC3
POP PP,AC2
POP PP,AC1
POPJ PP,
MRTM.E: PUSH PP,AC1
PUSH PP,AC2
PUSH PP,AC3
MOVEI AC1,.MEREA ;E-BOX TICKS
METER% ;GET FAST CLOCK TIME IN AC2& AC3
ERJMP .+4 ;ERROR, SKIP TIME CALC
DSUB AC2,MBTIM. ;SUB START TIME
ASHC AC2,^D24 ;SHIFT TO SINGLE WORD
ADDM AC2,@MRTMB. ;ADD TO TIME BUCKET
POP PP,AC3 ;RESTORE AC3
POP PP,AC2 ;RESTORE AC2
POP PP,AC1 ;RESTORE AC1
POPJ PP, ;RETURN
>;END IFDEF METER%
>;END IFN TOPS20
SUBTTL LSTATS - ROUTINES TO CALCULATE BUCKET OFFSETS
;BUCREC IS A ROUTINE TO CALCULATE THE BUCKET OFFSET FOR
;READ,WRT,ETC. GIVEN THE RECORD SIZE. THE BUCKETS ARE
;ALLOCATED FOR SIZES 72,80,132 (CHARS) ,128 AND 512 (WORDS)
;AND THE SPACES IN BETWEEN THEM.
;
; ARGUMENTS: AC1= REC SIZE IN CHARS
;
; RETURNS: AC2= BUCKET OFFSET
;
; AC1 IS NOT PRESERVED.
BUCREC: SETZ AC2, ;CLEAR OFFSET
CAILE AC1,^D132 ;.LE. 132?
JRST BUCRE2 ;NO,TEST WORD LENGTHS
CAIE AC1,^D132 ;
JRST BUCRE0 ;.LT.132
ADDI AC2,5 ;= 132, OFFSET=5
JRST BUCREX ;EXIT
BUCRE0: CAIGE AC1,^D80 ;
JRST BUCRE1 ;.LT. 80
CAIE AC1,^D80 ;
ADDI AC2,1 ;.GT. 80, OFFSET=4
ADDI AC2,3 ;= 80, OFFSET=3
JRST BUCREX ;EXIT
BUCRE1: CAILE AC1,^D72 ;
AOJA AC2,.+2 ;.GT.72&.LT.80, OFFSET=2
CAIL AC1,^D72 ;
ADDI AC2,1 ;= 72, OFFSET=1
JRST BUCREX ;.LT. 72, OFFSET=0
BUCRE2: MOVE AC2,D.BPW(I16) ;GET BYTES PER WORD
IDIV AC1,AC2 ;CALC WDS PER REC
JUMPE AC2,.+2 ;SKIP IF NO REMAINDER
ADDI AC1,1 ;ROUND UP
SETZ AC2, ;CLEAR THE OFFSET
CAILE AC1,^D128 ;
JRST BUCRE3 ;.GT.128 WORDS
CAIL AC1,^D128 ;
ADDI AC2,1 ;=128 WORDS, OFFSET=7
ADDI AC2,6 ;.LT.128 WORDS, OFFSET=6
JRST BUCREX ;EXIT
BUCRE3: CAILE AC1,^D512 ;
AOJA AC2,.+2 ;.GT.512 WORDS, OFFSET=10
CAIL AC1,^D512 ;
ADDI AC2,1 ;=512 WORDS, OFFSET=9
ADDI AC2,^D8 ;.LT.512 WORDS, OFFSET=8
BUCREX: LSH AC2,1 ;MULTIPLY BY 2,ALLOWING FOR TIME BKTS
POPJ PP, ;RETURN
>;END IFN LSTATS
C.END: END