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