ASMB,L,R,C * NAME: POSNT * SOURCE: 92070-18049 * RELOC: 92070-16049 * PGMR: G.A.A. * MOD: G.L.M * * *************************************************************** * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. 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 POSNT,7 92070-1X049 REV.1941 790709 * HED POSNT ENT POSNT,EPOSN EXT EXEC,.ENTR,RFLG$,P.PAS,READF,$KIP EXT GTOPN,$DBLX SUP * * POSNT IS THE FILE POSITION ROUTINE FOR THE * RTE FILE MANAGEMENT PACKAGE * * CALLING SEQUENCE: * CALL POSNT (IDCB,IERR,NP,IR) * WHERE: * IDCB IS THE FILES DATA CONTROL BLOCK * ADDRESS * IERR IS THE ERROR RETURN ADDRESS * POSNT ERRORS ARE: * 0 NONE * -1 DISC DOWN * -5 AN ILLEGAL RECORD WASENCOUNTERED * (LENGTHS AT EACH END DID NOT MATCH * -10 NOT ENOUGH PARAMETERS * -11 DCB NOT OPEN * -12 EOF OR SOF SENSED * -17 CONTROL REQUEST FAILED * NP IF >0 THEN SKIP NP RECORDS * IF <0 THEN BACK SPACE NP RECORDS * IF =0 THEN NO OPERATION * IR (OPTIONAL) IF NOT CODED OR ZERO * NP IS RELATIVE OTHERWIZE * NP IS ABSOLUTE (NP MUST BE>0) SKP EPOSN NOP DOUBLE WORD ENTRY POINT CCA SET DBL FLAG TRUE LDB EPOSN GET RETURN ADDRESS JMP SETUP GO FINISH SET UP SPC 3 POSNT NOP SINGLE WORD ENTRY CLA SET DBL FLAG FALSE LDB POSNT GET RETURN ADDRESS SETUP STA DBLWD STORE DBL FLAG STB DOSNT STORE RETURN ADDRESS LDA DFZER PRE-SET OPTIONAL ENTRY PARMS STA NP STA IR CLA STA ZERO JMP DOSNT+1 GO FETCH CALL PARMS SPC 3 DCB NOP ER NOP NP DEF ZERO IR DEF ZERO SPC 1 DOSNT NOP ENTRY POINT JSB .ENTR FETCH DEF DCB ADDRESSES LDA N10 ENOUGH LDB NP PRAMS CPB DFZER SUPPLIED? JMP EXIT NO,EXIT ISZ DBLWD DOUBLE OR SINGLE ENTRY? JMP SINGL SINGLE, SKIP RANGE TESTS DLD NP,I GET DOUBLE INTEGER JSB $DBLX CHECK RANGE JMP EXIT ERROR RETURN (A= ERROR CODE) ISZ NP POINT TO LOWER BITS * SINGL STB RFLG$ FORCE READS WHILE SPACING CLB,CLE SET LDA DCB UP JSB P.PAS LOCAL DEC -15 DCB RCOU NOP ADDRESSES DUM NOP TYPE NOP TYPE LU NOP LU FOR TYPE 0 EOF NOP EOF CODE FOR TYPE 0 SPACE NOP SPACING LEGAL FLAGE TYPE 0 CONND NOP LN NOP DSTAT NOP OPEN NOP OPEN FLAG ABRC NOP RCLN NOP BFPT NOP BUFFER POINTER TYPE 3AND ABOVE RWFLG NOP READ/WRIE /EOF FLAG RC NOP RECORD COUNT JSB GTOPN GET CURRENT OPEN FLAG DEF *+1 CPA OPEN,I SAME AS IN DCB? JMP OPIN YES, IT'S OK LDA N11 NO, NOT OPEN JMP EXIT SO LEAVE OPIN CCE SET E FOR LATER LDA BFPT GET BUFFER POINTER ADDRESS RAL,ERA SET INDIRECT BIT STA BFPT RESET POINTER * LDA NP,I GET RECORD NUMBER SZA,RSS IS IT 0? JMP EXOK YES, NOP EXIT * LDA IR,I GET RELATIVE /ABSOLUTE FLAG CLB ASSUME ABSOLUTE SZA,RSS RELATIVE? LDB RC,I YES; GET CURRENT RECORD NO. ADB NP,I ADD THE REQUESTED MOVEMENT STB ABRC SAVE NEW ABSOLUTE ADDRESS CMB,INB SET NEGATIVE AND ADB RC,I COMPUTE RELATIVE RECORD NUMBER CMB,INB,SZB,RSS SET TO RIGHT SIGN - ZERO? JMP EXOK YES - GO EXIT STB RCOU NO; SET COUNT SPC 1 LDA TYPE,I GET TYPE OF FILE CMA,INA,SZA,RSS TYPE ZERO? JMP TYP0 YES; GO TO TYPE ZERO ROUTINE INA,SZA TYPE; 1 INA,SZA,RSS OR 2 JMP TY1/2 YES; GO TO RANDOM ACESS POSITION SPC 1 CMB,SSB,INB TYPE 3 OR ABOVE - FORWARD JMP FSRC SPACE - YES GO DO IT. SPC 2 * TYPE 3 AND ABOVE BACKSPACE ROUTINE SPC 1 BSRC LDA BFPT,I GET CURRENT POSITION INA,SZA IS IT EOF? JMP BSRC3 NO; GO BACKSPACE LDA RWFLG,I YES; GET THE READ/WRITE RAR,CLE,RAR FLAG AND CLEAR THE EOF BIT ELA,RAL THEN STA RWFLG,I RESTORE THE FLAG SEZ WAS IT SET? JMP BSRC5 YES; COUNT AS A RECORD BSRC3 CCB NO; BACKSPACE 1 LDA DCB WORD JSB $KIP WITH THE JMP EXIT SKIP ROUTINE LDA BFPT,I GET THE RECORD LENGTH STA RCLN SAVE IT CMA BACK SPACE TO STA B THE LDA DCB TWIN JSB $KIP WITH THE JMP EXIT SKIP ROUTINE LDA BFPT,I GET TWIN CPA RCLN TWINS MATCH? BSRC5 CCA,RSS YES; SKIP JMP ER5 NO; ERROR -5 ADA RC,I DECREMENT THE STA RC,I RECORD COUNT ISZ RCOU STEP BACKSPACE COUNT ; DONE? JMP BSRC3 NO; DO THE NEXT ONE JMP EXOK * FORWARD SPACE TYPE ZERO AND 3 AND ABOVE FILES * FSRC STB RCOU SET COUNT FSRC1 JSB READF READ DEF REART A DEF DCB,I RECORD DEF ER,I TO DEF DUM LOCAL DUMMY DEF .1 ONE WORD BUFFER DEF LN REART SSA IF ERROR JMP EXIT EXIT LDB LN SSB JMP EOFEX ISZ RCOU JMP FSRC1 JMP EXIT SKP * TYPE ZERO SPACE ROUTINE SPC 1 TYP0 CMB,SSB,INB IF FORWARD SPACE JMP FSRC GO TO READ ROUTINE SPC 1 LDA N3 PRESET FOR ERROR LDB SPACE,I BACK SPACE GET SSB,RSS LEGAL CODE JMP EXIT BACK SPACE NOT LEGAL-EXIT SPC 1 LDA LU,I GET AND AND B77 ISOLATE LU ADA B200 ADD BACK SPACE FUNCTION STA CONND SET FOR CALL ADA B400 MAKE A DYNAMIC STATUS RQ STA DSTAT SET IT CCA SET FIRST EOF RECORD FLAG SPC0 STA OPEN IN OPEN JSB EXEC CALL EXEC DEF EXRTN TO DEF .3I BACK DEF CONND SPACE EXRTN JMP ER17 EXEC ERROR JSB EXEC DO DYNAMIC STATUS DEF STRTN DEF .3I DEF DSTAT STRTN JMP ER17 EXEC ERROR AND B200 MASK EOF BIT CCB DECREMENT ADB RC,I THE RECORD COUNT STB RC,I CCB SET B TO FORWARD SPACE 1 SZA,RSS IF EOF TEST FOR FIRST JMP *+3 ELSE SKIP TO COUNT THE RECORD ISZ OPEN SKIP IF EOF ON FIRST RECORD JMP FSRC ELSE GO FORWARD SPACE ISZ RCOU DONE? JMP SPC0 NO; DO NEXT ONE JMP EXOK YES; GO EXIT SKP * TYPE 1 AND TWO SPACE ROUTINE * THE NEW RECORD NO. IS SET ONLY * NO EOF CHECK IS DONE * NEGATIVE OR ZERO RECORD * NUMBERS ARE REPLACED * WITH 1 AND SOF ERROR SENT * TY1/2 LDA ABRC GET THE ABSOLUTE RECORD NO. CCE,SZA IF ZERO SSA OR NEGATIVE CLA,CLE,INA SET TO ONE STA RC,I SET NEW RECORD NO. SEZ IF FORCED TO ONE TAKE SOF EXIT SPC 2 EXOK CLA,RSS GOOD EXIT EOFEX LDA N12 EOF/SOF EXIT SPC 1 EXIT STA ER,I SET ERROR AND JMP DOSNT,I RETURN SPC 2 ER17 LDA N17 JMP EXIT SPC 2 ER5 LDA N5 JMP EXIT SKP * STORAGE SPC 2 .1 DEC 1 .3I OCT 100003 N12 DEC -12 N10 DEC -10 N11 DEC -11 DFZER DEF ZERO ZERO NOP \THESE TWO ARE DOUBLE NOP / DUMMY ZERO DBLWD NOP DOUBLE WORD FLAG N3 DEC -3 N17 DEC -17 N5 DEC -5 B200 OCT 200 B400 OCT 400 B77 OCT 77 SPC 2 A EQU 0 B EQU 1 SPC 1 END EQU * SPC 1 END