// DATE 100622 // NOHALT * *** RUN MAINT. * // LOAD $MAINT,F1 // RUN // COPY FROM-READER,TO-F1,RETAIN-R,LIBRARY-S,NAME-$DLST MACRO $DLST .* .* 5703-XM1 LIST DATA FILES .* TEXT TITLE 'SDLIST - LIST DATA FILES' *********************************************************************** * 5703-XM1 COPYRIGHT IBM CORP. 1970 * * REFER TO INSTRUCTIONS ON COPYRIGHT NOTICE, 120-2083 * * * *********************************************************************** *STATUS * * VERSION 1 MODIFICATION 0 * * * *FUNCTION * * * SDLIST WILL CONVERT THE CONTENTS OF THE WORK FILE FROM * * INTERNAL FLOATING POINT REPRESENTATION TO THE 'SHORTEST' * * EXTERNAL REPRESENTATION. THIS ROUTINE IS USED TO CONVERT * * EITHER KEYBOARD OR PROGRAM GENERATED FILES FOR LISTING * * PURPOSES. * * * FOR LISTING PROGRAM GENERATED FILES, SDLIST ALSO WILL OUTPUT * * THE FILE TO THE SPECIFIED OUTPUT DEVICE. * * * CHARACTER STRINGS ARE ALSO OUTPUT VIA SDLIST. * * * *ENTRY POINTS * * SDLIST HAS TWO(2) ENTRY POINTS. ONE ENTRY POINT IS USED WHEN * * THE WORK FILE CONTAINS A KEYBOARD DATA FILE. * * B SDLIST CONVERT KEYBOARD DATA FILE * * * * TO OUTPUT A PROGRAM GENERATED FILE, THE FOLLOWING ENTRY POINT * * IS USED. * * B SDLPGM OUTPUT PGD FILE * * * * THE ENTIRE FILE WILL BE OUTPUT BY SDLIST * * FOR PROGRAM GENERATED FILES THE CONSTANT SDLWID SHOULD * * CONTAIN THE LOGICAL WIDTH * * * *INPUT * * * FOR KEYBOARD DATA FILES THE LINE TO SE CONVERTED MUST BE * * AT THE ADDRESS POINTED BY GTTEXT * * * FOR PROGRAM GENERATED FILES DL4ICS IS USED TO ACCESS EACH * * SECTOR OF THE WORK FILE. * * * *OUTPUT * * * EACH CONVERTED LINE IS PLACED IN THE LOCATION POINTED TO BY * * SDLBUF WHICH IS DEFINIED BY THE CALLING PROGRAM. FOR PGD'S * * THE PROPER OUTPUT DEVICE IS DETERMINED AND DLPRNT (PRINTER OR * * CRT) OR DCDOUT IS CALLED TO OUTPUT THE LINE. * * XR1 AND XR2 ARE SAVED AND RESTORED. * * * *EXTERNAL REFERENCES * * * $INDR1 - CHECK PRECISION OF WORK FILE AND PGD INDICATOR * * * $XRSAV - REGISTER STORAGE AREA * * * *EXITS, NORMAL * * CONTROL IS RETURNED TO THE BYTE FOLLOWING THE CALL TO SDLIST * * IN THE CALLING PROGRAM * * * *EXITS, ERROR * * NONE * * * *TABLES/WORKAREAS * * NONE * * * *ATTRIBUTES * * SDLIST IS REUSABLE * * * *CHARACTER CODE DEPENDENCY * * N/A * * * *NOTES * * ERROR PROCEDURES * * NONE * * * * REGISTER USAGE * * XR1 IS USED AS A POINTER TO THE OUTPUT AREA * * XR2 IS USED AS A POINTER TO THE INPUT AREA * * - AS A BASE REGISTER * * * * SAVED RESTORED AREA * * NONE * * * * MODIFICATION CONSIDERATIONS * * NONE * * * * REQUIRED MODULES * * @SYSEQ - COMMON SYSTEM EQUATES * * @FXDEQ - LOCATION OF INDICATORS WITHIN THE NUCLEUS * * DCDOUT - CARD PUNCH IOCR * * DLPRNT - CRT/PRINTER INTERFACE ROUTINE * * C2DEC5 - BINARY TO DECIMAL CONVERSION ROUTINE * * * * OTHER * * N/A * *********************************************************************** EJECT SDLIST EQU * ST SDL089+@OP1,@XR SAVE @XR ST SDL090+@OP1,@BR SAVE BASE RESISTER ST SDL091+@OP1,@ARR SAVE RETURN ADDRESS SDL001 EQU * MVI SDLBUF+SDLEND,@BLANK SET LAST FIELD TO BLANKS MVC SDLBUF+SDLED1(SDLMAX),SDLBUF+SDLEND SET FIELD TO BLANKS LA GRLINE-1,@XR BINARY LINE %UNSER B C2DEC5 CONVERT STATEMENT NUMBER MVC SDLBUF+3(SDLFOR),C2DVAL NOVE STATEMENT NUMBER LA SDLBUF+SDLLNG,@BR POINTER TO OUTPUT AREA LA SDLBF@,@XR SET-UP INPUT ADRESS EJECT SDL005 EQU * CHECK ALPHA OR FLOATING POINT MVI SDLSMN,@ZERO INIT MINUS SIGN IND OFF 1-5 TBN @ZERO(,@XR),SDLTYP ALPHA DATA ? 1-5 BT SDL250 GO TO ALPHA OUTPUT 1-5 TBN @ZERO(,@XR),SDLMIN MINUS SIGN ? JF SDL010 NO MVI SDLSMN,@MINUS SET ON MINUS SIGN INDICATOR MVI @ZERO(,@BR),@MINUS MOVE MINUS SIGN LA @B1(,@BR),@BR BUMP POINTER TO NEXT SPACE SDL010 TBN $INDR1,$PRESN SHORT PRECISION ? MVI SDLCTR,SDLSRT-1 SET SHORT PREC CTR 1-3 JF SDL025 IF SHORT, JUMP OVER LONG 1-3 MVI SDLCTR,SDLONG-1 SET LONG PREC CTR 1-3 EJECT SDL025 EQU * ST SDLSAV,@BR SAVE BEGINNING ADDRESS MVX 0(SDLNUM,@BR),0(,@XR) MOVE FIRST DIGIT SBN 0(,@BR),SDLEBC SET ZONE MASK LA @B1(,@BR),@BR ADVANCE OUTPUT PRINTER MVI SDL035+@Q,@UCB SET SW -- VALUE = ZERO TBF 0(,@XR),SDLDZR LEADING ZERO ? JT SDL030 JUMP IF YES MVI SDL035+@Q,@NOP ELSE, SET -- VALUE = NOT ZERO SDL030 B SDL100 GET NEXT CHARACTER SDL035 JC SDL037,*-* JUMP IF VALUE = ZERO MVX @ZERO(SDLZON,@BR),@ZERO(,@XR) MOVE FIRST DIGIT MVX @B1(SDLNUM,@BR),@ZERO(,@XR) MOVE SECOND DIGIT SBN @ZERO(,@BR),SDLEBC SBN @B1(,@BR),SDLEBC TURN ON ZONE FOR DIGIT LA SDLTWO(,@BR),@BR BUMP POINTER SDL037 SLC SDLCTR(@B1),SDLPL1 DECREMENT PRECISION COUNTER BNZ SDL030 NOT ZERO -- CONTINUE B SDL100 BUMP @XR PAST EXPONENT CLI SDL035+@Q,@UCB WAS VALUE OF THIS ITEM = ZERO ? JE SDL066 YES -- EXIT MVC SDLEXP(1),0(,@XR) MOVE EXPONENT SDL040 A SDLMN1,@BR REDUCE POINTER BY ONE CLI @ZERO(,@BR),SDLZRO CHARACTER ZERO ? JNE SDL050 NO -- EXIT MVI @ZERO(,@BR),@BLANK BLANK OUT ZERO B SDL040 CONTINUE CHECKING EJECT SDL050 EQU * ST SDL065+@OP1,@XR SAVE INPUT POINTER USING SDL060,@XR INFORM ASSEMBLER LA SDL060,@XR SET UP BASE LA @B1(,@BR),@BR BUMP INPUT POINTER ST SDLLST(,@XR),@BR SAVE ENDING ADDRESS MVI SDL062+@Q(,@XR),@UCB ASSUME VALUE > 1 ST SDL060+@OP1(,@XR),@BR ONE POSITION TO THE RIGHT ST SDL060+@OP2(,@XR),@BR SET UP SHIFT FROM POSITION SLC SDL060+@OP2(1,@XR),SDLPL1(,@XR) REDUCE FOR MOVE MVC SDL061+@OP1(@CADDR,@XR),SDLSAV(,@XR) SET POINT POSITION SLC SDLLST(@CADDR,@XR),SDLSAV(,@XR) COMPUTE SIGNIFICANCE MVC SDL060+@Q(1,@XR),SDLLST(,@XR) * OF DIGITS TO SHIFT SLC SDL060+@Q(1,@XR),SDLPL1(,@XR) MANTISSE LENGTH CLI SDLEXP,SDLC80 CHECK EXPONENT JH SDL053 INTEGER AND FRANCTION EJECT * THIS CODE HANDLES FRACTIONS 7F 123000 .0123 SDL052 EQU * VARIABLE LABEL MVI SDLCTR,SDLC80 SLC SDLCTR(,@XR),SDLEXP(,@XR) COMPOTE EXCESS 10**0 ALC SDL060+@OP1(1,@XR),SDLCTR(,@XR) INCREASE SHIFT MVI SDL062+@Q(,@XR),@NOP SET SWITCH MVC SDLEXP(@B1,@XR),SDLCTR(,@XR) MOVE EXPONENT B SDL200 GO CHECK PRECISION EXPONENT SPACE SDL053 EQU * SLC SDLEXP(,@XR),SDLMOD(,@XR) COMPUTE EXPONENT MODULO 80 ALC SDL061+@OP1(1,@XR),SDLEXP(,@XR) * POSTION OF POINT SDL054 EQU * SLC SDL060+@Q(1,@XR),SDLEXP(,@XR) * RIGHT FOR POINT CLC SDLLST(1,@XR),SDLEXP(,@XR) CHECK SIGNIFICANCE EXPONENT JH SDL060 FIXED POINT JE SDL065 INTEGER -- EXIT EJECT ALC SDLLST(@CADDR,@XR),SDLPL2(,@XR) COMPUTE CHOICE POINT CLC SDLLST(@B1),SDLEXP JNH SDL055 MVI @ZERO(,@BR),SDLZRO SET LOW ORDER ZERO LA 1(,@BR),@BR ADJUST OUTPUT POINTER J SDL065 EXIT SPACE SDL055 MVI @ZERO(,@BR),SDLEXE MOVE E VALUE SLC SDLEXP(,@XR),SDLLST(,@XR) COMPUTE EXPONENT ALC SDLEXP(,@XR),SDLPL2(,@XR) ADJUST SDL056 LA SDLCON,@XR SET UP INPUT B C2DEC5 CONVERT TO EBCDIC CLI C2DVAL-1,SDLZRO ZERO ? JE SDL057 MVC SDLTWO(@CADDR,@BR),C2DVAL MOVE 2 DIGITS LA SDLTHR(,@BR),@BR BUMP TO LAST ENTRY J SDL065 EXIT SPACE SDL057 MVC @B1(@B1,@BR),C2DVAL MOVE 1 DIGIT LA SDLTWO(,@BR),@BR BUMP TO LAST ENTRY J SDL065 EXIT EJECT SDL060 MVC *-*(@VQ),*-* SHIFT RIGHT SDL061 MVI *-*,SDLPNT SET DECIMAL POINT LA 1(,@BR),@BR INCREMENT POINTER SDL062 JC SDL065,*-* GREATER THAN ONE -- JUMP L SDL061+@OP1(,@XR),@BR PICK UP BEGIN ADDRESS SDL063 LA @B1(,@BR),@BR BUMP TO NEXT POSITION CLI SDLEXP(,@XR),@ZERO HAVE ENOUGH 0 BEEN INSERTED ? JE SDL064 YES -- EXIT MVI 0(,@BR),SDLZRO SET ZERO SLC SDLEXP(,@XR),SDLPL1(,@XR) REDUCE EXPONENT B SDL063(,@XR) CONTINUE SPACE SDL064 L SDL060+@OP1(,@XR),@BR GET TO END OF DATA LA 1(,@BR),@BR BUMP TO BLANK SDL065 LA *-*,@XR RESTORE INPUT POINTER SDL066 EQU * TBN $INDR1,$PGMDT PROGRAM GENERATED ? BT SDL300 YES -- GO OUTPUT ST $XRSAV,@XR SAVE POINTER FOR TEST CLC $XRSAV,GRTEND END OF LINE ? JL SDL075 CONTINUE EXECUTION ST SDLSAV,@BR CURRENT POINTER B SDL089 EXIT SPACE SDL075 EQU * MVI @ZERO(,@BR),@COMMA MOVE COMMA TO OUTPUT FIELD LA @B1(,@BR),@BR BUMP OUTPUT POINTER ST SDLSAV,@BR SAVE ADDRESS B SDL100 GET NEXT CHARACTER B SDL005 CHECK TYPE OF DATA SDL080 MVI @ZERO(,@BR),SDLZRO SET TO ZERO B SDL066 CONTINUE OUTPUT SPACE SDL089 LA *-*,@XR RESTORE @XR SDL090 LA *-*,@BR RESTORE BASE REGISTER SDL091 B *-* RETURN EJECT SDL100 EQU * GET NEXT CHARACTER ST SDL105+@OP1,@ARR SAVE RETURN ADDRESS LA @B1(,@XR),@XR INCREMENT POINTER ST $XRSAV,@XR SAVE CURRENT POINTER SLC $XRSAV,SDLED@(@CADDR) COMPUTE CURRENT BUFFER LENGTH JNZ SDL105 END OF BUFFER ? B DL4ICS RETRIEVE DISK BLOCK DC AL2(SDLDPL) ADDRESS OF DPL B $DISKN SO ISSUE WAIT DC AL2($WAITF) WAIT FUNCTION LA GFIBF1,@XR INPUT POINTER ALC SDLDPL+@DSAD(1),SDLPL1 BUMP SECTOR COUNT SDL102 TBN $INDR1,$PGMDT PROGRAM GENERATED ? 1-2 JF SDL105 IF NOT, JUMP OVER EOS CHECK 1-2 CLI 0(,@XR),@EOF IS FIRST BYTE EOF ? 1-2 JNE SDL105 IF NOT, JUMP TO CONTINUE 1-2 A SDLMN1,@BR DECR POINTER OVER COMMA 1-2 MVI 1(,@XR),@EOF SET NEXT BYTE TO EOF ALSO 1-2 SDL104 BC SDL300,*-* GO OUTPUT -- FINISHED 1-3 ORG SDL104+@Q INIT 1-3 DC AL1(@NOP) * TO NOP 1-3 ORG *+2 1-3 SDL105 B *-* RETURN EJECT SDL150 EQU * SDLIST OUTPUT INTERFACE ST SDL180+@OP1,@ARR SAVE RETURN ADDRESS CLI KLIDVT,KLIMK1 CARD OUTPUT ONLY ? JE SDL170 YES -- GO PUNCH CARDS B DLPRNT PRINTER -- CRT INTERFACE DC AL2(SDLPPL) PRINTER PARAMETER LIST SDL160 TBN KLIDVT,KLIMK1 CARD OUTPUT ? JF SDL180 NO -- CONTINUE SDL170 B DCDOUT GO OUTPUT CARD DC AL2(SDLPPL) PRINT PARAMETER LIST B DCDOUT ISSUE WAIT FUNCTION DC AL(@CADDR)($WAITF) WAIT FUNCTION ADDRESS MVI SDLBUF+KLICWD-1,@BLANK SET BUFFER TO BLANKS - ONLY IF MVC SDLBUF+KLICWD-2,SDLBUF+KLICWD-1(KLICWD-2) * PUNCHING SDL180 B *-* RETURN EJECT SDLLST DS CL2 SAVE AREA FOR LENGTH SDLACT DS CL1 COUNT OF ALPHA CHARACTERS SDLPL2 DC IL2'2' PLUS 2 SDLMN1 DC IL2'-1' MINUS ONE SDLSAV DS CL2 BEGINNING OF DATA SDLCON DC IL1'0' HEADER FOR EXPONENT SDLEXP DS CL1 EXPONENT SDLPL1 DC IL2'1' PLUS ONE SDLMOD DC XL1'80' MODULO FOR EXPONENT SDLCTR DS CL1 PRECISION INDICATOR SDLED@ DC AL(@CADDR)(GFIBF1+256) END OF BUFFER (PGD) SDLOT@ DC AL2(SDLBUF) ADDRESS OF OUTPUT BUFFER SPACE SDLED1 EQU 253 SDLEND EQU 254 SDLC18 EQU 18 MAXIMUM COUNT SDLQUO EQU X'7D' QUOTE SDLBF@ EQU GRTEXT LINE BUFFER ADDRESS SDLSRT EQU 4 SHORT PRECISION LENGN SDLMIN EQU X'10' STATUS BYTE MINUS SIGN SDLZON EQU 02 ZONE TO NUMERIC SDLBEG EQU 6 LENGTH OF SDF INFO SDLNUM EQU 03 NUMERIC TO NUMERIC SDLEBC EQU X'F0' ZONED DECIMAL REPRESENTATION SDLTWO EQU 2 INCREMENT SDLONG EQU 8 LONG PRECISION SDLDZR EQU X'0F' MASK FOR LEADING ZERO SDLZRO EQU X'F0' BITS OFF INDICATE ZERO DIGIT SDLPNT EQU C'.' DECIMAL POINT SDLEXE EQU C'E' EXPONENT SDLTHR EQU 3 DISPLACEMENT OF THREE SDLC80 EQU X'80' 10**0 SDLFOR EQU 4 DISPLACEMENT OF FOUR SDLMAX EQU 255 MAXIMUM LINE SIZE SDLLNG EQU 5 LENGTH OF SDF INFO SDLTYP EQU X'40' ALPHA INDICATOR SDLLNE EQU 7 BYPASS SDF INFO ET AL * *SDLPPL $PPL FUNC-@PRETR,CADDR-SDLBUF SDLPPL EQU * DC AL1(@PRETR) DC AL1(*-*) DC AL2(SDLBUF) *** END OF EXPANSION *** SPACE *SDLDPL $DPL FUNC-@DGET,DADDR-@WSTBL,CNT-SDLONE,CADDR-GFIBF1 SDLDPL EQU * DC AL1(@DGET) DC AL2(@WSTBL) DC AL1(SDLONE) DC AL2(GFIBF1) *** END OF EXPANSION *** SPACE SDLONE EQU 1 ONE SDLWID DS CL2 LOGICAL WIDTH ORG *-2 RESET LOCATION COUNTER DC IL2'64' INITIALIZE SPACE SDL200 CLI SDLEXP(,@XR),SDLTWO EXP > TWO(2) = FLOATING BNH SDL060(,@XR) CHOOSE FIXED MVI 0(,@BR),SDLEXE SET EXPONENT MVI 1(,@BR),C'-' SET MINUS SIGN ALC SDLEXP(,@XR),SDLLST(,@XR) VALUE FOR PRINTING LA 1(,@BR),@BR PTR = PTR + 1; B SDL056 CONTINUE -- EJECT SDL250 EQU * OUTPUT ALPHA STRING MVI SDLACT,SDLC18 SET MAXIMUM LIMIT * @BR - POINTS TO OUTPUT AREA * @XR - POINTS TO INPUT LINE BUFFER * MVI @ZERO(,@BR),SDLQUO MOVE BEGINNING QUOTE LA @B1(,@BR),@BR POINTER + 1 --> POINTER ST SDL270+@OP1,@BR SAVE CURRENT LOCATION SDL251 B SDL100 GET NEXT CHARACTER CLI @ZERO(,@XR),@BLANK CHARACTER BLANK ? JNE SDL280 NO MVI @ZERO(,@BR),@BLANK MOVE A BLANK TO BUFFER LA @B1(,@BR),@BR POINTER + 1 --> POINTER SLC SDLACT(@B1),SDLPL1 DECREMENT COUNT JZ SDL270 EXIT B SDL251 CONTINUE SDL255 B SDL100 AT NEXT CHARACTER CLI @ZERO(,@XR),@BLANK CHARACTER BLANK JNE SDL280 LEAVE SWITCH ON SDL256 JC SDL257,*-* SWITCH ST SDL270+@OP1,@BR SAVE CURRENT ADDRESS MVI SDL256+@Q,@UCB SET SWITCH ON SDL257 MVI @ZERO(,@BR),@BLANK MOVE A BLANK TO BUFFER LA @B1(,@BR),@BR POINTER + 1 --> POINTER SLC SDLACT(@B1),SDLPL1 DECREMENT COUNT BNZ SDL255 CONTINUE SDL270 LA *-*,@BR RESTORE POINTER J SDL285 GO TO WINDUP SPACE SDL280 EQU * MVI SDL256+@Q,@NOP TURN SWITCH FOR OFF MVC @ZERO(@B1,@BR),@ZERO(,@XR) MOVE CHARACTER TO OUTPUT LA @B1(,@BR),@BR BUMP POINTER SLC SDLACT(@B1),SDLPL1 DECREMENT COUNT CLI @ZERO(,@XR),SDLQUO CHARACTER QUOTE ? JNE SDL281 NO -- MVI @ZERO(,@B1),SDLQUO MOVE QUOTE LA @B1(,@BR),@BR BUMP POINTER SDL281 CLI SDLACT,@ZERO COUNT EQUAL ZERO ? BNE SDL255 NO -- CONTINUE SDL285 MVI @ZERO(,@BR),SDLQUO MOVE ENDING QUOTE LA @B1(,@BR),@BR BUMP COUNTER B SDL066 GO CHECK FILE TYPE EJECT * * PROGRAM GENERATED FILES * DS CL1 EOS FOR SLLINE SDL300 EQU * HANDLE OUT PGM GENERATED LINE ST SDLWRK,@BR SAVE CURRENT POSITION SLC SDLWRK(@CADDR),SDLOT@ COMPUTE CURRENT LENGTH CLC SDLWRK(@CADDR),SDLWID GREATER THAN LOGICAL WIDTH ? JNH SDL340 CONTINUE -- CONVERSION ST SDLWRK,@BR COMPUTE CURRENT POSITION CLI SDLSMN,@ZERO MINUS SIGN INDICATOR ON ? JE SDL305 NO -- GO COMPUTE LENGTH ALC SDLWRK(1),SDLPL1 INCR NUMBER OF PLACES BY ONE SDL305 SLC SDLWRK(@CADDR),SDLSAV COMPUTE LENGTH MVC SDL310+@Q(1),SDLWRK SET-UP LENGTH MVC SDL330+@Q(1),SDLWRK * MVC SDL320+@Q(1),SDLWRK SET UP LENGTH SDL310 MVC SDLHLD(1),0(,@BR) MOVE OVERFLOW A SDLMN1,@BR DECREMENT POINTER MVI 1(,@BR),@BLANK SET BLANK SDL320 MVC 0(@VQ,@BR),1(,@BR) SET FIELD TO BLANKS B SDL150 OUTPUT LINE LA SDLBUF,@BR BEGINNING OF BUFFER A SDLWRK,@BR INDEX INTO BUFFER SDL330 MVC 0(@VQ,@BR),SDLHLD MOVE FIELD TO BUFFER SDL340 CLI 1(,@XR),@EOF END OF FILE ? BNE SDL075 NO -- CONTINUE MVC SDLPPL+@PRCNT,SDLWRK SET PPL LENGTH B SDL150 OUTPUT DATA B SDL089 EXIT -- SPACE SDLPGM EQU * PGM DATA FILE ENTRY POINT ST SDL091+@OP1,@ARR SAVE RETURN ADDRESS LA GFIBF1+255,@XR INTIALIZATION VALUE B SDL100 INTIALIZE BUFFER MVI SDL104+@Q,@UCB SET BC AFTER FIRST TIME 1-3 MVI GFIBF1+@SCTSZ,@ZERO SET BUFFER END + 1 = 0 1-3 CLI @ZERO(,@XR),@EOF TEST FOR AN EMPTY FILE ? JNE SDL345 BR IF NOT EMPTY FILE MVI $CAERR,@@E226 SET EMPTY FILE ERROR MSG # B $CAERK BR TO ERROR ROUTINE SDL345 LA SDLBUF,@BR SET-UP OUTPUT ADDRESS MVC SDLPPL+@PRCNT,SDLWID SET FINAL WIDTH B SDL005 GO -- CONTINUE SPACE SDLHLD EQU GRABIT+90 LINE OVERFLOW AREA SDLSMN DS XL1 IND FOR MINUS SIGN, X'60' --> ON SDLWRK DS CL2 COMPUTED LINE LENGTH *********************************************************************** *** END OF SDLIST *** MEND // CEND // END * // READER CONSOLE