ASMB,R,L,C * NAME: APOSN * SOURCE: 92070-18038 * RELOC: 92070-16038 * PGMR: G.A.A. * MOD: M.L.K. * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980. ALL RIGHTS * * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, * * * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* * * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * * *************************************************************** * * NAM APOSN,7 92070-1X038 REV.2011 800319 * HED APOSN ENT APOSN,EAPOS EXT $KIP,NX$EC,RFLG$,.ENTR,LOCF EXT GTOPN,$DBLX SUP SPC 1 * THE APOSN ROUTINE DOES ABSOLUTE FILE POSITIONING * OF RTE FILES * * CALLING SEQUENCE: * * CALL APOSN(IDCB,IERR,IREC,IRS,IOFF) SPC 1 * WHERE: * * IDCB IS THE FILES DATA CONTROL BLOCK * * IERR IS AN ERROR RETURN FLAG. POSSIBLE ERRORS, * 0 NO ERROR * -1 DISC DOWN * -5 SPACING BEYOND END OF DEFINED EXTENT * -9 ATTEMPT TO POSITION TYPE ZERO FILE * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 SOF IE IREC <1 * * IREC THE RECORD NUMBER TO BE READ NEXT * * IRS (REQUIRED FOR 3 & ABOVE ONLY) THE * RELATIVE BLOCK OF THE NEXT RECORD * * * IOFF THE BLOCK OFFSET OF THE NEXT * RECORD (REQUIRED FOR TYPE 3 AND * ABOVE ONLY) * SKP EAPOS NOP DOUBLE WORD ENTRY CCA SET DOUBLE WORD FLAG TRUE LDB EAPOS MOVE ENTRY ADDRESS JMP SETUP GO SETUP REST SPC 5 APOSN NOP CLA LDB APOSN GET RETURN ADDRESS SETUP STA DBLWD STORE DOUBLE WORD FLAG STB DPOSN STORE RETURN ADDRESS CLA CLEAR PARAMETER ADDRESSES STA IRC FOR ENOUGH PARAMETER STA IOFF TESTS JMP DPOSN+1 GO FETCH CALL PARMS SPC 5 * DCB NOP ER NOP IRC NOP IRS NOP IOFF NOP SPC 1 DPOSN NOP ENTRY POINT JSB .ENTR FETCH PRAM DEF DCB ADDRESSES * CLB,INB SET THE READ STB RFLG$ FLAG LDB DCB COMPUTE ADB .2 TYPE STB TYPE AND ADB .5 STEP TO BLOCK LENGTH LDA B,I FETCH ARS,ALR AND ALF,ALF CONVERT RAL TO NUMBER OF 128 WORD BLOCKS STA BLKSZ SAVE ADB .2 STEP TO OPEN FLAG JSB GTOPN GET CURRENT OPEN FLAG DEF *+1 CPA B,I IS IT SAME AS IN DCB? JMP OPIN YES, FILE OPEN LDA N11 NO, ERROR 11 JMP EXIT NOW EXIT * OPIN LDA N9 SET A= -9 LDB TYPE,I IS FILE TYPE SZB,RSS ZERO? JMP EXIT YES; EXIT ADB N3 IF TYPE 1 OR 2 STB TYPE SAVE FOR LATER LDA IRC TEST FOR RECORD PRAM SSB,RSS ELSE TEST LDA IOFF FOR FULL PRAM SZA,RSS LIST JMP ER10 NOT ENOUGH PRAMS - EXIT * ISZ DBLWD TEST DBL FLAG JMP SINGL SINGLE WORD, SKIP TESTS DLD IRC,I GET DOUBLE RECORD JSB $DBLX CHECK RANGE JMP EXIT ERROR (A=ERROR CODE) ISZ IRC POINT TO LOW BITS LDB TYPE GET TYPE INDICATION AGAIN SSB IF TYPE 1 OR 2, SKIP JMP RCSET DOUBLE TEST OF BLOCK DLD IRS,I GET DOUBLE SECTOR JSB $DBLX CHECK RANGE JMP EXIT ERROR ISZ IRS POINT TO LOW BITS * SINGL LDB TYPE GET TYPE INDICATOR AGAIN SSB IF 1 OR 2 JMP RCSET GO SET RECORD NO. SPC 1 JSB LOCF USE LOCF TO DEF LOCRT GET DEF DCB,I CURRENT DEF ER,I RELATIVE DEF RC SECTOR DEF CIRS ADDRESS LOCRT CLB CALL LDA DCB SKIP JSB $KIP TO JMP EXIT SET UP NX$EC CLB CACULATE LDA CIRS THE RELATIVE DIV BLKSZ BLOCK CMA,INA NUMBER STA CIRS CLB LDA IRS,I DESIRED DIV BLKSZ AND SWP SET FOR ADB CIRS NX$EC CALL SZB,RSS IF ALREADY THERE JMP RCSET SKIP POSITION CALL JSB NX$EC POSITION WITH NX$EC JMP EXIT ERROR - EXIT RCSET RRL 7 LDB DCB GET DCB ADB .12 COMPUTE BUFFER POINTER ADDRESS STB CIRS ADB IOFF,I COMPUTE DESIREDED ADB .4 CONTENTS ADB A ADD THE NO OF 128 WORD BLOCKS STB CIRS,I AND SET ISZ CIRS STEP TO THE ISZ CIRS RECORD NUMBER LDB IRC,I SET RECORD NUMBER SZB ZERO SSB OR NEG JMP ER12 EXIT ERROR STB CIRS,I SET THE RECORD NUMBER LDB DCB GET DCB ADDRESS ADB .13 POSITION TO EOF FLAG LDA B,I GET WRITTEN-ON/EOF/IN BUFFER FLAG RAR,CLE,RAR CLEAR EOF ELA,RAL READ FLAG STA B,I STORE IN DCB CLA,RSS OK - EXIT ER10 LDA N10 EXIT STA ER,I SET ERROR CODE JMP DPOSN,I RETURN. SPC 2 ER12 LDA N12 SEND EOF ERROR JMP EXIT SPC 2 * STORAGE SPC 1 N3 DEC -3 N9 DEC -9 N11 DEC -11 N12 DEC -12 .2 DEC 2 .4 DEC 4 .5 DEC 5 .12 DEC 12 .13 DEC 13 N10 DEC -10 BLKSZ NOP CIRS NOP DBLWD NOP TYPE NOP RC EQU TYPE SPC 2 A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END