File: ISAM.02 of Tape: Various/Decus/decus-2
(Source file text)
LAP
IBUF, BLOCK 200/START OF MAIN BUFFER
BLOCK 177
IBUFE, 0 /END OF MAIN BUFFER
JBUF, BLOCK 200/START OF AUX BUFFER
BLOCK 177
JBUFE, 0 /END OF AUX BUFFER
CPAGE 6
EAP
/INDEX SEQUENTIAL I/O ROUTINES
/
/
/
/VERSION 02
/
/
/THERE ARE EIGHT ENTRIES TO THIS SOUBROUTINE
/ INITL WILL INITIALIZE THE DATA BASE CALLED
/ FROM THE CALLING PROGRAM WITH AN EXTENSION
/ OF '.DA' ASSUMED
/
/ RESET WILL RESET ALL THE POINTERS AND GET
/ THE FIRST BLOCK OF DATA
/
/ GET WILL GET THE NEXT SEQUENTIAL RECORD OF DATA
/
/ PUT WILL PLACE THE DATA AFTER THE LAST RECORD
/ OF DATA ACCESSED
/
/ BKSPC WILL BACKSPACE THE FILE ONE LOGICAL RECORD
/
/ DELET WILL DO JUST THAT - DELETE THE RECORD THAT
/ WAS JUST READ
/
/ FINISH WILL ALSO DO JUST THAT-CLOSE THE FILE TO
/ ALL ADDITIONAL I/O.
/
/ RWRTE WILL PLACE NEW DATA WITH AN EQUAL BLOCK
/ AS THE OLD IN THE OLD'S PLACE
/
/
/THESE ROUTINES WILL OPERATE ONLY ON A FILE ON THE
/ SYSTEM DEVICE SINCE IT USES THE PERMINATELY
/ RESIDENT DEVICE HANDLER WITH AN ENTRY POINT
/ OF 7607
/
/
/ USE WITH CAUTION
/
ENTRY INITL /INITIALIZE THE I/O HANDLERS ETC.
ENTRY RESET /RESET ALL GOODIES AND GO TO REC#1
ENTRY GET /GET A LOGICAL RECORD
ENTRY PUT /PUT A LOGICAL RECORD
ENTRY BKSPC /GO BACK ONE LOGICAL RECORD
ENTRY DELET /DELETE THE MOST RECENTLE READ RECORD
ENTRY FINSH /CLOSE THE FILE TO ALL ADDL I/O
ENTRY RWRTE /REWRITE A BLOCK OF EQUAL LENGTH
/
/
/
/
OPDEF CIFZ 6202 /CHANGE INST FIELD TO ZERO
OPDEF CDFZ 6201 /CHANGE TO DF 0
OPDEF CDF1 6211 /CHANGE DF TO 1
OPDEF TADI 1400 /TAD INDIRECT
OPDEF DCAI 3400 /DCA INDIRECT
/
/
ABSYM GPNT 130 /POINTER TO CURRENT LOCATION
ABSYM RCNT 131 /CNTR- NUMBER OF RECORDS/BLOCK
ABSYM DEST 132 /DESTINATION OF COMMON DATA
ABSYM IMRK 133 /NUMBER OF BLOCK IN CORE
ABSYM IFW 134 /FORDWARD POINTER
ABSYM IBK 135 /REVERSE POINTER
ABSYM MEND 136 /ABS END OF DATA BASE(BLK NO)
ABSYM MBASE 137 /ABS START OF DATA BASE(BLK NO)
ABSYM FREE 140 /BLK NO OF FIRST FREE BLOCK
ABSYM STRT 141 /BLK NO OF FIRST DATA BLOCK
ABSYM TEMP1 142 /JUST THAT - TEMPORARY STORAGE
ABSYM TEMP2 143 /DITTO
ABSYM TEMP3 144 /DITTO
ABSYM TEMP4 145 /DITTO
ABSYM CNTR 146 /COUNTER FOR VARIOUS DATA MOVES
/
/
IXYZ, COMMN 1 /FORCE ERROR IF NO
/COMMON STORAGE SPECIFIED
LOSTR, IBUF# /ADDRESS OF START OF DATA
MNWDS, 7777 /SKIPS AFTER WORD COUNT OVFLO
MNREC, 7777 /SKIPS AFTER REC COUNT OVFLO
MSG2, TEXT 'ISM2' /NO OR TWO INITL'S
INITL, BLOCK 2 /INITIALIZE ALL GOODIES
TAD MHAND /TWO OPENS???
SNA CLA
JMP INOK /NOPE
CALL 0,FINSH /YUP - RATS
JMP NOPEN /AND THE NASTY GRAM
INOK, TAD I INITL /GET THE NAME OF THE FILE
DCA NAME
INC INITL#
TAD I INITL
DCA NAME#
INC INITL#
CALL 2,IOPEN /GET THE PARAMETERS
ARG DEV /DEV WAS SET TO SYS EARLIER
NAME, ARG 0 /.DA ASSUMED
CLA CLL CMA /AND PICK UP THE GOODIES
CDFZ
TADI S616
DCA MBASE /SAVE THE FIRST BLOCK NO
TADI S573
CMA IAC /AND COMP SINCE IS NEGATIVE
IAC
TAD MBASE
DCA MEND /SAVE THE LAST BLOCK NO
TADI S122
CURFD, DCA MHAND /AND ENTRY OF SYS HANDLER
TAD CURFD /AND PUT THE CALLING DATA FIELD
AND (70 /IN THE READ/WRITE ROUTINE
TAD (0200
DCA RWPAR
CLA CLL IAC
JMS RWROT
INC MBASE /BUMP MBASE TO FORCE ERROR IF
CLA CLL CMA RAL /TRY TO ACCESS BLOCK ZERO
/GET THE START OF THE FIRST BLK
TAD LOSTR
DCA 10
TADI 10 /GET THE START BLK NO
DCA STRT
TADI 10 /GET THE FIRST FREE BLK NO
DCA FREE
TADI 10 /GET THE NO WDS PER BLK
DCA MNWDS
TADI 10 /GET THE NO RECS PER REC
DCA MNREC
CALL 0,RESET /GET THE FIRST RECORD
TAD CTLC
CDFZ
DCAI S167
TAD CURFD
IAC /TO MAKE IT A CIF CUR
DCAI S165
TAD (5567 /AND PUT A JMP I .+1 IN 166
DCAI S166
TAD S5165 /********************
DCAI S7600 /AND A JMP 165 IN 07600
/NOTE IF ODT IS USED, THESE TWO
/CELS MUST BE NOP'ED SINCE ODT
/USES 07600 FOR SWAPPING
/**********************
RETRN INITL /AND GO HOME
S5165, 5165 /JMP PG 0 165
CTLC, CTLCX /ENTRY OF CRASH ROUTINE
EOF, CALL 0,FINSH /EOF WHEN NOT EXPECTED
CALL 1,ERROR /NASTY-GRAM
ARG MSG1
S7600, 7600 /ENTRY OF MONITOR
S616, 616 /LOCATION OF FIRST BLOCK NO
S573, 573 /LOCATION OF LAST BLOCK NO
S122, 122 /LOCATION OF HANDLER
S165, 165
S166, 166
S167, 167
MSG1, TEXT 'ISM1' /EOF WHEN NOT EXPECTED
GET, BLOCK 2 /GET THE NEXT SEQ RECORD
GETNX, CLA CLL
TAD MNWDS /GET THE NUMBER OF WORDS
DCA CNTR
DCA TEMP1 /WHEN AT END,IF TEMP1=0,A FILLER
TAD (200
DCA DEST
NCAR2, TAD I GPNT
CDF1
DCAI DEST
INC DEST
DTAG1, TAD I GPNT /TAG TO FORCE CDF CUR
SNA CLA
INC TEMP1 /THAT ONE WAS A ZERO
INC GPNT /GETTING THE DATA FROM 0
ISZ CNTR
JMP NCAR2
ISZ RCNT
JMP GETDN /STILL ROOM IN THIS BLOCK
CLA CLL
TAD IBUFE
SNA /END OF FILE???
JMP EOF /TOO BAD
JMS RWROT /GET IT
TAD IBUF
CMA IAC
TAD IMRK /HOPE IT MATCHES
SZA CLA
JMS ERRXR /RATS!!!
TAD IFW
JMS FRSET /SET THE POINTERS
GETDN, TAD MNWDS
TAD TEMP1
SNA CLA
JMP GETNX /THAT LAST ONE WAS BLANK
RETRN GET /THATS ALL FOLKS
FINSH, BLOCK 2 /CLOSE THE FILE TO I/O
CLA CLL CMA /SET AC=-1
TAD MBASE
DCA MBASE
CLA CLL IAC
JMS RWROT /GO GET THE FIRST BLOCK
TAD FREE
DCA IBUF#
TAD STRT
DCA IBUF
CLA STL IAC
JMS RWROT /SAVE THESE GOODIES
DCA MHAND /AN I/O NOW IS A NO-NO
CLA CLL CMA
DCA MNREC /RESET M NO RECORDS TO FORCE
CLA CLL CMA /ERROR IF TRY TO ACCESS I/O
DCA MNWDS /AGAIN
JMS RSTORE
RETRN FINSH
RESET, BLOCK 2 /GO BACK TO THE BEGINNING
CLA CLL
TAD STRT /GET THE STARTING BLOCK
JMS RWROT
TAD STRT /AND AGAIN
JMS FRSET
CALL 0,GET /AND GET THE FIRST RECORD
RETRN RESET /THAT WAS FAST
FRSET, 0 /SET ALL THE GOOD POINTERS ETC
DCA IMRK /THATS WHERE WE ARE
TAD IBUF
DCA IBK
TAD IBUFE
DCA IFW
TAD LOSTR /SET GPNT
DCA GPNT
TAD MNREC /ANS SET RCNT
DCA RCNT
JMP I FRSET
BKSPC, BLOCK 2 /GO BACK 2(ONE FOR THE ONE YOU
JMS BKONE /JUST READ AND AGAIN FOR THE ONE
JMS BKONE /YOU REALLY WANT TO GET TO)!
CALL 0,GET /SET THE DATA
RETRN BKSPC
BKONE, 0 /GO BACK ONE--DO NOT PASS GO
BK1, CLA CLL CMA /SET AC=-1
TAD RCNT
DCA RCNT
TAD GPNT
TAD MNWDS
DCA GPNT /GO BACKWORDS ONE RECORD
TAD GPNT
CMA
TAD LOSTR
SPA CLA /IN THIS BLOCK???
JMP THBLK /YUP
CLA CLL
TAD IBUF
SZA
JMP REVDR
CALL 0,RESET /THAT WAS THE BEGINNING OF FILE
JMP BKDON
REVDR, JMS RWROT
TAD IBUFE /CHECK THE POINTERS
CMA IAC
TAD IMRK
SZA CLA
JMS ERRXR /TILT - POINTERS DONT MATCH
TAD IBK
JMS FRSET
TAD MNWDS
CMA IAC
DCA TEMP2 /T2 NOW CONTAINS WDS PER RECORD
TAD MNREC
IAC
DCA TEMP1 /T1 CONTAINS THE -NO OF RECS
TAD LOSTR
MRCHK, TAD TEMP2
ISZ TEMP1
JMP MRCHK
DCA GPNT /COMPUTE NEXT TO LAST REC ADDR
CLA CLL CMA
DCA RCNT
THBLK, TAD GPNT
JMS EMCHK
SPA CLA
JMP BK1 /THIS ONE IS EMPTY,SO BACKONE AGAIN
BKDON, JMP I BKONE
CPAGE 11
RSTORE, 0 /PUT A 4207 BACK IN LOC 07600
CLA CLL
TAD (4207
CDFZ
DCAI X7600 /USE A NEW VAR SO ON SAME PAGE
JMP I RSTORE /AND GO HOME
X7600, 7600
RWROT, 0 /SYSTEM I/O HANDLER
TAD MBASE /SINCE THAT IS RELATIVE
DCA RW3 /ENTER WITH AC=BLOCK NO AND LINK
RAR /=0-READ;=1-WRITE
TAD RWPAR
DCA RW1
TAD MBASE /CHECK THE LOW BOUNDRY
CMA
TAD RW3
SPA CLA
JMS ERRXR /TOO SMALL
TAD RW3 /CHECK THE HI BOUNDRY
CMA IAC
TAD MEND
SPA CLA
JMS ERRXR /TOO LARGE
TAD MHAND /CHECK TO SEE IF INITL ALREADY
SNA CLA /CALLED
JMP NOPEN /TILT - - USER ERROR
CIFZ
JMS I MHAND /READ OR WRITE
RW1, 0 /RWPAR WITH 2 PAGES
RW2, IBUF /THATS WHERE WE START FROM
RW3, 0 /WITH THIS BLOCK NO
JMS ERRXR /ERROR RETURN
CLA CLL
JMP I RWROT /ALL DONE
RWPAR, 0 /TWO PAGES WITH DF IN BITS 6-8
MHAND, 0 /ENTRY OF SYS HANDLER GOES HERE
NOPEN, CALL 1,ERROR /NO OPEN OR TWO OPENS
ARG MSG2
MSG3, TEXT 'ISM3' /NO ROOM LEFT
PUT, BLOCK 2 /PUT A RECORD AFTER THE ONE
/YOU JUST READ
CLA CLL
TAD GPNT
JMS EMCHK /IS IT EMPTY?
SMA CLA
JMS SWOUT /NOPE SO SWAP OUT
TAD (200
DCA DEST
TAD MNWDS
DCA CNTR
PWRD, CDF1 /GET THE WORD
TADI DEST
DCA I GPNT /AND STORE IT AWAY
INC DEST
INC GPNT
ISZ CNTR /ALL DONE?
JMP PWRD /NOPE
JMS CMPCT /NOW SQUASH IT TOGETHER
TAD SWSTH /SWSTH=0 MEANS NO SECOND REQUIRED
SNA CLA /SWSTH=-1 MEANS USED TWO BLOCKS
JMP NSWPD
TAD FREE /YUP
DCA IBUFE /SET MARKERS
TAD IMRK
STL
JMS RWROT /WRITE THE I BLOCK
TAD FREE
JMS RWROT /GET THE NEW BLOCK TO INSERT
TAD IBUF
SZA CLA
JMS ERRXR /NONZERO ON IBUF OF FREE
TAD IMRK
DCA IBUF
TAD FREE
DCA TEMP4
TAD IBUFE
DCA FREE
TAD IFW
DCA IBUFE
TAD LOSTR /ALL POINTERS NOW SET
DCA TEMP1
TAD TEMP1
TAD (400
DCA TEMP2
TAD (-376
DCA TEMP3
MMORE, TADI TEMP2 /COPY I TO J
DCAI TEMP1
DCAI TEMP2 /CLEAR WHERE DATA CAME FROM
INC TEMP1
INC TEMP2
ISZ TEMP3
JMP MMORE
TAD TEMP4 /NOW SET THE 1ST REC ST POINT
STL
JMS RWROT /NOW WRITE THE NEW BLOCK
TAD IFW
SNA /IS IT AN END OF FILE?
JMP COREND /YUP!
JMS RWROT /GET THE OLD FWD BLOCK
TAD TEMP4
DCA IBUF
TAD IFW
STL
JMS RWROT /REWRITE THE OLD FWD BLOCK
COREND, TAD TEMP4
DCA IFW
TAD FREE /NOW SET THE IBUF OF THE FREE(NEW)
SNA
JMP NOEND /THERE IS NO ROOM IN FREE STRING
JMS RWROT /LIST TO ZERO
TAD IBUF
CMA IAC
TAD TEMP4 /AND CHECK THE LINKAGES
SZA CLA /THE FREE LIST HAS BAD LINKAGES
JMS ERRXR
DCA IBUF
STL
TAD FREE
JMS RWROT
NOEND, TAD SWSTH / START WITH ANOTHER RECORD???
SPA CLA
JMP KEPBLK /NOPE
TAD IFW /GET IT
JMS RWROT
TAD IBUF
CMA IAC
TAD IMRK
SZA CLA
JMS ERRXR /$%&* LINKAGE
TAD IFW
JMS FRSET /AND SET THE POINTERS
JMP ENPUT
NSWPD, STL
KEPBLK, TAD IMRK /STAY IN THIS BLOCK
JMS RWROT
ENPUT, DCA SWSTH
RETRN PUT /THATS ALL FOLKS
SWOUT, 0 /SWAP OUT THE SECOND HALF
CLA CLL IAC
DCA SWSTH
TAD FREE /I HOPE THERE IS ROOM
SNA CLA
JMP NOROOM /TOO BAD
TAD GPNT /MOVE GOOD DATA TO JBUF
DCA TEMP1
TAD TEMP1
TAD (400
DCA TEMP2
TAD HISTR
CMA IAC
IAC
TAD GPNT
DCA CNTR
MRCPY, TADI TEMP1
DCAI TEMP2
DCAI TEMP1
INC TEMP1
INC TEMP2
ISZ CNTR
JMP MRCPY
JMP I SWOUT /DONE
NOROOM, CALL 0,FINSH /NO ROOM LEFT ON FILE
CALL 1,ERROR
ARG MSG3
DELET, BLOCK 2 /DELETE AN ENTIRE BLOCK
JMS BKONE
TAD MNWDS
DCA CNTR
EMTMR, DCAI GPNT
INC GPNT
ISZ CNTR
JMP EMTMR
JMS CMPCT /SQUASH IT TOGETHER
TAD LOSTR /IS THE BLOCK EMPTY?
JMS EMCHK
SZA CLA
JMP DRPON /YUP - SO DROP IT
STL
TAD IMRK
JMS RWROT /REWRITE THE BLOCK
DON5, CALL 0,GET /NOW GET THE NEXT RECORD
RETRN DELET
HISTR, JBUF /START OF UPPER BUFFER
DRPON, TAD FREE /DROP AN ENTIRE BLOCK
DCA IBUFE
DCA IBUF
STL /PUT CURRENT REC ON FREE LIST
TAD IMRK /SET OT IN THE FREE LIST
JMS RWROT
TAD FREE /GET OLD FREE REC
SNA /IS THERE AN OLD FREE REC
JMP NOOLD /NOPE!!
JMS RWROT
TAD IBUF
SZA CLA
JMS ERRXR /****LINKAGE!!!
TAD IMRK
DCA IBUF
STL
TAD FREE
JMS RWROT /AND SET POINTERS ON OLD FREE
NOOLD, TAD IFW
SNA
JMP LREC /THAT WAS THE LAST RECORD
JMS RWROT /SET THE FWD POINTER
TAD IBUF /GET FWD BLOCK
CMA IAC
TAD IMRK
SZA CLA
JMS ERRXR
STL
TAD IBK
DCA IBUF
TAD IFW
JMS RWROT /REWRITE OLD FWD BLOCK
LREC, TAD IBK /SET THE BACK POINTER
SNA
JMP FRCRD /THAT WAS THE FIRST RECORD
JMS RWROT /GET REVERSE BLOCK
TAD IBUFE /AND CHECK THE LINKAGES
CMA IAC
TAD IMRK
SZA CLA
JMS ERRXR
TAD IFW
DCA IBUFE
STL CLA
TAD IBK
JMS RWROT
DON6, TAD IMRK
DCA FREE
TAD IFW
JMS RWROT /REWRITE REVERSE BLOCK
TAD IFW
JMS FRSET /GLUE THE POINTERS ETC TOGETHER
JMP DON5
FRCRD, TAD IFW /RESET THE START BLOCK NO
DCA STRT
JMP DON5
RWRTE, BLOCK 2 /REWRITE THE SAME SIZE BLOCK
JMS BKONE
TAD MNWDS
DCA TEMP1
TAD (200
DCA TEMP2
FAST, CDF1
TADI TEMP2
DCA I GPNT
INC TEMP2
INC GPNT
ISZ TEMP1
JMP FAST /GET ANOTHER WORD
STL
TAD IMRK
JMS RWROT /REWRITE THE BLOCK
ISZ RCNT /DONT FORGET TO BUMP RCNT
JMP DNRWT
CLA CLL
TAD IFW
SNA /END OF FILE???
JMP EOF
JMS RWROT
TAD IBUF /CHECK THE LINKAGES
CMA IAC
TAD IMRK
SZA CLA
JMS ERRXR /RATS!!!!!!
TAD IFW
JMS FRSET /AND SET THE POINTERS
DNRWT, RETRN RWRTE
MSG4, TEXT 'ISM4' /DESASTER A MAJOR ERROR
SWSTH, 0 /SWAP SWITCH TO SHOW IF SWAPPED
ERRXR, 0 /WHERE WE CAME FROM GOES HERE
JMS RSTORE /PUT 4207 BACK IN 07600
CALL 1,ERROR /BAD LINKAGE SOMEWHERE
ARG MSG4
CMPCT, 0 /COMPACT I AND J BUFFERS
TAD LOSTR /SET THE STARTING POINT
JMS CMPCTR /AND SQUASH I
TAD SWSTH /HAVE TO SQUASH J???
SZA CLA
JMP BOTH /YUP
HOME, DCA SWSTH /CLEAR SWAP SWITCH
JMP I CMPCT /BYE BYE
BOTH, TAD DEST
DCA TEMP3
TAD HISTR
IAC
JMS CMPCTR /AND SQUASH IT
CLA CLL CMA
TAD DEST /WILL IT ALL FIT IN ONE BLOCK??
TAD TEMP3
TAD MNREC
SPA CLA
JMP WILL
CLA CLL CMA /AC=-1 MEANS WONT FIT
JMP HOME
WILL, TAD MNREC
DCA TEMP3
TAD LOSTR
DCA TEMP1
WILL1, TAD TEMP1
JMS EMCHK
SPA CLA
JMP EMPT7
TAD MNWDS
CMA IAC
TAD TEMP1
DCA TEMP1
ISZ TEMP3
JMP WILL1
WONT, CLA CLL IAC /WONT FIT AFTER ALL-SET SWITCH
JMP HOME /TO THE NEXT BLOCK
EMPT7, TAD HISTR
IAC
DCA TEMP2
EMPT8, TAD MNWDS
DCA CNTR
EMPT9, TADI TEMP2
DCAI TEMP1
DCAI TEMP2
INC TEMP1
INC TEMP2
ISZ CNTR
JMP EMPT9 /LETS MOVE THE ENTIRE BLOCK
ISZ TEMP3
JMP EMPT8 /ALL OF IT
CLA CLL /SET AC=0
JMP HOME /AND RETURN
CMPCTR, 0 /COMPACT 256 WORDS
DCA TEMP1 /T1 WHERE DATA COMMING FROM
DCA DEST /RESET COUNTER OF NO VALID RECS
TAD MNREC /AND T2 IS WHERE IT WILL GO
DCA TEMP4
CMP0, TAD TEMP1
JMS EMCHK /CHECK IF FIRST ONE EMPTY
SMA CLA /AC=-1 EMPTY -- AC=0 FULL
JMP FULL1
TAD TEMP1
DCA TEMP2
CMP1, JMS GPCHK /THAT ONE WAS EMPTY
TAD MNWDS
CMA IAC
TAD TEMP1
DCA TEMP1
CMP2, ISZ TEMP4 /BUMP RECORD COUNTER BY ONE
JMP MAYBE
JMP I CMPCTR
MAYBE, TAD TEMP1
JMS EMCHK
SZA CLA
JMP CMP1 /ANOTHER EMPTY ONE
TAD MNWDS
DCA CNTR
JMS GPCHK
MOV3, TADI TEMP1
DCAI TEMP2
DCAI TEMP1
INC TEMP1
INC TEMP2
ISZ CNTR
JMP MOV3
INC DEST /COUNT THE NO OF GOOD RECORDS
JMP CMP2 /AND GO CHECK AGAIN
FULL1, INC DEST
TAD MNWDS
CMA IAC
TAD TEMP1
DCA TEMP1
ISZ TEMP4
JMP CMP0
JMP WONT /WONT FIT - NEVER
CPAGE 26
EMCHK, 0 /CHECK TO SEE IF RECORD IS EMPTY
CMA IAC
CMA
DCA 10
DCA DUM1
TAD MNWDS
DCA CNTR
EMCK1, TADI 10
SNA CLA /ZERO??
INC DUM1
ISZ CNTR
JMP EMCK1
CLA CLL
TAD DUM1
TAD MNWDS
SNA CLA
CMA /EXIT WITH AC=0 - OK
JMP I EMCHK /EXIT WITH AC=-1 - EMPTY
DUM1, 0 /COUNTER FOR NO OF EMPTY WORDS
GPCHK, 0 /MUST TAKE GPNT ALONG TOO
TAD GPNT
CMA IAC
TAD TEMP1
SZA CLA
JMP END3
TAD TEMP2
DCA GPNT
TAD MNREC
TAD DEST
DCA RCNT
END3, JMP I GPCHK /SO WE DID
CTLCX, CALL 0,FINSH
CALL 0,EXIT
DEV, TEXT 'SYS' /SYSTEMS DEVICE ONLY!!!!!
END