Trailing-Edge
-
PDP-10 Archives
-
ap-c800d-sb
-
isam.mac
There are 21 other files named isam.mac in the archive. Click here to see a list.
; UPD ID= 1993 on 8/6/79 at 2:40 PM by N:<NIXON>
TITLE ISAM VERSION 12A
SUBTTL ISAM FILE MAINTENANCE PROGRAM AL BLACKINGTON/CAM/FLD
;COPYRIGHT (C) 1971, 1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
EDIT==161
VERSION==1201,,EDIT
SEARCH INTERM
SEARCH UUOSYM ;FOR TAPOP.'S ARGS
LOC 137
EXP VERSION
RELOC 0
TWOSEG
RELOC 400000
SALL
IFNDEF NEW,<NEW==1> ;ELIMINATES "SIZE OF LARGEST INPUT BLOCK:" QUESTION
IFNDEF ANS74,<ANS74==0> ;DEFAULT TO COBOL-68
;ASSEMBLY INSTRUCTIONS
; .COMPIL ISAM (ASSUMING ISAM.MAC IS ON DSK:)
; .LOAD ISAM,SYS:LIBOL%L$
; .SSAVE DSK:ISAM
SUBTTL HISTORY
;NAME DATE COMMENTS
; 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
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>
;** EDIT 112 ;MONITOR COMMUNICATION ILG 3-MAY-74
$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
;** EDIT 112 SWITCH REGISTER FLAGS (LH) ILG 3-MAY-74
FDTA==1B13 ;[112] /P OUTPUT IS TO DTA
;**EDIT 140 SWITCH REGISTER FLAGS (LH)
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)
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)
;** EDIT 107 IMPLEMENT /I OPTION ILG 22-JAN-74
OPT.I==1B30 ;/I OPTION (IGNORE ERRORS)
;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
; 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
;MODE CODES
SX.MOD==0 ;SIXBIT
EB.MOD==1 ;EBCDIC
AS.MOD==2 ;ASCII
MA.MOD==3 ;35 BIT ASCII TAPE I/O
SUBTTL TABLES
;FILE CODES FOR HEADER WORDS
FILCOD: EXP $ISAMS ;SIXBIT
EXP $ISAME ;EBCDIC
EXP $ISAMA ;ASCII
;BYTE SIZE
BYTSIZ: EXP 6
EXP 9
EXP 7
;BYTES PER WORD
BYTWRD: EXP 6
EXP 4
EXP 5
;BYTES PER WORD MINUS ONE
BYWDM1: EXP 5
EXP 3
EXP 4
;BYTE POINTER SKELETONS
BYPTRS: POINT 6,0
POINT 9,0
POINT 7,0
SUBTTL INITIALIZATION
START: CALLI 0 ;RESET
TTCALL 2,TTYKAR ;CLEAR ANY ^O CONDITION
SETZM TTYKAR ;CLEAR IF NOTHING READ
SETZM LOWCOR ;CLEAR IMPURE AREA (EXCEPT TTYKAR)
MOVE TA,[LOWCOR,,LOWCOR+1]
;DELETED;[EDIT #104]; HRRZ TB,.JBREL##
;DELETED;[EDIT#104]; BLT TA,(TB)
BLT TA,LOWCOR+LOWSIZ-1 ; [EDIT#104]
;**;[144],START+5.5,DPL,16-FEB-76
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:
MOVEI SW,0 ;CLEAR SWITCH REGISTER
MOVE PP,[IOWD PPSIZE,PPLIST] ;INIT PDL
SUBTTL READ COMMAND STRING
GETPPN TA, ; [143] GET USERS PPN
MOVEM TA,MYPPN ; [143] SAVE IT
SETALB: SETZM AUTOLB ; INIT TO NO AUTO FACILITY
MOVE TA,[%SITLP]
GETTAB TA,
SETZ TA, ; ERROR SO OLD STYLE PROCESSING
SKIPE TA ; WHAT IS IT?
SETOM AUTOLB ; AUTO FACILITY!
RCOM: TTCALL 3,[ASCIZ "
*"] ;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
;** EDIT 107 IMPLEMENT /I OPTION ILG 22-JAN-74
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
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
PUSHJ PP,GETFIL ;YES, GET INPUT FILENAME
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 OPTION
IOR TA,OF2DAT+PPNUM
TRNE SW,OPT.P
JUMPN TA,BADCOM ;IF THERE IS -- TOO BAD
SKIPE IF1DAT+FILNAM ;INPUT FILENAME GIVEN?
JRST RCOM4 ;YES, CONTINUE
MOVE TA,IF1DAT ;NO, SEE IF DEVICE IS A MTA
CALLI TA,$GETCH ;DO A DEVCHR
TLNE TA,$MTA ;MTA?
TRNE SW, OPT.L ; AND NO LABEL OPTION?
JRST BADCOM
RCOM4: SKIPE OF1DAT+FILNAM ;YES, OUTPUT FILENAME SPECIFIED?
JRST DEFLT ;YES
MOVE TA,OF1DAT ;IF OUTPUT DEVICE SPECIFIED
CALLI TA, $GETCH ; TEST OUTPUT SIDE
TLNN TA, $MTA
JRST DEFLT
TRNE SW, OPT.L
JRST BADCOM
JRST DEFLT ; OK
;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 ;DEFAULT OPTION IS /B
TRO SW,OPT.B
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
SKIPN TA,IF1DAT+DEV ;DEFAULT DEVICE FOR
MOVSI TA,(SIXBIT "DSK") ; INPUT FILE IS
MOVEM TA,IF1DAT+DEV ; 'DSK'
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
TRNN SW,OPT.P+OPT.M ;WHICH OPTION ARE WE DOING?
JRST DEFLT1 ;/B
SKIPN TA,IF1DAT+FILEXT ;/M OR /P: DEFAULT EXT FOR IF1 IS 'IDX'
MOVSI TA,(SIXBIT 'IDX')
HLLZM TA,IF1DAT+FILEXT
TRNN SW,OPT.P ;/P?
JRST DEFLT1 ;NO, /M
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
DEFLT1: SKIPN TA,OF1DAT+FILEXT ;/B OR /M: 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
TRNN SW,OPT.B ;/B OR /M?
JRST OPENER ;/M
SKIPN TA,IF1DAT+FILEXT ;/B: DEFAULT EXT FOR IF1 IS 'SEQ'
MOVSI TA,(SIXBIT 'SEQ')
HLLZM TA,IF1DAT+FILEXT
SUBTTL OPEN I/O FILES
;** EDIT 107 IMPLEMENT /I OPTION ILG 22-JAN-74
OPENER:
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 ;AND PACKING? [EDIT#107]
JRST OPN1 ;YES, OK [EDIT#107]
TTCALL 3,[ASCIZ"?THE /I SWITCH CAN ONLY BE USED WITH /P
"] ; [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?
JRST OPEN1 ;NO, INDEXED
MOVEI TA,14 ;/B: BUFFERED INPUT
MOVEI TC,IF1BUF
JRST OPEN2
OPEN1: MOVE TB,IF1DAT+DEV ;/M OR /P: INPUT DEVICE MUST BE A DISK
CALLI TB,$GETCH
TLNN TB,$DSK
JRST BADDEV ;NOT A DISK
MOVEI TA,17 ;/M OR /P: DUMP MODE INPUT
MOVEI TC,0
OPEN2: MOVE TB,IF1DAT+DEV ;OPEN PRIMARY INPUT FILE
OPEN IF1,TA
PUSHJ PP,CANTOP ;PROBLEMS
TRNN SW,OPT.B+OPT.M ;OUTPUT INDEXED?
JRST [ TLNN SW,(FASCII) ; [142] NO SEQUENTIAL ,/P, - IS IT ASCII?
JRST OPEN3 ; [142] NO USES BINARY
MOVEI TA,1 ; [142] ASCII SET MODE FOR OPEN
JRST OPEN3A ] ; [142] ASCII SET UP
MOVE TA,OF1DAT+DEV ;/B OR /M: OUTPUT DEVICES MUST BE DISKS
CALLI TA,$GETCH
TLNN TA,$DSK
JRST BADDEV ;INDEX DEVICE NOT A DISK
MOVE TA,OF2DAT+DEV ;/B OR /M: OPEN OUTPUT DATA FILE
CALLI TA,$GETCH
TLNN TA,$DSK
JRST BADDEV ;DATA DEVICE NOT A DISK
OPEN3: MOVEI TA,14 ;/P: PRIMARY OUTPUT, /B OR /M: SEC. OUTPUT
OPEN3A: 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
TRNE SW,OPT.P ;/P?
JRST OPEN4 ;YES, NO OUTPUT ON OF1
MOVEI TA,17 ;/B OR /M: DUMP MODE OUTPUT
MOVEI TC,0
MOVE TB,OF1DAT+DEV ;OPEN THE PRIMARY OUTPUT FILE
OPEN OF1,TA
PUSHJ PP,CANTOP ;PROBLEMS
OPEN4: TLNE SW,(FERROR) ;IF TROUBLE,
JRST START ; QUIT AND TRY ANOTHER
; HERE TO SET ANSI OR OMITTED LABELS FOR
; THE MONITOR'S LABEL PROCESSING FACILITY
SALB: SKIPN AUTOLB ; DO WE HAVE MLP (MONITOR LABEL PROCESSING)?
JRST LOOK ; NO
MOVE TB,OF1DAT ; SAVE DEVICE NAME
MOVE TA,OF1DAT ; SET UP FOR GETCHR
CALLI TA,$GETCH ; DO IT
TLNE TA,$MTA ; MTA?
JRST SALB1 ; YEP
MOVE TB,IF1DAT ; SAVE DEVICE NAME
MOVE TA,IF1DAT ; SET UP FOR GETCHR
CALLI TA,$GETCH ; DO IT
TLNN TA,$MTA ; MTA?
JRST LOOK ; NOP
SALB1: TLNN SW,OPT.L ; ANSI OR OMITTED?
SKIPA TC,[.TFLNL] ; OMITTED LABELS
MOVEI TC,.TFLAL ; ANSI LABELS
MOVE TD,[3,,TA] ; LENGTH ,, LOC
MOVEI TA,.TFLBL+.TFSET; FUNCT - LABEL PROCESSING
TAPOP. TD, ; INDICATE OMITTED OR ANSI
JRST TFUERR ; OOPS
LOOK: 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
TRNE SW, OPT.P
MOVEM TA+2, SA.CRE ; SAVE CREATION DATE FOR PACK OPTION
TRNE SW,OPT.P ;/P?
JRST LOOK2 ;YES
MOVE TA,OF1DAT+FILNAM ;ENTER THE PRIMARY OUTPUT FILE
HLLZ TB,OF1DAT+FILEXT
MOVEI TC,0
MOVE TD,OF1DAT+PPNUM
ENTER OF1,TA
;** EDIT 113 LOOK+16
PUSHJ PP,ENTRFA ;ERROR [ED#113]
LOOK2: 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
;** EDIT 113 LOOK2+5
PUSHJ PP,ENTRFB ;ERROR [ED#113]
LOOK1: TLNE SW,(FERROR) ;IF THERE WAS TROUBLE,
JRST START ; QUIT
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)
;** EDIT 112 LOOK1+12. ILG 3-MAY-74
TLNE TE,$DTA ;[112]IF DTA, SET DTA FLAG
TLO SW,(FDTA) ;[112]
TRNE SW, OPT.L ; LABEL OPTION?
TLNE SW, (FMTA) ; WITHOUT MTA?
JRST .+2
JRST LBLERR
;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?
TLNN SW,(FMTA) ; YES, IS DEVICE A MTA?
JRST SSAX ; NO
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 SSAX ; NO
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
TRNN SW,OPT.B ; INPUT OR OUTPUT?
SKIPA OM,[AS.MOD] ; OUTPUT!
MOVEI IM,AS.MOD ; INPUT!
SSAX:
STAT: MOVE TE,[STHDR,,STHDR+1] ;CLEAR STATISTICS BLOCKS
SETZM STHDR
BLT TE,STAT2+STATSZ-1
TRNN SW,OPT.P+OPT.M ;INDEX FILE INPUT?
JRST ASKM ;NO
MOVE TA,[IOWD STATSZ,STAT2] ;/M OR /P: READ INPUT FILE STAT BLK
MOVEI TB,0
IN IF1,TA
SKIPA TA,[STAT2,,STHDR] ;OK, INIT OUTPUT STAT = INPUT STAT
JRST STATER ;ERROR
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
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
JRST ASKM ;QUESTIONS
SUBTTL GET FILE PARAMETERS
; THESE QUESTIONS ARE ASKED BEFORE FILES ARE OPENED SO THAT SPECIAL
; MODES CAN BE HANDLEDTHERE
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
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "MODE OF OUTPUT FILE: "] ;/P
PUSHJ PP,GETMOD ;[EDIT 107]
JRST .-2 ;[EDIT 107]
JRST ASKM3A ;[EDIT 107]
ASKM2: TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "MODE OF INPUT FILE: "] ;/B
PUSHJ PP,GETMOD
JRST .-2 ;TROUBLE
MOVEI IM,(TB) ;SET INPUT MODE
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "MODE OF DATA FILE: "]
ASKM3: PUSHJ PP,GETMOD
JRST .-2
ASKM3A: 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
TRNE SW,OPT.M ;IS IT /M
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.
CAIE OM,MA.MOD
CAIN IM,MA.MOD
JRST ERMVAS ;TELL THEM THEY CAN'T DO THAT
TRNN SW,OPT.B ;/B?
; JRST ASKM8 ;NO, /P OR /M [151] WRONG PLACE
JRST [ MOVE TE,RECBYT ;[151] RECOMPUTE RECSIZ
JRST ASKM6 ] ;[151] IN CASE WE CHANGED MODE
ASKM5: TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "MAXIMUM RECORD SIZE: "]
PUSHJ PP,GETPOS
JRST .-2
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: 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]
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "RECORDS PER OUTPUT BLOCK: "] ;/P
MOVEI TE,0 ;IF NO ANSWER, ASSUME UNBLOCKED
JRST ASKM11
ASKM10: TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "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
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
;**AT ASKM12 EDIT 140 INSERTED TWO INSTRUCTIONS
ASKM12: TRNE SW,OPT.M ;/M? [EDIT#140]
TLO SW,(FCEOFK) ; [EDIT#140]
MOVE TE,DATBLK+I ;AIM AT DATBLK
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "TOTAL RECORDS PER DATA BLOCK"]
PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
PUSHJ PP,GETNUM
JRST .-3
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
TLZE SW,(FGETDC) ;IF /M, LEAVE AS IS IF NULL RESPONSE
MOVEM TE,DATBLK
ASKM13: MOVE TE,EMPDAT+I ;AIM AT EMPDAT
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "EMPTY RECORDS PER DATA BLOCK"]
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
MOVEM TE,DATSEC ; DATA BLOCK
ASKM15: TRNE SW,OPT.P
JRST ASKM16
MOVE TE,IDXBLK+I ;AIM AT IDXBLK
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "TOTAL ENTRIES PER INDEX BLOCK"]
PUSHJ PP,MCUR ;IF /M, GIVE CURRENT
PUSHJ PP,GETNUM
JRST .-3
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
TLZE SW,(FGETDC) ;IF /M, LEAVE AS IS IF NULL RESPONSE
MOVEM TE,IDXBLK
MOVE TE,IDXBLK
CAIGE TE,2 ;MUST HAVE AT LEAST 2
JRST TOOFEW ;ERROR
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
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
JRST ASKM17
MOVE TE,EMPIDX+I ;AIM AT EMPIDX
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "EMPTY ENTRIES PER INDEX BLOCK"]
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
JRST SETIO
ASKM18: MOVE TE,%DAT+I ;AIM AT %DAT
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "PERCENTAGE OF DATA FILE TO LEAVE EMPTY"]
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
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "PERCENTAGE OF INDEX FILE TO LEAVE EMPTY"]
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
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIR CMD FILE
TTCALL 3,[ASCIZ "MAXIMUM NUMBER OF RECORDS FILE CAN BECOME"]
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
DPB OM,KY.MOD ;STORE OUTPUT MODE
SUBTTL GET READY FOR I/O
SETIO:
PUSHJ PP,LOPINI ;SOME INITIALIZATION
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
MOVE TE,LEVELS+I ;GET INDEX SPACE FOR /P, /M 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
;** EDIT 115 SETIO+12 ILG 11-JUN-74
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 DATA INPUT
ADDI TE,1 ;INCLUDE HEADER WORD OF EACH RECORD
IMUL TE,DATBLK+I
MOVEM TE,INSIZ
;** EDIT 115 SETIO8+9. ILG 11-JUN-74
MOVE TD,.JBFF ;[115]
MOVEM TD,INDAT
PUSHJ PP,GETCOR
MOVE IX,LEVELS+I ;READ IN TOP LEVEL OF INDEX
MOVE TA,IDXADR+I
TLNN TA,-1 ;[157] IF BLOCK-NMBR GT 18 BITS
JRST SETI8A ;[157] NO GO TO USETI
;[157] PUSHJ PP,FUSI ; DO FILOP. TYPE USETI
MOVEM TA,FUSI+1 ;[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
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
;** EDIT 115 SETIO7+1 ILG 11-JUN-74
MOVE TD,.JBFF ;RESERVE
MOVEM TD,OLDKEY ; AN AREA TO
PUSHJ PP,GETCOR ; SAVE RECORD KEY
MOVE TE,SIZKEY ;DO SAME
;** EDIT 115 SETIO7+5. ILG 11-JUN-74
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
;** EDIT 115 SETIO7+11. ILG 11-JUN-74
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
; MOVE TE,RECSIZ ;[156]
IFN ANS74,<
ADDI TE,1 ;; ROOM FOR A LF IN FRONT IF /P+ASCII
>
;** EDIT 115 SETIO6+11. ILG 11-JUN-74
HRR TD,.JBFF
MOVEM TD,RECPTR
PUSHJ PP,GETCOR ; [EDIT#77]
IFN ANS74,<
MOVEI TE,12B34 ;; GET A LF
MOVEM TE,@RECPTR ;; PLACE IT JUST IN FRONT OF RECORD
AOS RECPTR ;; MAKE RECPTR POINT JUST AFTER LF
>
TRNN SW,OPT.P ;/P?
JRST SETI10 ;NO
MOVE TE,INPBLK ;FOR /P, SWITCH INPUT ARGS TO OUTPUT
MOVEM TE,DATBLK
MOVEM TE,DATRIT
MOVEM TE,ORLEFT ;NO EMPTY RECORDS ON /P
SETZM INPBLK
MOVE TE,INPSEC
MOVEM TE,DATSEC
SETZM INPSEC
MOVE TE,INPBPB ;BYTES PER BLOCK - EBCDIC VAR
MOVEM TE,DATBPB
;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
;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
; 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
CNVP6O: [POINT 6,CH,35] ;SIXBIT TO SIXBIT
PTR%69## ;SIXBIT TO EBCDIC
PTR%67## ;SIXBIT TO ASCII
CNVP9O: PTR%96## ;EBCDIC TO SIXBIT
[POINT 9,CH,35] ;EBCDIC TO EBCDIC
PTR%97## ;EBCDIC TO ASCII
CNVP7O: PTR%76## ;ASCII TO SIXBIT
PTR%79## ;ASCII TO EBCDIC
[POINT 7,CH,35] ;ASCII TO ASCII
; CONVERT TO ASCII
CNVPI7: PTR%67
PTR%97
[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
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
OROUEB: Z FINRCF ;EBCDIC FIXED
Z FINRCV ;EBCDIC VARIABLE
OROUX: Z FINRXS ;ISAM SIXBIT
Z FINRXE ;ISAM EBCDIC
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 E-O-L
IFN DEBUG,<
SKIPE DBUGIT
PUSHJ PP,TRACSZ ;DISPLAY RECORD SIZE
>
LOOP2:IFN DEBUG,<
SKIPE DBUGIT
PUSHJ PP,TRACH ;DISPLAY CHARACTER
>
LDB CH,CONVRT ;CONVERT CHARACTER IF NECESSARY
CAMGE OC,RECBYT ;IF STILL ROOM IN RECORD,
IDPB CH,OP ; STASH CHARACTER IN RECORD
ADDI OC,1
PUSHJ PP,@GETBYT ;GET ANOTHER BYTE
TLNN SW,(FEOF!FENDIB!FENDL)
JRST LOOP2
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
>
PUSHJ PP,@FINREC ;FINISH UP THE RECORD
;SKIP KEY WRITING TO INDEX FILE IF /P
TRNE SW,OPT.P ;/P?
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
OUTSTR [ASCIZ "
SIZE:"]
PUSHJ PP,SAVAC ;SAVE AC'S
MOVE TE,INPSIZ
ADDI TE,1 ;BECAUSE ITS ONE SHORT
PUSHJ PP,PUTDEC ;TYPE IT
OUTSTR [ASCIZ "
"]
JRST RESAC
TRACH: ;TYE CURRENT CHARACTER OF RECORD
PUSH PP,CH
LDB CH,@CNVPI7(IM) ;CONVERT TO ASCII
OUTCHR CH
POP PP,CH
POPJ PP,
TRACKY: ;DISPLAY KEY
PUSHJ PP,SAVAC
MOVE TE,OC ;RECORD SIZE
OUTSTR [ASCIZ "
SIZ:"]
PUSHJ PP,PUTDEC
MOVE TE,NEWKEY
OUTSTR [ASCIZ "
KEY:"]
PUSHJ PP,@CAMKX(KT) ;DISP KEY
OUTSTR [ASCIZ "
"]
JRST RESAC
>
SUBTTL TRANSFER RECORD TO OUTPUT FILE
FINRCA: ;ASCII SEQUENTIAL OUTPUT
PUSHJ PP,FNCKSZ ;CHECK RECORD SIZE
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
; MOVN TE,OBPBCT ;GET COUNTER ;[152]
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
IFN ANS74,<
TRNE SW,OPT.P ;; IF WE ARE /PACKING AND
TRNN OM,AS.MOD ;; THE OUTPUT MODE IS ASCII
JRST FNMOV1 ;;
SUBI OP,1 ;; THEN MAKE RECORD POINTER POINT TO
HRLI OP,(POINT 7,,27);; THE "LF" JUST IN FRONT OF RECORD
>
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
OUTSTR [ASCIZ '%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
IFN ANS74,<
TRNN SW,OPT.P ;; NO LF IF WE ADVANCED BEFORE RECORD
>
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 FIRST BYTE OF RECORD ROUTINES
; SIXBIT - FIRST BYTE SEQUENTIAL INPUT
GETFB6: MOVEI TE,1
MOVEM TE,INPSIZ
PUSHJ PP,GETSM
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
MOVSI TE,770000
ANDCAM TE,IF1BUF+1
TLNE SW,(FENDIB)
POPJ PP,
SKIPN INPSIZ
JRST GETFB6
JRST GETSM
GETFB7: PUSHJ PP,GETAM
MOVE TE,@IF1BUF+1
TRNN TE,1B35 ;SEQ # FLAG UP?
POPJ PP, ;NO
IBP IF1BUF+1 ;IGNORE SEQ # WORD
IBP IF1BUF+1
IBP IF1BUF+1
IBP IF1BUF+1
JRST GETAM ;NOW GET REAL 1ST CHAR
GETFBF: ; EBCDIC FIXED SEQUENTIAL INPUT
MOVE TE,RECBYT ;GET BYTES PER RECORD
MOVEM TE,INPSIZ ;STORE IN SIZE
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 GETEMV ;NO - GO GET CHARACTER
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 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
PUSHJ PP,GETEMV ;GET A BYTE
MOVE TE,CH ;SAVE IT
LSH TE,^D8 ;ADJUST IT
TLNN SW,(FINDCP) ;INDUSTRY COMPATABLE?
LSH TE,1 ;NO - 9 BIT BYTES
PUSHJ PP,GETEMV ;NEXT BYTE
ADDI TE,(CH) ;ADD IT IN
PUSHJ PP,GETEMV ;SKIP NEXT 2 BYTES
PJRST GETEMV
;GET FIRST BYTE OF RECORD (INDEXED FILE INPUT)
IDXFB: PUSHJ PP,GETREC ;GET RECORD OF INPUT
JRST GETDAT
;GET 1 RECORD OF INDEXED FILE
GETREC: 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
JRST GETRE2 ; NO
MOVEM TA,FUSI+1 ; 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
CAIN IM,AS.MOD ;IS IT ASCII
LSH TA,-1 ;DROP BIT 35 IF ASCII FILE
JUMPE TA,GETRE3 ;IGNORE EMPTIES
;**AT GETRE1+13 EDIT 141
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
POPJ PP,
;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
SOJE IX,GETEN3 ;EXIT IF AT LEVEL 0 INDEX
MOVE TA,IDXHD1 ; OTHERWISE DROP BACK DOWN 1 LEVEL
TLNN TA,-1 ;[157] IF BLOCK-NMBR GT 18 BITS
JRST GETE1A ;[157] NO GO TO USETI
;[157] PUSHJ PP,FUSI ; DO FILOP. TYPE USETI
MOVEM TA,FUSI+1 ;[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
;** EDIT 107 IMPLEMENT /I OPTION ILG 22-JAN-74
CAMK2C: PUSHJ PP,CAMD ;DECIDE IF FATAL [EDIT#107]
TTCALL 3,[ASCIZ"KEYS ARE OUT OF ORDER
"] ; [EDIT#107]
;DELETED; [EDIT#107] ;CAMK2C: TTCALL 3,[ASCIZ "?KEYS ARE OUT OF ORDER
MOVE TA,NEWKEY
PUSHJ PP,@CAMKX(KT)
TTCALL 3,[ASCIZ "
IS AFTER
"]
MOVE TA,OLDKEY
JRST CAMK3A
;TWO KEYS ARE EQUAL
;** EDIT #107 IMPLEMENT /I OPTION ILG 22-JAN-74
CAMK3: PUSHJ PP,CAMD ;DECIDE IF FATAL [EDIT#107]
TTCALL 3,[ASCIZ "TWO KEYS WITH EQUAL VALUE = "] ; [EDIT#107]
;DELETED; [EDIT#107] ;CAMK3: TTCALL 3,[ASCIZ "?TWO KEYS WITH EQUAL VALUE = "]
MOVE TA,NEWKEY
CAMK3A: PUSHJ PP,@CAMKX(KT)
TTCALL 3,[ASCIZ "
"]
;** EDIT#107 IMPLEMENT /I OPTION ILG 22-JAN-74
TRNE SW,OPT.I ;NOT FATAL IF /I [EDIT#107]
POPJ PP, ;RETURN [EDIT#107]
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,
;** EDIT#107 IMPLEMENT /I OPTION ILG 22-JAN-74
CAMD: TRNE SW,OPT.I ;IGNORE OPTION ON? [EDIT#107]
JRST CAMD1 ;YES, GO OUTPUT "%" [EDIT/107]
TTCALL 3,[ASCIZ "?"] ;NO, OUTPUT "?" [EDIT#107]
POPJ PP, ; [EDIT#107]
CAMD1: TTCALL 3,[ASCIZ "%"] ;YES, WARN ONLY [EDIT#107]
POPJ PP, ; [EDIT#107]
;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
TTCALL 1,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
TTCALL 1,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.##
;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,
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
;** EDIT 106 FIX COMPUTATION OF EMPTY DATA BLOCKS ILG 22-JAN-74
;DELETED; [EDIT#106] ; MOVEI TA,^D100 ;# ADDITIONAL = %*CURRENT/100-%
;DELETED; [EDIT#106] ; SUB TA,%DAT
;DELETED; [EDIT#106] ; IDIVI TD,(TA)
IDIVI TD,^D100 ;# OF ADDITIONAL BLOCKS [EDIT #106]
JUMPE TE,.+2 ;ANY REMAINDER?
ADDI TD,1 ;YES, ROUND UPWARDS
;DELETED; [EDIT #106] ; JUMPN TD,ALLD12 ;IF ZERO,
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
ALLD13: TRNE SW,OPT.P ;IF /P, WE ARE ALL DONE
JRST START
;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
TTCALL 3,[ASCIZ "
"]
MOVE TE,LEVELS
PUSHJ PP,PUTDEC
TTCALL 3,[ASCIZ " LEVEL"]
MOVE TE,LEVELS
CAIE TE,1
TTCALL 3,[ASCIZ "S"]
TTCALL 3,[ASCIZ " OF INDEX
"]
MOVE TE,MUCHO
PUSHJ PP,PUTDEC
TTCALL 3,[ASCIZ " DATA RECORD"]
MOVE TE,MUCHO
CAIE TE,1
TTCALL 3,[ASCIZ "S"]
TTCALL 3,[ASCIZ "
"]
JRST START ;LOOP BACK TO THE BEGINNING
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]
SEARCH MONSYM ;[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]
MOVE 3,[377777,,777777] ;[154]
CHFDB ;[154]
POPJ PP, ;[154]
> ;[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
TRNN SW,OPT.B ;/M OR /P GET INFO FROM STAT BLK
JRST GETK13
SETZB KT,KEYDES
SETZM RECKEY
TLNN SW,(INDIR) ;SKIP QUESTION IF INDIRECT
OUTSTR [ASCIZ 'KEY DESCRIPTOR: ']
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: OUTSTR [ASCIZ /%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
JUMPE KT,GETK15 ;SKIP THIS IF NOT NUMERIC
;NUMERIC KEY
TLO SW,(FNUM) ;SET FLAG
LDB TA,KY.SGN ;IS IT SIGNED
SKIPN TA
TLO SW,(FSGND) ;YES
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
;**;[145],LAB.1+1,DPL,2-FEB-76
CAIN 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: TRNN SW, OPT.P ; WRITING 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
;**;[146],LAB.10+2.5,DPL,1-JUN-76
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
CAIN 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
CAME TB, IF1DAT+FILNAM ; VALUE OF ID MATCH (NAME)?
JRST LBLERN
MOVE TA, STDLBL+1
MOVE TB, STDLBL+2
ROTC TA, -^D12
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
;** EDIT 111 GETFL2+12. ILG 29-MAR-74
GET.SW: PUSHJ PP,GETTY ;IS THERE A SWITCH?
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"
;** EDIT #107 IMPLEMENT /I OPTION ILG 22-JAN-74
JRST .+3 ; [EDIT#107]
MOVEI TA,OPT.M ; [EDIT#107]
JRST GETFL7 ; [EDIT#107]
CAIE CH,"I" ; [EDIT#107]
JRST GETFL6 ;ILLEGAL SWITCH
;DELETED; [EDIT#107] ; MOVEI TA,OPT.M
MOVEI TA,OPT.I ; [EDIT#107]
GETFL7: TRO SW,(TA)
;**EDIT 111 GETFL7+1 ILG 29-MAR-74
JRST GET.SW ; AND TEST FOR ANOTHER SWITCH
GETFL6: TTCALL 3,[ASCIZ "?ILLEGAL SWITCH
"]
JRST GETFL8
GETFL4: TTCALL 3,[ASCIZ "?IMPROPER PROJ-PROG 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
;** EDIT 113 CHANGES ENTERF TO ENTRFA
ENTRFA: TTCALL 3,[ASCIZ "?ENTER FAILURE ON "] ;[ED#113]
MOVE TE,DEV+OF1DAT ;[ED#113]
PUSHJ PP,PUTSIX
TTCALL 3,[ASCIZ ":"]
MOVE TE,FILNAM+OF1DAT ;[ED#113]
PUSHJ PP,PUTSIX
HLLZ TE,FILEXT+OF1DAT ;[ED#113]
JUMPE TE,ENTRF1
TTCALL 3,[ASCIZ "."]
PUSHJ PP,PUTSIX
; INSERTED 11 INSTRUCTIONS EDIT 113
JUMPA ENTRF1 ;[ED#113]
ENTRFB: TTCALL 3,[ASCIZ "?ENTER FAILURE ON "] ;[ED#113]
MOVE TE,DEV+OF2DAT ;[ED#113]
PUSHJ PP,PUTSIX ;[ED#113]
TTCALL 3,[ASCIZ ":"] ;[ED#113]
MOVE TE,FILNAM+OF2DAT ;[ED#113]
PUSHJ PP,PUTSIX ;[ED#113]
HLLZ TE,FILEXT+OF2DAT ;[ED#113]
JUMPE TE,ENTRF1 ;[ED#113]
TTCALL 3,[ASCIZ "."] ;[ED#113]
PUSHJ PP,PUTSIX ;[ED#113]
ENTRF1: TTCALL 3,[ASCIZ " -- ("]
JRST LOOKF1
;LOOKUP FAILURE
LOOKF: TTCALL 3,[ASCIZ "?LOOKUP FAILURE ON INPUT FILE -- ("]
TRNE TB,-1 ;IS IT CODE ZERO?
JRST LOOKF1 ;NO
TTCALL 3,[ASCIZ "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)
TTCALL 3,(TF)
TTCALL 3,[ASCIZ "
"]
TLO SW,(FERROR)
POPJ PP,
;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 OT 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 0,[ASCIZ ") UNKNOWN ERROR"]
LISTSZ==.-ERALST-1
ILLDEV: TTCALL 3,[ASCIZ "?DEVICE MUST BE AN OUTPUT OR I/O DEVICE
"]
BADCOM: TTCALL 3,[ASCIZ "?IMPROPER COMMAND STRING
"]
PUSHJ PP,SKPTTY
JRST START
BADDEV: TTCALL 3,[ASCIZ "?INDEXED FILE DEVICES MUST BE DISKS
"]
JRST START
CANTOP: TLO SW,(FERROR)
TTCALL 3,[ASCIZ "?CANNOT OPEN DEVICE "]
MOVE TE,TB
PUSHJ PP,PUTSIX
TTCALL 3,[ASCIZ ":
"]
POPJ PP,
BADKEY: TTCALL 3,[ASCIZ "?IMPROPER KEY DESCRIPTOR
"]
PUSHJ PP,SKPTTY
JRST GETKEY
BIGLVL: TTCALL 3,[ASCIZ "?MORE THAN 10 LEVELS OF INDEX REQUIRED
"]
JRST START
NOCORE: TTCALL 3,[ASCIZ "?NOT ENOUGH CORE TO COMPLETE THE JOB
"]
JRST START
;**AT NOCORE+3 EDIT 140 INSERTED TWO INSTRUCTIONS
CMDINC: TTCALL 3,[ASCIZ "?EOF ON COMMAND FILE - COMMAND INCOMPLETE
"] ;[EDIT#140]
JRST START ;[EDIT#140]
REDERA: TTCALL 3,[ASCIZ "?ERROR READING INPUT FILE
"]
MOVEI TB,IF1 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
DATERA: TTCALL 3,[ASCIZ "?ERROR WRITING DATA FILE
"]
MOVEI TB,OF2 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
IDXERA: TTCALL 3,[ASCIZ "?ERROR WRITING INDEX FILE
"]
MOVEI TB,OF1 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
STATER: TTCALL 3,[ASCIZ "?ERROR READING INDEX FILE
"]
MOVEI TB,IF1 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
SIZERR: TTCALL 3,[ASCIZ "?RECORD SIZE MUST BE LESS THAN 4096
"]
JRST ASKM5
BIGKEY: TTCALL 3,[ASCIZ "?KEY IS OUTSIDE THE MAXIMUM RECORD
"]
JRST ASKM8
TOOMCH: TTCALL 3,[ASCIZ "?MUST BE LESS THAN RECORDS PER BLOCK
"]
JRST ASKM13
BIGIDX: ADDI TE,5 ;CONVERT TO
IDIVI TE,6 ; WORDS
TTCALL 3,[ASCIZ "?INDEX BLOCK CONTAINS "]
PUSHJ PP,PUTDEC
TTCALL 3,[ASCIZ " WORDS, MUST BE LESS THAN 683.
REDUCE THE NUMBER OF ENTRIES PER INDEX BLOCK.
"]
JRST ASKM15
TOOFEW: TTCALL 3,[ASCIZ "?MUST HAVE AT LEAST TWO FULL ENTRIES PER BLOCK
"]
JRST ASKM15
DATERR: TTCALL 3,[ASCIZ "?ERROR READING DATA FILE
"]
MOVEI TB,IF2 ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
CMDERR: TTCALL 3,[ASCIZ "?CANNOT OPEN COMMAND FILE
"]
JRST START
CMDLER: PUSHJ PP,LOOKF
JRST START
CMDRER: TTCALL 3,[ASCIZ "?ERROR READING COMMAND FILE
"]
MOVEI TB,CMD ;SAVE THE CHANNEL
JRST LTCTST ;CHECK FOR MORE ERRORS
;**AT CMDRER+2 EDIT141 INSERTED 7 INSTRUCTIONS
RECERR: TTCALL 3,[ASCIZ /?ACTUAL SIZE OF ISAM DATA RECORD /] ;[EDIT#141]
MOVE TE,INPSIZ ; [EDIT#141]
PUSHJ PP,PUTDEC ; [EDIT#141]
TTCALL 3,[ASCIZ / >ISAM MAX RECORD SIZE PARAM /] ;[EDIT#141]
MOVE TE,RECBYT+I ; [EDIT#141]
PUSHJ PP,PUTDEC ; [EDIT#141]
JRST START ; [EDIT#141]
DBLIND: TTCALL 3,[ASCIZ "?DOUBLE INDIRECT COMMAND
"]
JRST START
ERR%DA: TTCALL 3,[ASCIZ "?INVALID PERCENTAGE
"]
JRST ASKM18
ERR%IX: TTCALL 3,[ASCIZ "?INVALID PERCENTAGE
"]
JRST ASKM19
LBLERR: TTCALL 3, [ASCIZ "? LABEL OPTION ONLY APPLICABLE WITH BUILD OR PACK FOR MAG-TAPE
"]
JRST START
LBLEOF: TTCALL 3, [ASCIZ "? PRE-MATURE EOF (WITHIN LABEL) ON MTA
"]
LBLCLR: POP PP, TA ; DON'T CLOG PDL
JRST START
LBLERN: TTCALL 3, [ASCIZ "? FILE NAME DOES NOT MATCH LABEL ID
"]
JRST LBLCLR
EBLBER: OUTSTR [ASCIZ "?ISMLET LABELED EBCDIC TAPES ARE NOT SUPPORTED
"]
JRST START
TFCERR: OUTSTR [ASCIZ "?ISMTPC TAPOP. FAILED, CANNOT SET STANDARD-ASCII MODE
"]
JRST START
ERMVAS: OUTSTR [ASCIZ "?ISMSAM STANDARD-ASCII MODE REQUIRES TU70 MAGNETIC TAPE DRIVES
"]
JRST START
IVKERR: OUTSTR [ASCIZ "?ISMIVK INVALID KEY TYPE WITH RESPECT TO INPUT/OUTPUT MODE
"]
JRST START
RTSERR: OUTSTR [ASCIZ "?ISMRTS RECORD TOO SHORT TO CONTAIN KEY FIELD
"]
TRNN SW,OPT.I
JRST START
JRST CAMK1
INTERR: OUTSTR [ASCIZ "?ISMITE INTERNAL ISAM ERROR - SUBMIT SPR
"]
JRST START
EBBHER: OUTSTR [ASCIZ "?ISMEBH EBCDIC BLOCK HEADER COUNT LESS THAN 4
"]
JRST START
EBRHER: OUTSTR [ASCIZ "?ISMERH EBCDIC RECORD HEADER EXCEEDS BLOCK SIZE
"]
JRST START
CFKYER: OUTSTR [ASCIZ "?ISMCFE COMP AND COMP-1 KEYS MUST BEGIN ON WORD BOUNDRIES
"]
JRST START
TFUERR: OUTSTR [ASCIZ "?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!
TTCALL 3,[ASCIZ / MONITOR LABEL PROCESSING FAILED
/]
TTCALL 3,@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: [ASCIZ /DEVOP. failed while getting error code!/]
[ASCIZ /Code 1/]
[ASCIZ /Code 2/]
[ASCIZ /Label type error/]
[ASCIZ /Header label error/]
[ASCIZ /Trailer label error/]
[ASCIZ /Volume label error/]
[ASCIZ /Hard device error/]
[ASCIZ /Parity error/]
[ASCIZ /Write-lock error/]
[ASCIZ /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
TTCALL 1,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"
TTCALL 1,CH
TLNN TF,770000
POPJ PP,
PUTOC3: ILDB CH,TF
JRST PUTOC2
;TYPE OUT A SIGNED DECIMAL NUMBER, REMOVING LEADING ZEROES
PUTDEC: JUMPGE TE,PUTDC1 ;IF NEGATIVE,
TTCALL 3,[ASCIZ "-"] ; 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"
TTCALL 1,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"
TTCALL 1,(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
TTCALL 3,[ASCIZ " ("]
PUSHJ PP,PUTDEC
TTCALL 1,[")"]
MCUR1: TTCALL 3,[ASCIZ ": "]
POPJ PP,
;GET A CHARACTER FROM TTY
GETTY: SKIPE CH,TTYKAR ;IF ONE WAITING, USE IT
JRST GETTY2
TLNE SW,(INDIR) ;INDIRECT COMMANDS?
;**AT GETTY+3 EDIT 140 CHANGED ONE INSTRUCTION
JRST GETCMD ;YES [EDIT#140]
TTCALL 4,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: OUTSTR [ASCIZ /?ILLEGAL CHARACTER IN COMMAND STRING
/]
JRST START ;RESTART.
;GET A CHARACTER FROM INDIRECT COMMAND FILE
;**AT GETTY1+16 EDIT 140 INSERTED TWO INSTRUCTIONS
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
;**AT GETIN2+2 EDIT 140 INSERTED 2 INSTRUCTIONS
TLO SW,(FCEOF) ;CMDEOF [EDIT#140]
STATZ CMD,$ERA ;INPUT ERROR [EDIT#140]
JRST CMDRER
;**AT GETIN2+3 EDIT 140 INSERTED FOUR INSTRUCTIONS
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
SKIPE TE ;IS IT ZERO?
AOSA (PP) ;NO--SKIP RETURN
POSERR: TTCALL 3,[ASCIZ "?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: TTCALL 3,[ASCIZ "?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: PUSHJ PP,GETSIX ;GET A WORD
CAIE CH,15 ;IF IT DIDN'T TERMINATE WITH <C.R.>
JRST GETMD1 ; ERROR
MOVNI TB,1
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
AOS (PP)
POPJ PP,
GETMD1: TTCALL 3,[ASCIZ "?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
;** EDIT 115 GETLVL+2 ILG 11-JUN-74
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
;** EDIT 115 GETCOR+1 ILG 11-JUN-74
HRRM TD,.JBFF ;SET NEW JOBFF VALUE
MOVEI TE,(TD) ;IF
;** EDIT 115 GETCOR+3 ILG 11-JUN-74
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
SKIPA ;NO ERROR
JRST IDXERA ;WRITE ERROR
AOS IDXOUT ;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: SKIPE CH,INPKAR ;ANY 'LOOK-AHEAD' CHARACTER?
JRST GETAM3 ;YES
GETAM1: 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,GETAM1 ;IGNORE NULLS
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'
POPJ PP,
GETAM4: TLO SW,(FENDL) ;IT IS END-OF-LINE
POPJ PP,
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
TLNN SW,(FENDIB) ;DID WE HIT END-OF-BLOCK?
ILDB CH,IF1BUF+1 ;NO--PICK UP BYTE
SOS INPSIZ
POPJ PP,
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
;GET A BYTE FROM INDEXED DATA FILE
GETDAT: SKIPG INPSIZ ;ANY LEFT?
JRST GETDA1 ;NO
ILDB CH,INPTR ;YES, GET ONE
SOS INPSIZ
POPJ PP,
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
GETEMF:
; GET A BYTE FROM EBCDIC VARIABLE INPUT FILE
GETEMV:
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.
TLNN SW,(FENDIB) ;END OF BUFFER?
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
POPJ PP,
;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 [OUTSTR [ASCIZ "HEADER AS TRAILER??
ASSUMING END OF FILE"]
JRST READ5]
CAME CH,[SIXBIT " EOV1"] ;WAS IT VOLUME TRAILER?
JRST [OUTSTR [ASCIZ "ILLEGAL TRAILER RECORD
ASSUMING END OF FILE"]
JRST READ5]
TTCALL 3,[ASCIZ /$-END OF INPUT REEL, MOUNT NEXT AND CONT../]
MTUNL. IF1, ;REWIND IT
EXIT 1, ;HOLD IT UP AND WAIT FOR RESPONSE
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
STATO OF2,FEOT ;PHYSICAL END OF TAPE
JRST DATERA ;NO..ONCE AGAIN..
PUSHJ PP,VLABEL ;GO WRITE VOL LABEL
TTCALL 3,[ASCIZ /$-END OF OUTPUT REEL, MOUNT NEXT AND CONT/]
CLOSE OF2, ;CLEAR EOT ETC AND WRITE EOF
MTUNL. OF2, ;AND UNLOAD THE TAPE
EXIT 1, ;HOLD IT UP AND WAIT FOR RESPONSE
PJRST LABEL ;OUTPUT HEADER LABEL
;RETURN TO SENDER..
;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
POPJ PP,
;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
SKIPA ;NO ERRORS
JRST DATERR ;ERROR
SETZM DATFLG ;CLR RECORD USED CTR
POPJ PP,
;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,
SUBTTL IMPURE AREA
RELOC
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
LOWCOR: BLOCK 0 ;BASE OF IMPURE AREA (EXCEPT TTYKAR)
INPKAR: BLOCK 1 ;IF NON-ZERO, THIS IS THE NEXT INPUT CHARACTER
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
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
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
;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 #
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