Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/isam.mac
There are 21 other files named isam.mac in the archive. Click here to see a list.
; UPD ID= 3561 on 6/3/81 at 2:12 PM by NIXON
TITLE ISAM VERSION 12.2
SUBTTL ISAM FILE MAINTENANCE PROGRAM AL BLACKINGTON/CAM/FLD
;COPYRIGHT (C) 1971, 1980 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==162
VERSION==1202,,EDIT
SEARCH INTERM
SEARCH UUOSYM ;FOR TAPOP.'S ARGS
IFN TOPS20,<
SEARCH MONSYM ;[154]
>
LOC 137
EXP VERSION
RELOC 0
TWOSEG
RELOC 400000
SALL
IFNDEF NEW,<NEW==1> ;ELIMINATES "SIZE OF LARGEST INPUT BLOCK:" QUESTION
$CU001==-1 ; CUA assembly switch to make isam more intelligent
IFN TOPS20,<
IFN ANS74,< ;NO VERSION 13 IN COBOL-68
$OUTPAG==0 ;OUTPUT MODE SWITCH, ZERO = "OLD" (NON-PAGE) MODE,
; NON-ZERO = "NEW" (PAGE) MODE.
;"PAGE-MODE" MEANS THAT LOGICAL OUTPUT BLOCKS WILL BE
;SET UP TO CONTAIN n MULTIPLES-OF-FOUR SECTORS. THIS
;IS TO FACILITATE PAGE I-O ANTICIPATED FOR VERSION 13.
; DEFAULT = NON-PAGE MODE
>> ;END IFN ANS74, IFN TOPS20
SUBTTL HISTORY
;NAME DATE COMMENTS
;V12B SHIPPED
; LEM 12-AUG-80 [162] FIX USETI/O FOR BLK 777770-7777777
; TO USE FILOP. USETI/O
; MFY 6-AUG-79 [161] FIX TAPE LABEL ERROR ROUTINE AT LTCTST:
; HAM 3-NOV-78 [160] ISSUE WARNING U BEFORE X IN KEY DESC.
; EHM 14-JUN-78 [157] FIX FILOP. FOR LARGE FILES
;V12 SHIPPED
; EHM 27-JAN-78 [156] FIX ILL MEM REF ON /P FROM SIXBIT TO ASCII
; EHM 29-NOV-77 [155] PUT OUT KEYS OUT OF ORDER MESSAGE
; CORRECTLY FOR DOUBLE WORD NUMERIC KEYS
;V11 SHIPPED
; 02/22/77 [154] FOR TOPS20, ALLOW SMU USERS TO ACCESS
; APPENDED DATA INSTEAD OF GETTING INCORRECT
; EOF FOR APPENDED DATA.
;MDL 02/17/77 [153] ADD 'STANDARD ASCII' SUPPORT FOR TU16
; AND TU45 IN ADDITION TO TU70.
;MDL 11/22/76 [152] FIX " /P " FOR VARIABLE LENGTH, EBCDIC MAG
; TAPE FILES.
;EHM 9-NOV-76 [151] FIX ILL MEM REF FOR /P
;DPL 28-SEP-76 [150] FIX SIXBIT PACK TO MAGTAPE LOSING A CHARACTER
;DPL 18-AUG-76 [147] FIX EBCDIC END OF FILE
;DPL 1/6/76 [146] FIX STANDARD LABELS FOR SIXBIT INPUT TAPE
; WITH /B/L SWITCHES.
; 145 3/2/76 USE COREECT DATA MODE FOR LABELED MAG TAPES
;JC 16/2/76 [144] ZERO FROM .JBFF TO .JBREL SO THAT MULTIPLE
; ISAM COMMANDS WORK W/O INTERFERENCE
;DBT 6/1/75 ADD EBCDIC AND COMP-3 KEYS
; FIX COMP AND COMP-1 KEYS
; EBCDIC I/O
;********************
;EDIT 143 IN FILE SPEC USE USERS IN CASE 0 IS SPECIFIED FOR PROJECT AND/OR PROGRAMMER NUMBER
;EDIT 142 ALLOW AN ASCII DEVICE TO BE USED AS OUTPUT DEVICE FOR /P
;EDIT 141 FIX "ILL-MEM-REF" PROBLEM WITH /P AND /M
;EDIT 140 FIX HANDLING OF COMMAND FILE
;EDIT 116 - EDIT 137 RESERVED FOR Q/A:S
;EDIT 115 UPDATE JOBDAT SYMBOLS
;EDIT 114 REMOVAL OF EDIT 102, REQUIRES EDIT 335 TO LIBOL
;EDIT 113 FIX WRONG ERROR MESSAGE WHEN ENTER FAILURE ON A DEVICE
;EDIT 112 FIX BUFFER SIZE FOR DECTAPE OUTPUT
;EDIT 111 ENABLE TO GET MORE THAN ONE SWITCH PER COMMAND
;EDIT 110 CORRECT QUESTION WHEN BAD ANSWER TO /P OUTPUT MODE
;EDIT 107 IMPLEMENT /I OPTION (IGNORE KEY ERRORS WHEN PACKING)
;EDIT 106 FIX COMPUTATION OF EMPTY DATA BLOCKS
;EDIT 105 GIVE WARNING THAT COMP AND COMP-1 KEYS DON'T WORK
;EDIT 104 CHANGE INITIAL BLT OF ZEROES TO FACILITATE DEBUGGING
;EDIT 103 FIX WRITING OF BLOCKED TAPES WITH /P OPTION [EDIT#103]
;EDIT 102 WHEN BUILDING ASCII INDEXED FILES PADD RECORDS <MAX WITH BLANKS [EDIT#102]
;EDIT 101 ALLOW MTA BUFFER SIZE TO BE GREATER THAN 128 WRDS [EDIT#101]
;EDIT 100 FIXES "KEYS OUT OF ORDER" -- INPSIZ WAS WRONG [EDIT#100]
;EDIT 77 FIXES "ILL-MEM-REF" WHEN /P TO MTA &LARGE BUFFERS [EDIT#77]
;EDIT 76 ADDS /L SWITCH FEATURE TO PERMIT READING OR WRITING
;SEQUENTIAL LABELED MAGTAPES [EDIT #76]
;EDIT 75 ELIMINATES "SIZE OF LARGEST INPUT/OUTPUT BLOCK" QUESTION [EDIT#75]
;EDIT 74 ZERO FREE CORE AT START-UP TIME [EDIT#74]
;EDIT 73 IF DEALING WITH A MTA DOESN'T REQUIRE A FILE NAME--MTA BUFFER
;SIZE IS FIGURED INCORRECTLY [EDIT #73]
SUBTTL PARAMETERS
;ACCUMULATOR DEFINITIONS
SW=0 ;SWITCH REGISTER
TA=1 ;TEMP
TB=TA+1 ;TEMP
TC=TB+1 ;TEMP
TD=TC+1 ;TEMP
TE=TD+1 ;TEMP
TF=TE+1 ;TEMP
IX=7 ;CURRENT INPUT INDEX LEVEL
OP=10 ;OUTPUT BYTE-POINTER
KT=11 ;KEY TYPE
IM=12 ;INPUT MODE
OM=13 ;OUTPUT MODE
; 0 - SIXBIT
; 1 - EBCDIC
; 2 - ASCII
; 3 - MARVELOUS ASCII ( INTERNAL ONLY)
OC=14 ;NUMBER OF CHARACTERS IN OUTPUT RECORD
CH=15 ;TTY CHARACTER
DA=16 ;ADDRESS OF A FILE PARAMETER BLOCK
PP=17 ;PUSH-DOWN POINTER
;I/O CHANNELS
OF1==1 ;PRIMARY OUTPUT FILE
OF2==2 ;SECONDARY OUTPUT FILE
IF1==3 ;PRIMARY INPUT FILE
IF2==4 ;SECONDARY INPUT FILE
CMD==5 ;INDIRECT COMMAND FILE
;MONITOR COMMUNICATION
$MTA==1B31 ;DEVICE IS A MAG-TAPE
$DSK==1B19 ;DEVICE IS A DISK
$CDR==1B20 ;CARD DEVICE
MTIND==101 ;INDUSTRU COMPATABLE MODE FUNCTION CODE FOR MTAPE UUO
MT.7TR==1B31 ;7 TRACK TAPE BIT FOR MTCHR UUO
FEOT==1B25 ;PHYSICAL END OF TAPE
DEFINE MTCHR(AC) <CALLI AC,112>
$DTA==1B29 ;[112]DEVICE IS A DECTAPE
$EOF==020000 ;END OF FILE FLAG FROM I/O
$ERA==740000 ;ERROR FLAGS FROM I/O
$GETCH==4 ;CALLI CODE FOR 'DEVCHR'
$CORE==11 ;CALLI CODE FOR CORE
$DATE==14 ;CALLI CODE FOR DATE
OPDEF FILOP. [CALLI 155] ; FILOP. TO DO USETI FUNCT WHEN BLK-NMBR GT 18 BITS
OPDEF TAPOP. [CALLI 154]
.TFKTP==1002 ; FUNCT TO GET CONTROLER TYPE
.TU70==3 ; CODE FOR A TU70 CONTROLER
.TM02==4 ;[153] CODE FOR TU16 AND TU45 CONTROLLER
.TFMOD==2007 ; FUNCT TO SET STD ASCII MODE
.TFM7B==4 ; CODE FOR STD ASCII MODE
OPDEF PJRST [JRST]
; DEVCHR BITS
DV.OUT==1 ; [142] OUTPUT DEVICE (LEFT-HALF)
DV.M14==10000 ; [142] BINARY MODE LEGAL FOR DEVICE (RIGHT-HALF)
$ISAMI==401 ;FLAG FOR ISAM INDEX FILE
$ISAMS==1000 ;FLAG FOR ISAM SIXBIT DATA FILE
$ISAMA==1100 ;FLAG FOR ISAM ASCII DATA FILE
$ISAME==0 ;FLAG FOR ISAM EBCDIC DATA FILE ???????
;SWITCH REGISTER FLAGS (LH)
FERROR==1B0 ;ERROR IN COMMAND STRING
FNUM==1B1 ;KEY IS NUMERIC
FSIGN==1B2 ;'S' OR 'U' TYPED IN KEY DESCRIPTOR
FASCII==1B3 ; [142] /P OUTPUT DEVICE IS ASCII
FENDL==1B4 ;WE HAVE AN END-OF-LINE
FENDIB==1B5 ;END OF INPUT BLOCK
FEOF==1B6 ;END OF INPUT FILE
FDSK==1B7 ;/B INPUT OR /P OUTPUT IS DISK
FEBVAR==1B8 ;EBCDIC VARIABLE LENGTH RECORDING MODE
FMTA==1B9 ;/B INPUT OR /P OUTPUT IS MAG-TAPE
FGETDC==1B10 ;GETDEC ROUTINE SAW ACTUAL NUMBER
INDIR==1B11 ;READING INDIRECT COMMAND FILE
FRECIN==1B12 ;A DATA RECORD HAS BEEN SEEN
FDTA==1B13 ;[112] /P OUTPUT IS TO DTA
FCEOFK==1B14 ;END OF FILE ON CMD FILE OK [EDIT#140]
FCEOF==1B15 ;END OF FILE ON CMD FILE REACTED [EDIT#140]
FSGND==1B16 ;KEY IS SIGNED
FINDCP==1B17 ;INDUSTRY COMPATABLE MODE FOR TAPE
;SWITCH REGISTER FLAGS (RH)
OPT.OP==1B23 ;OUTPUT IN PAGES
FNUL==1B24 ;INPUT DEVICE=NUL:
ONEBYT==1B25 ; REQUEST FIRST BYTE OF RECORD
OPT.A7==1B26 ; /ADV:74 SET ANS74 DEFAULT SEQ ASCII ADVANCING
OPT.C==1B27 ; /C OPTION CHECK THE ISAM FILE FOR ERRORS (VERSION AND DATA)
OPT.R==1B28 ; /R OPTION RENAME THE ISAM FILE (INTERNAL AND EXTERNAL)
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
OPT.S==1B29 ;/S OPTION (SHOW STATISTICS)
>;END OF IFN $CU001
OPT.I==1B30 ;[107] /I OPTION (IGNORE ERRORS)
TEMP.==1B31 ;TEMP BIT
OPT.L==1B32 ;/L OPTION (PUT OR READ LABELS ON MAGTAPES)
OPT.M==1B33 ;/M OPTION (MAINTAIN FILE)
OPT.P==1B34 ;/P OPTION (PACK FILE)
OPT.B==1B35 ;/B OPTION (BUILD INDEXED FILE)
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
;CUA C.D.BALDWIN ADD /S OPTION TO PRINT STATISTICS WHILE DOING RECOMMENDED
;BLOCKING FACTOR CALCULATIONS FOR BENEFIT OF THE PROGRAMMER IN CASE OF HIM/HER
;HAVING TO SELECT VALUES OTHER THAN THOSE RECOMMENDED
OPT.S==1B29 ;/S OPTION (SHOW STATISTICS)
>;END OF IFN $CU001
;CONSTANTS USED TO INDEX INTO FILE PARAMETER DATA
DEV==0 ;DEVICE NAME
FILNAM==1 ;FILE NAME
FILEXT==2 ;FILE EXTENSION
PPNUM==3 ;PROJECT-PROGRAMMER NUMBER
BUFADR==4 ;3-WORD BUFFER HEADER
;MISCELLANEOUS
EXTERNAL EASTB. ;CONVERSION TABLE
; RIGHT JUSTIFIED ASCII CR/LF
RTCRLF==6424 ; $7O /0,0,0,15,12,0/
; KEYDES POINTERS
DEFINE KY.MOD <[POINT 2,KEYDES,19]>
DEFINE KY.SGN <[POINT 1,KEYDES,20]>
DEFINE KY.TYP <[POINT 18,KEYDES,17]>
DEFINE KY.SIZ <[POINT 12,KEYDES,35]>
PPSIZE==40 ;SIZE OF PUSH-DOWN LIST
CMPJFN==10 ;FUNCTION FOR COMPT. UUO
MTOBSZ==3 ;SIZE OF MTOPR ARG BLOCK
; FILE MODE CODES
SX.MOD==0 ;SIXBIT
EB.MOD==1 ;EBCDIC
AS.MOD==2 ;ASCII
MA.MOD==3 ;35 BIT ASCII TAPE I/O
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
; CONSTANTS USED TO CALCULATE RECOMMENDED BLOCKING FACTORS
IDALIM=^D32 ;32. BLOCKS MAXIMUM RECOMMENDED .IDA LOG-BLK SIZE
IFE TOPS20,<
IDXLIM=5 ;5. BLOCKS MAXIMUM RECOMMENDED .IDX LOG-BLK SIZE
> ;END IFE TOPS20
IFN TOPS20,<
IDXLIM=10 ;2. PAGES MAXIMUM RECOMMENDED .IDX LOG-BLK SIZE
> ;END IFN TOPS20
> ;END OF IFN $CU001
SUBTTL TABLES
;FILE CODES FOR HEADER WORDS
FILCOD: EXP $ISAMS ;SIXBIT
EXP $ISAME ;EBCDIC
EXP $ISAMA ;ASCII
EXP $ISAMA ;STANDARD ASCII
;BYTE SIZE
BYTSIZ: EXP 6
EXP 9
EXP 7
EXP 7
;BYTES PER WORD
BYTWRD: EXP 6
EXP 4
EXP 5
EXP 5
;BYTES PER WORD MINUS ONE
BYWDM1: EXP 5
EXP 3
EXP 4
EXP 4
;BYTE POINTER SKELETONS
BYPTRS: POINT 6,0
POINT 9,0
POINT 7,0
POINT 7,0
INTERNAL CVARGS ;USED BY GD ROUTINE IN LIBOL
; TOPS10-TOPS20 COMPATIBILITY MACRO
IFE TOPS20,<
DEFINE TYPEA (ADDR)<
OUTSTR ADDR
>>
IFN TOPS20,<
DEFINE TYPEA (ADDR)<
HRROI 1,ADDR
PSOUT
>>
SUBTTL INITIALIZATION
START: CALLI 0 ;RESET
MOVEI SW,0 ;RESET SWITCHES
SETZM TTYKAR ;CLEAR IF NOTHING READ
; SETZM LOWCOR ;CLEAR IMPURE AREA (EXCEPT TTYKAR)
; MOVE TA,[LOWCOR,,LOWCOR+1]
; BLT TA,LOWCOR+LOWSIZ-1 ; [EDIT#104]
SETZM CMDBUF ;CLEAR IMPURE AREA (EXCEPT TTYKAR)
MOVE TA,[CMDBUF,,CMDBUF+1]
BLT TA,CMDBUF+LOWSIZ-1+CMBFSZ
HRRZ TA,.JBFF ;[144] GET JOBFF
CAML TA,.JBREL ;[144] UP AGAINST .JBREL FINISHED
JRST START1 ;[144] DONE
SETZM 0(TA) ;[144] CLEAR JBFF
HRLS TA ;[144] SET UP TO
AOS TA ;[144] FROM JBFF
HRRZ TB,.JBREL ;[144] GO TO JBREL
BLT TA,0(TB) ;[144] NOW ZERO THEM--LEAVING SYMBOLS IN CORE
START1:
SETZM LOWCOR ;CLEAR IMPURE AREA (EXCEPT TTYKAR)
MOVE TA,[LOWCOR,,LOWCOR+1]
BLT TA,LOWCOR+LOWSIZ-1
IFN TOPS20,<
IFN ANS74,<
IFN $OUTPAG,<
TRO SW,OPT.OP ;SET PAGE-MODE OUTPUT
> ;END IFN $OUTPAG
>> ;END IFN ANS74, END IFN TOPS20
MOVE PP,[IOWD PPSIZE,PPLIST] ;INIT PDL
SUBTTL READ COMMAND STRING
GETPPN TA, ; [143] GET USERS PPN
MOVEM TA,MYPPN ; [143] SAVE IT
RCOM: TLNE SW,(FCEOF) ;EOF INDIRECT COMMAND FILE?
JRST START ; YES, GO AROUND AGAIN
TLNE SW,(INDIR) ;ALREADY IN INDIRECT COMMAND FILE?
JRST RCOM3 ; YES, NO PROMPT NEEDED
TYPE (
*) ;TYPE '*'
RCOM3: PUSHJ PP,GETTY ;GET FIRST CHARACTER OF COMMAND LINE
CAIN CH,15 ;IF CARRIAGE-RETURN,
JRST RCOM ; LOOP
CAIN CH,"@" ;INDIRECT?
JRST ICOM ;YES
MOVEM CH,TTYKAR ;SAVE THAT CHARACTER
TRZ SW, OPT.L+OPT.M+OPT.P+OPT.B+OPT.I ;CLR OPTION FLAGS
PUSHJ PP,GETFIL ;GET 1ST FILENAME
CAIN CH,15 ;END OF LINE ALREADY?
JRST RCOM2 ;YES, THIS IS THE INPUT FILE
TRNE SW,OPT.C ; /C OPTION?
JRST RCOM1 ; YES, ALLOW "=" WITH NO OUT FILE NAME
MOVE TA,[FILDAT,,OF1DAT] ;NO, STORE PARAMS FOR 1ST OUT FILE
BLT TA,OF1DAT+BUFADR-1
CAIE CH,"," ;IS THERE A SECONDARY OUTPUT FILENAME?
JRST RCOM1 ;NO
PUSHJ PP,GETFIL ;GET NAME OF 2ND OUTPUT FILE
MOVE TA,[FILDAT,,OF2DAT]
BLT TA,OF2DAT+BUFADR-1
RCOM1: CAIE CH,"=" ;OUTPUT SPECIFICATIONS END WITH EQUAL SIGN?
JRST BADCOM ;NO
TRNN SW,OPT.C ; /C OPTION?
JRST RCOM1A ; NO, CONT ON TO GET INPUT NAME
MOVE TA,OF1DAT+DEV ;CHECK THAT THERE IS NO
IOR TA,OF1DAT+FILNAM ;OUTPUT FILE SPEC FOR
IOR TA,OF1DAT+FILEXT ;THE /C OPTION
IOR TA,OF1DAT+PPNUM
JUMPN TA,BADCOM ; JUMP IF THERE IS AN OUTPUT FILE
RCOM1A: PUSHJ PP,GETFIL ; GET INPUT FILENAME AFTER SEEING "="
RCOM2: MOVE TA,[FILDAT,,IF1DAT] ;STORE PARAMS FOR INPUT FILE
BLT TA,IF1DAT+BUFADR-1
CAIE CH,15 ;COMMAND END WITH EOL CHAR?
JRST BADCOM ;NO
MOVE TA,OF2DAT+DEV ;CHECK THAT THERE IS NO 2ND
IOR TA,OF2DAT+FILNAM ;OUTPUT FILE SPEC FOR
IOR TA,OF2DAT+FILEXT ;THE /P AND /C OPTIONS
IOR TA,OF2DAT+PPNUM
TRNE SW,OPT.P+OPT.C
JUMPN TA,BADCOM ;IF THERE IS -- TOO BAD
RCOMX: TLNN SW,(FERROR) ;IF TROUBLE,
JRST DEFLT ; OK
PUSHJ PP,SKPTTY ; BAD, SKIP TO EOL
JRST START ; QUIT AND TRY ANOTHER
;INIT INDIRECT COMMAND FILE
ICOM: TLNE SW,(INDIR) ;ALREADY INDIRECT?
JRST DBLIND ;CANT DO DOUBLE INDIRECT
PUSHJ PP,GETFIL ;GET FILE NAME
CAIE CH,15 ;SHOULD END WITH CR
JRST BADCOM
MOVEI TA,0 ;OPEN ASCII INPUT
SKIPN TB,FILDAT+DEV
MOVSI TB,(SIXBIT 'DSK') ;USE DSK BY DEFAULT
MOVEI TC,CMDBUF
OPEN CMD,TA
JRST CMDERR
MOVE TA,FILDAT+FILNAM ;LOOKUP COMMAND FILE
HLLZ TB,FILDAT+FILEXT
MOVEI TC,0
MOVE TD,FILDAT+PPNUM
LOOKUP CMD,TA
JRST [JUMPN TB,CMDLER ;NOT NUL EXT OR NOT FOUND ERROR
MOVSI TB,'CMD' ;TRY CMD AS EXTENSION
LOOKUP CMD,TA ;TRY AGAIN
JRST CMDLER ;TOTAL FAILURE
JRST .+1]
INBUF CMD,2 ;GET 2 BUFFERS
TLO SW,(INDIR) ;INDICATE INDIRECT INPUT
JRST RCOM3 ;START READING COMMANDS
SUBTTL SET COMMAND STRING DEFAULTS
DEFLT: TRNN SW,OPT.B+OPT.M+OPT.P+OPT.R+OPT.C ;DEFAULT OPTION IS /B
TRO SW,OPT.B
; FIRST SET INPUT FILE DEFAULTS
DEFLT0: SKIPN TA,IF1DAT+DEV ;DEFAULT DEVICE FOR
MOVSI TA,(SIXBIT "DSK") ; INPUT FILE IS
MOVEM TA,IF1DAT+DEV ; 'DSK'
TRNN SW,OPT.B ;/B OR /M /R /C?
JRST DEFLT1 ;/M /R /C
SKIPN TA,IF1DAT+FILEXT ;/B: DEFAULT EXT FOR IF1 IS 'SEQ'
MOVSI TA,(SIXBIT 'SEQ')
HLLZM TA,IF1DAT+FILEXT
JRST DEFLT2 ; NOW SET OUTPUT DEFAULTS
DEFLT1: SKIPN TA,IF1DAT+FILEXT ;/M OR /P OR /R OR /C: DEFLT IF1 EXT IS 'IDX'
MOVSI TA,(SIXBIT 'IDX')
HLLZM TA,IF1DAT+FILEXT
TRNE SW,OPT.C ; /C OPTION?
JRST OPEN1 ; YES, ONLY INPUT FOR /C, NO ? SO OPEN NOW
; NOW SET OUTPUT DEFAULTS
; FIRST THE DEVICE
DEFLT2: SKIPN TA,OF1DAT+DEV ;DEFAULT DEVICE FOR
MOVSI TA,(SIXBIT "DSK") ; FIRST OUTPUT FILE IS
MOVEM TA,OF1DAT+DEV ; 'DSK'
SKIPN OF2DAT+DEV ;DEFAULT DEVICE FOR 2ND OUTPUT FILE IS
MOVEM TA,OF2DAT+DEV ; 1ST OUTPUT DEVICE
; THEN THE FILE NAME
SKIPN TA,OF1DAT+FILNAM ;DEFAULT NAME FOR OF1 IS IF1
MOVE TA,IF1DAT+FILNAM
MOVEM TA,OF1DAT+FILNAM
SKIPN OF2DAT+FILNAM ;DEFAULT NAME FOR OF2 IS OF1
MOVEM TA,OF2DAT+FILNAM
; FINALLY THE EXTENSION
TRNN SW,OPT.P ;/P?
JRST DEFLT3 ;NO, /M /R
SKIPN TA,OF1DAT+FILEXT ;DEFAULT EXT FOR OF1 IS 'SEQ'
MOVSI TA,(SIXBIT 'SEQ')
HLLZM TA,OF1DAT+FILEXT
MOVE TA,[OF1DAT,,OF2DAT] ;REAL /P OUTPUT IS DONE ON OF2
BLT TA,OF2DAT+BUFADR-1
JRST OPENER ; DONE FOR /P, DO OPEN
DEFLT3: SKIPN TA,OF1DAT+FILEXT ;/B OR /M /R: DEFAULT EXT FOR OF1 IS 'IDX'
MOVSI TA,(SIXBIT 'IDX')
HLLZM TA,OF1DAT+FILEXT
SKIPN TA,OF2DAT+FILEXT ;DEFAULT EXT FOR OF2 IS 'IDA'
MOVSI TA,(SIXBIT 'IDA')
HLLZM TA,OF2DAT+FILEXT
SUBTTL OPEN I/O FILES
OPENER: TRNN SW,OPT.R ; SKIP QUESTIONS IF /RENAME
PUSHJ PP,IOMOD ;ASK QUESTIONS ABOUT I/O MODES NOW SO
;THAT SPECIAL TAPE MODES CAN BE SETUP
TRNE SW,OPT.I ; IGNORE ERROR OPTION? [EDIT#107]
TRNE SW,OPT.P+OPT.M ;AND PACKING OR MAINTAINING? [EDIT#107]
JRST OPN1 ;YES, OK [EDIT#107]
TYPE (?The /I switch can only be used with /P or /M
) ; [EDIT#107]
JRST START ;TRY AGAIN [EDIT#107]
OPN1: TRNE SW, OPT.L ; LABEL OPTION?
TRNN SW, OPT.M ; AND MAINTAIN?
JRST .+2
JRST LBLERR ; YES
TRNN SW,OPT.B ;INPUT SEQUENTIAL (/B)?
JRST OPEN1 ;NO, INDEXED
PUSHJ PP,OP1INB ; OPEN PRIMARY INPUT BUFFERED
JRST OPEN2 ; NOW OPEN INDEXED OUTPUTS
; OPEN PRIMARY INDEXED INPUT
OPEN1: PUSHJ PP,OP1INX ; OPEN PRIMARY INPUT INDEXED
TRNE SW,OPT.C ; /C?
JRST OPEN4 ; YES, NO OUTPUT SIDE
TRNN SW,OPT.P ; /P??
JRST OPEN2 ; NO, OPEN INDEXED OUTPUTS
PUSHJ PP,OP2OTB ; YES, OPEN SEQ OUTPUT
JRST OPEN4 ; ALL DONE FOR /P
; HERE FOR OPENING INDEXED OUTPUT FILES (/B/M)
OPEN2: TRNE SW,OPT.R ; /RENAME?
JRST OPEN4 ; YES, DON'T OPEN OUTPUT SIDE
PUSHJ PP,OP1OTX ; OPEN PRIMARY INDEXED OUTPUT
PUSHJ PP,OP2OTX ; OPEN SECONDARY INDEXED OUTPUT
OPEN4: TLNE SW,(FERROR) ;IF TROUBLE,
JRST START ; QUIT AND TRY ANOTHER
JRST CKMNLB ; OK, GO CHECK LABELING
; SOME ROUTINES TO OPEN THE PRIMARY AND SECONDARY INPUT
; AND OUTPUT FILES
; OPEN THE PRIMARY INPUT FILE SEQ
OP1INB: MOVEI TA,14 ;/B: BUFFERED INPUT
MOVEI TC,IF1BUF
MOVE TB,IF1DAT+DEV ;GET INPUT DEVICE
DEVCHR TB, ;GET CHARACTERISTICS
TRNE TB,DV.M14 ;DOES IT SUPPORT BINARY MODE?
JRST OP1IN1 ;YES
TLO SW,(FERROR)
TYPE (?Device )
MOVE TE,IF1DAT+DEV
PUSHJ PP,PUTSIX
TYPE (: does not support binary mode
)
POPJ PP,
; OPEN THE PRIMARY INPUT FILE INDEXED
OP1INX: MOVE TB,IF1DAT+DEV ;/M OR /P /R /C: INPUT DEVICE MUST BE A DISK
CALLI TB,$GETCH
TLNN TB,$DSK
JRST BADDEV ;NOT A DISK
MOVEI TA,17 ; DUMP MODE INPUT
MOVEI TC,0
OP1IN1: MOVE TB,IF1DAT+DEV ;OPEN PRIMARY INPUT FILE
OPEN IF1,TA
PUSHJ PP,CANTOP ;PROBLEMS
POPJ PP, ; RETURN
; OPEN PRIMARY OUTPUT FILE
OP1OTX: MOVE TA,OF1DAT+DEV ;/B OR /M /R /C: OUTPUT DEVICES MUST BE DISKS
CALLI TA,$GETCH
TLNN TA,$DSK
JRST BADDEV ;INDEX DEVICE NOT A DISK
MOVEI TA,17 ;/B /M /R /C: DUMP MODE OUTPUT
MOVEI TC,0
MOVE TB,OF1DAT+DEV ;OPEN THE PRIMARY OUTPUT FILE
OPEN OF1,TA
PUSHJ PP,CANTOP ;PROBLEMS
POPJ PP,
; OPEN SECONDARY OUTPUT FILE
; BUFFERED (/P)
OP2OTB: TLNN SW,(FASCII) ; [142] SEQUENTIAL ,/P, - IS IT ASCII?
JRST OP2OT0 ; [142] NO USES BINARY
MOVEI TA,1 ; [142] ASCII SET MODE FOR OPEN
JRST OP2OT1 ; [142] ASCII SET UP
; INDEXED
OP2OTX: MOVE TA,OF2DAT+DEV ;/B OR /M /R /C: OUTPUT DEVICES MUST BE DISKS
CALLI TA,$GETCH
TLNN TA,$DSK
JRST BADDEV ;INDEX DEVICE NOT A DISK
OP2OT0: MOVEI TA,14 ;/P: PRIMARY OUTPUT, /B /M /R /C: SEC. OUTPUT
OP2OT1: MOVE TB,OF2DAT+DEV ; [142]
MOVSI TC,OF2BUF
OPEN OF2,TA
PUSHJ PP,CANTOP ;CAN'T
MOVEI TE,TA ; [142] GET BUFFER SIZE
DEVSIZ TE, ; [142]
MOVEI TE,^D131 ; [142] USE DSK
SUBI TE,2 ; [142] SUBTRACT HEADR SIZE (3) - 1
HRRZM TE,OF2SIZ ; [142] STORE BUFFER SIZE +1
POPJ PP, ; RETURN
;CHECK FOR AUTOMATIC MONITOR LABELING
CKMNLB: SETZM AUTOLB ;INIT MONITOR-LABEL SWITCH
TRNE SW,OPT.B+OPT.P ;BUILD OR PACK?
JRST CKMTA ; YES, CHECK FOR MTA
TRNN SW,OPT.L ;LABEL OPTION?
JRST CKNAM ; NO, GO CHECK NAMES
JRST LBLERR ; YES, BAD COMMAND
CKMTA: MOVE TA,IF1DAT ;CHANNEL FOR DEVCHR
TRNN SW,OPT.B ;CORRECT (BUILD/INPUT)?
MOVE TA,OF2DAT ;NO, IT'S PACK/OUTPUT
IFE TOPS20,<
MOVEM TA,MTACHN ;SAVE CHANNEL
> ;END IFE TOPS20
CALLI TA,$GETCH ;GET DEVICE CHARACTERISTICS
TLNE TA,$DSK ;DEVICE + DISK?
JRST [TLNN TA,$CDR ;& CARD READER TOO?
JRST CKMTA1 ; NO, NEXT CHECK
TRO SW,FNUL ; YES, DEVICE=NUL:
JRST CKMTA2 ] ; DON'T CHECK MTA FLAG
CKMTA1: TLNE TA,$MTA ;MAG TAPE?
TLO SW,(FMTA) ; YES, SET FLAG
CKMTA2: PUSHJ PP,CKLBL ;CHECK AUTO LABELING
CKNAM: SKIPE ,IF1DAT+FILNAM ;INPUT FILE NAME GIVEN?
JRST LOOK ;CHECKING NOT NEC
SKIPN ,OF1DAT+FILNAM ;ALSO NULL OUTPUT NAME?
JRST BADCOM ; BAD COMMAND IF YES
TRNN SW,OPT.B ;BUILD FILE?
JRST BADCOM ; NO, BAD COMMAND
TLNN SW,(FMTA) ; YES, FROM TAPE?
TRNE SW,FNUL ; OR NUL:?
JRST LOOK ; YES, CONTINUE
JRST BADCOM ; NO, BAD COMMAND LINE
; DO THE LOOKUPS AND/OR ENTERS
LOOK: PUSHJ PP,LOOK1I ; LOOKUP PRIMARY INPUT FILE
TRNE SW,OPT.R+OPT.C ; /RENAME OR /CHECK ?
JRST STAT ; YES, DON'T ENTER OUTPUT SIDE
TRNN SW,OPT.P ; /P?
PUSHJ PP,ENTR1 ; NO, ENTER PRIMARY OUTPUT FILE
PUSHJ PP,ENTR2 ; YES, ENTER THE SECONDARY OUTPUT FILE
TLNE SW,(FERROR) ; IF THERE WAS TROUBLE,
JRST START ; QUIT
JRST LOOK1 ; ELSE CONT
; ROUTINES TO DO LOOKUP AND ENTERS
; LOOK UP PRIMARY INPUT FILE
LOOK1I:
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
MOVE TA,IF1DAT+DEV ;GET DEVICE
CALLI TA,$GETCH ;SEE IF IT IS A DSK:
TLNN TA,$DSK
JRST LOOKT1 ;IF NOT DO REGULAR LOOKUP
MOVE TA,IF1DAT+FILNAM ;LOOKUP THE PRIMARY INPUT FILE
HLLZ TB,IF1DAT+FILEXT
MOVE TC,IF1DAT+PPNUM
MOVEM TA,IF1LB+.RBNAM
MOVEM TB,IF1LB+.RBEXT
MOVEM TC,IF1LB+.RBPPN
MOVEM TC,IF2DAT+PPNUM ;REMEMBER PPN FOR SECOND INPUT FILE
MOVEI TA,.RBEST ;STORE LENGTH OF EXTENDED LOOKUP BLOCK
MOVEM TA,IF1LB+.RBCNT
LOOKUP IF1,IF1LB ;LOOKUP THE FILE
PUSHJ PP,LOOKF ;WHAT HAPPENED?
JRST LOOKT2
LOOKT1:
>;END OF IFN $CU001
MOVE TA,IF1DAT+FILNAM ;LOOKUP THE PRIMARY INPUT FILE
HLLZ TB,IF1DAT+FILEXT
MOVEI TC,0
MOVE TD,IF1DAT+PPNUM
MOVEM TD,IF2DAT+PPNUM ;IF2PPN = IF1PPN
LOOKUP IF1,TA
PUSHJ PP,LOOKF ;ERROR
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
LOOKT2:
>;END OF IFN $CU001
TRNE SW, OPT.P
MOVEM TA+2, SA.CRE ; SAVE CREATION DATE FOR PACK OPTION
POPJ PP, ; RETURN
; LOOK UP THE PRIMARY OUTPUT FILE
LOOK1O: MOVE TA,OF1DAT+FILNAM ; GET OUT FILE NAME
HLLZ TB,OF1DAT+FILEXT ; GET OUT FILE EXT
MOVEI TC,0
MOVE TD,OF1DAT+PPNUM
LOOKUP OF1,TA
PUSHJ PP,LOOKF ; ERROR
POPJ PP, ; RETURN
; DO ENTER FOR PRIMARY OUTPUT FILE
ENTR1: MOVE TA,OF1DAT+FILNAM ;ENTER THE PRIMARY OUTPUT FILE
HLLZ TB,OF1DAT+FILEXT
MOVEI TC,0
MOVE TD,OF1DAT+PPNUM
ENTER OF1,TA
PUSHJ PP,ENTRFA ;ERROR [ED#113]
POPJ PP, ; RETURN
; ENTER SECONDARY OUTPUT FILE
ENTR2: MOVE TA,OF2DAT+FILNAM ;/B OR /M: ENTER THE SEC. OUT FILE (/P: PRIM.)
HLLZ TB,OF2DAT+FILEXT
MOVEI TC,0
MOVE TD,OF2DAT+PPNUM
ENTER OF2,TA
PUSHJ PP,ENTRFB ;ERROR [ED#113]
POPJ PP, ; RETURN
; SET SOME FLAGS AND CHECK MTA STUFF
LOOK1:
TRNE SW,OPT.M ;ANY SEQUENTIAL I/O?
JRST STAT ;NO
MOVE TE,IF1DAT+DEV ;GET SEQUENTIAL FILE DEVICE TYPE
TRNN SW,OPT.B ;IF1DEV FOR /B
MOVE TE,OF2DAT+DEV ;OF2DEV FOR /P
CALLI TE,$GETCH
TLNE TE,$DSK ;IF DSK, SET DSK FLAG
TLO SW,(FDSK)
TLNE TE, $MTA ;IF MTA, SET MTA FLAG
TLO SW,(FMTA)
TLNE TE,$DTA ;[112]IF DTA, SET DTA FLAG
TLO SW,(FDTA) ;[112]
;THIS ROUTINE SETS STANDARD ASCII MODE
;THE REQUEST IS IGNORED IF THE DEVICE IS NOT A TU70
SSA: CAIE IM,MA.MOD ; STD ASCII FOR INPUT DEVICE?
CAIN OM,MA.MOD ; ...FOR OUTPUT DEVICE?
SKIPA ; DO MTA TEST IF EITHER
JRST SSAX ; NO, CONTINUE
TLNN SW,(FMTA) ; YES, IS DEVICE A MTA?
JRST [TRNN SW,OPT.B ;NO, INPUT OR OUTPUT?
SKIPA OM,[AS.MOD] ; OUTPUT!
MOVEI IM,AS.MOD ; INPUT!
JRST SSAX ];SKIP CONTROLLER CODE;
MOVEI TA,.TFKTP ; FUNCT = GET CONTROLER TYPE
MOVE TB,IF1DAT+DEV ; GET DEVICE NAME
TRNN SW,OPT.B ; --
MOVE TB,OF2DAT+DEV ; --
MOVE TC,[2,,TA] ; POINT AT ARG BLOCK
TAPOP. TC, ; GET THE CONTROLER TYPE
JRST TFCERR ; COMPLAIN
CAIE TC,.TU70 ; IS IT A TU70?
CAIN TC,.TM02 ;[153] NO, IS IT A TU16 OR TU45?
SKIPA ;[153] YES, OK
JRST ERMVAS ;TELL THEM THEY CAN'T DO THAT
MOVEI TA,.TFMOD ; FUNCT = SET RECORDING MODE
MOVE TB,IF1DAT+DEV ; GET DEVICE NAME
TRNN SW,OPT.B ; --
MOVE TB,OF2DAT+DEV ; --
MOVEI TC,.TFM7B ; MODE = STANDARD ASCII
MOVE TD,[3,,TA] ; POINT TO AGR BLOCK
TAPOP. TD, ; SET STD ASCII MODE
JRST TFCERR ; COMPLAIN
SSAX:
STAT: MOVE TE,[STHDR,,STHDR+1] ;CLEAR STATISTICS BLOCKS
SETZM STHDR
BLT TE,STAT2+STATSZ-1
TRNN SW,OPT.P+OPT.M+OPT.R+OPT.C ;INDEX FILE INPUT?
JRST ASKM ;NO
MOVE TA,[IOWD STATSZ,STAT2] ; READ INPUT FILE STAT BLK
MOVEI TB,0
IN IF1,TA
SKIPA TA,[STAT2,,STHDR] ;OK, INIT OUTPUT STAT = INPUT STAT
JRST STATER ;ERROR
TRNE SW,OPT.R ; SKIP IF NOT /RENAME
JRST STAT1 ; ELSE SKIP STAT CHANGES
BLT TA,STHDR+STATSZ-1
HRRZS STHDR ;EXCEPT CLR FILE FORMAT FLAG
SETZM LEVELS ;/M: CLEAR STAT LOCS THAT MUST BE REDONE
SETZM NDATB
MOVE TE,[NDATB,,NDATB+1]
BLT TE,FEISEC
SETZM NUMOPS
MOVE TE,[NUMOPS,,NUMUUO]
BLT TE,SATBIT
SETZM IDXADR
STAT1: MOVEI TA,17 ;OPEN SECONDARY INPUT FILE
MOVE TB,IF1DAT+DEV
MOVEM TB,IF2DAT+DEV
MOVEI TC,0
OPEN IF2,TA
PUSHJ PP,CANTOP ;CAN'T
TLNE SW,(FERROR) ;RESTART IF ERROR
JRST START
MOVE TA,STNAM+I ;GET SPECIFICATIONS FOR INPUT DATA FILE
MOVEM TA,IF2DAT+FILNAM
MOVE TB,STEXT+I
MOVEM TB,IF2DAT+FILEXT
MOVEI TC,0
MOVE TD,IF2DAT+PPNUM
LOOKUP IF2,TA ;FIND DATA FILE
PUSHJ PP,LOOKF ;ERROR
TLNE SW,(FERROR) ;RESTART AFTER ERROR
JRST START
; IF /R (RENAME) NOW GO DO IT
TRNN SW,OPT.R ; /R?
JRST ASKM ; NO, ASK QUESTIONS
SUBTTL RENAME THE INPUT INDEXED FILE
; RENAME THE PRIMARY INPUT (IDX) FILE SAME AS PRIMARY OUT FILE
MOVE TA,OF1DAT+FILNAM ;ENTER THE PRIMARY OUTPUT FILE
HLLZ TB,OF1DAT+FILEXT
MOVEI TC,0
MOVE TD,OF1DAT+PPNUM
RENAME IF1,TA
PUSHJ PP,RENAMA ;ERROR [ED#113]
TLNE SW,(FERROR) ;RESTART AFTER ERROR
JRST START
; RENAME THE SECONDARY INPUT (IDA) FILE SAME AS SECONDARY OUT FILE
MOVE TA,OF2DAT+FILNAM ;RENAME THE SECONDARY OUTPUT FILE
HLLZ TB,OF2DAT+FILEXT
MOVEI TC,0
MOVE TD,OF2DAT+PPNUM
RENAME IF2,TA
PUSHJ PP,RENAMB ;ERROR [ED#113]
TLNE SW,(FERROR) ;RESTART AFTER ERROR
JRST START
; NOW OPEN THE PRIMARY PUTPUT FILE (NEW IDX FILE) AND PUT THE
; NEW IDA NEW INTO THE STAT BLOCK, WHICH HAS ALREADY BEEN
; READ INTO THE STAT2 AREA
PUSHJ PP,OP1OTX ; OPEN PRIMARY OUTPUT INDEXED FILE
PUSHJ PP,LOOK1O ; LOOKUP PRIMARY OUT FILE
; TO SAVE REST OF DATA
PUSHJ PP,ENTR1 ; DO ENTER ON PRIMARY OUTPUT FILE
; SO CAN WRITE NEW STAT BLOCK
TLNE SW,(FERROR) ;RESTART AFTER ERROR
JRST START
MOVE TA,OF2DAT+FILNAM ; GET OUTPUT IDA NAME
MOVEM TA,STNAM+I ; RESET IDA NAME IN STAT BLOCK
MOVE TB,OF2DAT+FILEXT ; GET OUTPUTX IDA EXT
MOVEM TB,STEXT+I ; RESET IDA EXT IN STAT BLOCK
; NOW WRITE OUT THE NEW STAT BLOCK
MOVE TA,[IOWD STATSZ,STAT2] ; WRITE INPUT FILE STAT BLK
MOVEI TB,0
OUT OF1,TA
JRST RENAMX ; AOK, FINISH UP
JRST IDXERA ;ERROR
RENAMX: CLOSE OF1, ; CLOSE OUTPUT IDX FILE
RELEASE OF1, ; RELEASE
JRST FIN$ ; AND BACK TO BEGIN
SUBTTL GET FILE PARAMETERS
; THESE QUESTIONS ARE ASKED BEFORE FILES ARE OPENED SO THAT SPECIAL
; MODES CAN BE HANDLED THERE
IOMOD: TRNE SW,OPT.B ;/B?
JRST ASKM2 ;YES
TRNE SW,OPT.M ;/M?
POPJ PP,
MOVE TB,OF2DAT+DEV ; [142] NO, SEQUENTIAL
DEVCHR TB, ; [142] GET DEVICE CHARACTERISTICS
TLNN TB,DV.OUT ; [142] ALSO CHECK IF OUTPUT DEVICE
JRST ILLDEV ; [142] ILLEGAL
TRNE TB,DV.M14 ; [142] SEE IF DEVICE CAN USE BINARY
JRST ASKM1 ; [142] IT CAN GO ON
TLO SW,(FASCII) ; [142] SET /P DEVICE ASCII
ASKM1: MOVEI TB,AS.MOD ; [142] ASSUME OUTPUT DEVICE ASCII
TLNE SW,(FASCII) ; [142] IS IT REALLY ASCII?
JRST ASKM3A ; [142] YES DONT ASK
ASKM1A: TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST ASKM1B
TYPE (Mode of output file: ) ;/P
ASKM1B: PUSHJ PP,GETMOD ;[EDIT 107]
JRST .-2 ;[EDIT 107]
; NEXT LINE DELETED, CAUSES INCORRECT FLOW IN CASE OF NULL RESPONSE/BL
; JRST ASKM3A ;[EDIT 107]
JUMPGE TB,ASKM3B ;JUMP IF VALID MODE
TYPE (?ISMRSP Response required.
) ;ERROR MESSAGE
JRST ASKM1A ;GO ASK AGAIN
ASKM2: TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST ASKM2F
ASKM2E: TYPE (Mode of input file: ) ;/B
ASKM2F: PUSHJ PP,GETMOD
JRST ASKM2E ; TROUBLE, TRY AGAIN
ASKM2A: JUMPGE TB,ASKM2D ; JUMP IF VALID RESPONSE GIVEN
MOVE TE,[SIXBIT "NUL"] ; TB=-1, NO RESPONSE
CAMN TE,IF1DAT+DEV ; WAS INPUT DEVICE "NUL:"
AOJA TB,ASKM2D ; YES, DEFAULT SIXBIT
TYPE (?ISMRSP Response required.
)
JRST ASKM2E ; ASK AGAIN
ASKM2D: MOVEI IM,(TB) ;SET INPUT MODE
ASKM2B: TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST ASKM3
ASKM2C: TYPE (Mode of data file: )
ASKM3: PUSHJ PP,GETMOD
JRST ASKM2C ; ASK ? AGAIN
ASKM3A: JUMPGE TB,ASKM3B ; JUMP IF A VALID MODE WAS GIVEN
TYPE (?ISMRSP Response required.
)
JRST ASKM2C ; ASK ? AGAIN
ASKM3B: MOVEI OM,(TB) ;SET OUTPUT MODE
POPJ PP,
ASKM:
TRNN SW,OPT.B ;IS IT /P OR /M?
LDB IM,KY.MOD ;/M OR /P: GET INPUT MODE FROM STATISTICS
;BL 1 LINE CHANGED TO FIX ILLEGAL MEM REF-QAR10-06073
TRNE SW,OPT.M+OPT.C ;IS IT /M OR /C?
HRRZI OM,(IM) ;/M: OUTPUT MODE SAME AS INPUT MODE
;CHECK TO SEE THAT NO ONE ASKED FOR 35 BIT ASCII I/O ON
; SOMETHING OTHER THAN TU-70 MAG TAPE
;[153] OR TU-16 OR TU-45.
;BL; 1 CHANGED AT ASKM+5 TO INFORM LAZY PROGRAMMER OF RECORD SIZE
TRNN SW,OPT.B+OPT.S ;BUILD OR STATS?
; JRST ASKM8 ;NO, /P OR /M [151] WRONG PLACE
ASKM5B: JRST [ MOVE TE,RECBYT ;[151] RECOMPUTE RECSIZ
JRST ASKM6 ] ;[151] IN CASE WE CHANGED MODE
ASKM5: TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST ASKM5A
TYPE (Maximum record size: )
;BL; 6 ADDED AT ASKM5+3 TO DISPLAY RECORD SIZE TO LAZY PROGRAMMER WITH /S
TRNE SW,OPT.B ;BUILD?
JRST ASKM5A ; YES
MOVE TE,RECBYT ;NO, MUST BE STATS, LOAD REC SIZE
PUSHJ PP,PUTDEC ;DISPLAY IT
TYPE (
) ;NEW LINE
JRST ASKM5B ; AND REJOIN /M/C
ASKM5A: PUSHJ PP,GETPOS
JRST .-3
CAILE TE,7777 ;RECORD SIZE MUST BE < 4096
JRST SIZERR ;TOO BIG
MOVEM TE,RECBYT
;CONVERT RECORD SIZE TO WORDS
ASKM6: ;[151] RECOMPUTE RECSIZ IN CASE WE CHANGED MODE WITH /P
CAIN OM,AS.MOD ;ASCII??
ADDI TE,2 ;ADD 2 FOR CRLF
ADD TE,BYWDM1(OM) ;ADD IN BYTES PER WORD MINUS ONE
IDIV TE,BYTWRD(OM) ;DIVIDE BY BYTES PER WORD
ASKM7: MOVEM TE,RECSIZ ; AND STORE IT AWAY
ASKM8: PUSHJ PP,GETKEY ;GET KEY DESCRIPTOR
TRNE SW,OPT.M
JRST ASKM12 ;SKIP NEXT QUESTION IF /M
MOVE TE,LASTKB ;IF KEY WON'T
CAMLE TE,RECBYT ; FIT IN RECORD,
JRST BIGKEY ; WE HAVE TROUBLE
ASKM9: TRNE SW,OPT.C ; /CHECK ?
JRST ASKM14 ; YES, SKIP QUESTIONS
TRNN SW,OPT.P
JRST ASKM10 ;/B
SETZ TE,0 ; [142] ASSUME UNBLOCKED
TLNE SW,(FASCII) ; [142] IF /P IS ASCII DONT ASK
JRST ASK11A ; [142]
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST ASKM9A
TYPE (Records per output block: ) ;/P
ASKM9A: MOVEI TE,0 ;IF NO ANSWER, ASSUME UNBLOCKED
JRST ASKM11
ASKM10: TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST ASKM11
TYPE (Records per input block: ) ;/B
ASKM11: PUSHJ PP,GETNUM
JRST .-2
JUMPE TE,[ ; SKIP IF BLK-FTR IS NONE ZERO
; ELSE SET EBCDIC BLOCKING FACTOR TO 1
TLNN SW,(FMTA) ; DEVICE A MTA?
JRST .+1 ; NO
TRNE SW,OPT.P ; SETUP TEST FOR SEQ FILE MODE
EXCH IM,OM ; EXCHANGE
CAIE IM,MA.MOD ; IS IT STANDARD ASCII?
CAIN IM,EB.MOD ; IS IT EBCDIC?
MOVEI TE,1 ; YES, CHANGE BF FROM 0 TO 1
TRNE SW,OPT.P ; RESTORE IM AND OM
EXCH IM,OM
JRST .+1 ]
ASK11A: MOVEM TE,INPBLK ; [142] STORE INPUT BLOCK SIZE
TRNE SW,OPT.P
JRST ASKM14
ASKM12: TRNE SW,OPT.M ;/M? [EDIT#140]
TLO SW,(FCEOFK) ; [EDIT#140]
MOVE TE,DATBLK+I ;AIM AT DATBLK
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM12A
TYPE (Total records per data block)
SKM12A: PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
TRNE SW,OPT.B+OPT.M ;IF /B OR /M, RECOMMEND BLOCKING FCTR
PUSHJ PP,RECDBF ;FOR DATA FILE BLOCKING FACTOR
>;END OF IFN $CU001
PUSHJ PP,GETNUM
JRST .-3
;BL; 9 REPLACED AT SKM12A+7
;IFE $CU001,< ;MAKE ISAM MORE INTELLIGENT
; TRNN SW,OPT.B ;IF /B, POSITIVE RESPONSE REQUIRED
; JRST .+4 ;NOT /B
; JUMPG TE,.+3 ;OK
; PUSHJ PP,POSERR ;WARNING
; JRST ASKM12 ;TRY AGAIN
; >;END OF IFE $CU001
; TLZE SW,(FGETDC) ;IF /M, LEAVE AS IS IF NULL RESPONSE
; MOVEM TE,DATBLK
TLZN SW,(FGETDC) ;RESPONSE FROM USER?
JRST SKM12B ; NO, GO USE DEFAULT
JUMPG TE,SKM12C ;POSITIVE RESPONSE, GO USE IT
PUSHJ PP,POSERR ;WARNING
JRST ASKM12 ;& TRY AGAIN
SKM12B: MOVE TE,DATBLK+I ;ASSUME /M, DEFAULT=CURRENT
TRNN SW,OPT.M ;IS IT /M?
MOVE TE,RECBLK ; NO, MUST BE /B, USE RECOMMENDED VALUE
SKM12C: MOVEM TE,DATBLK ;SET BLOCKING FACTOR
ASKM13: MOVE TE,EMPDAT+I ;AIM AT EMPDAT
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM13A
TYPE (Empty records per data block)
SKM13A: PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
PUSHJ PP,GETNUM
JRST .-3
TLZE SW,(FGETDC) ;LEAVE AS IS IF NULL RESPONSE
MOVEM TE,EMPDAT
ASKM14: MOVN TE,EMPDAT ;COMPUTE
ADD TE,DATBLK ; RECORDS
MOVEM TE,DATRIT ; TO USE
JUMPLE TE,TOOMCH ;IF NOT POSITIVE, ERROR
MOVE TE,RECSIZ ;COMPUTE
ADDI TE,1 ; NUMBER
IMUL TE,DATBLK ; OF
ADDI TE,177 ; SECTORS
LSH TE,-7 ; PER DATA BLOCK
hllzi ch, ;clear
movem ch,pagbuf ; page sw
IFN TOPS20,<
TRNN SW,OPT.OP ;OUTPUT IN PAGES?
JRST .+5 ;NO, SKIP SHIFT
ADDI TE,3 ;IN PAGE MULTIPLES
LSH TE,-2
LSH TE,2
HRROI CH,-1 ;
MOVEM CH,PAGBUF ;SET PAGE SW IN STAT BLOCK
> ;END IFN TOPS20
MOVEM TE,DATSEC
ASKM15: TRNE SW,OPT.P+OPT.C
JRST ASKM16 ; /CHECK OR /PACK SKIP QUESTION
MOVE TE,IDXBLK+I ;AIM AT IDXBLK
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM15A
TYPE (Total entries per index block)
SKM15A: PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
TRNE SW,OPT.B+OPT.M ;IF /B OR/M, RECOMMEND BLOCK FCTR
PUSHJ PP,RECIBF
>;END OF IFN $CU001
PUSHJ PP,GETNUM
JRST .-3
;BL; 10 REPLACED BY 11 AT ASKM15+13
;IFE $CU001,< ;MAKE ISAM MORE INTELLIGENT
; TRNN SW,OPT.B ;IF /B, POSITIVE RESPONSE REQUIRED
; JRST .+4 ;NOT /B
; JUMPG TE,.+3 ;OK
; PUSHJ PP,POSERR ;WARNING
; JRST ASKM12 ;TRY AGAIN
; >;END OF IFE $CU001
; TLZE SW,(FGETDC) ;IF /M, LEAVE AS IS IF NULL RESPONSE
; MOVEM TE,IDXBLK
; MOVE TE,IDXBLK
TLZN SW,(FGETDC) ;RESPONSE FROM USER?
JRST SKM15B ; NO, GO USE DEFAULT
JUMPG TE,SKM15C ;POSITIVE RESPONSE, GO USE IT
PUSHJ PP,POSERR ;WARNING
JRST ASKM15 ;& TRY AGAIN
SKM15B: MOVE TE,IDXBLK+I ;ASSUME /M, DEFAULT=CURRENT
TRNN SW,OPT.M ;IS IT /M?
MOVE TE,RECBLK ; NO, MUST BE /B, USE RECOMMENDED VALUE
SKM15C: CAIGE TE,2 ;MUST HAVE AT LEAST 2
JRST TOOFEW ;ERROR
MOVEM TE,IDXBLK ;SET BLOCKING FACTOR
MOVE TE,[IDXBLK,,IDXBLK+1] ;ALL LEVELS THE SAME
BLT TE,IDXBLK+^D9
ASKM16: MOVE TE,SIZIDX
IMUL TE,IDXBLK ;MULTIPLY INDEX ENTRY SIZE BY BLOCKING
ADDI TE,1+177 ;ADD 1 WORD FOR HEADER, AND ROUND UP
LSH TE,-7 ;CONVERT TO SECTORS
IFN TOPS20,<
TRNN SW,OPT.OP ;OUTPUT IN PAGES?
JRST .+4 ;NO, SKIP SHIFT
ADDI TE,3 ; IN PAGE MULTIPLES
LSH TE,-2
LSH TE,2
> ;END IFN TOPS20
MOVEM TE,IDXSEC
MOVEI TE,1 ;FIRST EMPTY INDEX SECTOR IS
MOVEM TE,FEISEC ; NUMBER 1
MOVE TE,SIZIDX ;COMPUTE
IMUL TE,IDXBLK ; NUMBER OF
ADDI TE,1 ; BYTES IN
IMULI TE,6 ; INDEX
MOVEM TE,STHDR ; BLOCK
; CAILE TE,7777 ;IF IT IS NOT TOO BIG, ALL IS WELL
; JRST BIGIDX ;IT IS TOO BIG
TRNE SW,OPT.P+OPT.C ; /CHECK OR /PACK ?
JRST ASKM17 ; SKIP QUESTION
MOVE TE,EMPIDX+I ;AIM AT EMPIDX
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM16A
TYPE (Empty entries per index block)
SKM16A: PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
PUSHJ PP,GETNUM
JRST .-3
TLZE SW,(FGETDC) ;LEAVE AS IS IF NULL RESPONSE
MOVEM TE,EMPIDX
MOVE TE,[EMPIDX,,EMPIDX+1] ;ALL LEVELS THE SAME
BLT TE,EMPIDX+^D9
ASKM17: MOVN TE,EMPIDX ;COMPUTE
ADD TE,IDXBLK ; NUMBER OF
MOVEM TE,IDXRIT ; ENTRIES TO USE
CAIG TE,1 ;IF ONLY ONE ENTRY
JRST TOOFEW ; OR IF NOT POSITIVE, ERROR
TRNE SW,OPT.P+OPT.C ; /CHECK OR /PACK ?
JRST SETIO ; ALL DONE HERE, SETUP FOR IO
ASKM18: MOVE TE,%DAT+I ;AIM AT %DAT
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM18A
TYPE (Percentage of data file to leave empty)
SKM18A: PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
PUSHJ PP,GETNUM
JRST .-3
TLZE SW,(FGETDC) ;LEAVE AS IS IF NULL RESPONSE
MOVEM TE,%DAT
CAIGE TE,^D100 ;% MUST BE 0 .LE. N .LT. 100
JUMPGE TE,ASKM19 ;OK
JRST ERR%DA
ASKM19: MOVE TE,%IDX+I ;AIM AT %IDX
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM19A
TYPE (Percentage of index file to leave empty)
SKM19A: PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
PUSHJ PP,GETNUM
JRST .-3
TLZE SW,(FGETDC) ;LEAVE AS IS IF NULL RESPONSE
MOVEM TE,%IDX
CAIGE TE,^D100
JUMPGE TE,ASKM20
JRST ERR%IX
ASKM20: MOVE TE,MAXSAT+I ;AIM AT MAX # RECORDS
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
JRST SKM20A
TYPE (Maximum number of records file can become)
SKM20A: PUSHJ PP,MCUR
PUSHJ PP,GETNUM
JRST .-3
TLZE SW,(FGETDC)
MOVEM TE,MAXSAT
;NOW FILL IN SOME STATISTIC WORDS
MOVE TE,[XWD OF2DAT+DEV,STDEV]
BLT TE,STEXT
CALLI TE,$DATE ;FIX
MOVEM TE,CREATE ; CREATION DATE AND
MOVEM TE,ACCDAT ; ACCESS DTAE
;IFN TOPS20,<
; PUSHJ PP,ASCNAM ;PUT TOPS20 FILE-SPEC
;>
DPB OM,KY.MOD ;STORE OUTPUT MODE
IFE TOPS20,<
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
ALLM: TRNN SW,OPT.M ;SEE IF IN /M MODE
JRST ALLB ;NO SO TEST FOR /B?
MOVE TA,DATBLK ;GO CALCULATE SOME THINGS
PUSHJ PP,FNDSTA ;TO USE FOR OUR CALCS
MOVE TA,NDATB+I ;GET # OF DATA BLOCKS IN FILE
ADD TA,NDATBE+I ;AND ADD NUMBER OF EMPTY ONES
IMUL TA,DATBLS ;TIMES # OF PHYSICAL DISK BLOCKS PER DATA BLOCK
ADDI TA,2 ;ADD IN ROOM FOR THE PRIME AND SPARE RIBS
PUSHJ PP,ALOF2 ;GO DO EXTENEDED ENTER FOR OUTPUT DATA FILE
MOVE TA,NSECI+I ;NOW GET # SECTORS(PHYS DISK BLOCK) IN INDEX FILE
ADD TA,NSECIE+I ;ADD IN NUMBER OF EMPTIES
ADDI TA,2 ;ADD IN ROOM FOR PRIME/SPARE RIBS
MOVE TB,LEVELS+I ;GET # OF LEVELS
MOVEM TB,CLLVLS ;ADN STORE FOR LATER
PUSHJ PP,ALOF1 ;GO DO EXTENDED ENTER FOR IDX FILE
JRST SETIO
ALLB:
TRNN SW,OPT.B ;SEE IF WE ARE BUILDING
JRST SETIO ;IF NOT JUST CONTINUE SINCE NOT /M OR /B
MOVE TA,IF1DAT+DEV ;SEE IF INPUT FILE IS ON DISK
CALLI TA,$GETCH ;SINCE WE DON'T DO AN EXTENDED LOOKUP OTHERWISE
TLNN TA,$DSK ;IF IT ISN'T JUST CONTINUE LIKE WE ALWAYS HAVE
JRST SETIO
MOVE TA,IF1LB+.RBSIZ ;GET ISZE OF THE FILE FOR APPROXIMATION OF OUTPUT FILE SIZES
IMUL TA,BYTWRD(IM) ;CALCULATE # OF BYTES THAT IS
MOVE TC,RECBYT ;GET RECORD SIZE IN BYTES
CAIN IM,AS.MOD ;AND ADD IN 2 IF IT
ADDI TC,2 ;IS IN ASCII MODE
IDIV TA,TC ;NOW SEE HOW MANY RECORDS THERE CAN BE IN INPUT
MOVE TC,TA ;SAVE IT FOR A WHILE
IDIVI TA,^D10 ;GET A TENTH OF IT FOR EXTRA 10%
SKIPN TA ;SEE IF THERE IS ANY
AOS TA ;IF NONE MAKE IT ONE
ADD TA,TC ;THEN PUT THEM TOGETHER
MOVE TB,DATRIT ;GET # OF ENTRIES TO USE
IDIV TA,TB ;GET APPROX NUMBER OF DATA BLOCKS NEEDED
SKIPN TA ;SEE IF THERE ARE
AOS TA ;ANY AND IF NOT MAKE AT LEAST ONE
MOVE TD,TA ;PUT OUT OF THE WAY FOR A BIT
MOVE TA,DATBLK ;SEE IF WE NEEDE TO RECALCULATE PHYSICAL BLOCKS PER DATA BLOCK
CAME TA,IDABF ;IF SO GO DO IT
PUSHJ PP,FNDSTA ;SO WE CAN FIND DISK BLOCKES NEEDED
IMUL TD,DATBLS ;CALCULATE DISK BLOCKS REQUIRED
MOVE TA,TD ;RESTORE # OF BLOCKS NEEDED ON DISK
IMUL TA,%DAT ;SEE IF WE MUST ADD ANY EMPTIES
MOVEI TB,^D100
SUB TB,%DAT ;AND IF SO THEN ADD THEM
IDIVI TA,(TB)
ADDI TA,1 ;ALWAYS ROUNDING UP
SKIPG TA ;MAKE SURE IS POSITIVE
MOVEI TA,1 ;ELSE SET TO ONE
ADD TD,TA ;ADD INTO TOTAL
ADDI TD,2 ;AND INCLUDE TWO BLOCKS FOR THE RIB'S
MOVE TA,TD ;THEN PRIME FOR CALL TO ALOF2
PUSHJ PP,ALOF2 ;GO DO THE EXTENDED ENTER
MOVE TA,IDXRIT ;GET # OF ENTRIES TO USE
SETZB TE,TF ;USE TE TO COUNT BLOCKS NEEDED
MOVE TB,TD ;GET NUMBER OF ENTRIES ON LOWEST LEVEL AGAIN
ALLBL: IDIV TB,TA ;GET NUMBER OF INDEX BLOCKS ON THE LOWEST LEVEL
SKIPN TB ;WE ARE DONE IF 0
JRST ALLBX ;SO GO TO EXIT OF LOOP
ADD TE,TB ;ADD INTO TOTAL
CAML TB,TA ;ONLY INCREMENT LEVEL IF NEED TO
AOS TF ;ADD ONE TO LEVELS COUNTER
JRST ALLBL ;GO THRU LOOP UNTIL ALL DONE
ALLBX: AOS TE ;ADD 1 INTO COUNTER FOR TOP INDEX BLOCK
AOS TF ;AND ADD 1 TO LEVEL COUNTER
MOVEM TF,CLLVLS ;SAVE CALCULATED LEVELS
MOVE TA,IDXSEC ;GET LENGTH OF INDEX BLOCK IN BITS FOR SAT BLOCK
LSH TA,7 ;CONVERT TO WORDS
SUBI TA,1 ;REMOVE THE HEADER WORD
IMULI TA,^D36 ;CONVERT TO BITS
MOVE TB,MAXSAT ;GET WHAT USER SPECIFIED AS MAXIMUM
IDIV TB,DATBLK ;CONVERT TO DATA BLOCKS
IDIV TB,TA ;CONVERT TO NUMBER OF SAT BLOCKS NEEDED
MOVE TC,TE ;GET TOTAL SO FAR TO SEE IF HAVE TO ADD ANY EMPTIES
IMUL TC,%IDX ;CALC HOW MANY TO ADD
MOVEI TD,^D100
SUB TD,%IDX
IDIVI TC,(TD)
SKIPG TC ;MAKE SURE THAT IT IS POSSITIVE
MOVEI TC,1 ;ELSE JUST MAKE IT ONE
ADD TE,TC ;AND ADD INTO TOTAL FROM ABOVE
ADD TE,TB ;THEN ADD THE NUMBER OF SAT BLOCKS
IMUL TE,IDXSEC ;CONVERT TO ACTUAL DISK BLOCKS NEEDED
ADDI TE,3 ;ADD ONE FOR THE STAT BLOCK, AND RIBS
MOVE TA,TE ;PRIME ALOF1
PUSHJ PP,ALOF1 ;GO ALLOCATE THE FILE
JRST SETIO
ALOF2: CLOSE OF2,40 ;DELETE FILE FROM ORIGINAL ENTER
MOVEM TA,OF2EB+.RBEST ;TELL TO ALLOCATE
MOVE TA,OF2DAT+FILNAM ;GET FILE NAME
MOVE TB,OF2DAT+FILEXT
MOVE TC,OF2DAT+PPNUM
MOVEM TA,OF2EB+.RBNAM
MOVEM TB,OF2EB+.RBEXT
MOVEM TC,OF2EB+.RBPPN
MOVEI TA,.RBALC ;GIVE THE LENGTH OF THE ENTER BLOCK
MOVEM TA,OF2EB+.RBCNT
IFN DEBUG,< ;SHOW ALLOCATED VALUE IF DEBUGGING
PUSHJ PP,DBOF2
> ;END OF IFN DEBUG
;BL; 1 LINE INSERTED AT ALOF2+13 TO FIX PARTIAL ALLOCATION BUG
SETZM OF2EB+.RBALC ;RESET ALLOCATION BLOCK
ENTER OF2,OF2EB ;DO AN EXTENDED ENTER
;BL; CHANGES AT ALOF2+15 TO FIX PARTIAL ALLOCATION BUG
PUSHJ PP,[
IFE DEBUG,<
HRRZ TB,OF2EB+.RBEXT ;LOAD ERROR CODE
CAIN TB,17 ;PARTIAL ALLOCATION?
POPJ PP, ; YES, FORGET IT
> ;END IFE DEBUG
MOVE TB,OF2EB+.RBEXT ;CODE FOR ERROR ROUTINE
JRST ENTRFB] ;GO GIVE ERROR
HRRZ TA,OF2EB+.RBEXT ;CHECK FOR PARTIAL ALLOCATION ERROR
CAIN TA,17 ;IF IT IS ERROR 17
TLZ SW,(FERROR) ;THEN TURN ERROR BIT OFF
TLNE SW,(FERROR) ;BUT IF ANYTHING ELSE THEN
JRST START ;START OVER
POPJ PP, ;IF OK RETURN TO CALLER
ALOF1: CLOSE OF1,40 ;DELETE FILE FROM ORIGINAL ENTER
MOVEM TA,OF1EB+.RBEST ;TELL HOW MUCH TO ALLOCATE
MOVE TA,OF1DAT+FILNAME ;GET FILE DATA AND PUT
MOVE TB,OF1DAT+FILEXT ;INTO THE ENTER BLOCK
MOVE TC,OF1DAT+PPNUM
MOVEM TA,OF1EB+.RBNAM
MOVEM TB,OF1EB+.RBEXT
MOVEM TC,OF1EB+.RBPPN
MOVEI TA,.RBALC
MOVEM TA,OF1EB+.RBCNT ;TELL HOW LONG THE BLOCK IS
IFN DEBUG,< ;SHOW ALLOCATED VALUE IF DEBUGGING
PUSHJ PP,DBOF1
> ;END OF IFN DEBUG
;BL; 1 LINE INSERTED AT ALOF1+13 TO FIX PARTIAL ALLOCATION BUG
SETZM OF1EB+.RBALC ;RESET ALLOCATION BLOCK
ENTER OF1,OF1EB ;DO THE EXTENDED ENTER
;BL; CHANGES AT ALOF1+15 TO FIX PARTIAL ALLOCATION BUG
PUSHJ PP,[
IFE DEBUG,<
HRRZ TB,OF1EB+.RBEXT ;GET ERROR CODE IF FAILED
CAIN TB,17 ;PARTIAL ALLOCATION?
POPJ PP, ; YES, FORGET IT
> ;END IFE DEBUG
JRST ENTRFA] ;GO GIVE ERROR
HRRZ TA,OF1EB+.RBEXT ;CHECK FOR PARTIAL ALLOCATION ERROR
CAIN TA,17 ;AND IF IT IS TURN THE ERROR BIT OFF
TLZ SW,(FERROR)
TLNE SW,(FERROR) ;THEN TEST FOR OTHER ERRORS
JRST START ;AND START OVER IF THERE ARE ANY
POPJ PP, ;THEN RETURN
IFN DEBUG,< ;ASSEMBLE ONLY IF DEBUGGING
DBOF2: TYPE ([ISMABD Allocating )
MOVE TE,OF2EB+.RBEST ;SHOW ESTIMATED VALUE
PUSHJ PP,PUTDEC
TYPE ( blocks for )
MOVE TE,OF2DAT+DEV ;SHOW FILE NAME
PUSHJ PP,PUTSIX
TYPE (:)
MOVE TE,OF2EB+.RBNAM
PUSHJ PP,PUTSIX ;SHOW FILENAME
HLLZ TE,OF2EB+.RBEXT ;AND EXTENSION
TYPE (.)
SKIPE TE
PUSHJ PP,PUTSIX ;IF THERE IS ONE
SKIPN TE,OF2EB+.RBPPN ; SKIP IF THERE IS A PPN
JRST DBOF3
; THERE IS A PPN, TYPE IT
TYPE ([)
HLRZ TE,TE ; GET PROJ NUM
SKIPE TE
PUSHJ PP,PUTOCT
TYPE (,)
HRRZ TE,OF2EB+.RBPPN
SKIPE TE
PUSHJ PP,PUTOCT
TYPE (])
DBOF3: TYPE ( ]
)
POPJ PP, ;THEN RETURN
DBOF1: TYPE ([ISMABI Allocating )
MOVE TE,OF1EB+.RBEST ;SHOW ESTIMATED VALUE
PUSHJ PP,PUTDEC
TYPE ( blocks for )
MOVE TE,OF1DAT+DEV ;SHOW FILE NAME
PUSHJ PP,PUTSIX
TYPE (:)
MOVE TE,OF1EB+.RBNAM
PUSHJ PP,PUTSIX ;SHOW FILENAME
HLLZ TE,OF1EB+.RBEXT ;AND EXTENSION
TYPE (.)
SKIPE TE
PUSHJ PP,PUTSIX ;IF THERE IS ONE
SKIPN TE,OF1EB+.RBPPN ; GET PPN
JRST DBOF4 ; NONE, CONT
; TYPE PPN
TYPE ([)
HLRZ TE,TE ; GET PROJ NUM
SKIPE TE
PUSHJ PP,PUTOCT
TYPE (,)
HRRZ TE,OF1EB+.RBPPN
SKIPE TE
PUSHJ PP,PUTOCT
TYPE (])
DBOF4: TYPE ( ]
[ISMCIL Calculated )
MOVE TE,CLLVLS ;RESTORE # OF LEVELS
PUSHJ PP,PUTDEC
TYPE ( levels of index.]
)
POPJ PP, ;THEN RETURN
>;END OF IFN DEBUG
>;END OF IFN $CU001
>;END IFE TOPS20
SUBTTL GET READY FOR I/O
SETIO:
PUSHJ PP,LOPINI ;SOME INITIALIZATION
;bl RELEASE CMD, ;IN CASE INDIRECT CMD FILE WAS OPEN
MOVE TE,[SIXBIT/0000/] ;CLEAR REEL NUMBER
MOVEM TE,OREENO
TLZ SW,(FRECIN) ;CLR RECORD-SEEN FLAG
SETZM IDXLOC ;CLEAR INDEX INFO
MOVE TE,[XWD IDXLOC,IDXLOC+1]
BLT TE,IDXFLG+^D9
TRNE SW,OPT.B
JRST SETIO3
; PACK OR MAINTAIN OR CHECK
MOVE TE,LEVELS+I ;GET INDEX SPACE FOR /P, /M , /C INPUT
MOVE TA,IDXSEC+I
LSH TA,7 ;TA=NUMBER OF WORDS/BLK OF INDEX
MOVEM TA,IDXSIZ
IMULI TE,(TA) ;TE=TOTAL # WORDS FOR ALL INDEX LEVELS
HRRZ TD,.JBFF## ;[115]ADDR FOR 1ST LEVEL OF INPUT INDEX
MOVEM TD,IDXLIN
PUSHJ PP,GETCOR
MOVE TB,IDXLIN ;MAKE PTR TO EACH LEVEL
MOVE TE,IDXBLK+I ;# ENTRIES AT EACH INPUT INDEX BLK
MOVEM TE,IDXEIN
MOVEI TC,1 ;START AT LEVEL 2
SETIO8: ADD TB,IDXSIZ
MOVEM TB,IDXLIN(TC)
MOVEM TE,IDXEIN(TC)
CAMGE TC,LEVELS+I
AOJA TC,SETIO8
MOVE TE,RECSIZ+I ;GET SPACE FOR /P, /M, /C DATA INPUT
ADDI TE,1 ;INCLUDE HEADER WORD OF EACH RECORD
IMUL TE,DATBLK+I
MOVEM TE,INSIZ
MOVE TD,.JBFF ;[115]
MOVEM TD,INDAT
PUSHJ PP,GETCOR
MOVE IX,LEVELS+I ;READ IN TOP LEVEL OF INDEX
MOVE TA,IDXADR+I
MOVEM TA,CURIDX(IX) ; SAV TOP INDEX BLK NUMBER
TLNN TA,-1 ;[157] IF BLOCK-NMBR GT 18 BITS
CAILE TA,-11 ; [162] OR BETWEEN 777770 & 777777
JRST SETI8F ; [162] YES, DO FILOP. USETI
JRST SETI8A ;[157] NO GO TO USETI
SETI8F: MOVEM TA,FUSI+1 ;[162] [157] BLK-NUMER TO ARG BLOCK
MOVEI TA,IF1 ;[157] GET CHANNEL
HRLM TA,FUSI ;[157] CHANNEL TO ARG BLOCK
MOVE TA,[2,,FUSI] ;[157] POINT TO ARG BLOCK
FILOP. TA, ;[157] DO THE FILOP. (USETI)
JFCL ;[157] ERROR RETURN
SKIPA ;[157] SKIP REG. USETI
SETI8A: USETI IF1,(TA) ;[157] DO REG. USETI
PUSHJ PP,IDXREA
MOVSI TA,377777 ;FORCE A CALL TO DATREA
MOVEM TA,DATFLG
SETIO3:
SETZM INPBPB ;EBCDIC VARIABLE BYTES PER BLOCK
SETZM IBPBCT ;AND COUNTER
AOS IBPBCT ;MAKE IT GREATER THAN ZERO
TRNE SW,OPT.C ; /CHECK?
JRST SETIO7 ; YES, DON'T ASSIGN OUT BUFFERS
OUTBUF OF2,2 ;GET 2 BUFFERS FOR DATA FILE
MOVE TE,BYTSIZ(OM) ;GET BYTE SIZE AND PUT IN
DPB TE,[POINT 6,OF2BUF+1,11]; BUFFER HEADER WORD
TRNE SW,OPT.P ;/P ?
JRST SETIO2 ;YES
PUSHJ PP,GETLVL ;/M OR /B: GET CORE FOR OUTPUT INDEX
TRNE SW,OPT.M
JRST SETIO7
INBUF IF1,2 ;/B: GET 2 BUFFERS FOR INPUT FILE
MOVE TE,BYTSIZ(IM) ;GET BYTE SIZE FOR BUFFER HEADER WORD
DPB TE,[POINT 6,IF1BUF+1,11]
SETIO2: TLNE SW,(FMTA) ;MAG TAPE?
PUSHJ PP,BLDBUF ;YES, MAKE NON-STD BUFFERS
TLNE SW, (FMTA) ; MAG TAPE?
TRNN SW, OPT.L ; AND LABELS?
JRST .+2
PUSHJ PP, LABEL ; YES - SET THEM UP
CAIN OM,SX.MOD ;[150] IS THIS SIXBIT OUTPUT?
TLNN SW,(FMTA) ;[150] YES, IS IT MAG TAPE OUTPUT?
JRST .+2 ;[150] NO, NEITHER
AOS OF2BUF+2 ;[150] ADD ONE TO MAKE UP FOR KLUDGEY OUTPUT
SETIO7: MOVE TE,SIZKEY ;GET SIZE OF INDEX KEY
MOVE TD,.JBFF ;RESERVE
MOVEM TD,OLDKEY ; AN AREA TO
PUSHJ PP,GETCOR ; SAVE RECORD KEY
MOVE TE,SIZKEY ;DO SAME
MOVE TD,.JBFF ; FOR
MOVEM TD,NEWKEY ; NEW
PUSHJ PP,GETCOR ; KEY
TRNE SW,OPT.B
JRST SETIO9 ;/B
MOVE TE,SIZKEY ;GET SPACE FOR INPUT KEY
MOVE TD,.JBFF
MOVEM TD,INKEY
PUSHJ PP,GETCOR
SETIO9: MOVE TE,BYPTRS(OM) ;CHANGE THOSE
HLLM TE,OLDKEY ; TO
HLLM TE,NEWKEY ; BYTE-POINTERS
MOVE TE,BYPTRS(IM) ;MAKE INPUT BYTE POINTERS
HLLM TE,INKEY
MOVE TE,LOWVAL(KT) ;GET LOW VALUES
MOVE TD,SIZKEY
MOVE TC,OLDKEY
MOVEM TE,(TC)
AOS TC
SOJG TD,.-2
MOVE TC,NEWKEY ;CLR NEWKEY AREA
MOVE TD,SIZKEY
SETZM (TC)
AOS TC
SOJG TD,.-2
TLNE SW,(FDSK) ;IF DISK INPUT & IT IS BLOCKED,
SKIPN INPBLK
JRST SETIO6
;COMPUTE # SECTORS PER INPUT OR OUTPUT BLOCK
PUSHJ PP,WDPBLK ;GET WORDS PER BLOCK IN TE
ADDI TE,177
LSH TE,-7
MOVEM TE,INPSEC
SETIO6: SETOM OSECC
SETZM MUCHO
SETZM DATLOC
SETZM DATBPB ;EBCDIC VARIABLE BYTES PER BLOCK
MOVEI TE,1
MOVEM TE,DATLOK
MOVE TE,DATRIT
MOVEM TE,ORLEFT
TRNN SW,OPT.P ;[156] /P OPTION?
JRST SETI6A ;[156] NO
MOVE TE,RECBYT ;[156] YES GET NO. BYTES PER RECORD
IDIV TE,BYTWRD(OM) ;[156] CALC NO. OF WORDS IN OUTPUT REC.
AOSA TE ;[156] ROUND UP ONE ALWAYS,BUT DON'T LOAD RECORD SIZE
SETI6A: MOVE TE,RECSIZ ;[156] GET INPUT RECORD SIZE
HLL TD,BYPTRS(OM) ;BYTE POINTER SKELETON
TRNE SW,OPT.A7 ; IS THIS ANS74 ADVANCING?
ADDI TE,1 ; YES,ROOM FOR A CR/LF IN FRONT IF /P+ASCII
HRR TD,.JBFF
MOVEM TD,RECPTR
PUSHJ PP,GETCOR ; [EDIT#77]
TRNN SW,OPT.A7 ; IS THIS ANS74 ADVANCING?
JRST SETI6B ; NO, CONT
MOVEI TE,RTCRLF ; GET A CR/LF, RIGHT JUSTIFIED
MOVEM TE,@RECPTR ; PLACE IT JUST IN FRONT OF RECORD
AOS RECPTR ; MAKE RECPTR POINT JUST AFTER LF
SETI6B: TRNN SW,OPT.P+OPT.C ;/P OR /C ?
JRST SETI10 ;NO
MOVE TE,INPBLK ;FOR /P OR /C, SWITCH INPUT ARGS TO OUTPUT
MOVEM TE,DATBLK
MOVEM TE,DATRIT
MOVEM TE,ORLEFT ;NO EMPTY RECORDS ON /P OR /C
SETZM INPBLK
MOVE TE,INPSEC
MOVEM TE,DATSEC
SETZM INPSEC
MOVE TE,INPBPB ;BYTES PER BLOCK - EBCDIC VAR
MOVEM TE,DATBPB
TRNE SW,OPT.C ; /CHECK?
JRST LOOP7 ; YES, START IO LOOP
;PUT OUT BLOCK HEADER FOR EBCDIC VARIABLE WRITES
CAIN OM,EB.MOD
TLNN SW,(FEBVAR)
JRST LOOP7 ;NO - FORGET IT
;EBCDIC VARIABLE LENGTH OUTPUT
SKIPN DATBPB ;IS IT PACKED?
JRST LOOP7 ;NO
SETOM ORLEFT ;THIS WILL CAUSE APPROPRIATE NUMBER OF
;EMPTY SECTORS TO BE WRITTEN OUT IN LAST
;RECORD
PUSHJ PP,FNEBST ;OUTPUT HEADER
JRST LOOP7
;SETI10: PUSHJ PP,GETCOR ; [EDIT#77]
SETI10: PUSHJ PP,RITID1 ;WRITE OUT EMPTY BLOCK TO BE
; REPLACED LATER BY STATISTICS BLOCK
;SET UP ISECC A LITTLE DIFFERENTLY FOR EBCDIC VARIABLE
CAIN IM,EB.MOD ;IS IT EBCIDC?
TLNN SW,(FEBVAR) ;AND VARIABLE?
JRST LOOP7 ;NO
TRNN SW,OPT.B ;MAKE SURE THIS IS /B
JRST LOOP7
MOVE TE,INPSEC ;SET THEM EQUAL FOR FIRST TIME THRU
MOVEM TE,ISECC
JRST LOOP7A ;SKIP THE ISECC ZEROING
WDPBLK: ;COMPUTE WORDS PER BLOCK FOR INPUT OR OUTPUT FILE
MOVE TE,RECBYT ;COMPUTE # SECTORS PER INPUT BLK
TRNE SW,OPT.P ;SWAP IM AND OM IF /P
EXCH IM,OM
JRST @.+1(IM) ;BASE UPON MODE
EXP SETI11 ;SIXBIT
EXP SETI12 ;EBCDIC
EXP SETIO4 ;ASCII
EXP SETIO4 ;STANDARD ASCII
;SIXBIT
SETI11: ADDI TE,^D11
IDIVI TE,6
IMUL TE,INPBLK
JRST SETIO5
;EBCDIC
SETI12: TLNE SW,(FEBVAR) ;FIXED OR VARIABLE
JRST SETI13 ;VARIABLE LENGTH
;FIXED EBCDIC
IMUL TE,INPBLK ;TOTAL NUMBER OF BYTES
ADDI TE,3 ;FILL OUT WORD
IDIVI TE,4 ;COMPUTE # WORDS USED
JRST SETIO5
;VARIABLE LENGTH EBCDIC
SETI13: ADDI TE,4 ;FOR THE RECORD HEADER
IMUL TE,INPBLK ;TOTAL NUMBER OF BYTES
ADDI TE,4 ;FOR HEADER WORD - BLOCK
MOVEM TE,INPBPB ;SAVE BYTES PER BLOCK
ADDI TE,3 ;ROUND UP
IDIVI TE,4 ;COMPUTE # WORDS USED
SETZM INPBLK ;PRETEND IT ISN'T BLOCKED - THE READ
;AND WRITE ROUTINES WILL WORRY ABOUT
;SUCH THINGS RATHER THAN 'LOOP'
JRST SETIO5
;ASCII
SETIO4: ADDI TE,2
IMUL TE,INPBLK
ADDI TE,4
IDIVI TE,5
SETIO5: TRNE SW,OPT.P ;SWAP BACK
EXCH IM,OM ;IF /P
POPJ PP,
LOPINI:
;INITIALIZE ALL THE THINGS SO THE LOOP WILL GO A LITTLE
;FASTER
;CONVERSION POINTER
MOVE TE,@CNVPTI(IM) ;GET BYTE POINTER BASED UPON INPUT
; AND OUTPUT MODES
MOVEM TE,CONVRT
;INPUT ROUTINE ADDRESSES
SETZI TF, ;CLEAR ISAM INPUT FLAG
TRNN SW,OPT.B ;BUILD???
AOS TF ;NO ISAM FILE INPUT
SETZI TE,
TLNE SW,(FEBVAR) ;VARIABLE LENGTH EBCDIC ???
AOS TE ;YES
MOVEI TE,@IROUAD(TF) ;GET ADDRESS OF ROUTINE ADDRESS BLOCK
MOVE TF,(TE) ;FIRST BYTE ROUTINE
MOVEM TF,GETFB
MOVE TF,1(TE) ;NORMAL BYTE ROUTINE
MOVEM TF,GETBYT
TRNE SW,OPT.C ; /CHECK ?
POPJ PP, ; YES, DON'T SET UP OUTPUT SIDE
; SETUP OUTPUT ROUTINE ADDRESS
SETZI TF,
TRNN SW,OPT.P ;ISAM FILE OUTPUT???
AOS TF ;YES
SETZI TE,
TLNE SW,(FEBVAR) ;VARIABLE EBCDIC?
AOS TE ;YES
MOVEI TE,@OROUAD(TF) ;FINISH RECORD ROUTINE ADDRESS
MOVEM TE,FINREC
POPJ PP,
CNVPTI: Z @CNVP6O(OM) ;SIXBIT INPUT
Z @CNVP9O(OM) ;EBCDIC INPUT
Z @CNVP7O(OM) ;ASCII INPUT
Z @CNVP7O(OM) ;ASCII INPUT (STANDARD)
CNVP6O: [POINT 6,CH,35] ;SIXBIT TO SIXBIT
PTR%69## ;SIXBIT TO EBCDIC
PTR%67## ;SIXBIT TO ASCII
PTR%67## ;SIXBIT TO ASCII
CNVP9O: PTR%96## ;EBCDIC TO SIXBIT
[POINT 9,CH,35] ;EBCDIC TO EBCDIC
PTR%97## ;EBCDIC TO ASCII
PTR%97## ;EBCDIC TO ASCII
CNVP7O: PTR%76## ;ASCII TO SIXBIT
PTR%79## ;ASCII TO EBCDIC
[POINT 7,CH,35] ;ASCII TO ASCII
[POINT 7,CH,35] ;ASCII TO ASCII
; CONVERT TO ASCII
CNVPI7: PTR%67
PTR%97
[POINT 7,CH,35]
[POINT 7,CH,35]
; INPUT ROUTINE ADDRESS TABLES
IROUAD: Z @SEQIN(IM) ;SEQUENTIAL INPUT
Z IDXROU ;ISAM FILE INPUT
SEQIN: Z SIXROU ;SIXBIT
Z @SEQEB(TE) ;EBCDIC
Z ASCROU ;ASCII
Z ASCROU ;ASCII
SEQEB: Z EBFROU ;FIXED EBCDIC
Z EBVROU ;VARIABLE EBCDIC
IDXROU: Z IDXFB ;FIRST BYTE
Z GETDAT ;NORMAL BYTE
SIXROU: Z GETFB6
Z GETSM
ASCROU: Z GETFB7
Z GETAM
EBFROU: Z GETFBF
Z GETEMF
EBVROU: Z GETFBV
Z GETEMV
; OUTPUT ROUTINE ADDRESSES
OROUAD: Z @OROUSQ(OM) ;SEQUENTIAL
Z @OROUX(OM) ;ISAM
OROUSQ: Z FINRCS ;SIXBIT
Z @OROUEB(TE) ;EBCDIC
Z FINRCA ;ASCII
Z FINRCA ;STANDARD-ASCII
OROUEB: Z FINRCF ;EBCDIC FIXED
Z FINRCV ;EBCDIC VARIABLE
OROUX: Z FINRXS ;ISAM SIXBIT
Z FINRXE ;ISAM EBCDIC
Z FINRXA ;ISAM ASCII
Z FINRXA ;ISAM ASCII
SUBTTL THE MAIN READ/WRITE LOOP
LOOP: TLNE SW,(FEOF) ;AT END OF FILE?
JRST ALLDUN ;YES
SETZM OC
MOVE OP,RECPTR
LOOP1: TLZ SW,(FENDL)
SETOM ALLNUL ;[147] ASSUME ONE CHAR TO START
PUSHJ PP,@GETFB ;GET A CHARACTER
TLNE SW,(FEOF) ;AT END OF FILE NOW?
JRST ALLDUN ;YES
TLO SW,(FRECIN) ;A RECORD HAS BEEN SEEN
TLNE SW,(FENDIB) ;NO--AT END OF BLOCK?
JRST LOOP6 ;YES
TLNE SW,(FENDL) ;NO--AT END OF LINE?
JRST LOOP1 ;YES--SKIP PAST EOL
LDB CH,CONVRT ;CONVERT IF REQUIRED
CAMGE OC,RECBYT ;RECORD FULL?
IDPB CH,OP ; NO..BYTE TO RECORD
ADDI OC,1 ;COUNT BYTE
PUSHJ PP,@GETBYT ;GETREC
TLNE SW,(FEOF) ;[147] WAS IT ACTUAL EOF
JRST [SKIPL ALLNUL ;[147] ANY REAL CHARS SEEN
JRST ALLDUN ;[147] NO, EOF IS REAL
JRST .+1] ;[147] FINISH UP THIS REC
PUSHJ PP,CAMKEY ;BE SURE KEYS ARE IN ORDER
IFN DEBUG,<
SKIPE DBUGIT
PUSHJ PP,TRACKY
>
TRNN SW,OPT.C ; /CHECK?
;BL 1 LINE CHANGED AT LOOP+21
JRST LOOP2B ; NO, MOVE RECORD TO OUTPUT SIDE
; /CHECK, DON'T MOVE RECORD, BUT CHECK SIZE
PUSHJ PP,FNCKSZ ; CHECK RECORD SIZE AGAINST MAX
JRST LOOP5 ; GO GET NEXT RECORD
LOOP2A: TRNN SW,OPT.P ;PACKING?
JRST LOOP2B ; NO
SKIPN DATBLK ; YES, AND BLOCKED, TOO?
JRST LOOP2B ; NO
SKIPE ORLEFT ;BLOCK FULL?
JRST LOOP2B ; NO
PUSHJ PP,WRITE ; YES, DO IT
MOVE TE,DATRIT ;RESET
MOVEM TE,ORLEFT ; BLOCK COUNTER
SETZM OSECC ;RESET OUT COUNTER
LOOP2B: PUSHJ PP,@FINREC ;FINISH UP THE RECORD
;SKIP KEY WRITING TO INDEX FILE IF /P
TRNE SW,OPT.P ;/P?
;BL 2 DELETED, 1 ADDED AT LOOP2B+2
JRST LOOP9 ; YES, NO OUTPUT INDEX
;OUTPUT EVERY N'TH KEY TO THE INDEX BLOCK
MOVE CH,ORLEFT ;IS THIS THE
CAMN CH,DATRIT ; FIRST RECORD IN BLOCK?
PUSHJ PP,RITKEY ;YES--WRITE A KEY
;CHECK TO SEE IF OUTPUT BLOCK IS FULL
LOOP8: SOSLE ORLEFT ;IS BLOCK FULL?
JRST LOOP5 ;NO
;BLOCKED OUTPUT AND THE LOCK IS FULL
PUSHJ PP,WRITE ;YES--WRITE IT OUT
LOOP3: AOS OF2BUF+2
MOVE TE,OSECC ;IF ENOUGH
CAML TE,DATSEC ; SECTORS WRITTEN,
JRST LOOP4 ; NO MORE NEEDED
PUSHJ PP,WRITE ;WRITE AN EMPTY RECORD
JRST LOOP3 ; AND LOOP
LOOP4: MOVE TE,DATRIT ;RESET
MOVEM TE,ORLEFT ; BLOCK COUNTER
MOVE TE,DATLOC ;REMEMBER LAST SECTOR USED
MOVEM TE,DATLOK
SETZM OSECC
;CHECK BLOCKING FOR THE INPUT FILE
LOOP5: SKIPE INPBLK ;IS INPUT BLOCKED?
SOSLE IRLEFT ;YES--ANYTHING LEFT IN BLOCK?
JRST LOOP ;NO
;INPUT IS BLOCKED AND THE CURRENT BLOCK IS EMPTY
LOOP6: TLZE SW,(FENDIB) ;NO--ANY MORE SECTORS?
JRST LOOP7 ;NO
PUSHJ PP,READ ;YES--GET ANOTHER SECTOR
JRST LOOP6 ; AND LOOP
LOOP7: SETZM ISECC
LOOP7A: SETZM IF1BUF+2 ;BE SURE A READ HAPPENS NEXT TIME
MOVE TE,INPBLK
MOVEM TE,IRLEFT
JRST LOOP
; SPECIAL HANDLING FOR /P BLOCKED FILES
LOOP9: SKIPE DATBLK ;/P BLOCKED?
JRST LOOP8 ;YES
JRST LOOP5 ;NO
;NOTE: BLOCKING PROBLEMS FOR EBCDIC VARIABLE LENGTH I/O ARE
; HANDLED BY THE INDIVIDUAL I/O ROUTINES BECAUSE THERE
; ISN'T A NICE SET COUNT OF RECORDS
IFN DEBUG,<
TRACSZ: ;DISPLAY SIZE OF KEY
TYPE (
SIZE:)
PUSHJ PP,SAVAC ;SAVE AC'S
MOVE TE,INPSIZ
ADDI TE,1 ;BECAUSE ITS ONE SHORT
PUSHJ PP,PUTDEC ;TYPE IT
TYPE (
)
JRST RESAC
TRACH: ;TYPE CURRENT CHARACTER OF RECORD
PUSH PP,CH
LDB CH,@CNVPI7(IM) ;CONVERT TO ASCII
TYPEC CH
POP PP,CH
POPJ PP,
TRACKY: ;DISPLAY KEY
PUSHJ PP,SAVAC
MOVE TE,OC ;RECORD SIZE
TYPE (
SIZ:)
PUSHJ PP,PUTDEC
MOVE TE,NEWKEY
TYPE (
KEY:)
PUSHJ PP,@CAMKX(KT) ;DISP KEY
TYPE (
)
JRST RESAC
>
SUBTTL TRANSFER RECORD TO OUTPUT FILE
FINRCA: ;ASCII SEQUENTIAL OUTPUT
PUSHJ PP,FNCKSZ ;CHECK RECORD SIZE
CAIN OM,MA.MOD ;STANDARD ASCII?
JRST FNMOVE ; YES, SKIP CRLF
TRNN OPT.A7 ; SKIP IF ANS74 STYLE ADVANCING
PUSHJ PP,FNCRLF ;PUT OUT CRLF
PJRST FNMOVE ;MOVE RECORD TO FILE
FINRCS: ;SIXBIT SEQUENTIAL OUTPUT
PUSHJ PP,FNCKSZ ;CHECK RECORD SIZE
HRRZ TE,OC ;SETUP HEADER WORD
PUSHJ PP,FNHDR ;OUTPUT TO FILE
PUSHJ PP,FNMOVE ;RECORD TOO
PJRST FNFILW ;FILL IN REST OF LAST WORD
FINRCF: ;SEQUENTIAL EBCDIC FIXED LENGTH
PUSHJ PP,FNCKSZ ;CHECK SIZE OF RECORD
PUSH PP,OC ;SAVE COUNT
PUSHJ PP,FNMOVE ;MOVE RECORD
POP PP,OC ;RESTORE
SUB OC,RECBYT ;COMPUTE #TO FILL
JUMPE OC,CPOPJ ;FORGET IT IF NONE
PJRST FNFILR ;FILL IN REST OF RECORD
FINRCV: ; VARIABLE LENGTH EBCDIC OUTPUT
SKIPE DATBPB ;BLOCKED?
PUSHJ PP,FNEBBK ;YES
PUSHJ PP,FNCKSZ ;CHECK RECORD SIZE
;PUTOUT RECORD HEADER WORD
ADDI OC,4 ;COUNT HEADER TOO
TLNN SW,(FINDCP) ;INDUSTRY COMPATABLE MODE?
SKIPA TE,[POINT 9,OC,17] ;NO
MOVE TE,[POINT 8,OC,19] ;YES - 8 BIT BYTES
ILDB CH,TE ;STORE HEADER WORD
PUSHJ PP,PUTBYT ;COUNT IN FIRST 2 BYTES
ILDB CH,TE
PUSHJ PP,PUTBYT
MOVEI CH,0 ;ZERO IN REST
PUSHJ PP,PUTBYT
PUSHJ PP,PUTBYT
SUBI OC,4 ;RESTORE COUNT
PJRST FNMOVE ;RECORD ALSO
FNEBBK: ;BLOCKED VARIABLE LENGTH RECORDS
;PUT AS MANY INTO THE BLOCK AS WILL FIT
MOVEI TE,4 ;4 FOR RECORD HEADER
ADDM TE,OBPBCT
ADDM OC,OBPBCT ;UPDATE COUNTER WITH RECORD COUNT
SKIPG OBPBCT ;ENOUGH ROOM LEFT?
POPJ PP, ;YES
;BLOCK IS FULL
TLNN SW,(FMTA) ;MAG TAPE?
JRST FNEBK1 ;NO
;FOR MAG TAPE GO BACK AND FILL IN CORRECT BLOCK COUNT
MOVE TE,OBPBCT ;[152] GET COUNTER POSITIVE
SUBI TE,(OC) ;BACK IT UP
SUBI TE,4 ;AND 4 FOR HEADER
ADD TE,DATBPB ;COMPUTE ACTUAL NUMBER OF BYTES WRITTEN
HRLZ TE,TE ;MOVE IT OVER
TLNE SW,(FINDCP) ;INDUSTRY COMPATABLE MODE??
LSH TE,2 ;YES - MOVE IT OVER A LITTLE - 8 BIT BYTES
HRRZ TF,OF2BUF ;GET BUFFER POINTER
MOVEM TE,2(TF) ;OVER WRITE HEADER WORD WITH NEW ONE
FNEBK1:
PUSHJ PP,WRITE ;OUTPUT THE BLOCK
AOS OF2BUF+2 ;[V10] ADJUST THE BYTE COUNT.
PUSHJ PP,FNEBST ;PUT IN NEW HEADER WORD - BLOCK
ADDM OC,OBPBCT ;UPDATE COUNTER
MOVEI TE,4 ;AND 4 FOR HEADER WORD
ADDM TE,OBPBCT
SKIPG OBPBCT ;THERE HAD BETTER BE ROOM
POPJ PP,
JRST INTERR ;INTERNAL ERROR
FNEBST: ;PUT OUT BLOCK HEADER WORD AND INITIALIZE COUNTER
MOVE TF,DATBPB ;MAX BYTE COUNT
HRLZ TE,TF ;BUILD HEADER WORD WITH MAX COUNT IN IT
SUBI TF,4 ;FOR HEADER WORD
MOVNM TF,OBPBCT ;STORE NEGATIVE IN COUNTER
TLNE SW,(FINDCP) ;INDUSTRY COMPATABLE
LSH TE,2 ;YES - 8 BIT BYTES
PJRST FNHDR ;STORE IT
FINRXA: ; ASCII - ISAM DATA FILE OUTPUT
PUSHJ PP,FNCKSZ ;CHECK RECORD SIZE
PUSHJ PP,FNCRLF ;PUT IN CRLF
MOVE TE,OC ;GET # BYTES
LSH TE,1 ;OVER 1 FOR ASCII
IORI TE,1 ; AND 1 IN B0
JRST FINRCX
FINRXS: ;SIXBIT - ISAM DATA FILE OUTPUT
FINRXE: ;EBCDIC - ISAM DATA FILE OUTPUT
PUSHJ PP,FNCKSZ ;CHECK RECORD SIZE
MOVE TE,OC ;GET NUMBER OF BYTES
FINRCX: ;PUT OUT DATA FILE RECORD WITH RECORD HEADER WORD
AOS MUCHO ;COUNT DATA RECORDS
HRL TE,FILCOD(OM) ;FILE CODE
PUSHJ PP,FNHDR ;OUTPUT HEADER WORD
PUSHJ PP,FNMOVE ;MOVE RECORD
PJRST FNFILW ;FILL OUT LAST WORD
; SUBROUTINES FOR OUTPUT
FNHDR: ;OUTPUT A HEADER WORD FOR NEXT RECORD - IN TE
MOVEI CH,0 ;GO TO BEGINNING OF NEXT WORD
PUSHJ PP,PUTBYT
MOVEM TE,@OF2BUF+1 ;STORE HEADER WORD
MOVSI TE,770000 ;UPDATE BYTE POINTER
ANDCAM TE,OF2BUF+1
MOVN TD,BYWDM1(OM) ;UPDATE BYTE COUNT ALSO
ADDB TD,OF2BUF+2
POPJ PP,
FNMOVE: ;MOVE RECORD FROM HOLDING AREA TO FILE
MOVE OP,RECPTR ;HOLD AREA POINTER
TRNN SW,OPT.A7 ; IS THIS ANS74 ADVANCING?
JRST FNMOV1 ; NO, CONT
TRNN SW,OPT.P ;PACKING?
JRST FNMOV1 ; NO, CONTINUE
CAIE OM,AS.MOD ; YES, AND REGULAR ASCII TOO?
JRST FNMOV1 ; NO, CONT
SUBI OP,1 ; THEN MAKE RECORD POINTER POINT TO
HRLI OP,(POINT 7,,20); THE "CRLF" JUST IN FRONT OF RECORD
ADDI OC,2 ; COUNT CRLF
FNMOV1: ILDB CH,OP ;NEXT BYTE
PUSHJ PP,PUTBYT ;STORE IT
SOJG OC,FNMOV1 ;LOOP IF MORE
POPJ PP,
FNFILW: ;FILL OUT END OF CURRENT WORD
MOVEI CH,0
FNFIL1: MOVE TE,OF2BUF+1 ;GET POINTER
TLNN TE,760000 ;AT END OF WORD??
POPJ PP, ;YES
PUSHJ PP,PUTBYT ;NO - FILL IT
JRST FNFIL1
FNCKSZ: ;CHECK THE SIZE OF THE RECORD
CAMG OC,RECBYT ;LESS THAN OR EQUAL MAX??
POPJ PP, ;YES - OK
TYPE (%ISMRTL Encountered record larger than maximum size - truncated
)
MOVE OC,RECBYT ;SET TO MAX
POPJ PP,
FNCRLF: ;PUT CRLF IN TO ASCII RECORD
MOVEI CH,15
IDPB CH,OP
MOVEI CH,12
IDPB CH,OP
ADDI OC,2 ;INCREMENT COUNTER
POPJ PP,
FNFILR: ; FILL IN REST OR RECORD
MOVEI CH,0
PUSHJ PP,PUTBYT ;FILL IT
AOJL OC,.-1 ;NEGATIVE FILL COUNT IN OC
POPJ PP,
SUBTTL GET-RECORD ROUTINES
; SIXBIT - FIRST BYTE SEQUENTIAL INPUT
GETFB6: MOVEI TE,1
MOVEM TE,INPSIZ
TRO SW,ONEBYT ;REQUEST ONE BYTE
PUSHJ PP,GETSM ;LOCATE RECORD COUNT
MOVE TE,@IF1BUF+1
; MOVEM TE,INPSIZ ; [EDIT#100]
HRRZM TE,INPSIZ ;MTA RECORD SEQUENCE # IS IN LEFT HALF [EDIT#100]
MOVNI TE,5
ADDM TE,IF1BUF+2 ;IGNORE 5 BYTES
MOVSI TE,770000
ANDCAM TE,IF1BUF+1 ;SET BITPLACE TO 36
TLNE SW,(FENDIB)
POPJ PP, ;RETURN IF END-OF-BLOCK
SKIPN INPSIZ
JRST GETFB6 ;LOOP IF NULL RECORD
TRO SW,ONEBYT ;REQUEST ONE BYTE
JRST GETSM ;GET RECORD AND RETURN
GETFB7: TRO SW,ONEBYT ;REQUEST ONE BYTE
PUSHJ PP,GETAM
MOVE TE,@IF1BUF+1
TRNN TE,1B35 ;SEQ # FLAG UP?
POPJ PP,
IBP IF1BUF+1 ;IGNORE SEQ # WORD
IBP IF1BUF+1
IBP IF1BUF+1
IBP IF1BUF+1
TRO SW,ONEBYT ;REQUEST ONE BYTE
JRST GETAM
GETFBF: ; EBCDIC FIXED SEQUENTIAL INPUT
MOVE TE,RECBYT ;GET BYTES PER RECORD
MOVEM TE,INPSIZ ;STORE IN SIZE
TRO SW,ONEBYT ;REQUEST ONE BYTE
JRST GETEMF ;GO GET FIRST BYTE
GETFBV: ;EBCDIC VARIABLE LENGTH SEQUENTIAL INPUT
SKIPG INPBPB ;IS IT BLOCKED?
JRST GETFV1 ;NO
GETFV0: SKIPLE IBPBCT ;YES - AT LEAST 4 LEFT?
;COUNTER IS ALWAYS OFF BY 4
JRST GETFV2 ;NO - GET SOME MORE
GETFV1: PUSHJ PP,GETFV3 ;GET SIZE FROM HEADER WORD
JUMPE TE,GETFV2 ;0 INDICATES END OF BUFFER
ADDM TE,IBPBCT ;SUBTRACT FROM COUNTER
SUBI TE,4 ;FOR HEADER
MOVEM TE,INPSIZ ;STORE SIZE
SKIPG INPBPB ;IS IT BLOCKED?
JRST [TRO SW,ONEBYT ; NO, REQUEST ONE BYTE
JRST GETEMV ] ; & GO GET CHAR
SKIPLE TE,IBPBCT ;MAKE SURE IT DOSEN'T GO OVER END OF BUFFER
CAIG TE,4 ;IE. MUST BE LESS OR EQUAL TO 4
JRST [TRO SW,ONEBYT ;ONE-BYTE ONLY
JRST GETEMV ] ;GO GET BYTE
JRST EBRHER ;RECORD COUNT EXCEEDS BLOCK
GETFV2: ;GET BLOCK COUNT
;FIRST SEE IF THERE ARE EMPTY SECTORS TO BE SKIPPED
MOVE TE,ISECC ;SECTORS READ THIS BLOCK
TLNE SW,(FDSK) ;DISK
CAML TE,INPSEC ;YES - SECTORS LEFT
JRST GETV2A ;OK - MOVE ON
PUSHJ PP,READ ;READ ANOTHER
JRST GETFV2
GETV2A: SETZM ISECC ;CLEAR SECTOR COUNT
SETZM IF1BUF+2 ;FORCE READ
PUSHJ PP,GETFV3 ;GET BLOCK SIZE
TLNE SW,(FEOF) ;END OF FILE?
POPJ PP, ;YES - RETURN
CAIGE TE,4 ;SEE IF THE COUNT IS REASONABLE
JRST EBBHER
SUBI TE,^D8 ;ADJUST COUNTER FOR BLOCK HEADER
; AND 4 MORE SO THAT SKIPLE TEST
;WILL INDICATE AT LEAST 4 BYTES LEFT
;I.E. POSSIBLE RECORD HEADER
MOVNM TE,IBPBCT ;SET COUNTER
JRST GETFV0
GETFV3: ;GET COUNT FROM BLOCK OR RECORD HEADER WORD
MOVEI TE,4 ;SET UP INPSIZ
MOVEM TE,INPSIZ
TRO SW,ONEBYT ;REQUEST ONE BYTE
PUSHJ PP,GETEMV ; & GET IT
MOVE TE,CH ;SAVE IT
LSH TE,^D8 ;ADJUST IT
TLNN SW,(FINDCP) ;INDUSTRY COMPATABLE?
LSH TE,1 ;NO - 9 BIT BYTES
TRO SW,ONEBYT ;REQUEST NEXT BYTE
PUSHJ PP,GETEMV ; & GET IT
ADDI TE,(CH) ;ADD IT IN
TRO SW,ONEBYT
PUSHJ PP,GETEMV ;SKIP NEXT 2 BYTES
TRO SW,ONEBYT
PJRST GETEMV
GETEMF:
; GET A BYTE FROM EBCDIC VARIABLE INPUT FILE
GETEMV:
TLNE SW,(FENDIB)
POPJ PP, ;RETURN IF END-OF-BLOCK
SKIPG INPSIZ ;ANYTHING LEFT?
JRST [TLO SW,(FENDL) ;NO
POPJ PP,] ;RETURN
SOSG IF1BUF+2 ;UPDATE COUNTER
PUSHJ PP,READ ;GET ANOTHER BUFFER IF NECES.
TLNE SW,(FENDIB) ;END OF BUFFER?
POPJ PP, ; YES, RETURN
ILDB CH,IF1BUF+1 ;GET CHARACTER IF NOT
SETOM ALLNUL ;[147] SET SEEN REAL CHAR
SKIPN CH ;[147] REAL CHAR OR NULL
SETZM ALLNUL ;[147] SET NULL SEEN
SOS INPSIZ ;DECREMENT BYTE COUNT
TRZE SW,ONEBYT ;REQUEST ONE BYTE?
POPJ PP, ; & RETURN
LDB CH,CONVRT ;CONVERT IF REQUIRED
CAMGE OC,RECBYT ;RECORD FULL?
IDPB CH,OP ; NO, PUT BYTE
ADDI OC,1 ;COUNT BYTE
JRST GETEMV ;CONTINUE THRU RECORD
;GET FIRST BYTE OF RECORD (INDEXED FILE INPUT)
IDXFB: MOVE TA,DATFLG ;USED ALL RECORDS IN CURRENT BLK?
CAMGE TA,DATBLK+I
JRST GETRE1 ;NO
GETRE3: PUSHJ PP,GETENT ;READ 1 ENTRY OF INDEX
TLNE SW,(FEOF) ;END-OF-FILE?
POPJ PP, ;YES
MOVE TA,IDXHD1 ;GET DATA BLK #
TLNN TA,-1 ; IS BLK-NMBR GT 18 BITS
CAILE TA,-11 ; [162] OR BETWEEN 777770 & 777777?
JRST GTRE2F ; [162] YES, DO FILOP. USETI
JRST GETRE2 ; NO
GTRE2F: MOVEM TA,FUSI+1 ; [162] BLK-NMBR TO ARG BLOCK
MOVEI TA,IF2 ; SAME FOR THE
HRLM TA,FUSI ; CHANNEL NMBR
MOVE TA,[2,,FUSI] ; POINT AT ARG BLOCK
FILOP. TA, ; FILOP. TYPE USETI
JFCL ; ERROR RETURN
JRST GETRE4 ;
GETRE2: USETI IF2,(TA) ;AIM AT THAT BLK
GETRE4: PUSHJ PP,DATREA ;& READ IT IN
GETRE1: AOS TA,DATFLG ;INCR COUNT TO NEW RECORD
SUBI TA,1 ;ADVANCE BYTE PTR TO NEW RECORD
HRRZ TA,INPTR ;INCREMENT INPTR TO 1ST WORD OF NEXT REC
AOJ TA,
HLL TA,BYPTRS(IM) ;GET PROPER POINTER
MOVEM TA,INPTR
HRRZ TA,@INPTR ;GET REC SIZE
TRNE IM,AS.MOD ;IS IT ASCII?
LSH TA,-1 ;DROP BIT 35 IF ASCII FILE
JUMPE TA,GETRE3 ;IGNORE EMPTIES
CAIN IM,AS.MOD ; ASCII FILE [141]
SUBI TA,2 ; YES DONT'T COUNT CR-LF [141]
MOVEM TA,INPSIZ
CAMLE TA,RECBYT+I ;[EDIT#141]
JRST RECERR ;[EDIT#141]
AOS INPTR ;SET PTR TO 1ST REAL BYTE
TRO SW,ONEBYT ;REQUEST ONE BYTE
JRST GETDAT ; PROCESS & RETURN
;READ 1 ENTRY OF INDEX
GETENT: MOVE TA,IDXFLG-1(IX) ;LAST ENTRY READ AT THIS LEVEL
CAMG TA,IDXEIN-1(IX) ;ANYMORE THERE?
JRST GETEN1 ;YES
GETEN2: CAME IX,LEVELS+I ;ARE WE ALREADY AT TOP LEVEL?
AOJA IX,GETENT ;NO, MOVE UP 1 LEVEL
TLO SW,(FEOF) ;HAVE HIT END OF FILE
CPOPJ: POPJ PP,
GETEN1: MOVE TF,IDXLIN-1(IX) ;MAKE BYTE PTR TO CURRENT ENTRY
ADD TF,IDXWIN-1(IX)
MOVE TA,(TF) ;STORE 1ST 2 WORDS OF ENTRY
JUMPE TA,GETEN2 ;ENTRY IS EMPTY
MOVEM TA,IDXHD1 ;BLOCK # THIS ENTRY POINTS TO
MOVE TA,1(TF)
MOVEM TA,IDXHD2 ;ITS VERSION #
MOVE TC,SIZIDX+I ;READ & SAVE THE KEY
SUBI TC,2
HRLZI TA,2(TF)
HRRZ TB,INKEY
HRRI TA,(TB)
ADDI TB,-1(TC)
BLT TA,(TB)
MOVE TF,IDXWIN-1(IX) ;MAKE PTR TO NEXT INDEX ENTRY
ADD TF,SIZIDX+I
MOVEM TF,IDXWIN-1(IX)
AOS IDXFLG-1(IX) ;INCREMENT ENTRY USED CTR
MOVE TA,IDXHD1 ; GET BLK NUMBER OF NEXT IDX LEVEL
MOVEM TA,CURIDX-1(IX) ; SAV CURRENT INDEX BLK NUMBER
SOJE IX,GETEN3 ;EXIT IF AT LEVEL 0 INDEX
TLNN TA,-1 ;[157] IF BLOCK-NMBR GT 18 BITS
CAILE TA,-11 ; [162] OR BETWEEN 777770 & 777777?
JRST GETE1F ; [162] YES, DO FILOP. USETI
JRST GETE1A ;[157] NO GO TO USETI
GETE1F: MOVEM TA,FUSI+1 ;[162] [157] BLK-NUMER TO ARG BLOCK
MOVEI TA,IF1 ;[157] GET CHANNEL
HRLM TA,FUSI ;[157] CHANNEL TO ARG BLOCK
MOVE TA,[2,,FUSI] ;[157] POINT TO ARG BLOCK
FILOP. TA, ;[157] DO THE FILOP. (USETI)
JFCL ;[157] ERROR RETURN
SKIPA ;[157] SKIP REG. USETI
GETE1A: USETI IF1,(TA) ;[157] AIM AT DESIRED LOWER LEVEL BLK OF IDX
PUSHJ PP,IDXREA ;READ IT
JRST GETEN1
GETEN3: CAIN IX,0 ;IF IX HAS GONE TO 0, RESET IT TO 1
MOVEI IX,1
POPJ PP,
SUBTTL COMPARE NEW KEY VERSUS OLD KEY
CAMKEY:
CAMGE OC,LASTKB ;IS THE RECORD GREATER THAN OR = KEY SIZ
JRST RTSERR ;NO - TOO SHORT
CAMK1: HRRZ TA,RECPTR ;GET THIS
ADD TA,RECKEY ; KEY
MOVE TB,NEWKEY ; INTO
PUSHJ PP,@CAMKZ(KT) ; NEWKEY
;COMPARE THE KEYS
MOVE TA,OLDKEY
MOVE TB,NEWKEY
MOVE TC,SIZKEY
CAMK2: MOVE TE,(TB)
CAME TE,(TA)
JRST CAMK2A
SOJLE TC,CAMK3
ADDI TB,1
AOJA TA,CAMK2
CAMK2A: JUMPE KT,CAMK2B
CAML TE,(TA)
JRST CAMK4
JRST CAMK2C
CAMK2B: MOVE TD,(TA)
TLC TD,1B18
TLC TE,1B18
CAML TE,TD
JRST CAMK4
;KEYS ARE OUT OF ORDER
CAMK2C: PUSHJ PP,CAMD ;DECIDE IF FATAL [EDIT#107]
TYPE (ISMKOO keys are out of order
) ; [EDIT#107]
TYPE ( )
MOVE TA,NEWKEY
PUSHJ PP,@CAMKX(KT)
TYPE (
is after
)
TYPE ( )
MOVE TA,OLDKEY
JRST CAMK3A
;TWO KEYS ARE EQUAL
CAMK3: PUSHJ PP,CAMD ;DECIDE IF FATAL [EDIT#107]
TYPE (ISMDPK two keys with equal value = ) ; [EDIT#107]
MOVE TA,NEWKEY
CAMK3A: PUSHJ PP,@CAMKX(KT)
TYPE (
)
PUSHJ PP,CAMK4 ; RESET OLDKEY VALUE
TRNE SW,OPT.I ;NOT FATAL IF /I OR /C [EDIT#107]
POPJ PP, ;RETURN [EDIT#107]
TRNE SW,OPT.C ;/CHECK?
PJRST DTBLK ; YES,PRINT DATA BLK INFO AND RET TO CALLER
JRST START
;ALL IS OK--MOVE NEW KEY TO OLD KEY
CAMK4: MOVE TB,SIZKEY
MOVE TA,NEWKEY
MOVE TC,OLDKEY
CAMK5: MOVE TE,(TA)
MOVEM TE,(TC)
SOJLE TB,CAMK5A
ADDI TC,1
AOJA TA,CAMK5
CAMK5A: POPJ PP,
CAMD: TRNE SW,OPT.I+OPT.C ;IGNORE OPTION ON OR /C? [EDIT#107]
JRST CAMD1 ;YES, GO OUTPUT "%" [EDIT/107]
TYPE (
?) ;NO, OUTPUT "?" [EDIT#107]
POPJ PP, ; [EDIT#107]
CAMD1: TYPE (
%) ;YES, WARN ONLY ;[EDIT#107]
POPJ PP,
;DISPLAY A KEY
CAMKX: EXP CAMKX1 ;NON-NUMERIC
EXP CAMKX2 ;1-WORD NUMERIC
EXP CAMKX3 ;2-WORD NUMERIC
EXP CAMKX2 ;1-WORD FIXED-POINT
EXP CAMKX3 ;2-WORD FIXED-POINT
EXP CAMKX4 ;1-WORD FLOATING-POINT
EXP CAMKX5 ;2-WORD FLOATING-POINT
EXP CAMKX2 ;1-WORD COMP-3
EXP CAMKX3 ;2-WORD COMP-3
CAMKX1: LDB TC,KY.SIZ ;GET KEY SIZE
CAMX1A: ILDB CH,TA
LDB CH,@CNVPI7(OM) ;CONVERT TO ASCII
TYPEC CH
SOJG TC,CAMX1A
POPJ PP,
;1-WORD FIXED-POINT
CAMKX2: MOVE TE,(TA)
JRST PUTDEC
;2-WORD FIXED-POINT
CAMKX3: PUSHJ PP,SAVAC ;[155] SAVE AC'S
MOVE 0,(TA) ;[155] PUT KEY IN 0
MOVE 1,1(TA) ;[155] AND 1 FOR PD7.
MOVEI TB,3 ;[155]
MOVE TD,[POINT 7,TTYBUF] ;[155] SET UP PINTER
MOVEM TD,INKEY ;[155] TO PUT OUT
TLZ TD,7777 ;[155] BUILD PARAMETER WORD
LDB TE,KY.SIZ ;[155] FOR PD7.
DPB TE,[POINT 11,TD,17] ;[155] TO CONVERT THIS TO ASCII
SKIPGE 0 ;[155] IS IT SIGNED?
TLO TD,4000 ;[155] YES
MOVEM TD,GDPARM ;[155] STORE PARAMETER
MOVEI 16,GDPARM ;[155] TELL PD7. WHERE IT IS
PUSHJ PP,PD7.## ;[155] DO THE CONVERSION
MOVE TA,INKEY ;[155] GET RCONVERTED NUMBER
MOVEI TC,22 ;[155] PUT OUT 18 DIGITS
CAMX3A: ILDB CH,TA ;[155] GET NEXT CHAR
TYPEC CH ;[155] PUT IT OUT
SOJG TC,CAMX3A ;[155] LOOP BACK
JRST RESAC ;[155] RESTORE AC'S AND CONTINUE
;2-WORD FLOATING-POINT IS NOT SUPPORTED
CAMKX5: SUBI KT,1
;1-WORD FLOATING-POINT
CAMKX4: MOVE TE,(TA)
MOVE TF,[POINT 3,TE]
JRST PUTOC3
;PICK UP THE NEXT KEY
CAMKZ: EXP CAMKZ1 ;NON-NUMERIC
EXP CAMKZ2 ;NUMERIC DISPLAY < 11 DIGITS
EXP CAMKZ2 ;NUMERIC DISPLAY > 10 DIGITS
EXP CAMKZ3 ;1-WORD FIXED-POINT
EXP CAMKZ4 ;2-WORD FIXED POINT
EXP CAMKZ3 ;1-WORD FLOATING-POINT
EXP CAMKZ6 ;2-WORD FLOATING-POINT
EXP CAMKZ7 ;1-WORD COMP-3
EXP CAMKZ7 ;2-WORD COMP-3
CAMKZ1: LDB TE,KY.SIZ ;GET SIZE
CAMZ1A: ILDB CH,TA
IDPB CH,TB
SOJG TE,CAMZ1A
POPJ PP,
;KEY IS COMP-3
CAMKZ7: MOVEI TD,GC3.## ;PROPER CONVERSION ROUTINE
JRST CAMKZ8
CNVROC: ;COMP CONVERSION ROUTINES
EXP GD6.##
EXP GD9.##
EXP GD7.##
EXP GD7.##
;KEY IS NUMERIC DISPLAY
CAMKZ2:
MOVE TD,CNVROC(OM) ;GET CONVERSION ROUTINE
CAMKZ8:
PUSHJ PP,SAVAC ;SAVE AC'S 0-16
TLZ TA,7777 ;BUILD
LDB TE,KY.SIZ ; PARAMETER
DPB TE,[POINT 11,TA,17]; FOR
TLNE SW,(FSGND) ;IS IT SIGNED
TLO TA,4000 ; YES
MOVEM TA,GDPARM ;STORE PARAMETER
MOVEI 16,GDPARM
PUSHJ PP,(TD) ;CALL APPROPRIATE ROUTINE
MOVE TE,SAVEAC+TB
MOVEM 0,(TE)
MOVE TD,SIZKEY
CAILE TD,1
MOVEM 1,1(TE)
JRST RESAC ;RESTORE AC'S AND RETURN
;KEY IS 2-WORD FLOATING .....NOT SUPPORTED
CAMKZ6: SUBI KT,1
;KEY IS 1-WORD (FIXED OR FLOATING)
CAMKZ3: MOVE TD,(TA)
TLNN SW,(FSGND) ;IS IT SIGNED?
MOVMS TD ;NO - USE MAGNITUDE
MOVEM TD,(TB)
POPJ PP,
;KEY IS 2-WORDS FIXED
CAMKZ4:
TLNE SW,(FSGND) ;IS IT SIGNED?
JRST CAMKZ5 ;NO
PUSHJ PP,SAVAC
MOVE 16,(TA)
HRLI 16,(Z TA,)
PUSHJ PP,MAG.##
MOVE TE,SAVEAC+TB
MOVEM TA,(TE)
MOVEM TA+1,1(TE)
JRST RESAC
CAMKZ5: MOVE TE,1(TA)
MOVEM TE,1(TB)
MOVE TE,(TA)
MOVEM TE,(TB)
POPJ PP,
SUBTTL FILE IS COMPLETE--FINISH UP INDEX
ALLDUN: CLOSE IF1,
RELEASE IF1, ;BL
TRNE SW,OPT.C ; /CHECK ?
; JRST START ; YES, ALL DONE THEN
JRST [CLOSE IF2,
RELEASE IF2,
JRST FIN$ ]
TRNE SW,OPT.P ;PACK?
TRNN SW,OPT.A7 ; AND ADVANCE AFTER?
JRST ALLD05 ; NO, SKIP
MOVEI CH,15 ; YES, LOAD CR
PUSHJ PP,PUTBYT ; AND PUT TO BUFFER
ALLD05: MOVE TE,ORLEFT ;IS ANYTHING
CAMN TE,DATRIT ; IN DATA BUFFER?
JRST ALLD2 ;NO
PUSHJ PP,WRITE ;YES--WRITE IT OUT
ALLD1: MOVE TE,OSECC ;MAKE SURE
CAML TE,DATSEC ; ALL SECTORS
JRST ALLD2 ; WRITTEN
PUSHJ PP,WRITE ;NOT ENOUGH--WRITE EMPTY ONE
JRST ALLD1 ; AND LOOP
ALLD2: TRNE SW,OPT.P ;NO EMPTY BLKS WITH /P
JRST ALLD10
MOVE TD,%DAT ;COMPUTE
IMUL TD,NDATB ; NUMBER OF EMPTY BLOCKS REQUIRED
IDIVI TD,^D100 ;# OF ADDITIONAL BLOCKS [EDIT #106]
JUMPE TE,.+2 ;ANY REMAINDER?
ADDI TD,1 ;YES, ROUND UPWARDS
SKIPE NDATB ;MUST HAVE AT LEAST ONE DATA BLOCK [EDIT#106]
JRST ALLD12 ;HAS AT LEAST ONE [EDIT#106]
MOVEI TD,1 ; GIVE 1 EMPTY
PUSHJ PP,WRITE ;(MUST DO DUMMY OUTPUT 1ST)
ALLD12: MOVEM TD,NDATBE ;THAT IS NUMBER OF EMPTY DATA BLOCKS
ADDM TD,NDATB ;UPDATE TOTAL NUMBER OF BLOCKS
IMUL TD,DATSEC ;MULTIPLY BY NUMBER OF SECTORS PER BLOCK
JUMPE TD,ALLD10 ;MIGHT HAVE 0 EXTRA [EDIT#106]
ALLD3: PUSHJ PP,WRITE ;WRITE EMPTY SECTOR
SOJG TD,ALLD3 ;LOOP UNTIL DONE
ALLD10: TLNE SW, (FMTA) ; MAG TAPE?
TRNN SW, OPT.L ; WITH LABELS?
JRST .+2
PUSHJ PP, TLABEL ; YES - PUT OUT TRAILING LABEL
;IFN TOPS20,< PUSHJ PP,OF2AFS >;[154]GET ASCII FILE SPEC
CLOSE OF2, ;CLOSE DATA FILE
STATZ OF2,$ERA ;BE SURE NO ERRORS
JRST DATERA
;IFN TOPS20,<
; MOVE TA,OF2DAT ;GET DEVICE NAME OF IDA FILE
; CALLI TA,$GETCH ;GET CHARACTERISTICS
; TLNN TA,$DSK ;A DISK?
; JRST ALLD13 ;NO
; TRNN SW,OPT.P ;SKIP IF A SEQ FILE
; PUSHJ PP,OF1SIZ ;CHANGE .FBSIZ TO +INFINITY
;>;END IFN TOPS20
RELEASE OF2, ;BL
ALLD13: TRNE SW,OPT.P ;IF /P, WE ARE ALL DONE
JRST [CLOSE IF2,
RELEASE IF2,
JRST FIN$ ]
;WRITE OUT INDEX BLOCKS STILL IN CORE
ALLD4: TLZN SW,(FRECIN) ;IF NO DATA RECORDS SEEN,
PUSHJ PP,RITKEY ; WRITE A DUMMY INDEX ENTRY
MOVEI TA,1 ;START AT LEVEL ONE
ALLD5: CAMN TA,LEVELS ;IS THIS THE TOP LEVEL?
JRST ALLD9 ;YES
PUSH PP,TA ;SAVE LEVEL
PUSHJ PP,RITKY4 ;UPDATE HIGHER LEVELS AND WRITE THIS ONE
POP PP,TA ;RESTORE IN CASE 'RITKY4' CLOBBERED IT
AOJA TA,ALLD5 ;GO TO NEXT HIGHER LEVEL
ALLD9: MOVE TE,FEISEC ;NEXT FREE SECTOR IS
MOVEM TE,IDXADR ; LOCATION OF HIGHEST LEVEL INDEX BLOCK
PUSHJ PP,RITIDX ;WRITE OUT THAT BLOCK
;WRITE OUT SAT BLOCKS
MOVE TE,STHDR ;SAVE INDEX RECORD SIZE
MOVEM TE,SAVSTH
MOVE TE,IDXSEC ;COMPUTE
LSH TE,7 ; NUMBER
SUBI TE,1 ; OF CHARACTERS IN
IMULI TE,6 ; INDEX SECTOR
MOVEM TE,STHDR ;THAT IS RECORD SIZE FOR SAT BLOCKS
IMULI TE,6 ;COMPUTE NUMBER OF BITS
MOVEM TE,NB1SB ;SAVE THAT
MOVE TD,FEISEC ;SAT BLOCKS WILL BE
MOVEM TD,SATADR ; WRITTEN IN FIRST AVAILABLE BLOCK
MOVE TA,NDATB ;GET NUMBER OF DATA BLOCKS
SUB TA,NDATBE ; LESS NUMBER OF EMPTIES
MOVEM TA,NBWRIT ;WE MUST PUT OUT THAT MANY 1-BITS
JUMPE TA,ALLD0 ;NO BITS IF TA=0
ALLD6: CAMLE TA,NB1SB ;WILL THIS BLOCK BE FULL OF 1-BITS?
MOVE TA,NB1SB ;YES
MOVN TB,TA ;DECREMENT
ADDM TB,NBWRIT ; NUMBER LEFT TO GO AFTER THIS ONE
HRRZ TB,IDXLOC ;BUILD
ADD TB,[POINT 1,1] ; BYTE-POINTER
MOVEI TC,1 ;FILL BLOCK WITH
IDPB TC,TB ; ENOUGH
SOJG TA,.-1 ; ONE-BITS
ALLD0: PUSHJ PP,RITID1 ;WRITE OUT SAT BLOCK
AOS NUMSAT ;INCREMENT NUMBER WRITTEN
SKIPLE TA,NBWRIT ;IF MORE TO GO,
JRST ALLD6 ; LOOP
MOVE TD,MAXSAT ;HOW MANY DID HE SAY HE WANTED?
IDIV TD,DATBLK
MOVE TA,NDATB
CAIL TA,(TD) ;IF MORE THAN WHAT WE COUNT,
MOVE TD,NDATB ; GIVE THEM TO HIM
MOVEM TD,NDATBT
ALLD7: MOVE TA,NB1SB ;DO WE
IMUL TA,NUMSAT ; NEED
CAML TA,NDATBT ; MORE EMPTY ONES?
JRST ALLD8 ;NO
AOS NUMSAT ;YES--WRITE OUT
PUSHJ PP,RITID1 ; AN EMPTY ONE
JRST ALLD7 ;LOOP
ALLD8: MOVEM TA,SATBIT ;SAVE TOTAL NUMBER OF BITS IN ALL SAT BLOCKS
MOVE TE,SAVSTH ;RESTORE
MOVEM TE,STHDR ; ORIGINAL RECORD SIZE
;NOW WRITE OUT ANY EMPTY INDEX BLOCKS REQUIRED
MOVN TE,IDXOUT ;SAVE NUMBER OF BLOCKS
IMUL TE,IDXSEC ; ALREADY WRITTEN
MOVEM TE,NSECIE ; AS NEGATIVE NUMBER (UPDATED LATER)
MOVE TC,IDXOUT ;GET NUMBER OF INDEX BLOCKS WRITTEN
SUB TC,NUMSAT ; LESS NUMBER OF SAT BLOCKS
SUBI TC,1 ; LESS 1 FOR STATISTICS BLOCK
IMUL TC,%IDX ;COMPUTE # EMPTY BLKS REQUIRED
MOVEI TA,^D100
SUB TA,%IDX
IDIVI TC,(TA)
JUMPE TD,ALLD11 ;ANY REMAINDER?
ADDI TC,1 ;YES, ROUND UP
JRST ALLD11
PUSHJ PP,RITID1 ;WRITE UNTIL
ALLD11: SOJGE TC,.-1 ; ENOUGH WRITTEN
MOVE TE,IDXOUT ;COMPUTE NUMBER OF
IMUL TE,IDXSEC ; BLOCKS WRITTEN
MOVEM TE,NSECI ; AND PUT IN STAT BLOCK
ADDM TE,NSECIE ;NUMBER OF FREE BLOCKS
SUB TE,NSECIE ;RECOMPUTE
ADDI TE,1 ; ADDRESS OF FIRST
MOVEM TE,FEISEC ; FREE SECTOR
;WRITE OUT STATISTICS BLOCK
MOVEI TE,$ISAMI ;SET ISAM INDEX FLAG IN 1ST WORD
HRLM TE,STHDR
MOVE TE,.JBVER## ;PUT ISAM VERSION # IN STAT BLK
MOVEM TE,ISAVER
MOVE TE,IDXLOC ;MOVE STAT BLOCK
HRLI TE,STHDR ; OVER
MOVE TD,TE ; TO FIRST
BLT TE,STATSZ-1(TD) ; INDEX BLOCK
USETO OF1,1 ;WE WILL WRITE IN FIRST INDEX BLOCK
PUSHJ PP,RITID1
;IFN TOPS20,< PUSHJ PP,OF1AFS >;[154] GET ASCIZ FILE SPEC
CLOSE OF1, ;CLOSE INDEX FILE
STATZ OF1,$ERA ;BE SURE THERE ARE
JRST IDXERA ; NO ERRORS
;IFN TOPS20,<
; MOVE TA,OF1DAT ;GET DEVICE NAME OF IDX FILE
; CALLI TA,$GETCH ;GET CHARACTERISTICS
; TLNE TA,$DSK ;SKIP IF NOT A DSK
; PUSHJ PP,OF1SIZ ;CHANGE .FBSIZ TO +INFINITY
;>;END IFN TOPS20
RELEASE OF1, ;RELEASE
; RELEASE OF2, ; ALL
; RELEASE IF1, ; FILES
;DISPLAY SOME OF THE FINAL STATISTICS
TYPE (
[ISMLOV )
MOVE TE,LEVELS
PUSHJ PP,PUTDEC
TYPE ( Level)
MOVE TE,LEVELS
CAIN TE,1
JRST ALD11A
TYPE (s)
ALD11A: TYPE ( of index ]
)
TYPE ([ISMNDR )
MOVE TE,MUCHO
PUSHJ PP,PUTDEC
TYPE ( Data record)
MOVE TE,MUCHO
CAIN TE,1
JRST ALD11B
TYPE (s)
ALD11B: TYPE ( ]
)
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
FINSTA: ;REPORT FINAL STATS ON THE INDEX BLOCKING FACTORS AND
;THEIR EFFICIENCY
MOVE TA,DATBLK ;PICK UP THE USED BLOCKING FACTOR FOR THE DATA FILE
CAME TA,IDABF ;AND SEE IF USER USED CORRECT ONE
PUSHJ PP,FNDSTA ;NO SO GO FIGURE EVERYTHING OUT
TYPE ([ISMWSD Wasted )
MOVE TE,DATWST
PUSHJ PP,PUTPNT ;TELL HOW MANY WORDS ARE WASTED
TYPE ( words of )
MOVE TA,RECSIZ ;GET RECORD SIZE
ADDI TA,1 ;ADD OVERHEAD WORD
IMUL TA,IDABF ;AND CALC # OF USED WORDS
ADD TA,DATWST ;ADD IN WASTED WORDS
MOVE TE,TA
PUSHJ PP,PUTDEC ;TLL USER
TYPE (. )
MOVE TD,DATWST
JUMPE TD,FNSTAA ; SKIP % IF ZERO
MOVE TB,DATBLS
PUSHJ PP,CLPCN ;GO GET PERCENTAGE
MOVE TA,TE ;PUT INTO TA FOR FINPCN
PUSHJ PP,FINPCN ;GO PRINT PERCENTAGE
TYPE (% wasted space)
FNSTAA: TYPE ( in the Data file.]
)
TYPE ([ISMLDE One logical Data block equals )
MOVE TE,DATBLS ;TELL USER HOW LARGE HIS BLOCK IS
IFN TOPS20,<
TRNE SW,OPT.OP ;OUTPUT IN PAGES?
JRST [PUSHJ PP,BKTOPG ; YES, CONVERT TO PAGES
PUSHJ PP,PUTPNT
TYPE ( page)
JRST PLURL1 ] ;CHECK FOR MORE THAN ONE
> ;END IFN TOPS20
PUSHJ PP,PUTPNT ; OUTPUT NOT IN PAGES
TYPE ( physical disk block)
PLURL1: MOVE TE,DATBLS ;SEE IF SHOULD BE BLOCKS OR BLOCK
IFN TOPS20,<
TRNE SW,OPT.OP ;OUTPUT IN PAGES?
PUSHJ PP,BKTOPG ; YES, CONVERT TO PAGES
> ;END IFN TOPS20
SOJE TE,FNSTAB
TYPE (s)
FNSTAB: TYPE (.]
)
FINST1: MOVE TA,IDXBLK ;GET BLOCKING FACTOR FOR INDEX FILE
CAME TA,IDXBF ;SEE IF USER USED THE CORRECT ONE
PUSHJ PP,FNISTA ;NO SO GO CALC EVERYTHING
TYPE ([ISMWSI Wasted )
MOVE TE,IDXWST ;GET WASTED SPACE
PUSHJ PP,PUTPNT ;TELL THE USER
TYPE ( words of )
MOVE TA,SIZIDX ;GET ENTRY SIZE
IMUL TA,IDXBF ;CALC TOTAL USED
ADD TA,IDXWST ;ADD IN WASTED WORDS
ADDI TA,2 ;AND ADD OVERHEAD FOR BLOCK
MOVE TE,TA
PUSHJ PP,PUTDEC ;TELL USER
TYPE (. )
MOVE TD,IDXWST
JUMPE TD,FNST1A ; JUMP IF % ZERO
MOVE TB,IDXBLS
PUSHJ PP,CLPCN ;CALC %
MOVE TA,TE
PUSHJ PP,FINPCN ;GO PRINT THE PERCENTAGE
TYPE (% wasted space)
FNST1A: TYPE ( in the Index file.]
)
TYPE ([ISMLIE One logical Index block equals )
MOVE TE,IDXBLS ;TELL USER HOW LARGE HIS INDEX BLOCK IS
IFN TOPS20,<
TRNE SW,OPT.OP ;OUTPUT IN PAGES?
JRST [PUSHJ PP,BKTOPG ; YES,CONVERT TO PAGES
PUSHJ PP,PUTPNT
TYPE ( page)
JRST PLURL2 ] ; & CHECK FOR MORE THAN ONE
> ;END TOPS20
PUSHJ PP,PUTPNT ; OUTPUT NOT IN PAGES
TYPE ( physical disk block)
PLURL2: MOVE TE,IDXBLS ;SEE IF SHOULD BE BLOCKS OR BLOCK
IFN TOPS20,<
TRNE SW,OPT.OP ;OUTPUT IN PAGES?
PUSHJ PP,BKTOPG ; YES, CONVERT
> ;END IFN TOPS20
SOJE TE,FNST1B
TYPE (s)
FNST1B: TYPE (.]
)
FINIOB: MOVEI TD,^D256 ;CALCULATE AND REPORT STORAGE
;REQUIREMENTS FOR LIBOL'S I/O BUFFER FOR THIS FILE
MOVE TB,IDXBLS ;GET # OF DISK BLOCKS PER INDEX BLOCK
IMUL TB,LEVELS ;CALC TOTAL FOR EACH LEVEL OF INDEX
MOVE TC,DATBLS ;GET # OF DISK BLOCKS PER DATA BLOCK
IMULI TC,2 ;AND GET TOTAL FOR DATA AND SCRATCH BLOCK
ADD TB,TC ;GET SUB TOTAL
LSH TB,7 ;CONVERT INTO WORDS
ADD TD,TB ;GET TOTAL # OF WORDS
TYPE ([ISMIBS LIBOL's I/O buffer will require )
MOVE TE,TD ;REPORT # OF WORDS
PUSHJ PP,PUTPNT
TYPE ( words )
TYPE (<(>) ;TYPE LEFT PAREN
ADDI TD,777 ;ROUND UP TO NEAREST PAGE BOUNDRY
LSH TD,-^D9 ;CONVERT TO PAGES
MOVE TE,TD ;AND REPORT TOTAL REQUIRED
PUSHJ PP,PUTPNT
TYPE ( Pages)
TYPE (<)>) ;TYPE RIGHT PAREN
TYPE ( of memory.]
)
JRST FIN$
IFN TOPS20,<
BKTOPG:
MOVEI TB,0 ;INIT SW
TRNE TE,3 ;TEST FOR CARRY
AOS TB ;SET CARRY
LSH TE,-2 ;DIVIDE BY 4
ADD TE,TB ;ADD CARRY
POPJ PP, ;RETURN
> ;END IFN TOPS20
FINPCN: IDIVI TA,^D10
MOVE TE,TA
PUSHJ PP,PUTPNT ;AND PRINT TOTAL WORDS IN BLOCK
; AND DECIMAL POINT
MOVE TE,TB ;PICK UP THE REMAINDER
JRST PUTDEC ;WRITE IT AND RETURN FROM PUTDEC
FNISTA: MOVE TB,SIZIDX ;GET SIZE OF EACH INDEX ENTRY
MOVEM TA,IDXBF ;SAVE USER'S BLOCKING FACTOR FOR LATER
IMUL TA,TB ;GET # OF WORDS USED
ADDI TA,2 ;ADD IN THE TWO HEADER WORDS PER INDEX BLOCK
MOVE TC,TA ;AND SAVE FOR A LITTLE LATER
ADDI TA,^D127 ;ROUND UP
LSH TA,-7 ;CONVERT TO BLOCKS
MOVEM TA,IDXBLS ;SAVE FOR LATER
LSH TA,7 ;CONVERT BACK TO WORDS
SUB TA,TC ;CALC THE # OF WASTED WRODS
MOVEM TA,IDXWST ;SAVE IT
POPJ PP, ;AND THEN RETURN
FNDSTA: MOVE TB,RECSIZ ;PICK UP RECORD SIZE
ADDI TB,1 ;ADD OVERHEAD WORD FOR EACH RECORD
MOVEM TA,IDABF ;SAVE FOR LATER
IMUL TA,TB ;CALC # OF WORDS USED
MOVE TC,TA ;SAVE FOR A LITTLE LATER TO CALC WASTED SPACE
ADDI TA,^D127 ;ADD TO ROUND UP
LSH TA,-7 ;THEN SEE HOW MANY BLOCKS IT IS
MOVEM TA,DATBLS ;AND SAVE FOR LATER
LSH TA,7 ;CONVERT BACK TO WORDS
SUB TA,TC ;AND GET # OF WASTED WORDS
MOVEM TA,DATWST ;AND SAVE
POPJ PP, ;THEN RETURN
>;END OF IFN $CU001
FIN$: TLNN SW,(INDIR) ;INDIRECT COMMAND FILE?
JRST START ; NO, LOOP BACK TO THE BEGINNING
TLNE SW,(FCEOF) ;END OF CMD FILE?
JRST START ; YES, GO START AGAIN
MOVEI SW,0 ; NO, CLEAR OLD SWITCHES
TLO SW,(INDIR) ; & REMIND THIS IS INDIRECT
TLO SW,(FCEOFK) ;EOF OK TO BEGIN WITH
JRST START1 ;GO DO IT AGAIN
IFN TOPS20,<
;THIS CODE MAKES THE .IDX FILE'S END-OF-FILE POINTER (.FBSIZ)
;BE 377777,,777777 - THIS ENABLES ALL "SMU" UPDATERS TO FIND
;DATA APPENDED TO THE END OF FILE. THIS CODE SHOULD GO AWAY
;WHEN THE TOPS20 MONITOR IS FIXED. I.E. VERSION 3. [154]
OF1AFS: SKIPA TA,[3,,[OF1,,5
-1,,OF1AZB
111110,,1]] ;[154] EXCHANGE CHAN# FOR ASCIZ FILE SPEC
OF2AFS: MOVE TA,[3,,[OF2,,5
-1,,OF1AZB
111110,,1]] ;[154] EXCHANGE CHAN# FOR ASCIZ FILE SPEC
COMPT. TA, ;[154]
JFCL ;[154]
POPJ PP, ;[154]
OF1SIZ: HRLZI 1,(GJ%OLD!GJ%SHT) ;[154] EXCHANGE ASCIZ STRING FOR JFN
HRROI 2,OF1AZB ;[154]
GTJFN ;[154]
JFCL ;[154]
HRLI 1,.FBSIZ ;[154] CHANGE JFN'S .FBSIZ TO +INFINITY
SETO 2, ;[154]
HRLOI 3,377777 ;[154]
CHFDB ;[154]
ERJMP ERRJSY ; JSYS ERROR
POPJ PP, ;[154]
ERRJSY: TYPE (?ISMJSY Internal JSYS error, submit SPR
)
MOVEI 1,.PRIOU ; TYPE MESSAGE ON TERMINAL
HRLOI 2,.FHSLF ; THIS FORK, LAST ERROR
SETZB 3,4 ; NOTHING SPECIAL
ERSTR ; PRINT LAST JSYS ERROR
JFCL
JFCL
JRST START
> ;[154]
SUBTTL PUT KEY INTO AN INDEX BLOCK
RITKEY: AOS NDATB ;INCREMENT NUMBER OF DATA BLOCKS
MOVEI TA,1 ;START AT LOWEST LEVEL INDEX
MOVE TE,IDXEIB-1(TA) ;IS THIS
CAML TE,IDXRIT ; BLOCK FULL?
PUSHJ PP,RITKY4 ;YES--UPDATE HIGHER LEVELS AND WRITE THIS
MOVE TB,OLDKEY ;MOVE KEY FROM 'OLDKEY'
MOVE TE,DATLOK ;GET 1ST SECTOR NUMBER OF DATA BLOCK
RITKY1: MOVE TD,IDXWRD-1(TA) ;GET DESTINATION ADDRESS
MOVE TC,SIZKEY ;GET KEY SIZE IN WORDS
MOVEM TE,(TD) ;STASH SECTOR NUMBER
RITKY2: MOVE TE,(TB) ;GET WORD OF KEY
SKIPN IDX1KY-1(TA) ;1ST KEY AT THIS LEVEL?
MOVE TE,LOWVAL(KT) ;YES, GET LOW VALUES FOR THIS KEY TYPE
MOVEM TE,2(TD) ;STORE WORD OF KEY
SOJLE TC,RITKY3
ADDI TB,1
AOJA TD,RITKY2
RITKY3: AOS IDX1KY-1(TA) ;HAVE DONE 1ST KEY AT THIS LEVEL
AOS IDXEIB-1(TA) ;BUMP ENTRY COUNT FOR THIS BLOCK
ADDI TD,3 ;BUMP LOCATION FOR
MOVEM TD,IDXWRD-1(TA) ; NEXT ENTRY
POPJ PP, ;RETURN
;CURRENT INDEX BLOCK IS COMPLETE--UPDATE HIGHER LEVELS
RITKY4: ADDI TA,1 ;STEP UP TO NEXT LEVEL
CAMLE TA,LEVELS ;IF THERE IS NO NEXT LEVEL,
PUSHJ PP,GETLVL ; MAKE ONE
MOVE TE,IDXEIB-1(TA) ;IS THAT
CAML TE,IDXRIT ; BLOCK FULL?
PUSHJ PP,RITKY4 ;YES--GO UP TO NEXT
MOVE TB,IDXLOC-2(TA) ;WE WILL MOVE KEY FROM 1ST ENTRY IN
ADDI TB,4 ; NEXT LOWER LEVEL
MOVE TE,FEISEC ;MOVE SECTOR NUMBER OF INDEX BLOCK
PUSHJ PP,RITKY1 ;STASH ENTRY AND UPDATE INFO FOR THIS BLOCK
SUBI TA,1 ;DROP DOWN ONE LEVEL
JRST RITIDX ;WRITE THAT BLOCK AND RETURN
;LOW VALUES FOR EACH KEY TYPE
LOWVAL: 0 ;NON-NUMERIC
1B0 ;NUMERIC DISPLAY
1B0
1B0 ;COMP
1B0
1B0+1B35 ;COMP-1
1B0+1B35
1B0 ;COMP-3
1B0
GETKEY: TLZ SW,(FNUM!FSGND) ;CLEAR FLAGS
;BL; 5 INSERTED AT GETKEY+1 TO DISPLAY KEY DESCRIPTOR FOR LAZY PROGRAMMER /S
TLNE SW,(INDIR) ;SKIP QUESTION IF INDIRECT
JRST GETKY0
TRNN SW,OPT.B+OPT.S ;BUILD OR STAT?
JRST GETKY0 ; NO
TYPE (Key descriptor: )
GETKY0: TRNN SW,OPT.B ;/M OR /P GET INFO FROM STAT BLK
JRST GETK13
SETZB KT,KEYDES
SETZM RECKEY
;BL; 3 LINES DELETED AT GETKY-1
GETKY1: PUSHJ PP,GETTY
;CHECK FOR SIGNS FIRST
TLO SW,(FSGND) ;SIGNED IS DEFAULT
CAIN CH,"S"
JRST [ PUSHJ PP,GETTY ;GET NEXT CHARACTER
CAIN CH,"X" ;IS IT AN X??
JRST BADKEY ;DON'T ALLOW S WITH X
JRST GETKY2 ;SIGNED
]
CAIE CH,"U" ;UNSIGNED SPECIFIED??
JRST GETKY3 ;NO SIGN SPECIFIED- DEFAULT SIGNED
PUSHJ PP, GETTY ;[V10] GET THE NEXT CHAR.
CAIN CH, "X" ;[V10] IF IT'S "X", ALL IS WELL,
JRST GETK4A ;[160] ISSUE WARNING.
TLZ SW,(FSGND) ;TURN OFF FLAG
MOVEI TE,1 ;SET KEYDES UNSIGNED FLAG
DPB TE,KY.SGN
;[V10] PUSHJ PP,GETTY ;ANOTHER CHARACTER
GETKY2: HRROI KT,-1 ;DEFAULT CHANGES TO DISPLAY NUMERIC
GETKY3: CAIN CH,"X" ;HOW ABOUT X?
JRST GETKY4 ;OK
;LETS LOOK FOR NUMERIC KEYS NOW
CAIN CH,"N"
MOVEI KT,1 ;NUMERIC DISPLAY
CAIN CH,"C"
MOVEI KT,3 ;COMP
CAIN CH,"F"
MOVEI KT,5 ;FLOATING POINT
CAIN CH,"P"
MOVEI KT,7 ;COMP-3
JUMPE KT,GETKY5 ;LEAVE IF NOTHING SEEN
TLO SW,(FNUM) ;SET NUMERIC FLAG
;CHECK FOR DEFAULT NUMERIC CASE
JUMPG KT,GTKY3A ;OK NOT DEFAULT
MOVEI KT,1 ;DEFAULT TO NUMERIC DISPLAY
JRST GETKY5 ;KEEP CURRENT CHARACTER AND PROCEED
;CHECK THE NUMERIC KEYS TO SEE IF DATA MODE IS VALID
GTKY3A: CAIN KT,1 ;IS IT DISPLAY
JRST GETKY4 ;YES - NO PROBLEMS
;IT IS SOME NON-DISPLAY NUMERIC FORM
CAIN OM,(IM) ;INPUT AND OUTPUT MUST BE SAME
CAIN IM,AS.MOD ;NO ASCII ALLOWED
JRST IVKERR ; - CAN'T HAVE THAT
CAIN OM,EB.MOD ;IS IT EBCDIC
JRST [CAIN KT,7 ;YES - COMP-3 ONLY
JRST GETKY4 ;OK
JRST IVKERR] ;SORRY
CAIN KT,7 ;IF SIXBIT THEN OTHER THAN COMP-3
JRST IVKERR ;ERROR
JRST GETKY4 ;[160] OK
GETK4A: TYPE (%U inappropriate before X, U ignored
) ;[160]
GETKY4: PUSHJ PP,GETTY ;GET NEXT CHARACTER
GETKY5: MOVEM CH,TTYKAR ;SAVE CH SO IT WILL BE PICKED UP BY 'GETDEC'
PUSHJ PP,GETDEC ;GET BYTE POSITION
JUMPLE TE,BADKEY
CAIE CH,"." ;MUST BE TERMINATED BY
JRST BADKEY ; PERIOD
SUBI TE,1
MOVEM TE,FRSTKB ;SAVE RELATIVE BYTE POSITION
; GENERATE THE BYTE POINTER
IDIV TE,BYTWRD(OM) ;DIVIDE BY BYTES PER WORD
HLL TE,BYPTRS(OM) ;BYTE POINTER SKELETON
;CHECK TO SEE THAT COMP AND FLOATING FALL ON WORD BOUNDRIES
JUMPE TF,GETKY6 ;OK IF EQUAL TO 0
CAIE KT,3 ; OR IF NOT COMP
CAIN KT,5 ;OR FLOATING
JRST CFKYER ;ERROR OTHERWISE
GETKY6:
IMUL TF,BYTSIZ(OM) ;COMPUTE # BITS TO LEFT
MOVNS TF ;COMPUTE BYTE RESIDUE
ADDI TF,^D36
DPB TF,[POINT 6,TE,5]; FINISH BYTE-POINTER
MOVEM TE,RECKEY
PUSHJ PP,GETPOS ;GET POSITIVE DECIMAL NUMBER
JRST BADKEY ;TROUBLE
DPB TE,KY.SIZ ;SAVE SIZE
CAIG TE,^D10 ;IS BYTE-SIZE > 10?
JRST GETKY8 ;NO
TLNE SW,(FNUM) ;YES--IS KEY NUMERIC?
ADDI KT,1 ;YES--BUMP KEY TYPE BY ONE
GETKY8: MOVE TD,FRSTKB ;COMPUTE
XCT GETK12(KT) ; LAST BYTE
MOVEM TD,LASTKB ; POSITION
DPB KT,KY.TYP ;SAVE KEY TYPE
;COMPUTE SIZE OF AN INDEX ENTRY
GETK14: JUMPN KT,GETK10 ;IS KEY ALPHANUMERIC?
;COMPUTE # WORDS FOR DISPLAY
ADD TE,BYWDM1(OM) ;BYTES PER WORD-1
IDIV TE,BYTWRD(OM) ;BYTES PER WORD
JRST GETK11
GETK10: ; NUMERIC KEY
MOVEI TE,1 ;ONE-WORD
TRNN KT,1 ; OR
MOVEI TE,2 ; TWO
GETK11: MOVEM TE,SIZKEY ;SAVE SIZE OF KEY, IN WORDS
ADDI TE,2 ;ADD TWO WORDS FOR VERSION, POINTER
MOVEM TE,SIZIDX
POPJ PP,
;TABLE TO COMPUTE LAST BYTE POSITION OF KEY
GETK12: ADD TD,TE ;NON-NUMERIC
ADD TD,TE ;NUMERIC DISPLAY < 11 DIGITS
ADD TD,TE ;NUMERIC DISPLAY > 10 DIGITS
ADD TD,BYTWRD(OM) ;1-WORD FIXED POINT
PUSHJ PP,FIX2WD ;2-WORD FIXED POINT
ADD TD,BYTWRD(OM) ;1-WORD FLOATING POINT
PUSHJ PP,NO2FP ;2-WORD FLOATING POINT
PUSHJ PP,PAK1WD ;1-WORD COMP-3
PUSHJ PP,PAK2WD ;2-WORD COMP-3
FIX2WD: ;GET # BYTES IN TWO WORDS
PUSH PP,TE
MOVE TE,BYTWRD(OM) ;BYTES PER WORD
LSH TE,1 ;TIMES 2
ADDI TD,(TE) ;ADD IT IN
POP PP,TE
POPJ PP, ;RETURN
PAK1WD: ;BYTE COUNT FOR PACKED DECIMAL
PAK2WD:
PUSH PP,TE
ADDI TE,2 ;ROUND UP AND ONE FOR SIGN
LSH TE,-1 ;DIVIDE BY 2
ADDI TD,(TE) ;ADD IT IN
POP PP,TE
POPJ PP,
NO2FP: ;COBOL DOES NOT SUPPORT ANY FORM OF TWO WORD FLOATING
SUBI KT,1
XCT GETK12(KT)
POPJ PP,
;/M OR /P: GET KEY INFO FROM STATISTICS BLOCK
GETK13:
LDB KT,KY.TYP ;GET KEY TYPE
;BL; 6 OUT, 33 IN AT GETK13+1 TO DISPLAY KEY DESCRIPTOR WITH /S
JUMPN KT,GETK16 ;NUMERIC, GO CHECK SIGN
TRNN SW,OPT.S ;/S?
JRST GETK15 ; NO
TYPE (X) ;ALPHANUMERIC
JRST GETK17 ;GO DISPLAY KEY POSITION
;NUMERIC KEY
GETK16: TLO SW,(FNUM) ;SET FLAG
LDB TA,KY.SGN ;IS IT SIGNED
SKIPN TA ;NO, GO DISPLAY TYPE
TLO SW,(FSGND) ;YES
TRNN SW,OPT.S ;/S?
JRST GETK15 ; NO
JUMPN TA,CKPACK ;SKIP IF NO SIGN
TYPE (S) ;KEY IS SIGNED
CKPACK: CAIG KT,6 ;PACKED?
JRST CKFLOT ; NO
TYPE (P)
CKFLOT: CAIG KT,4 ;FLOATING POINT?
JRST CKCOMP ; NO
TYPE (F)
CKCOMP: CAIG KT,2 ;COMP?
JRST NUMRIC ; NO
TYPE (C)
JRST GETK17 ;GO CHECK LENGTH
NUMRIC: TYPE (N) ;NUMERIC
GETK17: HRRZ TE,RECKEY ;GET RELATIVE BYTE POSITION
AOS TE ;+1 = ABSOLUTE POSITION
PUSHJ PP,PUTDEC ;SHOW IT
TYPE (.)
LDB TE,KY.SIZ ;GET KEY LENGTH
PUSHJ PP,PUTDEC ;SHOW IT
TYPE (
) ;NEW LINE
GETK15: TRNE SW,OPT.P ;IF /P, USE IM INSTEAD OF OM
EXCH IM,OM ; DURING CALCULATION OF FRSTKB
HRRZ TD,RECKEY ;REL POSITION OF KEY IN RECORD
IMUL TD,BYTWRD(OM) ;TIMES # BYTES PER WORD
LDB TA,[POINT 6,RECKEY,5] ;PLUS EXTRA BYTES BEFORE KEY
HRRZI TE,^D36
SUBI TE,(TA)
IDIV TE,BYTSIZ(OM) ;DIVIDE BY BYTE SIZE
ADDI TD,(TE)
MOVEM TD,FRSTKB ;GIVES BYTE POSITION OF KEY IN REC
TRNE SW,OPT.P ;IF /P, RESTORE IM AND OM
EXCH IM,OM
LDB TE,KY.SIZ ;ADD SIZE OF KEY
XCT GETK12(KT) ;COMPUTE LAST BYTE
MOVEM TD,LASTKB
TRNE SW,OPT.M ;/M OR /P?
JRST GETK14 ;/M: GO ON TO GET SIZE OF KEY IN WORDS
;/P: CREATE OUTPUT RECKEY OFFSET
MOVE TB,FRSTKB ;GET # OF BYTES BEFORE KEY
IDIV TB,BYTWRD(OM) ;Q= # OF OUTPUT WORDS BEFORE KEY
MOVEM TB,RECKEY
MOVE TA,BYTSIZ(OM) ;BYTE SIZE
DPB TA,[POINT 6,RECKEY,11]
IMULI TC,(TA) ;36-(R*(#BITS)) = # ODD BITS BEF. KEY
MOVEI TA,^D36
SUBI TA,(TC)
DPB TA,[POINT 6,RECKEY,5]
JRST GETK14
SUBTTL FORM AND WRITE LABELS FOR MAGTAPE
LABEL: TRNN SW, OPT.L ; NECCESSARY?
POPJ PP,
TRNN SW, OPT.P ; WRITE LABEL?
JRST LAB.1X ; NO - READ
CAIN OM,EB.MOD ;IS IT EBCDIC?
JRST EBLBER ;NO EBCDIC LABELS
MOVE TA, [XWD STDLBL, STDLBL+1]
SETZM STDLBL
BLT TA, STDLBL+14 ; ZERO LABEL AREA
MOVE TA, [SIXBIT / HDR1/] ; FIRST LABEL
MOVE TB, OF2DAT+FILNAM ; VALUE OF ID
ROTC TA, ^D12 ; LEFT JUSTIFY
MOVEM TA, STDLBL
MOVEM TB, STDLBL+1
SETZI TA,
MOVE TB, OF2DAT+FILEXT ;
ROTC TA, ^D12
ORM TA, STDLBL+1 ; ADD EXT
MOVEM TB, STDLBL+2
MOVE TB,OREENO ;STUFF IT
PUSHJ PP,CONREL ;CONVERT IT
MOVEM TB,OREENO ;REPLACE IT
HLRZM TB, STDLBL+4
HRLZM TB, STDLBL+5
SETZB TA, TB ; GET CREATION DATE OF INPUT FILE
LDB TC, [POINT 12, SA.CRE, 35] ; GET CREATION DATE OF IF1
IDIVI TC, ^D31
AOJ TD, ; GET DAY
PUSHJ PP, LAB.SX ; TURN TO SIXBIT AND ADD
IDIVI TC, ^D12 ; MONTH
AOJ TD,
PUSHJ PP, LAB.SX ;
ADDI TC, ^D64 ; BASE YEAR
MOVEI TD, (TC)
PUSHJ PP, LAB.SX
MOVEM TA, STDLBL+6
MOVEM TB, STDLBL+7 ; SAVE DATE
LAB.0: MOVE TA, [POINT 6, STDLBL]
MOVNI TB, ^D80-2 ; LENGTH OF LABEL (MINUS 2 FOR CR-LF)
LAB.1: ILDB CH, TA ; GET NEXT CHAR OF LBL
TRNE OM,AS.MOD ;[145] OUTPUT MODE ASCII?
ADDI CH,40 ;[145] YES, CONVERT 6BIT TO ASCII
PUSHJ PP, PUTBYT
AOJL TB, LAB.1 ; MORE
TROE SW, TEMP. ; DONE?
JRST LAB.2 ; YES
MOVNI TB, 2
CAIE OM, AS.MOD ; ASCII?
JRST LAB.1
MOVEI CH, 15 ; YES - PUT A CR-LF
PUSHJ PP, PUTBYT
MOVEI CH, 12
PUSHJ PP, PUTBYT
LAB.2: TRZ SW, TEMP. ; CLEAR
JRST WRITE ; WRITE IT AND DONE
CONREL: ADD TB,[OCT 464646470000] ;ADD ONE AND HANDLE CARRIES
MOVE TA,TB ;COPY INTO AC
AND TA,[OCT 606060600000] ;ISOLATE CARRY BITS
LSH TA,-3 ;PUT THEM IN PLACE
SUB TB,TA ;FUDGE UP CARRIES
AND TB,[OCT 171717170000] ;NOW HAVE BINARY NUMBER
IOR TB,[OCT 202020200000] ;BACK TO SIXBIT
POPJ PP, ;SAY GOODBYE...
; WRITE TRAILING LABEL
TLABEL: TRNE SW,OPT.P ;PACKING?
TRNN SW,OPT.L ; WITH LABELS?
POPJ PP, ; NO - BACK
MOVSI TA, (SIXBIT /EOF/)
TLAB1: HLLM TA, STDLBL
CLOSE OF2, ; PUT OUT AN EOF (BEFORE TRAILER LABEL)
STATZ OF2, $ERA ; ERRORS?
JRST DATERA
JRST LAB.0 ; PUT TAIL LABEL AND DONE
VLABEL: TRNN SW,OPT.P ;WRITING LABELS?
POPJ PP, ;GO BACK
MOVSI TA, (SIXBIT "EOV") ;PUT OUT AN VOL
JRST TLAB1 ;AND PROCEED WITH TRAILER
; READ STANDARD LABEL AND VERIFY NAME.
LAB.10: AOS IF1BUF+2 ;BECAUSE INPUT ROUTINES DO SOSG NOT SOSGE
LAB.1X:
;CHECK FOR EBCDIC
CAIN IM,EB.MOD
JRST EBLBER ;NO EBCDIC LABEL SUPPORT
MOVNI TA, ^D80-2 ; NUMBER OF CHARS IN LABEL
MOVMM TA,INPSIZ ;[146] SAVE SIZE OF LABEL FOR GETSM
MOVE TB, [POINT 6, STDLBL]
LAB.11: PUSHJ PP, @GETBYT ; GET NEXT CHAR
TLNE SW, (FEOF) ; PRE-MATURE EOF?
JRST LBLEOF
TLZE SW, (FENDL) ; END OF LINE?
JRST LAB.12
TRNE IM,AS.MOD ; ASCII?
LDB CH,PTR%76## ;CONVERT IF NECESSARY
IDPB CH, TB ; ADD TO LABEL REC
AOJL TA, LAB.11 ; MORE
LAB.12: SETZM IF1BUF+2 ; CLEAR WD CNT
MOVE TA, STDLBL
MOVE TB, STDLBL+1
ROTC TA, -^D12
SKIPN ,IF1DAT+FILNAM ;INPUT NAME GIVEN?
MOVEM TB,IF1DAT+FILNAM ; SET NAME IF NO
CAME TB, IF1DAT+FILNAM ; VALUE OF ID MATCH (NAME)?
JRST LBLERN
MOVE TA, STDLBL+1
MOVE TB, STDLBL+2
ROTC TA, -^D12
SKIPN ,IF1DAT+FILEXT ; INPUT EXT GIVEN?
MOVEM TB,IF1DAT+FILEXT ; SET IT IF NO
HLLZ TA, IF1DAT+FILEXT
CAME TA, TB ; EXT MATCH?
JRST LBLERN
POPJ PP, ; DONE.
SUBTTL SCAN COMMAND STRING FOR ONE FILE DESCRIPTOR
GETFIL: SETZM FILDAT ;CLEAR FILE
MOVE TE,[FILDAT,,FILDAT+1] ; PARAMETER AREA
BLT TE,FILDAT+BUFADR-1
PUSHJ PP,GETSIX ;GET A WORD
CAIE CH,":" ;IS IT A DEVICE?
JRST GETFL1 ;NO
MOVEM TE,DEV+FILDAT ;YES--SAVE IT
PUSHJ PP,GETSIX ;GET ANOTHER WORD
GETFL1: MOVEM TE,FILNAM+FILDAT ;SAVE FILE NAME
CAIE CH,"." ;IS THERE AN EXTENSION?
JRST GETFL2 ;NO
PUSHJ PP,GETSIX ;YES--GET IT
HLLZM TE,FILEXT+FILDAT ; AND SAVE IT
AOS FILEXT+FILDAT ;"." SEEN
GETFL2: CAIN CH,"/" ;SWITCH DELIMITER?
JRST GETFL3 ;YES
CAIE CH,"[" ;IS THERE A P-P NUMBER?
POPJ PP, ;NO--QUIT
PUSHJ PP,GETOCT ;YES--GET LEFT-HALF
SKIPN TE ; [143] IF ZERO
HLRZ TE,MYPPN ; [143] USE DEFAULT PROJ NUMBER
MOVSM TE,PPNUM+FILDAT
CAIE CH,"," ;MUST TERMINATE WITH
JRST GETFL4 ; COMMA
PUSHJ PP,GETOCT ;GET RIGHT-HALF
SKIPN TE ; [143] IF ZERO
HRRZ TE,MYPPN ; [143] USE DEFAULT PROG NUMBER
HRRM TE,PPNUM+FILDAT
CAIE CH,"]" ;MUST TERMINATE WITH RIGHT-BRACKET
JRST GETFL4 ;IT DIDN'T
GET.SW: PUSHJ PP,GETTY ;IS THERE A SWITCH?
GETSW0: CAIE CH,"/"
POPJ PP, ;NO
GETFL3: PUSHJ PP,GETTY ;GET SWITCH
CAIE CH,"B"
JRST .+3
MOVEI TA,OPT.B
JRST GETFL7
CAIE CH, "L"
JRST .+4
SKIPN AUTOLB ; DONT SET SW IF MONITOR DOES LABELING
MOVEI TA, OPT.L
JRST GETFL7
CAIE CH,"P"
JRST .+3
MOVEI TA,OPT.P
JRST GETFL7
CAIE CH,"M"
JRST .+3 ; [EDIT#107]
MOVEI TA,OPT.M ; [EDIT#107]
JRST GETFL7 ; [EDIT#107]
CAIE CH,"R" ; IS IT RENAME?
JRST .+3 ; NO
MOVEI TA,OPT.R ; YES, SET IT
JRST GETFL7 ; CONT
CAIE CH,"C" ; IS IT CHECK?
JRST .+3 ; NO
MOVEI TA,OPT.C ; YES, SET IT
JRST GETFL7 ; CONT
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
CAIE CH,"S" ;CHECK FOR STATISTICS REQUEST
JRST .+3
MOVEI TA,OPT.S ;FLAG STAS WANTED
JRST GETFL7
>;END OF IFN $CU001
CAIE CH,"I" ; IS THIS /I? [EDIT#107]
JRST .+3 ; NO,
MOVEI TA,OPT.I ; YES, SET IT [EDIT#107]
JRST GETFL7 ; CONT
IFN TOPS20,< ;CHECK PAGED OUTPUT SW
CAIE CH,"O" ; IS IT /O?
JRST CKADV ; NO, CHECK "ADVANCING"
PUSHJ PP,GETTY ; YES, GET ANOTHER CHAR
CAIE CH,":" ; COLON?
JRST GETFL6 ; NO, ERROR
PUSHJ PP,GETTY ; YES, GET ANOTHER
CAIE CH,"N" ; "NEW"?
JRST .+3 ; NO, CHECK FOR "OLD"
MOVEI TA,OPT.OP ; YES, SET IT
JRST GETFL7 ; & CONTINUE
CAIE CH,"O" ; "OLD"?
JRST GETFL6 ; NO, ERROR
TRZ SW,OPT.OP ; YES, RESET PAGE SW
JRST GET.SW ; GO GET NEXT SW
> ;END IFN TOPS20
CKADV: CAIE CH,"A" ; HOW ABOUT "ADV"?
JRST GETFL6 ; NO, ERROR
PUSHJ PP,GETTY ;GET ANOTHER CHAR
CAIE CH,"D" ; "AD"?
JRST SWADV0 ; NO, CHECK FOR :
PUSHJ PP,GETTY ; YEP, GET ANOTHER
CAIE CH,"V" ; "ADV"?
JRST SWADV0 ; NO, CHECK FOR :
; NOW CHECK FOR :, MUST BE THERE FOR /A(DV):68
PUSHJ PP,GETTY ; GET CHAR AFTER "ADV"
SWADV0: CAIE CH,":" ; IS IT COLON?
JRST GETFL6 ; NO,ILLEGAL SWITCH
PUSHJ PP,GETSIX ; YES, GET A WORD OF SIXBIT
CAMN TE,[SIXBIT "6"]
JRST GETSW0 ; DEFAULT IS CORRECT, NEXT
CAMN TE,[SIXBIT "68"]
JRST GETSW0 ; DEFAULT IS CORRECT, NEXT
CAMN TE,[SIXBIT "B"]
JRST GETSW0 ; DEFAULT IS CORRECT, NEXT
CAMN TE,[SIXBIT "BEFORE"]
JRST GETSW0 ; DEFAULT IS CORRECT, NEXT
CAMN TE,[SIXBIT "A"]
JRST SWADV1 ; GO SET ANS74 DEFAULT
CAMN TE,[SIXBIT "AFTER"]
JRST SWADV1 ; GO SET ANS74 DEFAULT
CAMN TE,[SIXBIT "7"]
JRST SWADV1 ; GO SET ANS74 DEFAULT
CAME TE,[SIXBIT "74"]
JRST GETFL6 ; ERROR, ILLEGAL SWITCH
; OK, CONT BELOW
; HERE IF "AFTER" ADVANCING IS INDICATED
SWADV1: MOVEI TA,OPT.A7 ; YES, INDICATE ANS74 STYLE
TRO SW,(TA) ; SET IT
JRST GETSW0 ; CONT,DON'T GET ANOTHER CHAR
GETFL7: TRO SW,(TA)
JRST GET.SW ; AND TEST FOR ANOTHER SWITCH
GETFL6: TYPE (?Illegal switch
)
JRST GETFL8
GETFL4: TYPE (?Improper project programmer number
)
GETFL8: TLO SW,(FERROR)
GETFL5: CAIE CH,15
CAIN CH,"="
POPJ PP,
PUSHJ PP,GETTY
JRST GETFL5
SUBTTL BUILD TWO MAG-TAPE BUFFERS OF NON-STANDARD SIZE
BLDBUF: SKIPN TE,INPBLK ;# RECORDS PER INPUT BLOCK SPECIFIED?
JRST BLDBF6 ;NO -- USE STANDARD LENGTH BUFFERS
;COMPUTE SIZE OF THE BUFFERS NEEDED AND REBUILD EXISTING ONES
PUSHJ PP,WDPBLK ;GET WORDS PER BLOCK IN TE
ADDI TE,1 ;ONE FOR MONITOR OVERHEAD
CAIGE TE,^D21 ;LEAVE ENOUGH ROOM FOR
MOVEI TE,^D21 ; LABELS
HRRZ TA,IF1BUF ;REBUILD
TRNE SW,OPT.P
HRRZ TA,OF2BUF
MOVEI TB,3(TA) ; POINTER
ADD TB,TE ; TO
HRRM TB,(TA) ; NEXT BUFFER
DPB TE,[POINT 17,(TA),17] ;PUT IN SIZE OF BUFFER
MOVEI TD,2(TB) ;GET ENOUGH CORE FOR
PUSHJ PP,GETCOR ; TWO BUFFERS
MOVE TD,.JBFF ;CLEAR
MOVSI TC,2(TA) ; CORE
HRRI TC,3(TA) ; THROUGH
SETZM 2(TA) ; BOTH
BLT TC,-1(TD) ; BUFFERS
MOVE TC,-1(TA) ;CREATE
MOVEM TC,-1(TB) ; NEW
MOVE TC,1(TA) ; THREE-
MOVEM TC,1(TB) ; WORD
MOVE TC,(TA) ; BUFFER
TRNE SW,OPT.B
HRR TC,IF1BUF ; HEADER
TRNE SW,OPT.P
HRR TC,OF2BUF
MOVEM TC,(TB) ; *
TRNN SW,OPT.P ;DONT CLEAR IF /P [EDIT#103]
SETZM INPBLK
BLDBF6: ;TAKE CARE OF INDUSTRY COMPATABLE MODE
MOVEI TE,IF1
TRNE SW,OPT.P
MOVEI TE,OF2
MTCHR TE,
POPJ PP, ;FORGET IT ON ERROR
TRNE TE,MT.7TR ;IS IT 9 TRACK?
POPJ PP, ;NO
TRNE SW,OPT.P
JRST BLDBF7
CAIE IM,EB.MOD ; IF NOT EBCDIC
POPJ PP, ; THEN NO IND-CMPTBL-MODE
MTAPE IF1,MTIND ;INDUSTRY COMPATABLE INPUT
JRST BLDBF8 ; FINISH UP
BLDBF7: CAIE OM,EB.MOD ; NO INDUSTRY COMPATIBLE MODE
POPJ PP, ; IF NOT AN EBCDIC FILE
MTAPE OF2,MTIND ;INDUSTRY COMPATABLE OUTPUT
BLDBF8: MOVEI TE,^D8 ;CHANGE BYTE SIZE TO 8
MOVEI TF,IF1BUF
TRNE SW,OPT.P
MOVEI TF,OF2BUF
DPB TE,[POINT 6,1(TF),11]
TLO SW,(FINDCP) ;SET INDUSTRY COMPATABLE FLAG
POPJ PP,
SUBTTL ERROR ROUTINES
;ENTER FAILURE
ENTRFA: TYPE (?ENTER )
TDNA ; SKIP
RENAMA: TYPE (?RENAME )
TYPE ( failure on )
MOVE TE,DEV+OF1DAT ;[ED#113]
PUSHJ PP,PUTSIX
TYPE (:)
MOVE TE,FILNAM+OF1DAT ;[ED#113]
PUSHJ PP,PUTSIX
HLLZ TE,FILEXT+OF1DAT ;[ED#113]
JUMPE TE,ENTRF1
TYPE (.)
PUSHJ PP,PUTSIX
; INSERTED 11 INSTRUCTIONS EDIT 113
JUMPA ENTRF1 ;[ED#113]
ENTRFB: TYPE (?ENTER )
JRST RNAMB1
RENAMB: TYPE (?RENAME )
RNAMB1: TYPE (failure on )
MOVE TE,DEV+OF2DAT ;[ED#113]
PUSHJ PP,PUTSIX ;[ED#113]
TYPE (:) ;[ED#113]
MOVE TE,FILNAM+OF2DAT ;[ED#113]
PUSHJ PP,PUTSIX ;[ED#113]
HLLZ TE,FILEXT+OF2DAT ;[ED#113]
JUMPE TE,ENTRF1 ;[ED#113]
TYPE (.) ;[ED#113]
PUSHJ PP,PUTSIX ;[ED#113]
ENTRF1: TYPE ( -- )
TYPE (<(>) ;TYPE LEFT PAREN
JRST LOOKF1
;LOOKUP FAILURE
LOOKF: TYPE (?Lookup failure on input file -- )
TYPE (<(>) ;TYPE LEFT PAREN
TRNE TB,-1 ;IS IT CODE ZERO?
JRST LOOKF1 ;NO
TYPE (0)
HRRI TB,-1
JRST LOOKF2
LOOKF1: MOVEI TE,(TB)
PUSHJ PP,PUTOCT
LOOKF2: MOVE TE,[XWD -LISTSZ,ERALST]
LOOKF3: HLRZ TF,(TE)
CAIE TF,(TB)
AOBJN TE,LOOKF3
MOVE TF,(TE)
TYPEA ((TF))
TYPE (
)
TLO SW,(FERROR)
POPJ PP,
; TYINF1 IS A ROUTINE TO TYPE THE PRIMARY INPUT FILE NAME
TYINF1: MOVE TE,DEV+IF1DAT ; GET PRIMARY INPUT DEVICE NAME
PUSHJ PP,PUTSIX ; PRINT IT
TYPE (:)
MOVE TE,FILNAM+IF1DAT ; GET PRIMARY INPUT FILE NAME
PUSHJ PP,PUTSIX ; PRINT IT
HLLZ TE,FILEXT+IF1DAT ; GET PRIMARY INPUT EXTENSION
JUMPE TE,CPOPJ ; EXIT IF NO EXTENSION
TYPE (.)
JRST PUTSIX ; PRINT IT AND RETURN
; TYINF2 IS A ROUTINE TO TYPE THE SECONDARY INPUT FILE NAME
TYINF2: MOVE TE,DEV+IF2DAT ; GET SECONDARY INPUT DEVICE NAME
PUSHJ PP,PUTSIX ; PRINT IT
TYPE (:)
MOVE TE,FILNAM+IF2DAT ; GET SECONDARY INPUT FILE NAME
PUSHJ PP,PUTSIX ; PRINT IT
HLLZ TE,FILEXT+IF2DAT ; GET SECONDARY INPUT EXTENSION
JUMPE TE,CPOPJ ; EXIT IF NO EXTENSION
TYPE (.)
JRST PUTSIX ; PRINT IT AND RETURN
;TABLE OF ERROR MESSAGE FOR LOOKUP/ENTER FAILURES
ERALST: XWD -1,[ASCIZ ") file not found"]
XWD 0,[ASCIZ ") illegal file name"]
XWD 1,[ASCIZ ") UFD doesn't exist"]
XWD 2,[ASCIZ ") protection failure"]
XWD 3,[ASCIZ ") file being modified"]
XWD 6,[ASCIZ ") bad UFD or bad RIB"]
XWD 14,[ASCIZ ") device full, or quota exceeded"]
XWD 15,[ASCIZ ") device is write-locked"]
XWD 16,[ASCIZ ") not enough monitor table space"]
XWD 17,[ASCIZ ") Partial allocation only."]
XWD 0,[ASCIZ ") unknown error"]
LISTSZ==.-ERALST-1
ILLDEV: TYPE (?Device must be an OUTPUT or I/O device
)
BADCOM: TYPE (?Improper command string
)
PUSHJ PP,SKPTTY
JRST START
BADDEV: TYPE (?Indexed file devices must be disks
)
JRST START
CANTOP: TLO SW,(FERROR)
TYPE (?Cannot open device )
MOVE TE,TB
PUSHJ PP,PUTSIX
TYPE (:
)
POPJ PP,
BADKEY: TYPE (?Improper key descriptor
)
PUSHJ PP,SKPTTY
JRST GETKEY
BIGLVL: TYPE (?More than 10 levels of index required
)
JRST START
NOCORE: TYPE (?Not enough memory to complete the job
)
JRST START
CMDINC: TYPE (?EOF on command file - command incomplete
) ;[EDIT#140]
JRST START ;[EDIT#140]
REDERA: TYPE (?Error reading input file
)
MOVEI TB,IF1 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
DATERA: TYPE (?Error writing Data file
)
MOVEI TB,OF2 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
IDXERA: TYPE (?Error writing Index file
)
MOVEI TB,OF1 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
STATER: TYPE (?Error reading Index file
)
MOVEI TB,IF1 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
SIZERR: TYPE (?Record size must be less than 4096
)
JRST ASKM5
BIGKEY: TYPE (?Key is outside the maximum record
)
JRST ASKM8
TOOMCH: TYPE (?Must be less than records per block
)
JRST ASKM13
BIGIDX: ADDI TE,5 ;CONVERT TO
IDIVI TE,6 ; WORDS
TYPE (?Index block contains )
PUSHJ PP,PUTDEC
TYPE ( words, must be less than 683.
reduce the number of entries per index block.
)
JRST ASKM15
TOOFEW: TYPE (?Must have at least two full entries per block
)
JRST ASKM15
DATERR: TYPE (?Error reading Data file
)
MOVEI TB,IF2 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
CMDERR: TYPE (?Cannot open command file
)
JRST START
CMDLER: PUSHJ PP,LOOKF
JRST START
CMDRER: TYPE (?Error reading command file
)
MOVEI TB,CMD ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
RECERR: TYPE (?Actual size of ISAM Data record ) ;[EDIT#141]
MOVE TE,INPSIZ ; [EDIT#141]
PUSHJ PP,PUTDEC ; [EDIT#141]
TYPE ( >ISAM maximum record size parameter ) ;[EDIT#141]
MOVE TE,RECBYT+I ; [EDIT#141]
PUSHJ PP,PUTDEC ; [EDIT#141]
JRST START ; [EDIT#141]
DBLIND: TYPE (?Double indirect command
)
JRST START
ERR%DA: TYPE (?Invalid percentage
)
JRST ASKM18
ERR%IX: TYPE (?Invalid percentage
)
JRST ASKM19
LBLERR: TYPE (? Label option only applicable with build or pack for mag-tape
)
JRST START
LBLEOF: TYPE (Pre-mature EOF (within label) on MTA
)
LBLCLR: POP PP, TA ; DON'T CLOG PDL
JRST START
LBLERN: TYPE (? File name does not match label id
)
JRST LBLCLR
EBLBER: TYPE (?ISMLET labeled EBCDIC tapes are not supported
)
JRST START
TFCERR: TYPE (?ISMTPC TAPOP. failed, cannot set STANDARD-ASCII mode
)
JRST START
ERMVAS: TYPE (?ISMSAM STANDARD-ASCII mode requires TU70 magnetic tape drives
)
JRST START
IVKERR: TYPE (?ISMIVK invalid key type with respect to input/output mode
)
JRST START
RTSERR: PUSHJ PP,CAMD
TYPE (ISMRTS record too short to contain key field
)
TRNN SW,OPT.I+OPT.C ; /IGNORE OR /CHECK CONTINUE?
JRST START ; NOP, ERROR RESTART
PUSHJ PP,DTBLK ; YEP,PRINT DATA BLK WE ARE IN
JRST CAMK1 ; AND CONT FOR MORE
INTERR: TYPE (?ISMITE internal ISAM error - submit SPR
)
JRST START
EBBHER: TYPE (?ISMEBH EBCDIC block header count less than 4
)
JRST START
EBRHER: TYPE (?ISMERH EBCDIC record header exceeds block size
)
JRST START
CFKYER: TYPE (?ISMCFE COMP and COMP-1 keys must begin on word boundries
)
JRST START
TFUERR: TYPE (?ISMTFU TAPOP. failed - unable to set label type
)
JRST START
LTCTST: MOVE TC,[GETSTS TC] ; SEE IF ALL THE ERROR BITS ARE ON
DPB TB,[POINT 4,TC,12]; LOAD THE CHANNEL FIELD
XCT TC ; GET THE ERROR BITS
TRC TC,$ERA ;
TRCE TC,$ERA ; IS THIS A MTA LABEL PROCESSING ERROR?
JRST START ; NO
MOVEI TA,.DFRES ;[161] RETURN ERROR CODE
MOVE TD,[3,,TA] ; LEN,,LOC OF ARG BLOCK
DEVOP. TD, ;[161] GET IT
SETZ TD, ; "ERROR" GETTING ERROR CODE!
TYPE ( monitor label processing failed
)
LSH TD,1 ;INDEX X 2 (MACROS USE 2 WORDS)
SKIPE TD ;CONTINUE IF INDEX=0
ADDI TD,-1 ;CORRECT INDEX
XCT @LTCTBL(TD) ;[161] DECODE THE CODE
JRST START
;[161] PUT ALL THE "ASCIZ /XXX/" ITEMS INSIDE LITERAL BRACKETS
;[161] ALSO CHANGE ERROR MESSAGES TO WORK FOR DEVOP. RATHER THAN TAPOP.
LTCTBL: TYPE (DEVOP. failed while getting error code!)
TYPE (Code 1)
TYPE (Code 2)
TYPE (Label type error)
TYPE (Header label error)
TYPE (Trailer label error)
TYPE (Volume label error)
TYPE (Hard device error)
TYPE (Parity error)
TYPE (Write-lock error)
TYPE (Illegal positioning operation)
SUBTTL MISCELLANEOUS ROUTINES
;TYPE OUT A WORD OF SIXBIT DATA
PUTSIX: MOVE TF,[POINT 6,TE]
PUTSX1: ILDB CH,TF
JUMPE CH,PUTSX9
ADDI CH,40
TYPEC CH
TLNE TF,770000
JRST PUTSX1
PUTSX9: POPJ PP,
;TYPE OUT A WORD OF OCTAL DATA
PUTOCT: MOVE TF,[POINT 3,TE]
PUTOC1: ILDB CH,TF
JUMPN CH,PUTOC2
TLNE TF,770000
JRST PUTOC1
PUTOC2: ADDI CH,"0"
TYPEC CH
TLNN TF,770000
POPJ PP,
PUTOC3: ILDB CH,TF
JRST PUTOC2
; TYPE OUT DECIMAL NUMBER WITH DECIMAL POINT
PUTPNT: PUSHJ PP,PUTDEC ; WRITE THE DECIMAL DIGITS
TYPE (.)
POPJ PP,
;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES
PUTDEC: JUMPGE TE,PUTDC1 ;IF NEGATIVE,
TYPE (-) ; TYPE SIGNED AND
MOVMS TE ; GET MAGNITUDE
PUTDC1: IDIVI TE,^D10
HRLM TF,(PP)
SKIPE TE
PUSHJ PP,PUTDC1
HLRZ CH,(PP)
ADDI CH,"0"
TYPEC CH
POPJ PP,
;TYPE OUT AN UNSIGNED DECIMAL NUMBER, WITHOUT SUPPRESSING LEADING ZEROES
PUTDC2: MOVEI TD,^D10
PUTDC3: IDIVI TE,^D10
HRLM TF,(PP)
SOSLE TD
PUSHJ PP,PUTDC3
HLRZ CH,(PP)
ADDI CH,"0"
TYPEC (CH)
POPJ PP,
;PRINT DECIMAL NUMBER IN TE IF /M IS IN EFFECT
MCUR: TLNE SW,(INDIR) ;IF INDIR COMMANDS, DO NOTHING
POPJ PP,
TRNN SW,OPT.M
JRST MCUR1
TYPE ( )
TYPE (<(>) ;TYPE LEFT PAREN
PUSHJ PP,PUTDEC
TYPE (<)>) ;TYPE RIGHT PAREN
MCUR1: TYPE (: )
POPJ PP,
;GET A CHARACTER FROM TTY
GETTY: SKIPE CH,TTYKAR ;IF ONE WAITING, USE IT
JRST GETTY2
TLNE SW,(INDIR) ;INDIRECT COMMANDS?
JRST GETCMD ;YES [EDIT#140]
INCHWL CH ;NONE-WAITING--GET IT FROM TTY
GETTY2: SETZM TTYKAR
CAIE CH,175 ;ALTMODES ARE NO LONGER LEGAL
CAIN CH,176 ; BREAK CHARACTERS.
JRST BADCHR
CAIE CH,33
CAIN CH,"_" ;ALSO, BACK ARROW IS NO LONGER A
JRST BADCHR ; LEGAL SUBSTITUTE FOR "=".
CAIG CH,40
JRST GETTY1
CAIGE CH,"A"+40
POPJ PP,
CAIG CH,"Z"+40
SUBI CH,40
POPJ PP,
GETTY1: JUMPE CH,GETTY
CAIE CH,40 ;IGNORE SPACES & TABS
CAIN CH,11
JRST GETTY
CAIN CH,15
JRST GETTY
CAILE CH,11
CAILE CH,14
POPJ PP,
MOVEI CH,15
POPJ PP,
BADCHR: TYPE (?Illegal character in command string
)
JRST START ;RESTART.
;GET A CHARACTER FROM INDIRECT COMMAND FILE
GETCMD: TLNE SW,(FCEOF) ;END OF CMD? [EDIT#140]
JRST GETEOF ; [EDIT#140]
GETIND: SOSGE CMDBUF+2
JRST GETIN2
ILDB CH,CMDBUF+1
JUMPE CH,GETIND
JRST GETTY2
GETIN2: IN CMD,
JRST GETIND
TLO SW,(FCEOF) ;CMDEOF [EDIT#140]
STATZ CMD,$ERA ;INPUT ERROR [EDIT#140]
JRST CMDRER
GETEOF: TLNN SW,(FCEOFK) ;EOF OK [EDIT#140]
JRST CMDINC ;NO, INFO MUST BE SUPPLIED [EDIT#140]
MOVEI CH,15 ;SET EOL CONDITION [EDIT#140]
POPJ PP, ;RETURN [EDIT#140]
;GET A WORD OF SIXBIT CHARACTERS
GETSIX: MOVE TF,[POINT 6,TE]
MOVEI TE,0
GETSX1: PUSHJ PP,GETTY ;GET A CHARACTER
CAIL CH,"0" ;IF
CAILE CH,"Z" ; NOT
POPJ PP, ; LETTER
CAIG CH,"9" ; OR
JRST GETSX2 ; DIGIT,
CAIGE CH,"A" ; THEN
POPJ PP, ; QUIT
GETSX2: SUBI CH,40 ;CONVERT TO SIXBIT
TLNE TF,770000 ;IF WORD NOT FULL,
IDPB CH,TF ; STASH CHARACTER IN WORD
JRST GETSX1 ;LOOP
;GET A POSITIVE NUMBER FROM TTY
GETPOS: PUSHJ PP,GETDEC ;GET A DECIMAL NUMBER
POPJ PP, ;ERROR--RETURN
SKIPN TE ;IS IT ZERO?
JRST POSERR ; YES, PUT ERROR MESSAGE
AOS (PP) ;NO--SKIP RETURN
POPJ PP,
POSERR: TYPE (?Positive number required
)
POPJ PP,
;GET A DECIMAL NUMBER FOLLOWED BY A CARRIAGE-RETURN
GETNUM: PUSHJ PP,GETDEC ;GET DECIMAL NUMBER
JRST SKPTTY ;TROUBLE
CAIE CH,15 ;FOLLOWED BY CARRIAGE-RETURN?
JRST GETDC8 ;NO--TROUBLE
AOS (PP) ;YES--SKIP RETURN
POPJ PP, ;RETURN
;GET A DECIMAL NUMBER FROM TTY
GETDEC: MOVEI TE,0
TLZ SW,(FGETDC) ;CLR ACTUAL NUMBER SEEN FLAG
AOS (PP) ;ASSUME NO ERRORS, SO SKIP RETURN
GETDC1: PUSHJ PP,GETTY
CAIL CH,"0" ;IS IT A
CAILE CH,"9" ; DIGIT?
POPJ PP, ;NO
TLO SW,(FGETDC) ;DIGIT SEEN
JOV .+1 ;CLEAR OVERFLOW FLAG
IMULI TE,^D10
ADDI TE,-"0"(CH)
JOV GETDC8 ;IF OVERFLOW--ERROR
JRST GETDC1 ;LOOP
GETDC8: TYPE (?Bad decimal number
)
SOS (PP) ;REMOVE THE SKIP
JRST SKPTTY
;GET AN OCTAL NUMBER FROM THE TTY
GETOCT: MOVEI TE,0
GETOC1: PUSHJ PP,GETTY ;GET A CHARACTER
CAIL CH,"0" ;IF NOT
CAILE CH,"7" ; OCTAL DIGIT,
POPJ PP, ; RETURN
LSH TE,3
IORI TE,-"0"(CH)
TLNN TE,-1 ;IF MORE THAN
JRST GETOC1 ; HALF-WORD,
POPJ PP, ; RETURN
;GET MODE OF A FILE
; GETMOD Get mode of input/output file.
; Returns:
;
; SKIP- TB= SX.MOD==0 ;SIXBIT
; EB.MOD==1 ;EBCDIC
; AS.MOD==2 ;ASCII
; MA.MOD==3 ;35 BIT ASCII TAPE I/O
; -1 IF JUST CRLF RESPONSE
;
; TE= WORD OF SIXBIT RESPONSE
;
;
; NONSKIP- ERROR RESPONSE
GETMOD: PUSHJ PP,GETSIX ;GET A WORD
CAIE CH,15 ;IF IT DIDN'T TERMINATE WITH <C.R.>
JRST GETMD1 ; ERROR
; IF JUST A CRLF, GIVE VALID RETURN, BUT WITH TB=-1
MOVNI TB,1 ; INITIALIZE MODE
JUMPE TE,GETMDX ; EXIT NOW IF NO INPUT BUT CRLF
CAMN TE,[SIXBIT "A"]
MOVEI TB,AS.MOD
CAMN TE,[SIXBIT "S"]
MOVEI TB,SX.MOD
CAMN TE,[SIXBIT "ASCII"]
MOVEI TB,AS.MOD
CAMN TE,[SIXBIT "SIXBIT"]
MOVEI TB,SX.MOD
CAMN TE,[SIXBIT "ST"]
MOVEI TB,MA.MOD
CAMN TE,[SIXBIT "STANDA"]
MOVEI TB,MA.MOD
CAMN TE,[SIXBIT "F"]
MOVEI TB,EB.MOD
CAMN TE,[SIXBIT "FIXED"]
MOVEI TB,EB.MOD
CAMN TE,[SIXBIT "VARIAB"]
JRST .+3
CAME TE,[SIXBIT "V"]
JRST .+3
MOVEI TB,EB.MOD
TLO SW,(FEBVAR) ;NOTE VARIABLE LENGTH
JUMPL TB,GETMD1
GETMDX: AOS (PP)
POPJ PP,
GETMD1: TYPE (?Improper mode
)
SKPTTY: TLO SW,(FERROR)
SKPTT1: CAIN CH,15
POPJ PP,
PUSHJ PP,GETTY
JRST SKPTT1
;GET A BLOCK OF FREE CORE FOR INDEX AND CLEAR IT
GETLVL: MOVE TE,IDXSEC ;NUMBER OF WORDS =
LSH TE,7 ; NUMBER OF SECTORS * 128
HRRZ TD,.JBFF ;GET CURRENT JOBFF
AOS TA,LEVELS ;BUMP NUMBER OF LEVELS
CAILE TA,^D10 ;IF MORE THAN 10,
JRST BIGLVL ; TOO BAD
MOVEM TD,IDXLOC-1(TA) ;SAVE LOCATION OF FREE SPACE
PUSHJ PP,GETCOR ;RESET JOBFF
CLRIDX: MOVE TD,IDXSEC ;COMPUTE
LSH TD,7 ; END OF
ADD TD,IDXLOC-1(TA) ; INDEX CORE AREA
MOVE TE,IDXLOC-1(TA) ;CLEAR
SETZM 0(TE) ; AREA
HRLS TE ; TO
HRRI TE,1(TE) ; ZEROES
BLT TE,-1(TD) ; *
MOVE TD,IDXLOC-1(TA) ;SET ADDRESS FOR FIRST ENTRY
ADDI TD,2
MOVEM TD,IDXWRD-1(TA)
POPJ PP,
GETCOR: ADD TD,TE ;COMPUTE NEW JOBFF
HRRM TD,.JBFF ;SET NEW JOBFF VALUE
MOVEI TE,(TD) ;IF
CAMG TE,.JBREL## ; WE ARE
POPJ PP, ; OVER JOBREL,
IORI TE,1777 ; GET
CALLI TE,$CORE ; MORE CORE
JRST NOCORE ;NOT ENOUGH CORE, TROUBLE
POPJ PP,
;WRITE OUT AN INDEX BLOCK
;WRITE OUT FROM LEVEL 1
RITID1: MOVEI TA,1
MOVE TB,IDXLOC
MOVE TE,STHDR
JRST RITID2
;WRITE OUT FROM ANY LEVEL
RITIDX: MOVE TB,IDXLOC-1(TA) ;GET ADDRESS OF BLOCK
MOVE TE,STHDR ;GET SIZE OF BLOCK IN BYTES
HRLI TE,-1(TA) ;MAKE VISIBLE IDX LEVEL = 0-9 INSTEAD OF 1-10
RITID2: MOVEM TE,(TB) ;PUT THAT IN BLOCK
MOVE TE,IDXSEC ;COMPUTE SIZE OF BLOCK
LSH TE,7
MOVNS TE ;BUILD
HRL TB,TE ; OUTPUT DUMP POINTER
SUBI TB,1
MOVEM TB,OUTLST
SETZM OUTLST+1
MOVE TE,IDXSEC ;UPDATE
ADDM TE,FEISEC ; FIRST FREE SECTOR
OUT OF1,OUTLST ;WRITE OUT BLOCK
AOS IDXOUT ;OK, BUMP 'NUMBER OF INDEX BLOCKS WRITTEN'
SETZM IDXEIB-1(TA) ;CLEAR 'NUMBER OF ENTRIES IN BLOCK'
JRST CLRIDX ;CLEAR THE BLOCK AND RETURN
;GET AN INPUT CHARACTER FROM ASCII FILE
GETAM: TLNE SW,(FENDL!FENDIB) ;ANYTHING SPECIAL GOING ON?
JRST GETAM5 ;YES
GETAM2: SOSG IF1BUF+2
PUSHJ PP,READ ;GET ANOTHER BUFFER
TLNE SW,(FENDIB) ;AT END OF BLOCK?
POPJ PP, ;YES--QUIT
ILDB CH,IF1BUF+1 ;GET A CHARACTER FROM INPUT FILE
JUMPE CH,GETAM ;IGNORE NULLS
IFN DEBUG,<
SKIPE DBUGIT
PUSHJ PP,TRACSZ ;DISPLAY RECORD SIZE
SKIPE DBUGIT
PUSHJ PP,TRACH ;DISPLAY CHARACTER
>
GETAM3: CAIL CH,12 ;ANY
CAILE CH,24 ; SPECIAL PROCESSING?
JRST GETA3A ;NO
CAILE CH,15 ;MAYBE
CAIL CH,20
JRST GETAM4 ;YES
GETA3A: TLZ SW,(FENDL) ;NO--CLEAR 'END-OF-LINE'
TRZE SW,ONEBYT ;ONE-BYTE-ONLY?
POPJ PP, ; YES, RETURN
LDB CH,CONVRT ;CONVERT CHARACTER IF NECESSARY
CAMGE OC,RECBYT ;IF STILL ROOM IN RECORD,
IDPB CH,OP ; STASH CHARACTER IN RECORD
AOS OC ;COUNT CHARACTER
CAIN IM,MA.MOD ;INPUT STANDARD ASCII?
JRST [CAML OC,RECBYT ;YES, END OF REC?
JRST GETAM4 ] ; YES, SET FLAG & RETURN
JRST GETAM ;GO GET NEXT BYTE
GETAM4: TLOA SW,(FENDL) ;IT IS END-OF-LINE
GETAM5: TLNE SW,(FENDIB) ;IF END-OF-BLOCK
POPJ PP, ; RETURN
PUSHJ PP,GETAM2 ;GRAB A CHARACTER
TLNE SW,(FENDL) ;STILL END-OF-LINE?
JRST GETAM5 ;YES--LOOP
POPJ PP, ;NO--RETURN
;GET A BYTE FROM SIXBIT INPUT FILE
GETSM: SKIPG INPSIZ ;ANYTHING LEFT IN RECORD?
JRST GETSM1 ;NO
SOSG IF1BUF+2 ;YES--IF BUFFER IS EMPTY,
PUSHJ PP,READ ; GET ANOTHER BUFFER
TLNE SW,(FENDIB) ;DID WE HIT END-OF-BLOCK?
POPJ PP, ; YES..RETURN
ILDB CH,IF1BUF+1 ;NO--PICK UP BYTE
IFN DEBUG,<
SKIPE DBUGIT
PUSHJ PP,TRACSZ ;DISPLAY RECORD SIZE
SKIPE DBUGIT
PUSHJ PP,TRACH ;DISPLAY CHARACTER
>
TRZE SW,ONEBYT ;REQUEST ONE-BYTE-ONLY?
JRST [SOS INPSIZ ; YES, COUNT ONE BYTE
POPJ PP,] ; & RETURN
LDB CH,CONVRT ;CONVERT IF REQUIRED
CAMGE OC,RECBYT ;RECORD FULL?
IDPB CH,OP ; NO..BYTE TO RECORD
ADDI OC,1 ;COUNT BYTE
SOSLE INPSIZ ;END OF REC?
JRST GETSM ; NO, GET NEXT BYTE
GETSM1: TLO SW,(FENDL) ;SET END-OF-LINE
GETSM2: MOVE CH,IF1BUF+1
TLNN CH,770000
POPJ PP,
SOS IF1BUF+2
IBP IF1BUF+1
JRST GETSM2
GTDAT0: LDB CH,CONVRT ;CONVERT IF REQUIRED
CAMGE OC,RECBYT ;RECORD FULL?
IDPB CH,OP ; NO, PUT BYTE TO RECORD
ADDI OC,1 ;COUNT BYTE
GETDAT: SKIPG INPSIZ ;ANY LEFT?
JRST GETDA1 ;NO
ILDB CH,INPTR ;YES, GET ONE
IFN DEBUG,<
SKIPE DBUGIT
PUSHJ PP,TRACSZ ;DISPLAY RECORD SIZE
SKIPE DBUGIT
PUSHJ PP,TRACH ;DISPLAY CHARACTER
>
TRZE SW,ONEBYT ;REQUEST ONE BYTE?
JRST [SOS INPSIZ ;DECREMENT INPUT COUNT
POPJ PP, ] ; & RETURN
SOS INPSIZ
JRST GTDAT0 ; GET REST OF REC
GETDA1: TLO SW,(FENDL) ;END OF LINE
CAIE IM,AS.MOD ;ASCII?
POPJ PP,
IBP INPTR ;SKIP CRLF
IBP INPTR
POPJ PP,
; GET A BYTE FROM EBCDIC FIXED INPUT FILE
;NEED ANOTHER BUFFER
READ: AOS CH,ISECC
SKIPE INPBLK ;IS INPUT BLOCKED?
JRST READ2 ;YES
READ1: IN IF1, ;NO
POPJ PP,
STATZ IF1,$ERA ;IS IT AN ERROR?
JRST REDERA ;YES
TLNE SW,(FDSK) ;TEST FOR DSK
JRST READ5 ;SINCE NUL: HAS BOTH DSK AND MTA BITS SET
TLNE SW,(FMTA) ;MAGTAPE?
JRST READ4 ;TELL HIM ABOUT IT
READ5: TLO SW,(FEOF!FENDIB!FENDL) ;NO--END-OF-FILE
JRST READ3
READ2: TLNE SW,(FDSK) ;NO--IS INPUT FROM DISK?
CAMG CH,INPSEC ;YES--HAVE WE READ ENOUGH SECTORS?
JRST READ1 ;NO
TLO SW,(FENDIB!FENDL) ;NO--END-OF-LINE AND END-OF-BLOCK
READ3: MOVEI CH,0
POPJ PP,
READ4: TRNN SW,OPT.L ;LABELS?
JRST READ5 ;NOPE
CLOSE 3, ;RESET EOF STUFF
IN IF1, ;INPUT TRAILER
JRST READ6 ;LOOKS GOOD
STATZ IF1,$ERA ;LOOKS BAD CHECK ERRORS
JRST REDERA ;ERROR!!
JRST READ5 ;EOF---TWO IN A ROW
;ASSUME END OF FILE
READ6: MOVE CH,INPSIZ ;GET CURRENT CHAR COUNT
MOVEM CH,SIZSAV ;SAVE IT
PUSHJ PP,LAB.10 ;CHECK LABEL AND CONVERT ASCII
;TO SIXBIT IF NECESSARY
LDB CH,[POINT 24,STDLBL,23]
CAMN CH,[SIXBIT " EOF1"] ;WAS IT EOF TRAILER?
JRST READ5 ;YES--END OF FILE
CAMN CH,[SIXBIT " HDR1"] ;WAS IT A HEADER?
JRST [TYPE ("%Header as trailer?, assuming end-of-file")
JRST READ5]
CAME CH,[SIXBIT " EOV1"] ;WAS IT VOLUME TRAILER?
JRST [TYPE ("%Illegal trailer record, assuming end-of-file")
JRST READ5]
SKIPN AUTOLB ;MONITOR CONTROL?
JRST [TYPE ($-End of input reel, mount next and cont..)
CLOSE IF1, ;RESET EOF
MTUNL. IF1, ;REWIND
EXIT 1 ;WAIT FOR RESPONSE
JRST READ7 ];& CONTINUE
PUSHJ PP,VOLSWT ;YES, LET MONITOR DO IT
READ7: PUSHJ PP,READ1 ;GET FIRST RECORD
PUSHJ PP,LAB.10 ;MAKE SURE LEGAL FILE ETC
MOVE CH,SIZSAV ;GET CHAR COUNT
MOVEM CH,INPSIZ ;STUFF IT WHERE IT BELONGS
JRST READ1 ;GO BACK INTO THE SWING OF THINGS
;PUT A CHARACTER INTO DATA-FILE BUFFER
PUTBYT: SOSG OF2BUF+2
PUSHJ PP,WRITE
IDPB CH,OF2BUF+1
POPJ PP,
; WRITE OUT A SECTOR OF DATA-FILE
WRITE: AOS DATLOC
AOS OSECC
TRNE SW,OPT.P ;DON'T FORCE FULL BUFFER FOR /P
JRST WRITE2
PUSH PP,CH ;WE
MOVE CH,OF2BUF ; WILL
ADD CH,OF2SIZ ; [142] ADD IN BUFFER SIZE
HLL CH,OF2BUF+1 ; WRITE
TLZ CH,770000 ; 128
MOVEM CH,OF2BUF+1 ; WORDS
WRITE1: POP PP,CH ; [EDIT#101]
WRITE2: OUT OF2,
POPJ PP,
TLNN SW,(FMTA) ;IS IT MAGTAPE?
JRST DATERA ;NO..DO THE SAME OLD THING
GETSTS OF2,TC ;GET FILE STATUS
TRZN TC,FEOT ;PHYSICAL END-OF-TAPE?(RESET)
JRST DATERA ;NO..ONCE AGAIN..
SETSTS OF2,(TC) ;YES, RESET EOT FLAG & CONTINUE
PUSHJ PP,SAVAC ;SAVE REGS
PUSHJ PP,VLABEL ;GO WRITE VOL LABEL
PUSHJ PP,RESAC ;RESTORE REGS
CLOSE OF2, ;CLEAR EOT/WRITE EOF
SKIPE ,AUTOLB ;MONITOR CONTROL?
JRST WRITE3 ; YES, LET MONITOR DO IT
TYPE ($-End of output reel, mount next and cont)
MTUNL. OF2, ;AND UNLOAD THE TAPE
EXIT 1, ;HOLD IT UP AND WAIT FOR RESPONSE
JRST WRITE4 ;GO PROCESS LABELS
WRITE3: PUSHJ PP,VOLSWT ;CHANGE REELS
WRITE4: PUSHJ PP,SAVAC ;SAVE REGISTERS
PUSHJ PP,LABEL ;PUT LABELS
JRST RESAC ;RESTORE REGISTERS & RETURN
;READ IN 1 BLK OF INDEX AT CURRENT LEVEL
IDXREA: MOVN TA,IDXSIZ ;WORD COUNT
HRLS TA
HRR TA,IDXLIN-1(IX) ;LOCATION
SUBI TA,1
MOVEI TB,0 ;END OF ARGS
IN IF1,TA
JRST IDXRE1
STATZ IF1,$ERA
JRST STATER ;ERROR
TLO SW,(FEOF!FENDIB!FENDL) ;END-OF-FILE
POPJ PP,
IDXRE1: MOVEI TA,1 ;INIT ENTRY COUNT
MOVEM TA,IDXFLG-1(IX)
MOVEI TA,2
MOVEM TA,IDXWIN-1(IX) ;POSITION OF 1ST ENTRY
MOVE TA,IDXLIN-1(IX)
MOVE TB,(TA)
MOVEM TB,IBW1 ;1ST BLK HEADER WD
MOVE TB,1(TA)
MOVEM TB,IBW2 ;2ND WORD OF BLK HEADR
; NOW MAKE CHECK TO MAKE SURE THAT VERSION NUMBERS ARE CORRECT
CAME IX,LEVELS+I ;ARE WE ALREADY AT TOP LEVEL? (NO VERSION NUM)
CAMN TB,IDXHD2 ; IS BLK VERSION SAME AS IDX ENTRY VERSION?
POPJ PP, ; YES, ALL OK, CONT
; ERROR CASE , VERSION NUMBERS DON'T MATCH
TRNE SW,OPT.C+OPT.I ; IS THIS /CHECK OR /IGNORE?
PJRST IVERWR ; YES,GIVE WARNING AND
; POPJ RETURN TO IDXREA CALLER
; ERROR, GIVE MESSAGE AND RESTART
PUSHJ PP,IVERER ; MESSAGE
JRST START ; AND RESTART
; CHECK OR IGNORE, GIVE WARNING AND TRY TO CONTINUE
; PRINT OUT IDX VERSION NUMBER ERROR MESSAGES
IVERER: ; ERROR CASE GIVE ? ERROR
TYPE (
?)
JRST IVRWR1
IVERWR: TYPE (
%)
IVRWR1: TYPE (ISMIVD Index version number discrepency .)
TYPE (
Reading index file )
PUSHJ PP,TYINF1 ; PRINT PRIMARY INPUT FILE NAME
TYPE (
Index level )
MOVEI TE,1(IX) ; GET LEVEL OF UPPER BLK
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( index block )
MOVE TE,CURIDX+1(IX) ; GET INDEX BLOCK NUMBER
; ACCOUNT FOR IX INCREMENTED AND UP 1 MORE
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( entry )
MOVE TE,IDXFLG+1 ; GET ENTRY NUMBER AT IDX LEVEL ABOVE
SUBI TE,1 ; ACCOUNT FOR LAST INCREMENT
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( version number )
MOVE TE,IDXHD2 ; GET HIGHER VERSION NUMBER
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( points to
)
TYPE ( Index block )
MOVE TE,IDXHD1 ; GET CURRENT INDEX BLOCK NUMBER
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( version number )
MOVE TE,TB ; GET LOWER VERSION NUMBER
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( .
)
POPJ PP, ; RETURN
;READ IN 1 BLK OF INDEXED DATA FILE
DATREA: MOVN TA,INSIZ ;WORD COUNT
HRLS TA
HRR TA,INDAT ;LOCATION
SUBI TA,1
MOVEM TA,INPTR ;INIT INPTR FOR GETREC
MOVEI TB,0
IN IF2,TA
TRNA ;NO ERRORS
JRST DATERR ;ERROR
SETZM DATFLG ;CLR RECORD USED CTR
; CHECK DATA BLOCK VERSION NUMBER AGAINST IDX BLOCK
; THAT POINTS TO IT
HLRZ TA,@INDAT ; GET DATA VERSION NUMBER FROM FIRST ENTRY
TRZ TA,-100 ; CLEAR FILE FORMAT INFO
CAMN TA,IDXHD2 ; IS IT THE SAME AS THAT FROM IDX BLK?
POPJ PP, ; YES, ALL OK
; ERROR CASE , VERSION NUMBERS DON'T MATCH
TRNE SW,OPT.C+OPT.I ; IS THIS /CHECK OR /IGNORE?
PJRST DVERWR ; YES, GIVE WARNING AND
; POPJ RETURN TO DATREA CALLER
; ERROR, GIVE MESSAGE AND RESTART
PUSHJ PP,DVERER ; MESSAGE
JRST START ; AND RESTART
; CHECK OR IGNORE, GIVE WARNING AND TRY TO CONTINUE
; GIVE DATA FILE VERSION NUMBER MESSAGE
DVERER: ; ERROR CASE GIVE ? ERROR
TYPE (
?)
JRST DVEWR1
DVERWR: TYPE (
%)
DVEWR1: TYPE (ISMDVD Data version number discrepency .)
TYPE (
Reading data file )
PUSHJ PP,TYINF2 ; PRINT SECONDARY INPUT FILE NAME
TYPE ( from index file )
PUSHJ PP,TYINF1 ; PRINT PRIMARY INPUT FILE NAME
TYPE (
Index block )
MOVE TE,CURIDX+1 ; GET INDEX BLOCK NUMBER AT BOTTOM LEVEL
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( entry )
MOVE TE,IDXFLG+1 ; GET ENTRY NUMBER AT IDX LEVEL ABOVE
SUBI TE,1 ; ACCOUNT FOR LAST INCREMENT
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( version number )
MOVE TE,IDXHD2 ; GET HIGHER VERSION NUMBER
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( points to
)
DTBLK: TYPE ( Data block )
MOVE TE,IDXHD1 ; GET CURRENT INDEX BLOCK NUMBER
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( version number )
HLRZ TE,@INDAT ; GET DATA VERSION NUMBER FROM FIRST ENTRY
TRZ TE,-100 ; CLEAR FILE FORMAT INFO
PUSHJ PP,PUTPNT ; TYPE IT
TYPE ( .
)
POPJ PP, ; NOW RETURN
;SAVE AC'S 0-16
SAVAC: MOVEM 16,SAVEAC+16
MOVEI 16,SAVEAC
BLT 16,SAVEAC+15
POPJ PP,
;RESTORE AC'S 0-16
RESAC: MOVSI 16,SAVEAC
BLT 16,15
MOVE 16,SAVEAC+16
POPJ PP,
; FORM SIXBIT DATE (IN TA AND TB - TA IS ACTIVE, TB PASSIVE)
LAB.SX: IDIVI TD, ^D10
ROTC TA, -6 ; SHIFT WHAT WE'VE GOT
MOVEI TA, 20(TE) ; ADD LOW ORDER DIGIT
ROTC TA, -6 ;
MOVEI TA, 20(TD) ; TOP DIGIT
POPJ PP,
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
RECDBF: ;SHOW RECOMENED BLOCKING FACTOR FOR THE DATA FILE
PUSHJ PP,SAVAC ;GO SAVE AC'S
MOVEI TA,^D1000 ;LOAD WITH MAX % OF WASTE THERE CAN BE 100.0%
MOVEM TA,DATPCN ;AND REMEMBER FOR LATER
;BL; 2 LINES MOVED FROM RECDB1-2 TO RECDBF+4
TRNE SW,OPT.S ;SEE IF WE ARE SHOWING STATS
PUSHJ PP,STTIT ;IF YES SHOW COLUMN HEADERS
MOVEI TB,1 ;START WITH 1 DISK BLOCK/LOGICAL DATA BLOCK
IFN TOPS20,<
TRNE SW,OPT.OP ;WANT OUTPUT IN PAGES?
MOVEI TB,4 ; YES
> ;END IFN TOPS20
;BL; 2 LINES MOVE FROM RECDBF+4 TO RECDB1
RECDB1: MOVE TA,RECSIZ ;GET RECORD SIZE IN WORDS
ADDI TA,1 ;ADD 1 FOR OVERHEAD CHARACTER COUNT
MOVEI TC,^D128 ;LOAD # WORDS/DISK BLOCK
IMUL TC,TB ;GET TOTAL # WORDS AVAIL IN DATA BLOCK
IDIV TC,TA ;CALC # RECORDS THAT WILL FIT
PUSHJ PP,CLPCN ;GET % OF WASTE
TRNE SW,OPT.S ;SEE IF STATS WANTED
PUSHJ PP,SHWSTA ;SHOW THEM IF SO
CAMGE TE,DATPCN ;CHECK IF FEWER % WASTED
PUSHJ PP,SAVDBF ;YES - GO SAVE NEW VALUES
ADDI TB,1 ;INCREMENT # OF DISK BLOCKS TO USE
IFN TOPS20,<
TRNE SW,OPT.OP ;WANT OUTPUT IN PAGES?
ADDI TB,3 ; YES
>
CAIG TB,IDALIM ;BUT LIMIT IT AT SITE LIMIT
JRST RECDB1 ;IF NOT DONE LOOP THRU AGAIN
SHWDBF: TLNE SW,(INDIR) ; INDIR CMD FILE?
POPJ PP, ; YES, SKIP RECOMMENDATIONS
TYPE (<(>) ;TYPE LEFT PAREM
TYPE (Recommended = )
PUSHJ PP,RESAC ;RESTORE AC'S HERE SO TE WILL BE RETURNED WITH CORRECT VALUE
;BL; 1 CHANGED AT SHWDBF+5
MOVE TE,RECBLK ;GET RECOMMENDED BLOCKING VALUE
PUSHJ PP,PUTDEC ;SHOW IT TO USER
TYPE (<)>) ;TYPE RIGHT PAREN
TYPE (: )
POPJ PP, ;THEN JUST RETURN
SAVDBF: MOVEM TC,RECBLK ;SAVE NEW BLOCKING FACTOR
MOVEM TC,IDABF
MOVEM TE,DATPCN ;SAVE NEW LOW % WASTED SPACE
MOVEM TD,DATWST ;SAVE # OF WORDS WASTED
MOVEM TB,DATBLS ;REMEMBER # OF PHYS DATA BLOCKS USED
SKIPE DATWST ;IF WASTE = 0 WE KNOW BEST BLOCKING FACTOR
POPJ PP, ;IF NOT JUST RETURN
POP PP,TD ;FIX UP THE STACK
JRST SHWDBF ;GO SHOW RECOMMENDED VALUE
CLPCN: PUSH PP,TD ;CALC % WASTED SPACE TO ONE DECIMAL RETURN AS INTEGER IN TE
IMULI TD,^D1000 ;ROUND TO 1 DECIMAL
MOVE TF,TB
IMULI TF,^D128 ;GET TOTAL WORDS USED
IDIV TD,TF ;GET %
LSH TE,1 ;SEE IF WE MUST ROUND
CAML TE,TF
AOS TD ;YES SO ROUND UP
MOVE TE,TD ;RETURN IT IN TE
POP PP,TD ;RESTORE WASTED WORDS
POPJ PP,
RECIBF: ;SHOW RECOMMENDED BLOCKING FACTOR FOR THE INDEX FILE
PUSHJ PP,SAVAC ;GO SAVE AC'S
MOVEI TA,^D1000 ;LOAD UP MAXIMUM WASTED % THAT CAN BE 100.0%
MOVEM TA,IDXPCN ;AND REMEMBER FOR LATER
;BL; 2 LINES MOVED FROM RECIB1-2 TO RECIBF+4
TRNE SW,OPT.S ;SEE IF WE NEED COLUMN HEADERS
PUSHJ PP,STTIT ;YES GO GIVE THEM
MOVEI TB,1 ;START WITH 1 DISK BLOCK/LOGICAL INDEX BLOCK
IFN TOPS20,<
TRNE SW,OPT.OP ;WANT OUTPUT IN PAGES?
MOVEI TB,4 ;YES
> ;END TOPS20
;BL; 1 LINE MOVED FROM RECIBF+4 TO RECIB1
RECIB1: MOVE TA,SIZIDX ;GET INDEX ENTRY SIZE IN WORDS
MOVEI TC,^D128 ;LOAD # WORDS/DISK BLOCK
IMUL TC,TB ;GET TOTAL # WORDS AVAIL IN INDEX BLOCK
SUBI TC,2 ;REMOVE THE TWO OVERHEAD WORDS PER INDEX BLOCK
IDIV TC,TA ;CALC # RECORDS THAT WILL FIT
PUSHJ PP,CLPCN ;GET WASTED PERCENTAGE
TRNE SW,OPT.S ;SEE IF STATS ARE NEEDED
PUSHJ PP,SHWSTA ;YES SO GIVE THEM
CAMGE TE,IDXPCN ;CHECK IF FEWER WASTED PERCENTAGE
PUSHJ PP,SAVIBF ;YES - GO SAVE NEW VALUES
ADDI TB,1 ;INCREMENT # OF DISK BLOCKS TO USE
IFN TOPS20,<
TRNE SW,OPT.OP ;WANT OUTPUT IN PAGES?
ADDI TB,3 ; YES
>
CAIG TB,IDXLIM ;BUT LIMIT IT AT SITE'S LIMIT
JRST RECIB1 ;IF NOT DONE LOOP THRU AGAIN
JRST SHWIBF ;ELSE SHOW CHOSEN BLOCKING FACTOR
SAVIBF: MOVEM TC,RECBLK ;SAVE NEW BLOCKING FACTOR
MOVEM TC,IDXBF
MOVEM TE,IDXPCN ;SAVE PERCENTAGE WASTED
MOVEM TD,IDXWST ;SAVE # OF WORDS WASTED
MOVEM TB,IDXBLS ;REMEMBER # OF PHYS INDEX BLOCKS USED
SKIPE IDXWST ;IF WASTE = 0 WE KNOW BEST BLOCKING FACTOR
POPJ PP, ;IF NOT JUST RETURN
POP PP,TD ;FIX UP THE STACK
SHWIBF: TLNE SW,(INDIR) ; INDIR CMD FILE?
POPJ PP, ; YES, SKIP RECOMMENDATION
TYPE (<(>) ;TYPE LEFT PAREN
TYPE (Recommended = )
PUSHJ PP,RESAC ;RESTORE AC'S HERE SO TE WILL BE RETURNED WITH CORRECT VALUE
;BL; 1 CHANGED AT SAVIBF+5
MOVE TE,RECBLK ;GET RECOMMENDED BLOCKING FACTOR
PUSHJ PP,PUTDEC ;SHOW IT TO USER
TYPE (<)>) ;TYPE RIGHT PAREN
TYPE (: )
POPJ PP, ;THEN JUST RETURN
STTIT: ;GIVE COULMN HEADERS FOR THE STATS BEING PRINTED
TYPE (
Records Disk Wasted Memory
/block Blocks space (wds)
) ;GIVE INITIAL CR-LF BEFORE SHOWING THEM
POPJ PP,
SHWSTA: ;SHOW FIGURES AS THEY ARE BEING CALCULATING
TYPE ( ) ;GIVE A TAB
PUSH PP,TE ;SAVE % WASTED SPACE UNTIL NEEDED
MOVE TE,TC ;SHOW BLOCKING FACTOR USED
PUSHJ PP,PUTDEC
TYPE ( ) ;SPACE IT OUT A BIT
MOVE TE,TB ;SHOW DISK BLOCKS NEEDED
PUSHJ PP,PUTDEC
TYPE ( ) ;MORE SPACE
MOVE TE,(PP) ;GET % WASTE BACK
IDIVI TE,^D10 ;GET TO DECIMAL
PUSH PP,TF ;SAVE REMAINDER
PUSHJ PP,PUTPNT ;GO PRINT IT
; AND DECIMAL POINT
POP PP,TE ;NOW GET REMAINDER BACK
PUSHJ PP,PUTDEC
TYPE (% )
MOVE TE,TB ;GET TOTAL BLOCKS USED AGAIN
LSH TE,7 ;CONVERT TO WORDS
PUSHJ PP,PUTDEC ;TELL HOW MANY NEEDED
TYPE (
)
POP PP,TE ;RESTORE % OF WASTED SPACE
POPJ PP, ;THEN RETURN
>;END OF IFN $CU001
IFN TOPS20,<
ASCNAM: HRLZI TB,OF2 ;DATA-FILE CHANNEL
MOVE TA,[1,,TB] ;1 ARG IN TB
HRRI TB,CMPJFN ;FUNCTION
COMPT. TA, ;GET JFN
JRST [TYPE (ERROR ON GETJFN
)
JRST START ]; RETRY
HRRZ TB,TA ;JFN TO TB
HRROI TA,NAME20 ;DESTINATION
MOVE TC,[111110,,1] ;GET ALL PARTS OF SPEC WITH PUNCT
HLLZI TD, ;CLEAR
JFNS ;FILE-SPEC TO INDEX BLOCK
POPJ PP, ;RETURN
> ;END IFN TOPS20
SUBTTL TOPS20 MONITOR LABELING CHECK ROUTINE
CKLBL: TLNN SW,(FMTA) ;MAG TAPE?
JRST NLBRTN ;RESET /L & RETURN
IFN TOPS20,<
HRLZI TB,IF1 ;CHANNEL FOR JFN REQUEST
TRNN SW,OPT.B ;CORRECT ONE (BUILD/INPUT)?
HRLZI TB,OF2 ;NO, IT'S PACK/OUTPUT
MOVE TA,[1,,TB] ;ONE ARGUMENT IN TB
HRRI TB,CMPJFN ;FUNCTION
COMPT. TA, ;GET JFN ***********
JRST [ TYPE (Error on GETJFN
)
JRST START ] ;MESSAGE & RETRY
HRRZ TA,TA ;ZERO LEFT SIDE/TA
MOVEM TA,MTAJFN ;SAVE JFN
SETZM MTOBLK ;ZERO 1ST WORD
MOVE TB,[MTOBLK,,MTOBLK+1] ;INIT BLOCK POINTER
BLT TB,MTOBLK+MTOBSZ ;INIT BLOCK
MOVEI TC,MTOBLK ;ADDR OF BLOCK
MOVEI TB,MTOBSZ ;WORD COUNT
MOVEM TB,MTOBLK ;STORE COUNT
MOVEI TB,.MORLI ;READ LABEL FUNCTION
MTOPR ;GET LABEL INFO ******
ERJMP MTOPER ;GO CHECK ERROR
SETOM AUTOLB ;SET AUTO LABEL SW
MOVE TB,MTOBLK+1 ;LOAD LABEL TYPE
CAIE TB,1 ;UNLABELED?
JRST NLBRTN ; NO, GO RESET /L & RETURN
POPJ PP,
MTOPER: MOVEI TA,.FHSLF ;CURRENT PROCESS
GETER ;LAST ERROR #/RH TB
CAME TB,[.FHSLF,,MTOX1] ;INVALID FUNCTION? (VER. 4)
JRST MTOERR ; NO, MTOPR ERROR, RESTART
POPJ PP,
MTOERR: TYPE (Error on MTOPR
)
JRST START ;GO TRY AGAIN
> ;END OF IFN TOPS20
IFE TOPS20,<
MOVE TA,[%SITLP] ;PID FOR TAPE LABEL
GETTAB TA,
POPJ PP, ;ERROR, NO AUTO LABELING
SKIPN ,TA ;DO WE HAVE PULSAR?
POPJ PP, ;RETURN IF NO
MOVE TA,[XWD 3,TB] ;3 WORDS, START IN TB
MOVEI TB,.TFLBL ;FUNCTION-READ LABEL TYPE
MOVE TC,MTACHN ;LOAD CHANNEL
TAPOP. TA, ;GET LABEL TYPE
JRST TFUERR ;ERROR ON CALL
CAIN TD,.TFLBP ;LABEL BYPASS?
POPJ PP, ; YES, NO AUTO LABEL
SETOM AUTOLB ;SET AUTO LABLING SW
CAIE TD,.TFLNL ;UNLABELED?
> ;END IFE TOPS20
NLBRTN: TRZ SW,OPT.L ; NO COBOL LABELS IF NO
POPJ PP, ;RETURN
SUBTTL MTA VOLUME-SWITCHING ROUTINE
VOLSWT:
; THIS IS A ROUTINE TO SWITCH MTA REELS WHEN UNDER MONITOR
; CONTROL, BUT WITHOUT LABELING.
IFN TOPS20,<
TRNN SW,OPT.P ;WRITING?
JRST VOLSW1 ; NOT CLOSED IF NO
MOVE TA,MTAJFN ;LOAD JFN
MOVE TB,[440000,,100000] ;36 BIT, WRITE ACCESS
OPENF ;OPEN FOR MTOPR
ERJMP VSWER1 ;MESSAGE, RESTART
VOLSW1: MOVE TA,MTAJFN ;LOAD JFN
MOVEI TB,.MOVLS ;VOLUME SWITCH MTOPR
MOVEI TC,3 ;3 WORD ARGUMENT
MOVEI TD,.VSMRV ;MOUNT RELATIVE VOLUME #
MOVEI TE,1 ;NEXT VOLUME
MTOPR ;PERFORM SWITCH *********
ERJMP VSWER2 ; ERROR, MESSAGE & RESTART
POPJ PP, ;RETURN
VSWER1: TYPE (%VSWER1: Volume switching error-OPENF
)
JRST START ; & RESTART
VSWER2: TYPE (%VSWER2: Volume switching error-MTOPR
)
JRST START ; & RESTART
> ;END IFN TOPS20
IFE TOPS20,<
MOVE TA,[2,,2] ;2 WORDS, START TB
MOVEI TB,.TFFEV ;END-OF-VOLUME
MOVE TC,MTACHN ;CHANNEL ID
TAPOP. TA, ;LET MONITOR CHANGE REELS
JRST VSWER1 ;MESSAGE & RESTART
POPJ PP, ;RETURN
VSWER1: TYPE (%VSWER1: Volume switching error-TAPOP
)
JRST START ; & RESTART
> ;END IFE TOPS20
SUBTTL IMPURE AREA
RELOC
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
RECBLK: BLOCK 1 ;RECOMMENDED BLOCKING FACTOR
IDABF: BLOCK 1 ;PLACE TO SAVE BLOCKING FACTOR FOR DATA FILE USED TO
;REPORT FINAL STAS
DATWST: BLOCK 1 ;TOTAL WASTED WORDS FOR BLOCKING FACTOR CHOSEN
DATBLS: BLOCK 1 ;NUMBER OF PHYS DATA BLOCKS PER LOGICAL DATA BLOCK
DATPCN: BLOCK 1 ;% OF WASTED SPACE AS INTEGER
IDXBF: BLOCK 1 ;PLACE TO SAVE BLOCKING FACTOR FOR INDEX FILE USED
;TO REPORT FINAL STATS
IDXWST: BLOCK 1 ;WASTED WORDS PFOR BLOCKING FACTOR
IDXBLS: BLOCK 1 ;# OF PHYS BLOCKS IN LOGICAL INDEX BLOCK
IDXPCN: BLOCK 1 ;% OF WASTED SPACE AS INTEGER (1 DECIMAL PLACE)
>;END OF IFN $CU001
SIZSAV: BLOCK 1
OREENO: SIXBIT /0000/
TTYKAR: BLOCK 1 ;IF NON-ZERO, THIS IS THE NEXT TTY INPUT CHARACTER
PATCH: BLOCK 40
DBUGIT: BLOCK 1 ;SET TO NON-ZERO FOR TRACE
FUSI: 0,,11 ; ARG BLOCK FOR FILOP. TYPE USETI
BLOCK 1 ; DITTO
CMBFSZ==3
CMDBUF: BLOCK CMBFSZ ;BUFFER HEADER FOR INDIRECT COMMAND FILE
LOWCOR: BLOCK 0 ;BASE OF IMPURE AREA (EXCEPT TTYKAR)
;INPKAR: BLOCK 1 ;IF NON-ZERO, THIS IS THE NEXT INPUT CHARACTER
;BL; 6 LINES RELOCATED TO LOWCOR+1 TO FIX PARTIAL ALLOCATION BUG
IFN $CU001,< ;MAKE ISAM MORE INTELLIGENT
IF1LB: BLOCK .RBALC+1 ;AREA FOR EXTENDED LOOKUP FOR SIZE CALC
OF1EB: BLOCK .RBALC+1 ;AREA FOR EXTENDED ENTER FOR IDX FILE
OF2EB: BLOCK .RBALC+1 ;AREA FOR EXTENDED ENTER FOR IDA FILE
CLLVLS: BLOCK 1 ;AREA TO SAVE # OF CALCULATED LEVELS
>;END OF IFN $CU001
FILDAT: BLOCK BUFADR ;GENERAL FILE DISCRIPTION PARAMETERS
OF1DAT: BLOCK BUFADR ;PARAMETERS FOR PRIMARY OUTPUT FILE
OF1BUF: BLOCK 3 ;BUFFER HEADER FOR 1ST OUTPUT FILE
IFN TOPS20,<OF1AZB: BLOCK 15 >;[154] TOPS20 ASCIZ FILE SPEC
OF2DAT: BLOCK BUFADR ;PARAMETERS FOR SECONDARY OUTPUT FILE
OF2BUF: BLOCK 3 ;BUFFER HEADER FOR 2ND OUTPUT FILE
IF1DAT: BLOCK BUFADR ;PARAMETERS FOR PRIMARY INPUT FILE
IF1BUF: BLOCK 3 ;BUFFER HEADER FOR 1ST INPUT FILE
IF2DAT: BLOCK BUFADR ;PARAMETERS FOR SECONDARY INPUT FILE
IF2BUF: BLOCK 3 ;BUFFER HEADER FOR 2ND INPUT FILE
;CMDBUF: BLOCK 3 ;BUFFER HEADER FOR INDIRECT COMMAND FILE
TTYBUF: BLOCK 4 ;[155] BUFFER FOR TTY OUTPUT
AUTOLB: BLOCK 1 ; -1 IF MONITOR HAS LABEL PROCESSING FACILITY
OF2SIZ: BLOCK 1 ; [142] BUFFER SIZE FOR /P OUTPUT
MYPPN: BLOCK 1 ; [143] USERS PPN
PPLIST: BLOCK PPSIZE ;PUSH-DOWN LIST
INPBLK: BLOCK 1 ;BLOCKING FACTOR OF INPUT FILE
IDXLOC: BLOCK ^D10 ;ADDRESS IN FREE STORAGE FOR INDEX BLOCK
IDXWRD: BLOCK ^D10 ;RELATIVE WORD WITHIN INDEX BLOCK FOR NEXT KEY
IDXEIB: BLOCK ^D10 ;NUMBER OF ENTRIES IN INDEX BLOCK
IDXLIN: BLOCK ^D10 ;SAME AS IDXLOC BUT FOR INPUT
IDXWIN: BLOCK ^D10 ; " " IDXWRD " " "
IDXEIN: BLOCK ^D10 ; " " IDXEIB " " "
IDX1KY: BLOCK ^D10 ;SET TO 1 AFTER 1ST KEY WRITTEN AT EACH LVL
CURIDX: BLOCK ^D11 ; BLOCK NUMBER OF ACTIVE INDEX ENTRY AT EACH LEVEL
DATFLG: BLOCK 1 ;CURRENT ENTRY IN DATA BLK (INPUT)
IDXFLG: BLOCK ^D10 ;CURRENT ENTRY IN EACH INDEX BLK (INPUT)
ISECC: BLOCK 1 ;COUNT OF SECTORS READ IN CURRENT BLOCK
OSECC: BLOCK 1 ;COUNT OF SECTORS WRITTEN IN DATA FILE
IRLEFT: BLOCK 1 ;RECORDS LEFT IN INPUT BLOCK
ORLEFT: BLOCK 1 ;RECORDS LEFT TO FILL IN DATA BLOCK
OLDKEY: BLOCK 1 ;ADDRESS OF OLD KEY VALUE
NEWKEY: BLOCK 1 ;ADDRESS OF NEW KEY VALUE
INKEY: BLOCK 1 ;PTR TO INPUT KEY
SIZKEY: BLOCK 1 ;SIZE OF KEY IN WORDS
RECPTR: BLOCK 1 ;POINTER TO IN-CORE RECORD
DATSEC: BLOCK 1 ;NUMBER OF SECTORS IN DATA BLOCK
INPSEC: BLOCK 1 ;NUMBER OF SECTORS IN INPUT BLOCK
INPSIZ: BLOCK 1 ;SIZE OF CURRENT INPUT RECORD, IN BYTES
GDPARM: BLOCK 1 ;PARAMETER FOR 'GD6.' OR 'GD7.' CALL
SAVEAC: BLOCK 17 ;SAVE AREA FOR AC'S 0-16
DATLOC: BLOCK 1 ;NUMBER OF NEXT DATA SECTOR
DATLOK: BLOCK 1 ;NUMBER OF 1ST SECTOR OF CURRENT BLOCK
OUTLST: BLOCK 2 ;OUTPUT LIST FOR WRTING INDEX BLOCK
IDXOUT: BLOCK 1 ;NUMBER OF INDEX BLOCKS WRITTEN
NB1SB: BLOCK 1 ;NUMBER OF BITS IN ONE SAT BLOCK
NBWRIT: BLOCK 1 ;NUMBER OF 1-BITS WRITTEN INTO SAT
DATRIT: BLOCK 1 ;NUMBER OF DATA RECORDS PER BLOCK TO USE
IDXRIT: BLOCK 1 ;NUMBER OF INDEX ENTRIES PER BLOCK TO USE
LASTKB: BLOCK 1 ;SMALLEST RECORD SIZE WHICH CONTAINS KEY
FRSTKB: BLOCK 1 ;BYTE POSITION OF FIRST BYTE IN KEY
SAVSTH: BLOCK 1 ;TEMP TO SAVE 'STHDR' WHILE WRITING SATS
MUCHO: BLOCK 1 ;NUMBER OF DATA RECORDS WRITTEN
INDAT: BLOCK 1 ;PTR TO INPUT DATA BLK FOR /P OR /M
INSIZ: BLOCK 1 ;SIZE OF INPUT DATA BLK FOR /P OR /M
IDXSIZ: BLOCK 1 ;# WORDS/INPUT INDEX BLK
IDXHD1: BLOCK 1 ;1ST HEADER WORD OF INDEX ENTRY
IDXHD2: BLOCK 1 ;2ND "
IBW1: BLOCK 1 ;1ST HEADER WD OF INDEX BLK
IBW2: BLOCK 1 ;2ND "
NDATBT: BLOCK 1 ;TEMPORARY NDATB WHILE WRITING SAT BLKS
INPTR: BLOCK 1 ;BYTE PTR TO INDEXED DATA INPUT RECORD
IFN TOPS20,<
MTOBLK: BLOCK MTOBSZ+1 ;ARGUMENT BLOCK FOR MTOPR
MTAJFN:
> ;END IFN TOPS20
IFE TOPS20,<
MTACHN:
> ;END IFE TOPS20
BLOCK 1 ;STORE MAG-TAPE JFN/CHANNEL
STDLBL: BLOCK 15 ; BLOCK FOR STANDARD LABEL (/L OPTION)
SA.CRE: BLOCK 1 ; SAVE CREATION DATE OF IF1 (FOR PACK)
CONVRT: BLOCK 1 ;BYTE POINTER TO CONVERT FROM INPUT TO OUTPUT
;MODE
GETFB: BLOCK 1 ;ADDRESS OF GET FIRST BYTE ROUTINE
GETBYT: BLOCK 1 ;ADDRESS OF NORMAL GET BYTE ROUTINE
FINREC: BLOCK 1 ;ADDRESS OF END OF RECORD PROCESSING ROUTINE
DATBPB: BLOCK 1 ;EBCDIC VARIABLE LENGTH BYTES PER BLOCK - OUTPUT
INPBPB: BLOCK 1 ;INPUT
OBPBCT: BLOCK 1 ;BYTES PER BLOCK COUNTER - OUTPUT
IBPBCT: BLOCK 1 ;INPUT
ALLNUL: BLOCK 1 ;[147] EBCDIC ALL NULL INDICATOR
CVARGS: BLOCK 2 ; CONVERSION ARGUMENTS INCASE ERRORS
; (This variable is referenced by GD).
;STATISTICS BLOCK FOR OUTPUT INDEX FILE
STHDR: BLOCK 1 ;HEADER WORD
STDEV: BLOCK 1 ;DEVICE NAME FOR DATA FILE
STNAM: BLOCK 1 ;FILE-NAME FOR DATA FILE
STEXT: BLOCK 1 ;FILE-EXTENSION FOR DATA-FILE
CREATE: BLOCK 1 ;DATE DATA-FILE CREATED
ACCDAT: BLOCK 1 ;ACCESS DATE FOR DATA-FILE
LEVELS: BLOCK 1 ;NUMBER OF INDEX LEVELS
DATBLK: BLOCK 1 ;BLOCKING FACTOR OF DATA FILE
EMPDAT: BLOCK 1 ;NUMBER OF EMPTY RECORDS PER DATA BLOCK
IDXBLK: BLOCK ^D10 ;NUMBER OF ENTRIES PER INDEX BLOCK
EMPIDX: BLOCK ^D10 ;NUMBER OF EMPTY ENTRIES PER INDEX BLOCK
NDATB: BLOCK 1 ;NUMBER OF DATA BLOCKS IN FILE
NDATBE: BLOCK 1 ;NUMBER OF EMPTY DATA BLOCKS IN FILE
NSECI: BLOCK 1 ;NUMBER OF SECTORS IN INDEX FILE
NSECIE: BLOCK 1 ;NUMBER OF EMPTY SECTORS IN INDEX FILE
FEISEC: BLOCK 1 ;FIRST EMPTY INDEX SECTOR
RECSIZ: BLOCK 1 ;SIZE OF LARGEST DATA RECORD, IN WORDS
RECKEY: BLOCK 1 ;POINTER TO RECORD KEY
NUMOPS: BLOCK 1 ;NUMBER OF I/O OPERATIONS
NUMUUO: BLOCK 1 ;NUMBER OF IN/OUT UUO'S EXECUTED
SATADR: BLOCK 1 ;ADDRESS OF FIRST SAT BLOCK
NUMSAT: BLOCK 1 ;NUMBER OF SAT BLOCKS
IDXSEC: BLOCK 1 ;NUMBER OF SECTORS IN INDEX BLOCK
SATBIT: BLOCK 1 ;NUMBER OF BITS IN ALL SAT BLOCKS
KEYDES: BLOCK 1 ;KEY DESCRIPTOR
SIZIDX: BLOCK 1 ;SIZE OF INDEX ENTRY
IDXADR: BLOCK 1 ;ADDRESS OF HIGHEST-LEVEL INDEX ENTRY
%DAT: BLOCK 1 ;PERCENTAGE OF DATA FILE TO LEAVE FREE
%IDX: BLOCK 1 ;PERCENTAGE OF INDEX FILE TO LEAVE FREE
RECBYT: BLOCK 1 ;SIZE OF LARGEST DATA RECORD, IN BYTES
MAXSAT: BLOCK 1 ;MAX # RECORDS FILE CAN BECOME
ISAVER: BLOCK 1 ;ISAM VERSION #
PAGBUF: BLOCK 1 ;I/O SW: 0=SECTOR MULTIPLES, NON 0 =PAGES
IFN TOPS20,<
NAME20: BLOCK 62 ;200 (DECIMAL) BYTES FOR FILE-SPEC
>
STATSZ==.-STHDR
I==STATSZ
;STATISTICS BLOCK FOR INPUT INDEX FILE
STAT2: BLOCK STATSZ ;REFERENCE AS STHDR VARIABLE + I
LOWSIZ==.-LOWCOR
X=START
RELOC
END START