.
. POSITION COMMAND ROUTINE
.
.
. (C) Copyright 1972-1978 John Walker
.
. This software is in the public domain
.
AXR$
DEFUNCT$
FANG
PURE CODE
.
POSITION* LA A5,CDOPTS,X8 LOAD OPTIONS FOR THIS COMMAND
LX X5,CDBPC,X8 LOAD LINK TO FIRST PARAMETER
LX X9,PBVAL,X5 LOAD FDT POINTER
LX X5,PBLINK,X5 LINK TO COUNT PARAMETER
LA A6,FDTYPE,X9 LOAD FILE TYPE
JTAPE A6,TPOS IS IT TAPE ?
TOP,U A5,OPTION('S') NO. IS IT SET ADDRESS VARIANT ?
J RELSET NO. IT'S POSITION BY 'BLOCKS'
LA,U A3 CLEAR TO ASSUMED ADDRESS
TZ X5 SECOND PARAMETER SUPPLIED ?
LA A3,PBVAL,X5 YES. USE SUPPLIED ADDRESS
SA A3,FDMSAD,X9 SET MASS STORAGE ADDRESS IN FDT
COMPLETE . TAKE NORMAL COMPLETION
.
RELSET LA,U A3,1 LOAD ASSUMED NUMBER (ONE BLOCK)
TZ X5 WAS PARAMETER OMITTED ?
LA A3,PBVAL,X5 NO. LOAD SUPPLIED SKIP
LA A0,FDBLEN,X9 LOAD BLOCK LENGTH FOR FILE
DSL A0,36 RIGHT JUSTIFY IN TWO REGISTERS
TE,U A6,FFAST IS IT FASTRAND FORMAT ?
J GWAD NO. NO NEED TO SECTORISE
AA,U A1,27 INSURE COVERED DIVIDE
DI,U A0,28 CONVERT TO SECTORS
DSL A0,36 MOVE ANSWER TO A1
GWAD MSI A1,A3 COMPUTE ADDRESS DIFFERENCE
TEP A5,(OPTION('B')) MOVE BACKWARDS ?
LNA A1,A1 YES. COMPLEMENT INCREMENT
AA A1,FDMSAD,X9 APPLY INCREMENT/DECREMENT TO ADDRESS
TP A1 DID WE MOVE BEFORE START ?
LA,U A1 YES. SET TO ADDRESS ZERO
SA A1,FDMSAD,X9 UPDATE MASS STORAGE ADDRESS
COMPLETE . NORMAL COMPLETION
.
. TAPE POSITIONING
.
TPOS BGET IOL ALLOCATE AN I/O BUFFER
DL A1,FDIN,X9 LOAD INTERNAL NAME
DS A1,IOFN,A0 PUT INTO PACKET
SZ IOSTATUS,A0 SET THE STATUS POSITIVE
SX X9,IOFDT,A0 ATTACH FDT TO PACKET
LA,U A1,MF$ LOAD MOVE FORWARD FUNCTION
TEP A5,(OPTION('B')) SHOULD WE BACK UP ?
LA,U A1,MB$ YES. BETTER GO RIGHT DIRECTION
SA A1,IOFUNC,A0 PUT FUNCTION IN PACKET
SZ IOACW,A0 CLEAR ACCESS WORD
LA,U A1,IOCR LOAD INTERRUPT ROUTINE ADDRESS
SA A1,IOINTAD,A0 PUT INTO PACKET
SZ IOINTNAM,A0 INSURE A LEGAL INTERRUPT ID
SZ IOMASS,A0 IT'S A TAPE, YA HEAR !
SX X4,IOBB,A0 SAVE SWL ADDRESS IN PACKET
LA,U A1,1 LOAD IMPLIED BLOCK COUNT
TZ X5 WAS THE COUNT OMITTED ?
LA A1,PBVAL,X5 NO. LOAD THE USER-SUPPLIED COUNT
SA A1,IOCOUNT,A0 PUT COUNT IN I/O FCT
LA,U A1 CLEAR OPTION MODE
TEP,U A5,OPTION('M') MOVE BY FILES ?
LA,U A1,'M' YES. LOAD 'M' MODE
TEP,U A5,OPTION('L') MOVE TO END OF INFORMATION ?
LA,U A1,'L' YES. SET THAT MODE
if byfiles
jz a1,tposblk skip if positioning is by block
la,u a2,fsf$ by files. load skip file function
tep a5,(option('B')) positioning backward ?
la,u a2,bsf$ yes. load backspace file function
sa a2,iofunc,a0 set function in I/O packet
tposblk endf
TEP A5,(OPTION('E')) IS THE 'E' OPTION ON ?
LA,U A1,'E' YES. SET 'E' PROCESSING MODE
SA A1,IOOPT,A0 SAVE OPTION
SZ IOBB+1,A0 CLEAR LAST WAS EOF FLAG
IOI$ . FIRE UP I/O
POSDACT* . TAG TO DETECT ACTIVATION BY II (ENTRY)
DACT$ . WAIT FOR CASCADED INTERRUPTS TO CEASE
LA A1,IOSTATUS,A0 LOAD I/O STATUS
JZ A1,IOCMP NORMAL COMPLETION ?
TNE,U A1,2 IS IT END OF TAPE ?
J IOEOT YES. PROCESS IT
TE,U A1,1 END OF FILE ?
J IOABN NO. EDIT ABNORMAL MESSAGE
LA A1,IOOPT,A0 LOAD OPTION SELECTED
TE,U A1,'M' MOVE BY FILES ?
J NOTM NO. CHECK 'L'
TOP A5,(OPTION('B')) MOVING BACKWARD ?
J IOCMP NO. COMPLETE
LA,U A1,MF$ LOAD MOVE FORWARD CODE
IOMOVE SA A1,IOFUNC,A0 PUT IN PACKET
SZ IOINTAD,A0 CLEAR INTERRUPT ADDRESS
IOW$ . MOVE OVER THE TERMINATING MARK
LA A1,IOSTATUS,A0 LOAD STATUS CODE
TNE,U A1,2 IS IT END OF TAPE ?
J IOEOT YES. PROCESS THAT STATUS
TE,U A1,1 IT SHOULD BE EOF
J IOABN ISN'T SOMETHING WENT WRONG
IOCMP BRELP A0 RELEASE THE I/O FCT
COMPLETE . DONE WITH THIS COMMAND
.
NOTM TE,U A1,'L' IS IT MOVE TO END ?
J NOTL NO. THIS IS OPTIONLESS MOVE STOPPED BY E
LA,U A1,MB$ GET FUNCTION TO BACK UP OVER IT
TEP A5,(OPTION('B')) UNLESS, OF COURSE, WE WERE BACKING UP
LA,U A1,MF$ IN WHICH CASE WE GO FORWARD
J IOMOVE GO AND MOVE IT. THEN COMPLETE
.
NOTL LMJ X11,IOSEDT EDT END OF FILE MESSAGE
J IOCMP COMPLETE NORMALLY, HOWEVER
.
IOABN LMJ X11,IOSEDT EDIT ABNORMAL STATUS
ZAP . ROADBLOCK THE FILE
J IOCMP COMPLETE THE OPERATION
.
IOEOT .
LMJ X11,EOT PROCESS END-OF-TAPE
J IOCMP COMPLETE THE OPERATION
IERR . CAN'T GET EOT ON MOVE FORWARD FUNCTION (
.
. INTERRUPT ROUTINE
.
IOCR LA A1,IOSTATUS,A0 LOAD I/O STATUS
JZ A1,CRNORM NORMAL COMPLETION ?
tne,u a1,4 abnormal frame count ?
j crnorm yes. ignore it and treat as normal
TE,U A1,1 NO. WAS IT EOF ?
J CRACT NO. HANDLE ABNORMAL STATUS
LA A1,IOOPT,A0 LOAD OPTION SPECIFIED
TNE,U A1,'E' IS THE 'E' OPTION ON ?
J CREOPT YES. SET TO IGNORE THIS EOF BLOCK
TE,U A1,'M' POSITION BY FILES ?
J CHKLO NO. LOOK FOR 'L' OPTION
CRDECR LA A1,IOCOUNT,A0 LOAD COUNT SPECIFIED
ANA,U A1,1 DECREMENT IT
SA A1,IOCOUNT,A0 UPDATE THE COUNT
JZ A1,CRACT ALL DONE IF IT'S ZERO
JN A1,CRACT OR NEGATIVE
CRIO IOXI$ . FIRE UP NEXT BLOCK
CHKLO TE,U A1,'L' POSITION TO EOI ?
J CRACT NO. LET EOF TERMINATE OPTIONLESS POSITI
TZ IOBB+1,A0 WAS THE LAST BLOCK AN EOF TOO ?
J CRACT YES. THIS TERMINATES POSITION,L
LA,U A2,1 NO. BUT THIS ONE WAS...
SA A2,IOBB+1,A0 ...FLAG IT
J CRIO LOOK AT NEXT BLOCK
.
CRNORM SZ IOBB+1,A0 CLEAR 'LAST WAS EOF' FLAG
LA A1,IOOPT,A0 LOAD I/O OPTIONS
TZ A1 NO OPTIONS ?
TNE,U A1,'E' OR IGNORE EOF'S ?
J CRDECR NO OPTIONS. WE'RE COUNTING BLOCKS
J CRIO OTHERWISE, LOOK AT NEXT BLOCK
.
CREOPT SZ IOSTATUS,A0 CLEAR STATUS IN PACKET
J CRDECR GO DECREMENT COUNT LIKE NORMAL BLOCK
.
CRACT LA A1,IOBB,A0 LOAD SWL ADDRESS
ACT$ QL,A1 ACTIVATE WAITING MAIN ACTIVITY
EXIT$ . TERMINATE THIS ACTIVITY
END