.
.         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