// DATE 040222 // NOHALT * *** RUN MAINT. * // LOAD $MAINT,F1 // RUN // COPY FROM-READER,TO-F1,RETAIN-R,LIBRARY-S,NAME-$CSTR MACRO $CSTR .* .* 5703-XM1 PLACES THE SYNTACTIC UNIT .* TEXT TITLE 'SCSTRG - PLACES SYNTACTIC UNIT ' *********************************************************************** * 5703-XM1 COPYRIGHT IBM CORP. 1970 * * REFER TO INSTRUCTIONS ON COPYRIGHT NOTICE, 120-2083 * * * *********************************************************************** *STATUS * * VERSION 1 MODIFICATION 0 * * * *FUNCTION * * * SCSTRG PLACES THE SYNTACTIC UNIT IN * * AN AREA DEFINED BY THE USER. THIS ROUTINE WILL ALSO PLACE A * * NUMBER OF CHARACTERS IN THE CALLING PROGRAMS AREA. * * * A COUNT OF THE NUMBER OF CHARACTERS IN THE STRING IS MAINTAINED * * BY SCSTRG. * * * *ENTRY POINTS * * THE ONLY ENTRY TO SCSTRG IS THE FIRST BYTE OF * * THE ROUTINE. THE CALLING SEQUENCE IS: * * B SCSTRG * * DC AL2(AREA) * * * * WHERE AREA POINTS TO THE LEFTMOST BYTE OF THE CALLING * * PROGRAMS OUTPUT AREA. * * * *INPUT * * INDEX REGISTER TWO(2) SHOULD POINT TO THE LEFT QUOTE OF THE * * CHARACTER STRING. THE CALLING PROGRAM MUST ALSO SET THE * * CHARACTER COUNT IN THE ONE BYTE FIELD SCSLNG. A ZERO(0) LENGTH * * DENOTES THAT THE CALLING PROGRAM WANTS THE ENTIRE STRING. * * * *OUTPUT * * THE CHARACTER STRING IS RETURNED TO THE ADDRESS GIVEN BY THE * * CALLING ROUTINE. THE FIELD SCSCNT CONTAINS THE NUMBER OF * * CHARACTERS IN THE CHARACTER STRING. * * * *EXTERNAL REFERENCES * * NONE * * * *EXITS, NORMAL * * NORMAL EXIT IS TO THE FIRST BYTE FOLLOWING THE THE * * POINTER TO THE USERS STRING AREA. THE BASE REGISTER * * IS RESTORED(XR1). XR2 WILL POINT TO THE CHARACTER * * FOLLOWING THE ENDING QUOTE. THE PSR WILL BE NOT LOW. * * * *EXITS,ERROR * * SHOULD AN ERROR BE FOUND THE PSR IS FORCED LOW. THE XR2 * * WILL POINT TO THE POSITION WHERE THE ERROR WAS FOUND. * * * *TABLES/WORKAREAS * * NONE * * * *ATTRIBUTES * * SCSTRG IS REUSABLE * * * *CHARACTER CODE DEPENDENCY * * THIS ROUTINE ASSUMES THE EBCDIC CODE OF X'7D' FOR A * * SINGLE QUOTE. * * * *NOTES * * ERROR PROCEDURES * * N/A * * * * REGISTER USAGE * * INDEX REGISTER 1 IS USED AS A POINTER TO THE CALLING PROGRAMS * * STRING AREA. INDEX REGISTER 2 POINTS TO THE CHARACTER STRING * * IN THE INPUT LINE. XR 1 IS SAVED AND RESTORED. * * * * REQUIRED MODULES * * @SYSEQ - SYSTEM EQUATES * * * * MODIFICATION CONSIDERATIONS * * NONE * * * * OTHER * * NONE * *********************************************************************** SPACE 1 SCSTRG EQU * ENTRY POINT ST SCS050+@OP1,@BR SAVE BASE REGISTER ST SCS051+@OP1,@ARR SAVE RETURN ADDRESS ALC SCS051+@OP1(@B1),SCSPL2 INCREMENT PAST PARAMETER A SCSPL1,@ARR POINT TO PARAMETER ST SCS005+@OP1,@ARR SAVE PARAMETER ADDRESS MVI SCSCNT,@ZERO CLEAR COUNTER MVI SCS020+@Q,@NOP SET SWITCH OFF SCS005 L *-*,@BR PICK UP OUTPUT ADDRESS CLI @ZERO(,@XR),SCSQUO CHECK QUOTES JNE SCS030 ERROR - * SCS006 LA @B1(,@XR),@XR INCREMENT POINTER CLI @ZERO(,@XR),SCSQUO EMBEDDED QUOTES JNE SCS010 NO GO CHECK FOR EOS LA @B1(,@XR),@XR MOVE INPUT POINTER CLI @ZERO(,@XR),SCSQUO DOUBLE QUOTE ? JNE SCS040 EXIT SCS010 CLI @ZERO(,@XR),@EOS END OF STATEMENT ? JE SCS030 YES - ERROR ALC SCSCNT(@B1),SCSPL1 INCREMENT COUNT * SCS020 JC SCS029,*-* SWITCH MVC @ZERO(@B1,@BR),@ZERO(,@XR) MOVE CHARACTER LA @B1(,@BR),@BR BUMP OUTPUT POINTER * SCS025 CLI SCSCNT,*-* CHECK CHARACTER COUNT JNE SCS029 NOT EXCEEDED CONTINUE MVI SCS020+@Q,@UCB SET SWITCH ON SCS029 B SCS006 RETURN TO MAINLINE EJECT * * ERROR SETTING * SCS030 EQU * L SCSERR,@PSR SET ERROR INDICATOR MVI $CAERR,@@E138 INCOMPLETE CHARACTER CONSTANT J SCS050 RETURN SCS040 CLI 0(,@XR),SCSFRC FORCE PSR LOW * * RETURN * SCS050 LA *-*,@BR RESTORE BASE SCS051 B *-* RETURN * * CONSTANTS * SCSLNG EQU SCS025+@Q LENGTH REQUESTED SCSQUO EQU X'7D' QUOTE SCSFRC EQU X'FF' FORCE PSR INDICATOR * SCSCNT DS CL1 CHARACTER COUNT SCSPL1 DC IL2'1' PLUS ONE SCSPL2 DC IL1'2' PLUS TWO SCSERR DC XL2'84' PSR CODE FOR ERROR *** END OF SCSTRG *** MEND // CEND // END * // READER CONSOLE