// DATE 200222 // NOHALT * *** RUN MAINT. * // LOAD $MAINT,F1 // RUN // COPY FROM-READER,TO-F1,RETAIN-R,LIBRARY-S,NAME-$GRAB MACRO $GRAB .* .* 5703-XM1 RETRIEVE FILE WITH STATEMENTS .* TEXT TITLE 'GRABIT -- RETRIEVE FILE STATEMENTS' *********************************************************************** * 5703-XM1 COPYRIGHT IBM CORP. 1970 * * REFER TO INSTRUCTIONS ON COPYRIGHT NOTICE, 120-2083 * * * *********************************************************************** *STATUS * * VERSION 1 MODIFICATION 0 * * * *FUNCTION * * GRABIT LOCATES SEQUENTIAL STATEMENTS IN THE FILE SPECIFIED BY THE * * USER, AND, DEPENDING UPON THE OPTION CHOSEN, PASSES BACK THE * * STATEMENT OR SKIPS TO THE NEXT. * * AFTER BEING PRIMED BY THE CALLING PROGRAM, GRABIT READS LOGICALLY * * CONSECUTIVE BLOCKS OF SEGMENTED STATEMENTS, FROM THE FILE * * SPECIFIED BY THE USER, INTO CORE. GRABIT RETURNS WITH @XR * * POINTING TO THE BINARY LINE NUMBER OF THE NEXT STATEMENT. * * IN ADDITION TO @XR, GRABIT PARAMETERS CAN BE SET TO CAUSE THE * * BINARY LINE NR; THE TYPE CODE; AND THE UNPACKED, NON-SEGMENTED * * TEXT OF THE NEXT STMT TO BE PLACED IN AREAS DEFINED BY THE USER. * * IF GRABIT IS USED TO SKIP THROUGH THE STMTS WITHOUT UNPACKING * * THEM OR CHANGING THEIR LENGTH OR SEGMENTED CONDITION, GRABIT CAN * * BE INSTRUCTED TO RETURN THE BLOCKS TO THEIR ORIGINAL DISK ADDRESS * * IF THE SPECIFIED FILE IS ACCESSED BY DL4ICS. * * * *NOTES * * THIS VERSION OF GRABIT USES DL2ICS AND DL4ICS TO ACCESS THE NEXT * * DATA BLOCK. * *********************************************************************** USING GRABSE,@BR GRABIT EQU * ENTRY POINT TO ROUTINE ST GRASBR,@BR SAVE CALLING PROG'S BASE REG. LA GRABSE,@BR LOAD LOCAL BASE TO BASE REG. ST GRASAR,@ARR SAVE RETURN ADDR. CLI GRWHAT(,@BR),GRAEFI IS FUNC REQ'D INITIALIZATION ? JE GRA100 YES, GO TO INITIALIZATION RTN * THE ADDRESS OF THE NEXT SEGMENT IN THE CURRENT BUFFER IS INITLZ'D * AND MAINTAINED IN THE NEXT INST, WHICH LOADS IT TO THE @XR. GRA020 LA *-*,@XR LOAD NEXT STMNT CADDR TO @XR CLI GRWHAT(,@BR),GRAEFR IS FUNC REQ'D RETURN TEXT ? JE GRA300 YES, GO RETURN STMNT ROUTINE CLI GRWHAT(,@BR),GRAEFS IS FUNC REQ'D SKIP STATEMENT JE GRA200 YES, GO TO SKIP STMNT ROUTINE J GRA210 GO TO SKIP SEGMENT RTN * * INITIALIZATION ROUTINE * GRA100 L GRBFRA(,@BR),@XR LOAD 1ST BFR ADDR TO DB ST GRANCA(,@BR),@XR PROPIGATE IT TO NEXT BFR DPL MVC GRANDA(@DADDR,@BR),GRSRDA(,@BR) INITLZ NEXT BRF DADDR MVI GRASIZ(,@BR),GRAEBS INITLZ BUFFER SIZE COUNTER MVC GRACSC(1,@BR),GRSCTR(,@BR) INITLZ SCTR COUNT IN DPL MVI GRAERR+@Q(,@BR),@@E551 SET ERR CODE TO SAVED FILE B $DISKN WAIT FOR FIRST DATA BLOCKS TO DC AL2($WAITF) * GET INTO CORE CLI GRSCTR(,@BR),GRAESC IS DL4ICS BEING USED ? JNE GRA260 NO, GO ACCESS 1ST STATEMENT MVI GRAERR+@Q(,@BR),@@E550 SET ERR CODE TO SPECIFY WRKFILE ALC GRANCA(@CADDR,@BR),GRASSZ(,@BR) SET CADDR OF NEXT BFR GRA140 CLI GRAELK(,@XR),GRAELN IS 1ST DB LINK CODE = 0 ? JE GRA150 YES, GO INCR TO NEXT LOGICAL DB MVI GRANDA(,@BR),GRAEDB SET DADDR OF NEXT DB ALC GRANDA(1,@BR),GRAELK(,@XR) * GRA150 ALC GRANDA(1,@BR),GRANPB(,@BR) INCR TO NEXT BFR DADDR J GRA260 GO ACCESS FIRST STATEMENT * * ACCESS NEXT STATEMENT OR NEXT SEGMENT ROUTINE * GRA200 CLI GRAEDT(,@XR),GRAEET END-OF-FILE RECORD ? JE GRA230 YES, RESET OR TO THIS RECORD GRA210 SLC GRASIZ(1,@BR),GRAES1(,@XR) DECR BFR CT BY SEGMENT LENGTH A GRAES1(,@XR),@XR INCR OR BY SEGMENT LENGTH GRA220 CLI GRASIZ(,@BR),@ZERO IS BUFFER EMPTY ? BL GRAERR(,@BR) GONE NEG, GO TO BAD ERR JE GRA250 YES, GO TO GET NEXT BFR CLI GRAES0(,@XR),@SNULL IS SEGMENT NULL ? JE GRA250 YES, GO TO GET NEXT BFR GRA230 ST GRA020+@OP1,@XR SAVE CADDR OF NEXT SEG.IN INST. LA GRAEDL(,@XR),@XR POINT @XR TO LINE NUMBER GRA240 LA *-*,@BR RESTORE THE BASE REGISTER GRASBR EQU GRA240+@OP1 * STORED IN INST AT GRA240 GRA245 B *-* RETURN TO USER GRASAR EQU GRA245+@OP1 * TO CADDR SAVED IN GRA245 GRA250 B GRA500(,@BR) ACCESS NEXT BUFFER GRA260 CLI GRAES0(,@XR),@SNULL IS 1ST SEG. NULL ? BE GRAERR(,@BR) YES, GO TO BAD ERR TBF GRAES2(,@XR),GRAETP PRIMARY SEGMENT BT GRA230 YES, SAVE LOCATION CLI GRWHAT(,@BR),GRAEFR ACTION REQ'D = RETURN TEXT ? BE GRAERR(,@BR) YES, GO TO BAD ERR CLI GRWHAT(,@BR),GRAEFG ACTION REQ'D = SKIP SEGMENT ? BE GRA230 YES, GO SAVE LOCATION B GRA210 NO, GO SKIP THIS SEGMENT * * RETURN TEXT ROUTINE * GRA300 MVC GRLINE,GRAEDL(GRAELL,@XR) SET BINARY LINE NO.IN O/P FIELD MVC GRTYPE,GRAEDT(1,@XR) SET TYPE CODE IN OUTPUT FIELD MVC GRTEND(@CADDR,@BR),GRATXT INITLZ TEXT 0/P CADDR IN INST. CLI GRAEDT(,@XR),GRAEET END OF FILE STATEMENT ? JNE GRA303 NO - GO RESET SEGMENT SWITCH MVI GRTEXT,@EOF MOVE EOF CODE TO GRTEXT B GRA230 GO GET OUT SPACE GRA303 MVI GRA310+@Q(,@BR),@UCB INITLZ BRANCH FOR ONLY SEGMENT CLI GRAES2(,@XR),@SONLY IS IT AN ONLY SEGMENT ? JE GRA305 YES, BYPASS BRANCH RESET MVI GRA310+@Q(,@BR),@NOP SET FOR MORE SEGMENTS GRA305 SLC GRASIZ(1,@BR),GRAES1(,@XR) DECR BFR CT BY SEG LENGTH SLC GRAES1(1,@XR),GRAPSG(,@BR) DECR SEG CT BY SDF-HDR LENGTH MVC GRASEG(1,@BR),GRAES1(,@XR) MOVE TEXT LENGTH TO TEXT CTR LA GRAELP(,@XR),@XR INCR TO TYPE CODE J GRA317 GO TEST FILE TYPE GRA310 B GRA220 GO ACCESS NEXT STATEMENT ORG GRA310 * UNLESS CURRENT STATEMENT BC GRA220,@UCB * HAS MORE SEGMENTS MVC GRASVC(,@BR),@ZERO(1,@XR) SAVE CURR CHAR IN RESTORE INST B GRA500(,@BR) ACCESS NEXT BUFFER CLI GRAES2(,@XR),@SLAST LAST SEGMENT ? JNE GRA313 NO, GO RESET SEG COUNTER MVI GRA310+@Q(,@BR),@UCB RESET BRANCH OUT GRA313 SLC GRASIZ(1,@BR),GRAES1(,@XR) DECR BUFFER COUNTER SLC GRAES1(1,@XR),GRASSG(,@BR) DECR SEG COUNT BY SDF LENGTH MVC GRASEG(1,@BR),GRAES1(,@XR) MOVE TEXT LNG TO SEG COUNTER LA GRAELS(,@XR),@XR INCR @XR PAST SECONDARY SDF GRA315 MVI @ZERO(,@XR),*-* RESTORE CHAR SAVED IN Q-CODE GRASVC EQU GRA315+@Q SAVED CHAR HOLD AREA GRA316 ALC GRTEND(@CADDR,@BR),GRABOA(,@BR) INCR RECEIVING CADDR GRA317 EQU * MOVE TEXT TO GRTEXT TBN $INDR1,$BASIC IS FILE TYPE = BASIC ? JF GRA350 NO, BYPASS REPITION CODE CHECK CLI GRAENC(,@XR),GRAEMR IS CHAR REF A REPITITION CODE ? JH GRA350 NO, GO RETURN REF'D CHAR MVC GRATND(@CADDR,@BR),GRTEND(,@BR) SET RCV'G CADDR IN INSTR GRA320 MVC *-*,@ZERO(1,@XR) RETURN REPEATED CHAR TO OUTPUT GRATND EQU GRA320+@OP1 * ADDR SUPPLIED SLC GRAENC(1,@XR),GRAONE(,@BR) DECR. REPITITION COUNTER JNZ GRA330 IF <> 0, GO INCR O/P CADDR MVC GRTEND(@CADDR,@BR),GRATND(,@BR) RESTORE NEW O/P CADDR J GRA360 GO INCR @XR GRA330 ALC GRATND(@CADDR,@BR),GRABOA(,@BR) INCR O/P CADDR IN INSTR B GRA320(,@BR) GO MOVE CHAR TO OUTPUT GRA350 MVC *-*,GRAENC(1,@XR) MOVE NON-REPEAT CHAR TO OUTPUT GRTEND EQU GRA350+@OP1 * ADDR SUPPLIED GRA360 LA GRAENC(,@XR),@XR INCR @XR TO NEXT CHAR. SLC GRASEG(1,@BR),GRABOA(,@BR) DECR BFR SPACE CTR BZ GRA310(,@BR) NO MORE TEXT IN SEG, CHK MORE B GRA316(,@BR) MORE TEXT, GO INCR RECV CADDR * * ACCESS NEXT BUFFER ROUTINE * GRA500 ST GRA5SA(,@BR),@ARR B $DISKN WAIT FOR PRIOR READ TO COMPLETE DC AL2($WAITF) * GRA600 EQU * CLI GRSCTR(,@BR),GRAESC DL4ICS BEING USED ? JNE GRA700 NO, GO REFILL BUFFER * * DL4ICS BEING USED - ACCESS NEXT DATA BLOCK * L GRBFRA(,@BR),@XR SAVE CURR BFR STARTING CADDR MVC GRBFRA(GRAEDS,@BR),GRANCA(,@BR) MOVE NEXT DPL TO CURR DPI ST GRANCA(,@BR),@XR RESTORE NEXT BFR STARTING CADDR L GRBFRA(,@BR),@XR POINT EN TO CURR BFR CADDR CLI GRAELK(,@XR),GRAELN NEXT LOGICAL DB = NEXT PHYS DB ? JE GRA620 YES, GO INCR SCTR DISP. MVI GRANDA(,@BR),GRAEDB SET DADDR OF NEXT DB ALC GRANDA(1,@BR),GRAELK(,@XR) * GRA620 ALC GRANDA(1,@BR),GRANPB(,@BR) INCR SCTR DISP FOR NEXT PHYS D GRA640 B DL4ICS GO READ NEXT DB DC AL2(GRANPL) * CADDR OF DPL GRA660 MVI GRASIZ(,@BR),GRAEBS RE-INITLZ BFR SPACE COUNT GRA680 B *-* RETURN TO GRA5SA EQU GRA680+@OP1 * CADDR SUPPLIED GRACPL EQU * DPL FOR CURRENT BUFFER GRACFN DC AL1(@DPUT) WRITE FUNCTION CODE GRSRDA DS CL2 RELATIVE DADDR OF CURR. BFR GRACCA EQU GRSRDA-@B1 CYLINDER BYTE OF DISK ADDR. ORG *-2 * INITIALIZED TO THE DC AL2(@WSTBL) * 1ST DB OF THE WORK FILE GRACSC DS CL1 SECTOR COUNT GRBFRA DC AL2(GRBFR1) CADDR OF CURRENT BUFFER GRANPL EQU * DPL FOR NEXT BUFFER DC AL1(@DGET) READ FUNCTION CODE GRANDA DS CL2 RELATIVE DADDR OF NEXT BFR. GRSCTR DS CL1 SECTOR COUNT ORG *-1 * INITIALIZE TO 1 DC XL1'01' GRANCA DS CL2 CADDR OF NEXT BUFFER GRWHAT DS CL1 USER SPEC'D FUNCTION CODE ORG *-1 SET TO ZERO FOR DC XL1'00' * INITIALIZATION CALL GRASSZ DC XL2'0100' SECTOR SIZE GRANPB DC XL2'01' DISP TO NEXT PHYS BFR DADDR GRAEDB EQU 2 DB DADDR ADJUSTMENT FACTOR GRASIZ DS CL1 BUFFER SPACE COUNTER GRATXT DC AL2(GRTEXT) ADDRESS OF TEXT OUTPUT AREA GRAPSG DC XL2'07' SIZE OF PRIMARY SEG. HEADER GRASSG DC XL2'04' SIZE OF 2NDARY SEG. HEADER GRAONE EQU GRANPB DECR FACTOR FOR REPITITION CTR GRABOA EQU GRANPB INCR FACTOR FOR NEXT TEXT CHAR GRANXC EQU GRANPB CYL ADJ FACTOR GRASEG DS CL1 SEGMENT TEXT COUNTER GRAEFI EQU X'00' INITIALIZATION FUNC. CODE GRAEFW EQU X'03' WRITE BACK ONLY FUNC. CODE GRAEFR EQU X'01' RETURN TEXT FUNC. CODE GRAEFS EQU X'02' SKIP STATEMENT FUNC. CODE GRAEFG EQU X'04' SKIP SEGMENT FUNC. CODE GRAEBS EQU X'FF' BUFFER TEXT AREA SIZE GRAESC EQU X'01' SCTR COUNT IF DL4ICS USED GRAELK EQU X'00' DISP TO LINK CODE WITHIN DB GRAELN EQU X'00' LINK CODE TO NEXT PHYS DB GRAEXA EQU X'01' ADJ TO '@' EQU'S FOR @XR ADDRG GRAEDL EQU @SBLN+GRAEXA DISP TO STMT BINARY LINE NO. GRAEDT EQU @STYPE+GRAEXA DISP TO STMNT TYPE CODE GRAELL EQU X'02' LENGTH OF BINARY LINE NUMBER GRAEET EQU @EOFTC TYPE CODE OF END-OF-FILE STMT GRAES0 EQU @SDF0+GRAEXA DISP TO SDF0 - NULL INDR GRAES1 EQU @SDF1+GRAEXA DISP TO SDF1 - LENGTH GRAES2 EQU @SDF2+GRAEXA DISP TO SDF2 - SEGMENTATION CDE GRAETP EQU X'02' MASK FOR A PRIMARY SEGMENT GRAELP EQU X'07' LENGTH OF PRIMARY SEG. GRAELS EQU X'04' LENGTH OF SECONDARY SEG. GRAEMR EQU 27 MAX. REPITITION CODE GRAENC EQU X'01' DISP TO NEXT TEXT CHARACTER GRAEDC EQU X'01' DISP TO CYL IN DADDR GRABSE EQU GRA310 BASE ADDRESS OF GRABIT GRAEDS EQU X'05' LNG OF DPL DADDR, SCTR-CT. GRAEW2 EQU 6 SECOND CYL OF WORK FILE * * ERROR ROUTINE * GRAERR MVI $CAERR,@@E551 SET BAD FILE ERROR CODE * THE ABOVE ERROR CODE IS INITIALLY SET FOR A SAVED FILE, * BUT IS MODIFIED TO THE WORK FILE IF DL4ICS IS USED SBN $INDR3,$ERHRD SET INDR FOR HARD ERROR B $CAERK GO TO ERRPGM INTERFACE * * DL2ICS BEING USED - ACCESS NEXT DATA BLOCK * GRASHT EQU * ORG HERE TO OVERLAY DL2ICS HDLG GRA700 SLC GRACSC(1,@BR),GRANPB(,@BR) DECR IN CORE SCTR COUNT JZ GRA720 IF ZERO, GO GET NEXT BFR BLOCK ALC GRBFRA(@CADDR,@BR),GRASSZ(,@BR) INCR DPL CADDR TO NEXT DB J GRA740 GO LOAD CADDR TO @XR GRA720 ALC GRANDA(1,@BR),GRSCTR(,@BR) INCR LAST DADDR BY SCTRS READ GRA730 B DL2ICS REFILL CORE BUFFER DC AL2(GRANPL) CADDR OF DPL MVC GRACSC(1,@BR),GRSCTR(,@BR) RE-INITLZ BFR SECTOR COUNT MVC GRBFRA(@CADDR,@BR),GRANCA(,@BR) RE-INITLZ BFR START CADDR B $DISKN WAIT FOR READ COMPLETE DC AL2($WAITF) * GRA740 L GRBFRA(,@BR),@XR POINT @XR TO START OF BFR B GRA660(,@BR) GO RE-INITLZ BFR SPACE CTR *** END OF GRABIT *** MEND // CEND // END * // READER CONSOLE