TITLE ALLPRT - INTERCONVERTS EBCDIC,ASCII AND SIXBIT ENTRY ALLPRT EXTERN .JBFF,.JBREL ; ; "STANDARD" MACROS ; DEFINE HEX(X) IFG "X"-"9",>> ; ; OPDEFS ; DEFINE INBYTE< JSP Q2,IN.BYT> DEFINE OUTBYT< JSP Q2,OU.BYT> DEFINE AOB (A)< AOBJN A,.+1> OPDEF TRZ [ANDCMI] OPDEF TRO [IORI] OPDEF PJRST [JRST] OPDEF PJUMPE [JUMPE] OPDEF PJUMPL [JUMPL] OPDEF PJUMPG [JUMPG] OPDEF PJUMPN [JUMPN] ; ; CUSP NAME AND VERSION ; CUSP==SIXBIT/ALLPRT/ VERWHO==0 VERVER==1 VERUPD==0 VERPAT==1 LOC 137 BYTE (3)VERWHO(9)VERVER(6)VERUPD(18)VERPAT ; ; AC DEFINITIONS ; FLG=0 ;HOLDS FLAGS CHR=1 ;HOLDS CHARACTER ADR=2 ;HOLDS DISPATCH ADDRESS T1=3 ;FIRST TEMPORARY T2=4 ;SECOND TEMPORARY T3=5 ;THIRD TEMPORARY T4=6 ;FOURTH TEMPORARY T5=7 ;FIFTH TEMPORARY F=10 ;BASE ADDRESS FOR FILE TABLE S=11 ;BASE ADDRESS FOR SWITCH TABLE ; IN=10 ;INPUT FILE HEADER WORD AUT=11 ;OUTPUT FILE HEADER WORD ; P1=12 ;FIRST PERMENANT AC P2=13 ;SECOND PERMENANT AC Q1=15 ;FIRST JSP AC Q2=16 ;SECOND JSP AC P=17 ;PUSHDOWN AC ; LOW==0 ;NO OFFSET SINCE TWOSEG ; ; FLAGS ; ; ; CONSTANTS ; DV.DRI==1B0 ;DTA WITH DIRECTORY IN CORE DV.DSK==1B1 ;DEVICE IS A FILE STRUCTURE DV.CDR==1B2 ;IF DVOUT=1 DEVICE IS A CDP ;IF DVIN=1 DEVICE IS A CDR DV.LPT==1B3 ;DEVICE IS A LINE PRINTER DV.TTA==1B4 ;DEVICE IS A TTY CONTROLING A JOB DV.TTU==1B5 ;TTY DDB IS IN USE DV.TTB==1B6 ;FREE BIT LEFT FROM SCNSRF DV.DIS==1B7 ;DEVICE IS A DISPLAY DV.LNG==1B8 ;DEVICE HAS A LONG DISPATCH TABLE DV.PTP==1B9 ;DEVICE IS A PAPER TAPE PUNCH DV.PTR==1B10 ;DEVICE IS A PAPER TAPE READER DV.DTA==1B11 ;DEVICE IS A DEC TAPE DV.AVL==1B12 ;DEVICE IS AVAILABLE TO THIS JOB DV.MTA==1B13 ;DEVICE IS A MAG TAPE DV.TTY==1B14 ;DEVICE IS A TTY DV.DIR==1B15 ;DEVICE HAS A DIRECTORY DV.IN==1B16 ;DEVICE CAN DO INPUT DV.OUT==1B17 ;DEVICE CAN DO OUTPUT DV.ASC==1B18 ;DEVICE ASSIGNED BY ASSIGN COMMAND DV.ASP==1B19 ;DEVICE ASSIGNED BY INIT OR OPEN UUO DV.M17==1B20 ;DEVICE CAN DO MODE 17 DV.M16==1B21 ;DEVICE CAN DO MODE 16 DV.M15==1B22 ;DEVICE CAN DO MODE 15 DV.M14==1B23 ;DEVICE CAN DO MODE 14 DV.M13==1B24 ;DEVICE CAN DO MODE 13 DV.M12==1B25 ;DEVICE CAN DO MODE 12 DV.M11==1B26 ;DEVICE CAN DO MODE 11 DV.M10==1B27 ;DEVICE CAN DO MODE 10 DV.M7==1B28 ;DEVICE CAN DO MODE 7 DV.M6==1B29 ;DEVICE CAN DO MODE 6 DV.M5==1B30 ;DEVICE CAN DO MODE 5 DV.M4==1B31 ;DEVICE CAN DO MODE 4 DV.M3==1B32 ;DEVICE CAN DO MODE 3 DV.M2==1B33 ;DEVICE CAN DO MODE 2 DV.M1==1B34 ;DEVICE CAN DO MODE 1 DV.M0==1B35 ;DEVICE CAN DO MODE 0 ; IFNDEF CH.HLP, ;HELP CHANNEL IFNDEF CH.IN, ;INPUT CHANNEL IFNDEF CH.OUT, ;OUTPUT CHANNEL IFNDEF CH.PCK, ;PACKED SPEC CHANNEL IFNDEF PSIZE, ;PUSHDOWN LIST LENGTH IFNDEF PATSIZ, ;PATCH AREA LENGTH IFNDEF SCNSIZ, ;LARGEST SIXBIT ITEM SCANNED IFNDEF SWHSIZ, ;LONGEST SWITCH NAME IFNDEF FDSIZE, ;LONGEST FD ALLOWED IFNDEF COBSIZ, ;LARGEST COBOL ITEM ALLOWED IFNDEF CH.EOL, ;PSEUDO COBOL EOL IFNDEF LINSIZ, ;LENGTH OF DUMPED LINE IFNDEF WD.CON, ;WIDTH OF "CONVENTIONAL" COBOL LINE IFNDEF WD.SEQ, ;WIDTH OF "STANDARD" COBOL LINE ; ; DEFINE FLAGS ; ; FL.XXX IS PERMENANT FLAG (LH OF FLG) ; FR.XXX IS TEMPORARY FLAG (RH OF FLG) ; FL.SPC==400000 ;SPECIAL CONVERSION REQUIRED FL.RWR==200000 ;REWRITING COUNT WORD FL.TRP==100000 ;OUTPUT TRAP IS SET FL.BNC==40000 ;BLOCK INCOMPLETE FL.RNC==20000 ;RECORD INCOMPLETE FL.DMP==10000 ;DUMP REQUESTED ; FR.CLN==400000 ;COLON SEEN FR.PER==200000 ;PERIOD SEEN FR.BLK==100000 ;BLANK LINE FR.MIN==40000 ;MINUS SEEN FR.DQT==20000 ;DOUBLE QUOTE LITERAL MODE FR.SQT==10000 ;SINGLE QUOTE LITERAL MODE FR.AST==4000 ;COBOL COMMENT LINE FR.CNT==2000 ;COBOL CONTINUATION LINE FR.CMA==400 ;COMMA SEEN FR.OCR==1 ;OUTPUT PACKED BYTE IN CORE FR.ICR==2 ;INPUT PACKED BYTE IN CORE FR.SGN==4 ;SET ON NEGATIVE ITEM FR.SSG==10 ;HAVE DONE INPUT SOSG FR.NCR==20 ;DON'T INCREMENT ; ; SCANNER FLAGS ; FS.REQ==400000 ;SWITCH VALUE REQUIRED ; ; PROGRAM IS TWOSEGMENT ; TWOSEG RELOC 400000 ; ALLPRT: RESET ;CLEAR CURRENT I/O TTCALL 3,[ASCIZ ./Help for HELP.] CAIA ;START UP ALLPRT RESTRT: RESET ;CLEAR I/O MOVEI T5,1 ;SET UP CHARACTER COUNT TTCALL 3,[ASCIZ / */] MOVE P,[IOWD PSIZE,PLIST] ;SET UP PUSHDOWN MOVE T1,[XWD FIRST,FIRST+1] SETZB FLG,FIRST ;CLEAR BLT T1,LAST-1 ;CLEAR LOW CORE ; ; CLEAR .JBFF THROUGH .JBREL ; HRRZ T1,.JBFF ;GET FIRST FREE SETZM 0(T1) ;CLEAR IT HRL T1,T1 ;SET UP BLT POINTER ADDI T1,1 HRRZ T2,.JBREL ;GET LAST LOC BLT T1,0(T2) ;CLEAR THROUGH .JBREL PUSHJ P,TABGEN ;GENERATE CONVERSION TABLE MOVE S,[XWD OUTSW1,OUTSW2] ;STORE SWITCH TABLE MOVEI F,OUTFIL ;GET OUTPUT SPECIFICATION PUSHJ P,SCANER ;GET OUTPUT SPECIFICATION JRST RESTRT ;RESTART ALLPRT ; ; TEST FOR OUTPUT FD ; CAIE CHR,"," ;SEPERATOR JRST ALLPR5 ;NO - ERROR MOVE S,[XWD PCKSW1,PCKSW2] ;SET FOR PACKED MOVEI F,FP.STA(F) ;GET PACKED TRZ FLG,FR.CLN ;CLEAR COLON FLAG PUSHJ P,SCANER JRST RESTRT ; ; TEST FOR OUTPUT DELIMITER ; ALLPR5: CAIE CHR,"=" CAIN CHR,"_" JRST ALLPR1 ;DONE ; ; SCANNER ERROR ; ALLPR3: PUSHJ P,SC%ERR ;CLEAR LINE - TYPE MESSAGE JRST RESTRT ; ; NOW GET INPUT SPEC ; ALLPR1: MOVE S,[XWD INSW1,INSW2] ;SET SWITCHES MOVEI F,INFILE ;GET INPUT SPECIFICATION TRZ FLG,FR.CLN ;CLEAR COLON FLAG PUSHJ P,SCANER ;GET INPUT SPECIFICATIONS JRST RESTRT ;RESTART ALLPRT ; ; TEST FOR PACKED ; CAIE CHR,"," ;FINISH WITH COMMA JRST ALLPR4 ;NO PACKED MOVE S,[XWD PCKSW1,PCKSW2] ;SET SWITCHES MOVEI F,FP.STA(F) ;SET PCKED FILE TABLE TRZ FLG,FR.CLN ;CLEAR COLON FLAG PUSHJ P,SCANER ;GET SPECIFICATION JRST RESTRT ;RESTART ON ERROR ; ; TEST FOR EOL ; ALLPR4: CAIE ADR,SC%BRK ;BREAK JRST ALLPR3 ;NO - ERROR PAGE SUBTTL ACTUALLY PERFORM CONVERSION ; ; HERE WITH ALL SPECIFICATIONS ; ALLPR2: MOVEI F,OUTFIL ;CHECK FOR PACKED SKIPN FP.DEV(F) ;DEVICE SPECIFIED? JRST ALLPR6 ;NO PUSHJ P,PCKTYP ;GET SPECIFICATION PUSHJ P,PCKERR ;TYPE ERROR MESSAGE TTCALL 3,[ASCIZ /OUTPUT FD: ------ -- /] TLNN F,FF.NLS ;DON'T LIST PACKED SPEC PUSHJ P,FDDUMP ;DUMP THE FD ALLPR6: MOVEI F,INFILE ;TEST FOR INPUT SKIPN FP.DEV(F) ;DEVICE JRST SETUP PUSHJ P,PCKTYP PUSHJ P,PCKERR TTCALL 3,[ASCIZ /INPUT FD: ----- -- /] TLZN F,FF.NLS ;DON'T LIST PACKED SPEC PUSHJ P,FDDUMP SETUP: TLZ FLG,FL.RWR!FL.SPC!FL.TRP!FL.BNC!FL.RNC ;CLEAR FLAGS MOVSI T2,(OUT CH.OUT,) ;SET UP EXOUT INSTRUCTION MOVE IN,F.STA+INFILE ;SET FLAGS MOVE T1,F.CODE(IN) ;GET CODE HRL T1,FNDTAB(T1) ;GET CODE TABLE HLRZM T1,F.CODE(IN) ;STORE CODE HRRI T1,FC.PAD(IN) ;GET FILE CODE TABLE BLT T1,FC.OFR(IN) ;COPY TABLE TSO IN,FC.FLG(IN) ;SET FLAGS HRRZ T1,F.CODE(IN) ;FIXED EBCDIC? CAIN T1,%FEBCD ;FIXED EBCDIC? TLZ IN,FF.VAR ;YES - CLEAR VARIABLE MOVEM IN,F.STA(IN) ;STORE FLAGS MOVE AUT,F.STA+OUTFIL ;SET FLAGS TLO AUT,FF.OUT ;SET OUTPUT FILE MOVE T1,F.CODE(AUT) ;GET CODE HRL T1,FNDTAB(T1) ;GET CODE TABLE HLRZM T1,F.CODE(AUT) ;STORE CODE HRRI T1,FC.PAD(AUT) ;GET FILE CODE TABLE BLT T1,FC.OFR(AUT) ;COPY TABLE TSO AUT,FC.FLG(AUT) ;SET FLAGS HRRZ T1,F.CODE(AUT) ;FIXED EBCDIC? CAIN T1,%FEBCD ;FIXED EBCDIC? TLZ AUT,FF.VAR ;YES - CLEAR VARIABLE MOVEM AUT,F.STA(AUT) ;STORE FLAGS SKIPN FP.ITM(IN) ;PACKED INPUT? JRST SETUP3 ;NO TLNE AUT,FF.RCC!FF.BLC ;YES - RECORD OR BLOCK COUNT? JRST SETUP4 ;YES - TRAP REQUIRED SETUP3: TLNE IN,FF.EOL ;INPUT SIZE KNOWN? TLNN AUT,FF.VAR ;COMPUTED OUTPUT COUNT JRST SETUP2 ;YES/NO TLNN AUT,FF.RCC!FF.BLC ;COUNT ON OUTPUT JRST SETUP2 ;NO - TRAP NOT NEEDED SETUP4: TLO FLG,FL.SPC!FL.TRP ;TRAP NEEDED ; ; SET UP TRAP BLOCK ; MOVE T2,[PUSHJ P,ADVBUF] ;GET TRAP INSTRUCTION MOVE T1,[JRST R.RINT] ;SET NEW DISPATCH EXCH T1,FC.OIR(AUT) ;SET NEW DISPATCH MOVEM T1,TOIREC ;SET OLD DISPATCH MOVE T1,[JRST R.RFIN] ;SET NEW DISPATCH EXCH T1,FC.OFR(AUT) ;SET NEW DISPATCH MOVEM T1,TOFREC ;SET OLD DISPATCH TLNN AUT,FF.BLC ;BLOCK COUNT JRST SETUP2 ;NO MOVE T1,[JRST R.BINT] ;SET NEW DISPATCH EXCH T1,FC.OIB(AUT) ;SET NEW DISPATCH MOVEM T1,TOIBLK ;SET OLD DISPATCH MOVE T1,[JRST R.BFIN] ;SET NEW DISPATCH EXCH T1,FC.OFB(AUT) ;SET NEW DISPATCH MOVEM T1,TOFBLK ;SET OLD DISPATCH ; SETUP2: MOVEM T2,EXOUT(LOW) ;SET UP OUTPUT INSTRUCTION MOVE F,F.STA+INFILE ;INITIALIZE INPUT PUSHJ P,INITFL ;INITIALIZE MOVE F,F.STA+OUTFIL ;INITIALIZE OUTPUT PUSHJ P,INITFL ;INITIALIZE ; ; HERE WITH FILES SET UP AND RINGS ; LINKED TO BUFFER HEADER IN FILE BLOCK ; ; GENERATE CODE TABLE ; MOVE IN,F.STA+INFILE ;GET INPUT CONTROL MOVE AUT,F.STA+OUTFIL ;GET OUTPUT CONTROL PUSHJ P,CODGEN ;GENERATE CODE TABLE ; ; DETERMINE CONVERSION ROUTINE ; IF DUMP REQUESTED - USE DUMP-MODE ; IF INPUT OR OUTPUT ARE PACKED USE PACKED-MODE ; IF INPUT AND OUTPUT ARE NOT PACKED AND ; RECORD , BLOCK AND CODE MATCH USE WORD-MODE ; INPUT AND OUTPUT ARE BOTH SIXBIT USE SYNCH-MODE ; OTHERWISE USE NORMAL CONVERSION ; TLNE FLG,FL.DMP ;DUMP REQUESTED? JRST FILDMP ;DO THE DUMP SKIPN FP.ITM(IN) ;PACKED SPEC? SKIPE FP.ITM(AUT) ;PACKED SPEC? JRST PCKWRT ;YES - PACKED CONVERSION HRRZ T1,F.CODE(IN) ;CHECK CODES HRRZ T2,F.CODE(AUT) ;CHECK CODES CAME T1,T2 ;MATCH JRST CONVRT ;DIFFERENT CODES MOVE T1,F.RCSZ(IN) ;COMPARE RECORD SIZES CAME T1,F.RCSZ(AUT) ;MATCH? JRST TSTSYN ;NO - TEST SYNCH MOVE T1,F.BLSZ(IN) ;COMPARE BLOCK SIZES CAME T1,F.BLSZ(AUT) ;MATCH? JRST TSTSYN ;NO - TEST SYNCH TLNN IN,FF.VAR ;VARIABLE INPUT JRST TSTFIX ;NO - TEST FIXED TLNN AUT,FF.VAR ;VARIABLE OUTPUT JRST TSTSYN ;TEST SYNCH JRST WRDMOD ;SPEC'S MATCH TSTFIX: TLNN AUT,FF.VAR ;FIXED OUTPUT JRST WRDMOD ;YES - SPEC'S MATCH TSTSYN: TLNE IN,FF.SYN ;SYNCHRONIZED MODE JRST SYNC00 ;YES - DO SYNCHRONIZED CONVERSION ; ; CONVERSION ROUTINES ; CONVRT: MOVE T1,FC.SIZ(IN) ;SET CONTAB MOVE T2,[AOS BCHRS] ;TO AOS CONV21: MOVEM T2,CONTAB(T1) ;STORE AOBJN T1,CONV21 ;STORE FOR ALL TLNN IN,FF.EOL ;END OF LINE CHARACTER? JRST CONV02 ;NO ; ; SET UP ASCII CONTAB ; MOVE T1,[JRST CONV06] ;IGNORE CHARACTER MOVEM T1,CONTAB ;IGNORE NULLS HRRI T1,CONV15 ;FOR CR MOVEM T1,CONTAB+15 ;SET FOR CR HRROS CODTAB ;SET NULL BAD HRROS CODTAB+15 ;SET CR BAD TLNN AUT,FF.TAB ;CODE WITH TAB? JRST CONV20 ;NO - SET TAB INTERCEPT TLNE AUT,FF.VAR ;VARIABLE OUTPUT? JRST CONV01 ;YES - DON'T NEED TAB INTERCEPT CONV20: HRRI T1,CONV16 ;FOR TAB MOVEM T1,CONTAB+11 ;SET FOR TAB HRROS T1,CODTAB+11 ;FOR TAB CONV01: ; ; START BLOCK ; CONV02: JSP ADR,.IIBLK ;INITIALIZE INPUT BLOCK JSP ADR,.OIBLK ;INITIALIZE OUTPUT BLOCK ; ; START A RECORD ; CONV03: JSP ADR,.IIREC ;INITIALIZE INPUT RECORD JRST CONV12 ;NO ROOM FOR RECORD SKIPN F.CREC(IN) ;ZERO RECORD SIZE TLNE IN,FF.EOL ;RECORD COUNT KNOWN CAIA ;NO/YES JRST CONV04 ;ZERO LENGTH INITIALIZATION SOSG F.CNT(IN) ;TEST FOR A BYTE JSP Q1,IN.BUF ;GET A BUFFER CONV04: MOVE P1,F.CREC(IN) ;GET INPUT RECSIZE TLNE AUT,FF.VAR ;VARIABLE OUTPUT? SKIPA P2,P1 ;OUTPUT RECSIZE = INPUT RECSIZE MOVE P2,F.CREC(AUT) ;GET OUTPUT RECSIZE JSP ADR,.OIREC ;INITIALIZE OUTPUT RECORD JRST CONV13 ;NO ROOM FOR RECORD TLNE IN,FF.EOL ;RECORD COUNT KNOWN? MOVE P1,P2 ;NO - USE OUTPUT SIZE SUB P2,P1 ;COMPUTE REMAINING CHARACTERS JUMPG P2,CONV05 ;TRUNCATING ADD P1,P2 ;YES CONV05: ADDM P1,NCHRS(LOW) ;ADD INTO CHARACTER COUNT MOVN P1,P1 ;SET NEGATIVE SKIPN F.CREC(IN) ;ZERO LENGTH INPUT TLNE IN,FF.EOL ;RECORD COUNT KNOWN JRST CONV07 ;SKIP FIRST SOSG JUMPE P2,CONV11 ;ANYTHING TO PAD JRST CONV09 ;YES ; ; MAIN CONVERSION LOOP ; ENTERED WITH FOLLOWING ; ; P1 = - # OF CHARACTERS TO CONVERT OR ; 0 IF VARIABLE OUTPUT RECORD ; CODTAB - INPUT TO OUTPUT CONVERSION TABLE ; CONTAB - ERROR CHARACTER PROCESSING TABLE ; CONV06: SOSG F.CNT(IN) ;GET A BYTE JSP Q1,IN.BUF ;INPUT A BUFFER CONV07: ILDB CHR,F.PNT(IN) ;GET THE BYTE SKIPG ADR,CODTAB(CHR) ;CONVERT XCT CONTAB(CHR) ;PROCESS BAD CHARACTER SOSG F.CNT(AUT) ;OUTPUT BYTE JSP Q1,OU.BUF ;OUTPUT BUFFER IDPB ADR,F.PNT(AUT) ;STORE THE BYTE AOJN P1,CONV06 ;CONVERT ALL ; ; EXIT HERE WITH P1 CHARACTERS TRANSLATED ; IF P2 = 0 NO PADDING OR TRUNCATION REQUIRED ; IF P2 GT 0 PADDING REQUIRED ; IF P2 LT 0 TRUNCATION REQUIRED ; CONV18: JUMPE P2,CONV11 ;PAD OR TRUNCATE? JUMPG P2,CONV09 ;PAD ; ; TRUNCATE INPUT RECORD ; TLNE IN,FF.EOL ;RECORD COUNT KNOWN? JRST CONV11 ;NO RECORD COUNT CONV08: SOSG F.CNT(IN) ;SKIP BYTE JSP Q1,IN.BUF ;GET BUFFER IBP F.PNT(IN) ;SKIP BYTE AOJL P2,CONV08 ;CONTINUE JRST CONV11 ;FINISH INPUT RECORD ; ; PAD OUTPUT RECORD ; CONV09: MOVE CHR,FC.PAD(AUT) ;GET PAD CHARACTER CONV10: SOSG F.CNT(AUT) ;ROOM IN BUFFER JSP Q1,OU.BUF ;NO IDPB CHR,F.PNT(AUT) ;YES - STORE PAD CHARACTER SOJG P2,CONV10 ;CONTINUE ; ; RECORD DONE ; CONV11: JSP ADR,FC.IFR(IN) ;FINISH INPUT RECORD JSP ADR,FC.OFR(AUT) ;FINISH OUTPUT RECORD JRST CONV03 ;START ANOTHER RECORD ; ; HERE WHEN INPUT COUNT EXPIRES ; CONV12: JSP ADR,.IFBLK ;FINISH INPUT BLOCK JSP ADR,.IIBLK ;START A NEW BLOCK JRST CONV03 ;START A NEW RECORD ; ; HERE WHEN OUTPUT COUNT EXPIRES ; CONV13: JSP ADR,.OFBLK ;FINISH BLOCK JSP ADR,.OIBLK ;START A BLOCK JRST CONV04 ;CONTINUE ; ; HERE WHEN CR FOUND IN INPUT STREAM ; CONV15: TLNE AUT,FF.VAR ;VARIABLE OUTPUT JRST CONV19 ;YES SUB P2,P1 ;COMPUTE # TO PAD JUMPGE P2,CONV18 ;PAD IF NECESSARY HALT CONV18 ;LOGIC ERROR CONV19: JUMPN P1,CONV11 ;ZERO RECORD? TLNE AUT,FF.ZER ;ZERO RECORDS ALLOWED JRST CONV11 ;YES MOVEI P1,1 ;SET 1 CHAR RECORD MOVEI P2,1 ;PAD 1 CHARACTER JRST CONV09 ;PAD 1 CHARACTER ; ; HERE ON A TAB ; CONV16: MOVE ADR,CODTAB+" " ;GET BLANK EQUIVALENT CONV17: SOSG F.CNT(AUT) ;OUTPUT A BLANK JSP Q1,OU.BUF ;CLEAR BUFFER IDPB ADR,F.PNT(AUT) ;STORE BLANK AOJE P1,CONV18 ;DONE WITH LINE TRNE P1,7 ;AT A TAB STOP JRST CONV17 ;NO JRST CONV06 ;YES ; ; WORD MODE ; ; CODE DEPENDENT MODE USED FOR BLOCKING AND UNBLOCKING FILES ; ; REQUIRES THAT INPUT AND OUTPUT CODES MATCH ; ; USED IN ALL CASES WHERE ONLY BUFFERSIZE IN BEING CHANGED ; (I.E. PACKING DISK BLOCKS ONTO TAPE AND VICA VERSA) ; AND FOR ALL SIXBIT TO SIXBIT TRANSFERS (SINCE IT IS ; SYNCHRONIZED IN WORDS SIXBIT CAN BE EASILY BLOCKED) ; WRDMOD: PUSHJ P,SETBIN ;SET POINTERS BINARY WRDMO1: HRLOI T1,377777 ;TRANSFER + INF WORDS PUSHJ P,BLTWRD HALT . ;HITS DONE ; ; SIXBIT TO SIXBIT CONVERSION ; SYNC00: PUSHJ P,SETBIN ;SET POINTER BINARY SYNC01: MOVE T1,[JRST 0(ADR)] ;SET DISPATCH HRLI T2,FC.OIB(AUT) ;SET DISPATCH HRRI T2,FC.OIB+1(AUT) ;SET DISPATCH MOVEM T1,FC.OIB(AUT) ;SET DISPATCH BLT T2,FC.OFR(AUT) ;SET DISPATCH JRST SYNC03 ;JUMP INTO LOOP SYNC02: JSP ADR,.OFBLK ;FINISH BLOCK SYNC03: JSP ADR,.OIBLK ;INITIALIZE OUTPUT BLOCK SYNC04: JSP ADR,.OIREC ;INITIALIZE OUTPUT RECORD JRST SYNC02 ;BLOCK EXPIRED SYNC05: SOSGE F.CNT(IN) ;ANYTHING IN BUFFER JRST SYNC13 ;NO - GET SOMETHING ILDB T1,F.PNT(IN) ;GET POINTER ANDI T1,7777 ;12 BITS IN RECORD COUNT JUMPE T1,SYNC05 ;IGNORE ZERO RECORDS HRRZ T2,FC.BYT(IN) ;GET BYTES PER WORD PUSHJ P,T1DT2 ;COMPUTE WORDS IN RECORD ADDI T1,1 ;INCLUDE RECORD WORD TLNE AUT,FF.VAR ;VARIABLE OUTPUT SKIPA T2,T1 ;COPY INPUT SIZE HRRZ T2,F.CBUF(AUT) ;GET OUTPUT SIZE TLNN AUT,FF.VAR ;VARIABLE OUTPUT? SKIPA T3,F.RCSZ(AUT) ;GET REQUIRED LDB T3,[POINT 12,F.PNT(IN),35] ;GET INPUT SYNC06: SOSGE F.CNT(AUT) ;STORE COUNT JRST SYNC14 ;GET BUFFER IDPB T3,F.PNT(AUT) ;STORE SUB T2,T1 ;COMPUTE EXCESS JUMPGE T2,SYNC07 ;USE WHOLE INPUT RECORD ADD T1,T2 ;USE PART OF RECORD SYNC07: MOVEM T2,TMPADR ;STORE T2 SUBI T1,1 ;IGNORE RECORD WORDS PUSHJ P,BLTWRD ;TRANSFER SKIPN T1,TMPADR ;EXTRA? JRST SYNC04 ;NEXT RECORD JUMPL T1,SYNC10 ;TRUNCATE ; ; PADDING RECORD ; SYNC08: CAMG T1,F.CNT(AUT) ;SKIP WHOLE BLOCK JRST SYNC09 ;NO SUB T1,F.CNT(AUT) ;REDUCE BY AMOUNT SKIPPED JSP Q1,OU.BUF ;PAD JRST SYNC08 ;START AGAIN SYNC09: ADDM T1,F.PNT(AUT) ;PUSH POINTER MOVN T1,T1 ;PUSH COUNTER ADDM T1,F.CNT(AUT) ;PUSH COUNTER JRST SYNC04 ;PADDING COMPLETE ; ; TRUNCATING RECORD ; SYNC10: MOVM T1,T1 ;HOW MANY TO TRUNCATE SYNC11: CAMG T1,F.CNT(IN) ;TRUNCATE WHOLE BUFFER JRST SYNC12 ;NO SUB T1,F.CNT(IN) ;REDUCE BY BUFFER SIZE JSP Q1,IN.BUF ;TRUNCATE JRST SYNC11 ;CONTINUE SYNC12: ADDM T1,F.PNT(IN) ;PUSH POINTER MOVN T1,T1 ;PUSH COUNTER ADDM T1,F.CNT(IN) ;PUSH COUNTER JRST SYNC04 ;TRUNCATION COMPLETE SYNC13: JSP Q1,IN.BUF JRST SYNC05 SYNC14: JSP Q1,OU.BUF JRST SYNC06 ; ; BLTWRD - TRANSFERS WORDS BETWEEN BUFFERS ; CALL: MOVE T1,# WORDS TO BE TRANSFERRED ; PUSHJ P,BLTWRD ; (RETURN) ; ; UPDATES INPUT AND OUTPUT POINTERS ; BLTWRD: SKIPG T3,F.CNT(IN) ;ANYTHING LEFT IN BUFFER JRST BLTWR1 ;NO - GET A BUFFER BLTWR3: SKIPG T2,F.CNT(AUT) ;ROOM IN BUFFER JRST BLTWR2 ;NO - GET A BUFFER CAML T3,T2 ;PICK THE LESSER ;LESS IN INPUT MOVE T3,T2 ;LESS IN OUTPUT CAML T3,T1 ;TRANSFER HOW MANY MOVE T3,T1 ;NOT MORE THAN REQUIRED SUB T1,T3 ;COMPUTE REMAINDER MOVN T4,T3 ;FIX WORD COUNTS ADDM T4,F.CNT(IN) ;FIX INPUT COUNT ADDM T4,F.CNT(AUT) ;FIX OUTPUT COUNT MOVE T4,F.PNT(AUT) ;BLT TO OUTPUT HRL T4,F.PNT(IN) ;BLT TO INPUT AOBJN T4,.+1 ;ILDB INCREMENTS FIRST ADDM T3,F.PNT(IN) ;ADVANCE INPUT POINTER ADDM T3,F.PNT(AUT) ;ADVANCE OUTPUT POINTER ADDI T3,-1(T4) ;WHERE LAST GOES BLT T4,0(T3) ;TRANSFER JUMPG T1,BLTWRD ;CONTINUE POPJ P, ;RETURN BLTWR1: JSP Q1,IN.BUF ;INPUT A BUFFER JRST BLTWRD ;START AGAIN BLTWR2: JSP Q1,OU.BUF ;OUTPUT A BUFFER JRST BLTWRD ;START OVER ; ; SETBIN - MAKE BUFFER POINTERS BINARY ; CALL: PUSHJ P,SETBIN ; (RETURN) ; SETBIN: MOVSI T1,4400 ;GET BINARY POINTER HLLM T1,F.PNT(IN) ;SET INPUT BINARY HLLM T1,F.PNT(AUT) ;SET OUTPUT BINARY POPJ P, ;DONE PAGE SUBTTL SPECIAL BUFFER ROUTINES ; ; BUFFER FLAGS LH OF BUFFER LINK ; BF.USE==400000 ;BUFFER IN USE BF.RNC==200000 ;INCOMPLETE BUFFER - RECORD COUNT INCOMPLETE BF.BNC==100000 ;INCOMPLETE BUFFER - BLOCK COUNT INCOMPLETE ; ; R.BINT - INITIALIZE COMPUTED BLOCK COUNT ; CALL: JSP ADR,R.BINT ; (RETURN) ; R.BINT: TLO FLG,FL.BNC ;SET BLOCK INCOMPLETE MOVSI T3,BF.BNC ;SET BUFFER INCOMPLETE IORM T3,@F.ADR(AUT) ;SET BUFFER INCOMPLETE HRLI T2,F.ADR(AUT) ;COPY BUFFER HEADER HRRI T2,BLKADR ;TO BLKADR BLT T2,BLKCNT ;COPY SETZM F.EBC(AUT) ;ZERO BLOCK LENGTH MOVEM ADR,TMPADR ;STORE RETURN JSP ADR,TOIBLK ;STORE DUMMY COUNT MOVSI T3,BF.BNC ;SET BUFFER INCOMPLETE IORM T3,@F.ADR(AUT) ;SET BUFFER INCOMPLETE JRST @TMPADR ;RETURN ; ; R.RINT - INITIALIZE COMPUTED RECORD COUNT ; CALL: JSP ADR,R.INT ; (RETURN) ; R.RINT: TLO FLG,FL.RNC ;SET RECORD INCOMPLETE MOVSI T3,BF.RNC ;SET BUFFER INCOMPLETE IORM T3,@F.ADR(AUT) ;SET BUFFER INCOMPLETE HRLI T2,F.ADR(AUT) ;COPY BUFFER HEADER HRRI T2,RECADR ;TO RECADR BLT T2,RECCNT MOVEI P2,0 ;ZERO RECORD COUNT MOVEM ADR,TMPADR ;STORE RETURN ADDRESS JSP ADR,TOIREC ;STORE DUMMY COUNT MOVSI T3,BF.RNC ;SET BUFFER INCOMPLETE IORM T3,@F.ADR(AUT) ;SET BUFFER INCOMPLETE JRST @TMPADR ;RETURN ; ; R.BFIN - STORE COMPUTED BLOCK COUNT IN BUFFER ; CALL: JSP ADR,R.BFIN ; (RETURN) ; R.BFIN: TLO FLG,FL.RWR ;SET REWRITING RECORD MOVEM ADR,TMPADR ;STORE RETURN HRLI T2,F.ADR(AUT) ;COPY BUFFER HEADER HRRI T2,ACTADR ;TO ACTADR BLT T2,ACTCNT HRLI T2,BLKADR ;RESTORE BUFFER HEADER HRRI T2,F.ADR(AUT) ;FROM BLKADR BLT T2,F.CNT(AUT) MOVSI T3,BF.BNC ;CLEAR BUFFER INCOMPLETE ANDCAM T3,@F.ADR(AUT) ;CLEAR BUFFER INCOMPLETE JSP ADR,TOIBLK ;STORE COUNT MOVSI T3,BF.BNC ;CLEAR BUFFER INCOMPLETE ANDCAM T3,@F.ADR(AUT) ;CLEAR BUFFER INCOMPLETE HRLI T2,ACTADR ;RESTORE BUFFER HEADER HRRI T2,F.ADR(AUT) ;FROM ACTADR BLT T2,F.CNT(AUT) TLZ FLG,FL.RWR!FL.BNC MOVE ADR,TMPADR ;RESTORE RETURN XCT TOFBLK ;COMPLETE BLOCK ; ; R.RFIN - STORE COMPUTED RECORD COUNT IN BUFFER ; CALL: JSP ADR,R.RFIN ; (RETURN) ; R.RFIN: TLO FLG,FL.RWR ;SET REWRITING RECORD MOVEM ADR,TMPADR HRLI T2,F.ADR(AUT) ;COPY BUFFER HEADER HRRI T2,ACTADR ;TO ACTADR BLT T2,ACTCNT HRLI T2,RECADR ;RESTORE BUFFER HEADER HRRI T2,F.ADR(AUT) ;FROM RECADR BLT T2,F.CNT(AUT) MOVSI T3,BF.RNC ;CLEAR BUFFER INCOMPLETE ANDCAM T3,@F.ADR(AUT) ;CLEAR BUFFER INCOMPLETE MOVE P2,P1 ;COPY COUNT JSP ADR,TOIREC ;OUTPUT COUNT MOVSI T3,BF.RNC ;CLEAR BUFFER INCOMPLETE ANDCAM T3,@F.ADR(AUT) ;CLEAR BUFFER INCOMPLETE HRLI T2,ACTADR ;RESTORE BUFFER HEADER HRRI T2,F.ADR(AUT) ;FROM ACTADR BLT T2,F.CNT(AUT) ;RESTORE BUFFER HEADER TLZ FLG,FL.RWR!FL.RNC ;TURN OFF REWRITE MOVE ADR,TMPADR ;RESTORE RETURN XCT TOFREC ;FINISH RECORD ; ; ADVBUF - ROUTINE TO ADVANCE OUTPUT BUFFERS ; CALL: MOVEI AUT,OUTFIL ; PUSHJ P,ADVBUF ; (NORMAL RETURN) ; (ERROR RETURN - MORE BUFFERS NEEDED) ; ADVBUF: SKIPG T2,F.ADR(AUT) ;GET BUFFER RING STATUS PJRST ADVBU2 ;VIRGIN RING - INIT FIRST BUFFER TLNN FLG,FL.RWR ;REWRITING SOS F.BUFC(AUT) ;COUNT BUFFER MOVSI T3,BF.USE ;SET BUFFER USED IORB T3,0(T2) ;SET BUFFER USED HRRZ T4,F.PNT(AUT) ;GET CURRENT POINTER WORD SUBI T4,1(T2) ;COMPUTE WORDS USED MOVEM T4,1(T2) ;STORE WORDS USED HRRM T3,F.ADR(AUT) ;ADVANCE BUFFER ADDRESS PUSHJ P,INTBUF ;INITIALIZE BUFFER MOVE T2,@F.ADR(AUT) ;GET BUFFER STATUS WORD TLNN FLG,FL.RWR ;REWRITING? TLNN T2,BF.USE!BF.BNC!BF.RNC ;BUFFER IN USE? POPJ P, ;RETURN PJRST OUTRNG ;YES - CLEAR RING ; ; HERE TO INIT VIRGIN RING ; ADVBU2: HRRZS F.ADR(AUT) ;CLEAR RING VIRGIN ;DROP INTO INTBUF AND RETURN ; ; INTBUF - SET UP BUFFER RING HEADER ; CALL: MOVEI AUT,OUTFIL ; PUSHJ P,INTBUF ; (RETURN) ; INTBUF: MOVE T2,F.ADR(AUT) ;GET BUFFER ADDRESS MOVEI T3,1(T2) ;SET BUFFER POINTER HRRM T3,F.PNT(AUT) ;SET BUFFER POINTER LDB T4,[POINT 6,F.PNT(AUT),11] ;GET BYTE SIZE MOVEI T3,^D36 ;GET WORD SIZE IDIV T3,T4 ;COMPUTE BYTES PER WORD HLRZ T4,0(T2) ;GET BUFFER SIZE IN WORDS ANDCMI T4,BF.USE!BF.RNC!BF.BNC ;CLEAR STATUS SUBI T4,1 ;GET BUFFER SIZE IN WORDS IMUL T3,T4 ;COMPUTE BYTES IN BUFFER MOVEM T3,F.CNT(AUT) ;STORE BYTES IN BUFFER MOVSI T3,770000 ;CLEAR POINTER OFFSET ANDCAM T3,F.PNT(AUT) ;CLEAR POINTER OFFSET POPJ P, ;DONE ; ; OUTRNG - OUTPUTS OUTPUT BUFFER RING ; CALL: MOVEI AUT,OUTFIL ; PUSHJ P,OUTRNG ; (NORMAL RETURN) ; (ERROR RETURN - MORE BUFFERS NEEDED OR HARDWARE ERROR) ; OUTRNG: MOVE T2,F.ADR(AUT) ;GET FIRST BUFFER ADDRESS MOVE T3,0(T2) ;GET BUFFER STATUS WORD TLNE T3,BF.BNC!BF.RNC ;INCOMPLETE BUFFER? PJRST OUTRN4 ;YES - ERROR TLNE T3,BF.USE ;IN USE JRST OUTRN2 ;YES ; ; FIRST CHASE AROUND RING FOR BUFFER IN USE ; OUTRN1: HRR T2,0(T2) ;ADVANCE POINTER MOVE T3,0(T2) ;GET BUFFER HEADER TLNE T3,BF.USE ;BUFFER IN USE JRST OUTRN2 ;YES CAME T2,F.ADR(AUT) ;WHERE WE STARTED? JRST OUTRN1 ;NO - TRY NEXT BUFFER POPJ P, ;YES - RING ALREADY CLEAR ; ; OUTPUT BUFFERS STARTING WITH BUFFER IN T2 ; OUTRN2: OUTRN3: HLLZ T3,0(T2) ;GET BUFFER WORD TLNN T3,BF.BNC!BF.RNC ;INCOMPLETE BUFFER? TLZN T3,BF.USE ;CLEAR USE BIT POPJ P, ;DONE HLLM T3,0(T2) ;RESTORE STATUS HRLI T3,200 ;OUTPUT WHOLE BUFFER SKIPE 1(T2) ;ZERO WORD COUNT? HRLZ T3,1(T2) ;NO - GET WORD COUNT MOVN T3,T3 ;NEGATE IT HRRI T3,1(T2) ;COMPLETE POINTER MOVEI T4,0 ;CLEAR IO WORD +1 OUT CH.OUT,T3 ;OUTPUT JRST OUTRN5 ;CLEAR BUFFER PJRST CPOPJ1 ;GIVE ERROR RETURN ; ; CLEAR CURRENT BUFFER AND WORD COUNT ; OUTRN5: HRRI T3,2(T2) ;SET UP BLT POINTER HRLI T3,1(T2) ;SET UP BLT POINTER SETZM 1(T2) ;CLEAR WORD COUNT HLRZ T4,0(T2) ;GET BUFFER SIZE + 1 ADDI T4,0(T2) ;FIND LAST WORD BLT T3,0(T4) ;CLEAR BUFFER HRRZ T2,0(T2) ;ADVANCE TO NEXT JRST OUTRN3 ; ; HERE WHEN NOT ENOUGH BUFFERS ; OUTRN4: TTCALL 3,[ASCIZ /?OUTPUT ERROR - not enough BUFFERS /] PJRST CPOPJ1 ;GIVE ERROR RETURN ; ; DONE ; DONE: CLOSE CH.IN, ;FIRST CLOSE FILES TLNN FLG,FL.SPC ;SPECIAL OUTPUT JRST DONE3 ;NO TLNE FLG,FL.RNC ;RECORD INCOMPLETE JSP ADR,R.RFIN ;COMPLETE IT TLNE FLG,FL.BNC ;BLOCK INCOMPLETE JSP ADR,.OFBLK ;COMPLETE IT SOS T2,F.PNT(AUT) ;GET POINTER HRL T3,FC.PNT(AUT) ;COMPUTE INITIAL POINTER HRR T3,F.ADR(AUT) ;COMPUTE INITIAL POINTER CAME T2,T3 ;SAME PUSHJ P,ADVBUF ;FINISH BUFFER PUSHJ P,OUTRNG ;CLEAR RING JFCL ;IGNORE DONE3: CLOSE CH.OUT, TLNE IN,FF.TAP ;THEN PERFORM UNLOAD TLNN IN,FF.UNL ;UNLOAD JRST DONE1 ;NO MTAPE CH.IN,11 ;REWIND AND UNLOAD DONE1: TLNE AUT,FF.TAP ;MAG-TAPE? TLNN AUT,FF.UNL ;UNLOAD DEVICE? JRST DONE2 ;NO MTAPE CH.OUT,11 ;UNLOAD MAGTAPE ; DONE2: RELEASE CH.IN, ;RELEASE INPUT RELEASE CH.OUT, ;RELEASE OUTPUT PUSHJ P,STATS ;PRINT STATISTICS JRST RESTRT ;FINISHED - TRY AGAIN ; ; I/O ROUTINES USED BY THE ABOVE ; IN.BUF: IN CH.IN, ;DO INPUT AOSA F.BUFN(IN) ;COUNT BUFFERS JRST IN.BU1 ;CHECK FOR EOF SOS F.BUFC(IN) ;DECREMENT COUNTER JRST 0(Q1) ;RETURN IN.BU1: STATO CH.IN,20000 HALT . JRST DONE ;EOF ; OU.BUF: XCT EXOUT ;EXECUTE EXOUT AOSA F.BUFN(AUT) ;COUNT BUFFERS HALT . SOS F.BUFC(AUT) ;DECREMENT COUNTER JRST 0(Q1) ;RETURN ; IN.BYT: SOSG F.CNT(IN) JSP Q1,IN.BUF ILDB CHR,F.PNT(IN) JRST 0(Q2) ; OU.BYT: SOSG F.CNT(AUT) JSP Q1,OU.BUF IDPB CHR,F.PNT(AUT) JRST 0(Q2) PAGE SUBTTL DUMP ROUTINES ; ; THIS ROUTINES DUMP THE INPUT FILE ; IN THE OUTPUT CODE ; ; CURRENTLY ONLY EBCDIC TO ASCII IS IMPLEMENTED ; FILDMP: HRRZ T1,F.CODE(IN) ;GET INPUT CODE CAIE T1,%FEBCD ;EBCDIC CAIN T1,%VEBCD ;EBCDIC JRST FILD01 ;YES FILD02: TTCALL 3,[ASCIZ /?Non EBCDIC To ASCII DUMP not yet implemented /] JRST RESTRT ;RESTART FILD01: HRRZ T2,F.CODE(AUT) ;GET OUTPUT CODE CAIE T2,%ASCII ;ASCII JRST FILD02 ;CAN'T DO IT ; ; READY TO START DUMP ; PUSHJ P,FILD09 ;SET UP POINTERS MOVEI P1,0 ;CLEAR P1 SETZM SAVCHR ;CLEAR RECORD COUNT JRST FILD17 ;START FILD04: JSP ADR,.IFBLK ;FINISH INPUT BLOCK FILD17: JSP ADR,.IIBLK ;START BLOCK FILD03: JSP ADR,.IIREC ;START RECORD JRST FILD04 ;START A NEW BLOCK AOS T1,SAVCHR ;COUNT RECORD IDIVI T1,^D1000 IDIVI T2,^D100 IDIVI T3,^D10 MOVEI CHR," " OUTBYT MOVEI CHR,"(" OUTBYT MOVEI CHR,"0"(T1) OUTBYT MOVEI CHR,"0"(T2) OUTBYT MOVEI CHR,"0"(T3) OUTBYT MOVEI CHR,"0"(T4) OUTBYT MOVEI CHR,")" OUTBYT SKIPN P2,F.CREC(IN) ;GET INPUT SIZE JRST FILD26 ;ZERO LENGTH RECORD FILD07: SOSG F.CNT(IN) ;GET A BYTE JRST FILD05 ;DO INPUT FILD06: ILDB CHR,F.PNT(IN) ;GET CHARACTER ; ; HERE WITH CHARACTER IN CHR ; MOVEI T1," " ;GET CONVERSION SKIPGE T2,CODTAB(CHR) ;GET CONVERSION JRST FILD27 ;IGNORE BAD CONVERSION ; ; CONVERT "LOWER" CASE CHARACTERS (VALUE GE 140) ; CAIG T2,"Z" ;UPPER CASE OR CONTROL JRST FILD77 ;YES MOVEI T1,"'" ;OUTPUT AS ' CHARACTER MOVEI T2,-<" ">(T2) ;CONVERT TO UPPER CASE JRST FILD27 ;OUTPUT ; ; CONVERT "CONTROL" CHARACTERS (VALUE LE 37) ; FILD77: CAILE T2,37 ;CONTROL JRST FILD27 ;NO MOVEI T1,"^" ;YES ADDI T2,"@" ;MAKE ALPHA FILD27: IDPB T1,D.PTR2 IDPB T2,D.PTR2 MOVE T1,CHR ;GET HEX MOVE T2,CHR ;GET HEX ANDI T1,17 ;GET HEX HEX(F0) ANDI T2,XXX ;GET HEX LSH T2,-4 ;GET HEX MOVEI T1,"0"(T1) ;GET ASCII MOVEI T2,"0"(T2) ;GET ASCII CAILE T1,"9" ADDI T1,7 CAILE T2,"9" ADDI T2,7 IDPB T2,D.PTR1 IDPB T1,D.PTR1 ; ; STORE PACKED ; CAILE T2,"9" ;IN RANGE JRST FILD13 ;NO CAILE T1,"9" ;IN RANGE JRST FILD14 ;NO FILD15: IDPB T2,D.PTR3 IDPB T1,D.PTR3 MOVEI P1,1(P1) ;INCREMENT CAIGE P1,^D60 ;DONE 60 YET JRST FILD16 ;NO PUSHJ P,FILD09 ;RESET PUSHJ P,FILD08 ;OUTPUT FILD16: SOJG P2,FILD07 ;EOR FILD26: JSP ADR,FC.IFR(IN) ;CLEAR INPUT RECORD PUSHJ P,FILD09 PUSHJ P,FILD08 JSP ADR,FC.OFR(AUT) JRST FILD03 FILD05: IN CH.IN, ;DO INPUT JRST FILD06 ;CONTINUE STATO CH.IN,20000 ;EOF HALT .+1 ;ERROR CAIN P1,^D60 ;ANY STORWD JRST FILD25 ;NO PUSHJ P,FILD09 ;RESET PUSHJ P,FILD08 ;OUTPUT FILD25: CLOSE CH.OUT, JRST RESTRT ;DONE ; ; FILD08 - OUTPUT LINES ; FILD08: LSH P1,1 MOVE T1,D.PTR1 ;GET FIRST LINE PUSHJ P,FILD10 ;OUTPUT LINE MOVE T1,D.PTR2 ;GET SECOND LINE PUSHJ P,FILD10 ;OUTPUT SECOND LINE MOVE T1,D.PTR3 ;GET THIRD LINE PUSHJ P,FILD10 ;OUTPUT THIRD LINE JSP ADR,FC.OFR(AUT) MOVEI P1,0 ;CLEAR COUNT POPJ P, ;DONE ; ; SET UP BYTE POINTER ; FILD09: MOVE T1,[POINT 7,D.LIN1 ] MOVEM T1,D.PTR1 HRRI T1,D.LIN2 MOVEM T1,D.PTR2 HRRI T1,D.LIN3 MOVEM T1,D.PTR3 POPJ P, ; ; FILD10 - OUTPUT LINE ; FILD10: JUMPE P1,FILD12 ;NOTHING TO PRINT MOVEI ADR,11 ;START WITH TAB SOSG F.CNT(AUT) JSP Q1,OU.BUF IDPB ADR,F.PNT(AUT) MOVE T2,P1 ;COPY SIZE FILD11: ILDB ADR,T1 ;GET BYTE JUMPE ADR,FILD12 SOSG F.CNT(AUT) JSP Q1,OU.BUF IDPB ADR,F.PNT(AUT) SOJG T2,FILD11 FILD12: JSP ADR,FC.OFR(AUT) POPJ P, ; ; HERE WHEN NOT IN RANGE ; FILD13: MOVEI T1," " MOVEI T2," " JRST FILD15 ; ; HERE WHEN SECOND NOT I RANGE ; FILD14: CAIE T1,"B" CAIN T1,"D" ADDI T2,(SIXBIT / 0/) MOVEI T1," " JRST FILD15 PAGE SUBTTL WRITE PACKED TAPES PCKWRT: MOVE T1,FC.SIZ(IN) ;SET CONTAB MOVE T2,[AOS BCHRS] ;TO AOS PCKW16: MOVEM T2,CONTAB(T1) ;STORE AOBJN T1,PCKW16 ;STORE FOR ALL MOVE T1,[MOVEI ADR,40] ;MAKE NULLS INTO BLANKS MOVEM T1,CONTAB TLNN IN,FF.EOL ;EOL CHARACTER? JRST PCKW02 ;NO ; ; SET UP ASCII CONTAB ; MOVE T1,[JRST PCKW06] MOVEM T1,CONTAB ; HRRI T1,PCKW15 ;FOR CR MOVEM T1,CONTAB+15 ;SET FOR CR HRROS CODTAB ;SET NULL BAD HRROS CODTAB+15 ;SET CR BAD ; ; START BLOCK ; PCKW02: JSP ADR,.IIBLK ;INITIALIZE INPUT BLOCK JSP ADR,.OIBLK ;INITIALIZE OUTPUT BLOCK ; ; START A RECORD ; PCKW03: JSP ADR,.IIREC ;INITIALIZE INPUT RECORD JRST PCKW12 ;NO ROOM FOR RECORD SKIPN F.CREC(IN) ;ZERO RECORD SIZE TLNE IN,FF.EOL ;RECORD COUNT? CAIA ;NO/YES JRST PCKW04 ;ZERO LENGTH INITIALIZATION SOSG F.CNT(IN) ;TEST FOR A BYTE JSP Q1,IN.BUF ;GET A BUFFER TRO FLG,FR.SSG ;SET SOSG DONE PCKW04: JSP ADR,.OIREC ;INITIALIZE OUTPUT RECORD JRST PCKW13 ;BLOCK EXPIRED SKIPN P2,F.CREC(IN) ;GET INPUT SIZE MOVEI P2,377777 ;SET LARGEST RECORD SKIPN P1,F.CREC(AUT) ;GET OUTPUT SIZE MOVEI P1,377777 ;SET LARGEST RECORD MOVN P1,P1 ;SET NEGATIVE MOVN P2,P2 ;SET NEGATIVE HRLZ P1,P1 ;SET UP AOBJN WORD HRLZ P2,P2 ;SET UP AOBJN WORD SKIPN F.CREC(IN) ;ZERO INPUT COUNT? TLNE IN,FF.EOL ;RECORD COUNT KNOWN? JRST PCKW07 ;NO/NO - SKIP FIRST SOSG SKIPN F.CREC(AUT) ;ZERO OUTPUT RECORD JRST PCKW11 ;YES - DON'T PAD JRST PCKW09 ;NO - PAD ; PCKW07: PUSHJ P,PCKRNT ;INITIALIZE POINTER PUSHJ P,PCKWNT ;INITAILIZE POINTER PCKW06: JUMPG P2,PCKW09 ;PAD OUTPUT RECORD PUSHJ P,PCKIN ;GET A CHARACTER SKIPG ADR,CODTAB(CHR) ;CONVERT XCT CONTAB(CHR) ;PROCESS BAD CHARACTER PUSHJ P,PCKOUT ;OUTPUT PACKED BYTE JUMPL P1,PCKW06 ;GET NEXT INPUT CHARACTER ; ; TEST FOR INPUT TRUNCATION ; TLNE IN,FF.EOL ;RECORD COUNT? JRST PCKW11 ;NO -DON'T TRUNCATE PCKW08: JUMPG P2,PCKW11 ;FINISHED TRUNCATING PUSHJ P,PCKIN ;GET A BYTE JRST PCKW08 ;CONTINUE ; ; PAD OUTPUT RECORD ; PCKW09: MOVE CHR,FC.PAD(AUT) ;GET PAD CHARACTER PCKW10: JUMPG P1,PCKW11 ;FINISHED PADDING PUSHJ P,PCKOUT ;PAD JRST PCKW10 ;GET ANOTHER ; ; RECORD DONE ; PCKW11: JSP ADR,FC.IFR(IN) ;FINISH INPUT RECORD JSP ADR,FC.OFR(AUT) ;FINISH OUTPUT RECORD AOS NRECS ;INCREMENT # OF RECORDS CONVERTED JRST PCKW03 ;START ANOTHER RECORD ; ; HERE WHEN INPUT COUNT EXPIRES ; PCKW12: JSP ADR,.IFBLK ;FINISH INPUT BLOCK JSP ADR,.IIBLK ;START A NEW BLOCK JRST PCKW03 ;START A NEW RECORD ; ; HERE WHEN OUTPUT COUNT EXPIRES ; PCKW13: JSP ADR,.OFBLK ;FINISH BLOCK JSP ADR,.OIBLK ;START A BLOCK JRST PCKW04 ;CONTINUE ; ; HERE WHEN CR FOUND IN INPUT STREAM ; PCKW15: PUSHJ P,PCKWFN ;FINISH BYTE IN CORE TLNE AUT,FF.VAR ;VARIABLE OUTPUT JRST PCKW11 ;FINISH OFF JRST PCKW09 ;PAD IF NECESSARY ; ; PCKRNT - INITIALIZE POINTER ; CALL: PUSHJ P,PCKRNT ; (RETURN) ; PCKRNT: MOVE T1,FP.ITM(IN) ;GET FIRST ITEM MOVEM T1,FP.CUR(IN) ;SET AS CURRENT TRZ FLG,FR.ICR ;CLEAE INCORE PJRST PCKRD1 ;ADVANCE IF NECESSARY ; ; PCKIN - GET A PACKED BYTE ; CALL: PUSHJ P,PCKIN ; (RETURN) ; ; RETURNS BYTE AS EBCDIC CHARACTER ; UNPAKCS PACKED DATA ; PCKIN: SKIPL FP.PCT(IN) ;COMP-3 JRST PCKI03 ;NO - RETURN BYTE ; ; HERE ON PACKED INPUT ; MOVE T1,FP.PSZ(IN) ;GET POSITION CAIN T1,1 ;LAST BYTE? JRST PCKI30 ;YES ; ; HERE TO PROCESS UNSIGNED BYTE ; PCKI35: TRZE FLG,FR.ICR ;BYTE IN CORE JRST PCKI31 ;YES TRZE FLG,FR.SSG ;SOSG DONE JRST PCKI32 ;YES SOSG F.CNT(IN) ;GET COUNT JSP Q1,IN.BUF ;GET BUFFER PCKI32: ILDB CHR,F.PNT(IN) ;GET BYTE MOVEM CHR,FP.TMP(IN) ;STORE BYTE TRO FLG,FR.ICR ;SET BYTE IN CORE LSH CHR,-4 ;GET FIRST BYTE HEX(F0) ;MAKE NORMAL PCKI34: IORI CHR,XXX ;MAKE NORMAL JRST PCKI05 ;RETURN BYTE ; ; HERE ON BYTE IN CORE ; PCKI31: LDB CHR,[POINT 4,FP.TMP(IN),35] ;GET BYTE AOB P2 ;COUNT BYTE JRST PCKI34 ;RETURN BYTE ; ; HERE ON LAST BYTE ; PCKI30: MOVE T1,FP.PCT(IN) ;GET PICTURE TLNN T1,FD.SGN ;SIGNED JRST PCKI35 ;NO TRZE FLG,FR.ICR ;BYTE IN CORE JRST PCKI40 ;YES TRNE FLG,FR.SSG ;SOSG DONE JRST PCKI41 ;YES SOSG F.CNT(IN) JSP Q1,IN.BUF PCKI41: ILDB CHR,F.PNT(IN) MOVEM CHR,FP.TMP(IN) LSH CHR,-4 ;SHIFT BYTE JRST PCKI43 ;GET SIGN PCKI40: LDB CHR,[POINT 4,FP.TMP(IN),35] AOB P2 ;COUNT BYTE PCKI42: TRZE FLG,FR.ICR ;BYTE IN CORE JRST PCKI43 ;YES SOSG F.CNT(IN) ;SOSG CANNOT HAVE BENN DONE JSP Q1,IN.BUF ;GET THE BUFFER ILDB T2,F.PNT(IN) ;GET THE BYTE HEX(F) ANDI T2,XXX ;GET LAST BYTE JRST PCKI44 ;SKIP LDB PCKI43: LDB T2,[POINT 4,FP.TMP(IN),35] PCKI44: ;PATCH...D. BRAITHWAITE JUNE 24,73 ;ILLEGAL TRANSLATION OF SIGN CHARACTER ;WHICH IS HEX(C) FOR POSITIVE, AND HEX(D) ;FOR NEGATIVE...PRESENT MERELY RETURNS ;THE HEX CHARACTER D# OR C# WHICH DOES ; NOT TRANSLATE CORRECTLY. ; ;SOLUTION..HAVE IT RETURN F# FOR POSITIVE ; AND #+EBCIDIC(J) FOR NEG (WITH NON-ZERO ; LAST DIGIT) OR EBCIDIC(:) (FOR ZERO ; LAST DIGIT). SKIPE ,T2 ;IS IT A "0"?(POSITIVE) CAIN T2,14 ;IS IT A "C" ? (POSITIVE) SKIPA T2,[17] ;YES...INSERT HIGH ORDER "F". CAIE T2,15 ;NO....IS IT THEN A "D" ? (NEGATIVE) ;IF NO..PLAY OLD GAME AND LET USER ;ADD HIS FIX ALSO. JRST PCKI45 ;HERE WHEN NEGATIVE. SKIPE T2,CHR ;IS LAST CHARACTER ZERO ? SKIPA CHR,[221] ;NO...MAKE OFFSET EBCIDIC(J). MOVEI CHR,172 ;YES..MAKE OFFSET EBCIDIC(:). ADDI CHR,0(T2) ;ADD IN LAST CHAR SETZ T2, ;CLEAR T2. PCKI45: LSH T2,4 ;SWAP BYTE. ;;;;;;;;;;;;;;;;;;;;;;;;END OF PATCH. AOB P2 ;COUNT SIGN BYTE IORI CHR,0(T2) ;SET SIGN JRST PCKI05 ;HAVE SIGNED BYTE ; ; RETURN A NORMAL BYTE ; PCKI03: TRZE FLG,FR.SSG ;SOSG DONE? JRST PCKI37 ;YES SOSG F.CNT(IN) JSP Q1,IN.BUF ;GET BUFFER PCKI37: ILDB CHR,F.PNT(IN) ;GET THE BYTE AOB P2 ;COUNT BYTE PCKI05: SOSE FP.PSZ(F) ;END OF PICTURE POPJ P, ;RETURN ;DROP INTO PCKRDV ; ; PCKRDV - ADVANCE INPUT POINTER ; CALL: PUSHJ P,PCKRDV ; (RETURN) ; PCKRDV: MOVE T1,FP.CUR(IN) ;GET CURRENT HRRZ T1,0(T1) ;GET NEXT MOVEM T1,FP.CUR(IN) ;ADVANCE PCKRD1: SKIPN T1,FP.CUR(IN) ;GET ITEM JRST PCKRD2 ;SUPPLY DEFAULT SKIPN T2,ITMPCT(T1) ;PICTURE? JRST PCKRDV ;NO - FIND A PICTURE ITEM PCKRD3: HRRZM T2,FP.PSZ(IN) ;STORE SIZE MOVEM T2,FP.PCT(IN) ;STORE PICTURE SETZM FP.TMP(IN) ;CLEAR STORAGE TRZE FLG,FR.ICR ;CLEAR INPUT BYTE IN CORE AOB P2 ;COUNT INCORE BYTE POPJ P, ;RETURN PCKRD2: MOVEI T2,377777 ;SET LARGEST PICTURE JRST PCKRD3 ;SET UP ; ; PCKWNT - INITIALIZE POINTER ; CALL: PUSHJ P,PCKWNT ; (RETURN) ; PCKWNT: MOVE T1,FP.ITM(AUT) ;GET FIRST ITEM BLOCK MOVEM T1,FP.CUR(AUT) ;STORE AS ITEM PJRST PCKWD1 ;CHECK THAT ELEMENTARY ; ; PCKOUT - OUTPUT PACKED BYTE ; CALL: MOVEI ADR,EBCDIC BYTE ; PUSHJ P,PCKOUT ; (RETURN) ; PCKOUT: SKIPL FP.PCT(AUT) ;COMP-3 JRST PCKO03 ;NO - STORE BYTE ; ; PCKO01 - PACKED BYTE ; HEX(F0) PCKO01: CAIL ADR, ;PACKABLE HEX(F9) CAILE ADR, ;PACKABLE JRST PCKO02 ;TEST IF LAST AND SIGNED TRCN FLG,FR.OCR ;BYTE IN CORE JRST PCKO04 ;NO ANDI ADR,17 ;YES IOR ADR,FP.TMP(AUT) ;GET BYTE FROM CORE JRST PCKO03 ;RETURN ; ; HERE WHEN NO BYTE IN CORE ; PCKO04: DPB ADR,[POINT 4,FP.TMP(AUT),31] ;STORE LOWER FOUR BITS JRST PCKO05 ;RETURN ; ; TEST IF LAST SIGNED BYTE ; PCKO02: MOVE T1,FP.PSZ(AUT) ;GET COUNT CAIE T1,1 ;LAST BYTE JRST PCKO06 ;NO - ERROR HEX(C0) CAIL ADR, ;POSITIVE BYTE HEX(C9) CAILE ADR, ;POSITIVE BYTE JRST PCKO20 ;NO JRST PCKO21 ;YES HEX(D0) PCKO20: CAIL ADR, ;NEGATIVE BYTE HEX(D9) CAILE ADR, ;NEGATIVE BYTE JRST PCKO06 ;ERROR TRO FLG,FR.SGN ;SET MINUS HEX(F0) PCKO21: IORI ADR, ;SET NORMAL JRST PCKOUT ;START AGAIN ; ; PCKO06 - NON PACKABLE ; PCKO06: TTCALL 3,[ASCIZ /?NON PACKABLE CHARACTER IN PACKED FIELD /] HEX(F9) MOVEI ADR,XXX ;SUPPLY A PACKABLE BYTE JRST PCKOUT ;RESTART ; ; HERE WHEN READY TO STORE A BYTE ; PCKO03: SOSG F.CNT(AUT) ;STORE BYTE JSP Q1,OU.BUF ;OUTPUT IDPB ADR,F.PNT(AUT) ;STORE BYTE AOS NCHRS ;INCREMENT # OF BYTES CONVERTED AOB P1 ;COUNT BYTE ; ; HERE WHEN NOT READY TO STORE BYTE ; PCKO05: SOSE FP.PSZ(AUT) ;END OF PICTURE POPJ P, ;RETURN ;DROP INTO PCKWFN ; ; PCKWFN - FINISH CURRENT PICTURE ; CALL: PUSHJ P,PCKWFN ; (RETURN) ; PCKWFN: SKIPL T1,FP.PCT(AUT) ;COMP-3 JRST PCKWDV ;NO TRZE FLG,FR.OCR ;BYTE IN CORE SKIPA ADR,FP.TMP(AUT) ;YES - FETCH IT SETZB ADR,FP.TMP(AUT) ;NO - CLEAR BOTH TLNN T1,FD.SGN ;SIGNED JRST PCKO08 ;NO TRZE FLG,FR.SGN ;POSITIVE QUANTITY HEX(D) SKIPA T2,[XXX] ;SET MINUS HEX(C) MOVEI T2,XXX ;SET PLUS IORI ADR,0(T2) ;OR IN SIGN PCKO08: JUMPE ADR,PCKWDV ;BYTE TO STORE SOSG F.CNT(AUT) ;YES JSP Q1,OU.BUF IDPB ADR,F.PNT(AUT) ;DROP IN PCKWDV AOB P1 ;COUNT BYTE ; ; PCKWDV - ADVANCE TO NEXT ITEM ; CALL: PUSHJ P,PCKWDV ; (RETURN) ; ; SETS UP NEXT ELEMENTARY ITEM ; PCKWDV: MOVE T1,FP.CUR(AUT) ;GET CURRENT HRRZ T1,0(T1) ;GET NEXT MOVEM T1,FP.CUR(AUT) ;ADVANCE ITEM PCKWD1: SKIPN T1,FP.CUR(AUT) ;GET CURRENT ITEM JRST PCKWD2 ;SET DUMMY ITEM SKIPN T2,ITMPCT(T1) ;ELEMENTARY JRST PCKWDV ;NO PCKWD3: HRRZM T2,FP.PSZ(AUT) ;STORE SIZE MOVEM T2,FP.PCT(AUT) ;STORE PICTURE SETZM FP.TMP(AUT) ;CLEAR COUNTERS TRZ FLG,FR.OCR!FR.SGN ;CLEAR BYTE IN CORE AND SIGN POPJ P, PCKWD2: MOVEI T2,777777 ;SET LARGEST PICTURE JRST PCKWD3 ;SET UP PAGE SUBTTL MANIPULATE FD POINTER LIST ; ; LAYOUT OF FD TABLES ; ------------------- ; ; FOR EACH ITEM (LINE STARTING WITH LEVEL #) GENERATE A ; FOUR WORD TABLE ; ; TABLE FORMAT ; ----- ------ ; ; WORD0 LAST ITM NEXT ITM ; WORD1 LEVEL # NAME POINTER ; WORD2 (OCCURS) REDEFINES ; IF LEVEL 66 [REDEFINES 1 REDEFINES 2] ; WORD3 PIC TYPE PIC SIZE ; ; NAME BLOCKS ; ----------- ; ; 2 + WORDS AS FOLLOWS ; ; WORD0 LAST NAME BLOCK NEXT NAME BLOCK ; WORD1 ITEM BLOCK ; WORD2+ ITEM NAME IN SIXBIT ; (COBSIZ WORDS) ; ; ; LOW CORE LOCATIONS ; FP.ITM POINTS TO 1ST ITEM BLOCK ; FP.NAM POINTS TO 1ST NAME BLOCK ; DEFINE ENTRIES IN ITEM TABLE ; ITMLNK==0 ;LINK WORD ITMLVL==1 ;LEVEL WORD ITMNAM==1 ;NAME LINK ITMOCR==2 ;OCCURS WORD ITMRDF==2 ;REDEFINES WORD ITMPCT==3 ;PICTURE WORD ITMLEN==ITMPCT+1 ;LENGTH OF TABLE ; ; DEFINE ENTRIES IN NAME TABLE ; NAMLNK==0 ;LINK WORD NAMITM==1 ;ITEM WORD NAMNAM==2 ;NAME IN SIXBIT NAMLEN==NAMNAM+COBSIZ ;LENGTH OF TABLE ENTRY ; ; PCKTYP - DECODE PACKED SPECIFICATION ; CALL: PUSHJ P,PCKTYP ; (ERROR RETURN) ; (RETURN) ; ; P1 HOLDS "CURRENT" ITEM BLOCK ADDRESS ; P2 HOLDS "CURRENT" NAME BLOCK ADDRESS ; ITM==P1 ;HOLDS CURRENT ITEM NAM==P2 ;HOLDS CURRENT NAME ; PCKTYP: HLL F,FP.STA(F) ;GET PACKED STATUS MOVEI T1,FP.ADR(F) ;GET HEADER MOVEM T1,FP.BUF(F) ;STORE IN OPEN BLOCK OPEN CH.PCK,FP.MOD(F) ;OPEN DEVICE HALT . LOOKUP CH.PCK,FP.NAM(F) ;LOOKUP FILE HALT . ;ERROR PUSHJ P,COBS00 ;INITIALIZE FOR COBSIX MOVEI ITM,FP.ITM(F) ;LINK TO FIRST ITEM MOVEI NAM,FP.NMB(F) ;LINK TO FIRST NAME BLOCK ; ; FIRST SCAN FOR FD ; SKIPN PCKFD(LOW) ;FD SPECIFIED JRST PCKT01 ;SCAN NOT REQUIRED PCKT02: PUSHJ P,COBSIX ;GET ITEM POPJ P, ;EOF - ERROR MOVE T1,COBDAT(LOW) ;GET FIRST WORD CAMN T1,[SIXBIT /FD/] ;FD? JRST PCKT03 ;YES PCKT04: PUSHJ P,NXTLNE ;GET NEXT LINE POPJ P, ;EOF - ERROR JRST PCKT02 ;TRY AGAIN ; ; HERE WHEN FD FOUND AT BEGINNING OF LINE ; PCKT03: PUSHJ P,COBSIX ;GET FD NAME POPJ P, ;EOF - ERROR ZZ==0 REPEAT FDSIZE,< MOVE T1,PCKFD+ZZ(LOW) ;GET FD CAME T1,COBDAT+ZZ(LOW) ;COMPARE TO DATA JRST PCKT04 ;NO MATCH ZZ==ZZ+1 > PUSHJ P,NXTLNE ;FD'S MATCH - SLEW LINE POPJ P, ;EOF - ERROR ; ; HERE WHEN POSITIONED AFTER FD AT FIRST 01 LEVEL ; PCKT01: PUSHJ P,COBSIX ;GET LINE START PJRST CPOPJ1 ;DONE PUSHJ P,MAKNUM ;MAKE NUMERIC PJRST CPOPJ1 ;DONE ; ; HERE WITH LEVEL # IN T1 ; PUSHJ P,ALCITM ;ALLOCATE AN ITEM TABLE PCKT05: HRLM ITM,ITMLNK(T2) ;STORE BACKWARD LINK HRRM T2,ITMLNK(ITM) ;STORE FORWARD LINK MOVE ITM,T2 ;SET NEW "CURRENT" ITEM BLOCK HRLZM T1,ITMLVL(ITM) ;STORE LEVEL # SETZM ITMPCT(ITM) ;CLEAR PICTURE WORD SETZM ITMOCR(ITM) ;CLEAR OCCURS WORD ; ; GET NAME AND STORE IT ; PUSHJ P,COBSIX ;GET NAME IN COBDAT POPJ P, ;ERROR RETURN PUSHJ P,FNDNAM ;FIND NAME JRST PCKT11 ;UNIQUE NAME HLRZ T2,ITMLVL(T3) ;GET LEVEL # CAIN T2,^D66 ;LEVEL 66? JRST PCKT30 ;YES - FILLER NOT LLOWED MOVE T2,COBDAT(LOW) ;GET DATA MOVE T3,COBDAT+1(LOW) ;GET DATA CAMN T2,[SIXBIT /FILLER/] ;FILLER JUMPE T3,PCKT31 ;YES PCKT30: TTCALL 3,[ASCIZ /?NON-UNIQUE NAME /] POPJ P, ;ERROR RETURN PCKT11: PUSHJ P,ALCNAM ;ALLOCATE NAME TABLE HRRM T2,NAMLNK(NAM) ;STORE FORWARD LINK HRLZM NAM,NAMLNK(T2) ;STORE BACKWARD LINK MOVE NAM,T2 ;SET "CURRENT" NAME BLOCK HRLI T3,COBDAT(LOW) ;WHERE IS DATA HRRI T3,NAMNAM(NAM) ;WHERE DOES NAME GO? BLT T3,NAMNAM+COBSIZ-1(NAM) ;COPY DATA MOVEM P1,NAMITM(P2) ;STORE ITEM IN NAME BLOCK PCKT31: HRRM NAM,ITMNAM(ITM) ;STORE NAME IN ITEM BLOCK ; ; TEST IF LEVEL 66 ; HLRZ T1,ITMLVL(ITM) ;GET LEVEL # CAIN T1,^D66 ;LEVEL 66 JRST PCKT06 ;YES - STORE LEVEL 66 ; ; TEST COBOL KEYWORDS ; ; PIC OR PICTURE ; COMP-3 OR COMPUTATIONAL-3 ; OCCURS ; REDEFINES ; PKLOOP: JUMPN CHR,PCKT01 ;DONE - GET NEXT ITEM PUSHJ P,COBSIX ;GET ITEM POPJ P, ;ERROR MOVE T1,COBDAT(LOW) ;GET FIRST DATA WORD CAMN T1,[SIXBIT /PIC/] ;"PIC"? JRST PCTURE ;YES MOVE T2,COBDAT+1(LOW) ;GET SECOND DATA WORD CAMN T1,[SIXBIT /PICTUR/] ;"PICTUR"? CAME T2,[SIXBIT /E/] ;"E"? JRST PCKT07 ;NO ; ; HERE ON "PIC" OR "PICTURE" ; PCTURE: JUMPN CHR,CPOPJ ;ERROR IF EOL PUSHJ P,COBSIX ;GET PICTURE POPJ P, ;EOF - ERROR MOVE T2,[POINT 6,COBDAT(LOW) ] ;SET POINTER IN P2 MOVEI T3,0 ;SET ITEM SIZE TO 0 PCTUR1: ILDB T1,T2 ;GET A CHARACTER JUMPE T1,PCTUR2 ;DONE ; ; TABLE OF COBOL PICTURE CHARACTERS AND THEIR VALUES ; -------------------------------------------------- ; ; CHARACTER TYPE POSITION ; --------- ---- -------- ; ; 9 NUM YES ; A ALPH YES ; X ALPH YES ; V NUM NO ; P NUM NO ; S NUM NO ; Z NUM YES ; * NUM YES ; $ NUM YES ; , NUM YES ; . NUM YES ; B BOTH YES ; O BOTH YES ; + NUM YES ; - NUM YES ; CR NUM YES(2) ; DB NUM YES(2) ; CAIE T1,"V"-" " ;V CAIN T1,"P"-" " ;P JRST PCTUR1 ;IGNORE CAIN T1,"S"-" " ;S JRST PCTURS ;PROCESS S CAIE T1,"."-" " ;PERIOD CAIN T1,","-" " ;COMMA JRST PCTURZ ;NUMERIC CAIE T1,"9"-" " ;NUMERIC CAIN T1,"Z"-" " ;Z JRST PCTURZ ;PROCESS 9 OR Z CAIE T1,"A"-" " ;A CAIN T1,"X"-" " ;X AOJA T3,PCTUR1 ;INCREASE SIZE AND CONTINUE CAIE T1,"*"-" " ;ASTERISK CAIN T1,"$"-" " ;DOLLAR SIGN JRST PCTURZ ;NUMERIC CAIE T1,"B"-" " ;B CAIN T1,"O"-" " ;O JRST PCTURZ CAIE T1,"-"-" " ;MINUS CAIN T1,"+"-" " ;PLUS JRST PCTURZ CAIN T1,"C"-" " ;CR JRST PCTURC CAIN T1,"D"-" " ;DB JRST PCTURD CAIE T1,"("-" " ;( POPJ P, ;INVALID PICTURE ; ; COMPUTE SIZE ; CAIE T3,1 ;ONLY 1 TO NOW POPJ P, ;ERROR MOVEI T3,0 ;CLEAR SIZE PCTUR3: ILDB T1,T2 ;GET NUMERIC CAIL T1,"0"-" " CAILE T1,"9"-" " JRST PCTUR4 ;NON-NUMERIC IMULI T3,^D10 ADDI T3,-<"0"-" ">(T1) JRST PCTUR3 PCTUR4: CAIN T1,")"-" " ;RIGHT PARENTHESIS? PCTUR2: JUMPN T3,PCTUR5 ;NON-ZERO PICTURE SIZE? POPJ P, ;ERROR RETURN PCTUR5: HRRM T3,ITMPCT(ITM) ;STORE PICTURE SIZE JRST PKLOOP ;DONE ; ; HERE ON S ; PCTURS: MOVSI T1,FD.SGN ;SET SIGNED IORM T1,ITMPCT(ITM) ;OR IN JRST PCTUR1 ; ; HERE ON Z OR 9 ; PCTURZ: MOVSI T1,FD.NUM ;SET NUMERIC IORM T1,ITMPCT(ITM) ;OR IN AOJA T3,PCTUR1 ;INCREASE SIZE ; ; C OF CR ; PCTURC: ILDB T1,T2 ;GET R CAIE T1,"R"-" " ;R? POPJ P, ;NO JRST PCTURF ;INC SIZE ; ; D OF DB ; PCTURD: ILDB T1,T2 CAIE T1,"B"-" " POPJ P, PCTURF: ADDI T3,2 JRST PCTUR2 ; ; TEST FOR COMP-3 OR COMPUTATIONAL-3 ; PCKT07: CAMN T1,[SIXBIT /COMP-3/] ;"COMP-3"? JUMPE T2,COMP3 ;COMP-3 IF SECOND WORD BLANK PCKT08: CAMN T1,[SIXBIT /COMPUTA/] ;"COMPUT"? CAME T2,[SIXBIT /ATIONA/] ;"ATIONA"? JRST PCKT09 ;NO MOVE T3,COBDAT+2(LOW) ;GET THIRD DATA WORD CAME T3,[SIXBIT /L-3/] ;"L-3"? JRST PCKT09 ;NO ; ; HERE ON "COMP-3" OR "COMPUTATIONAL-3" ; COMP3: MOVSI T1,FD.CMP ;SET COMP-3 IORM T1,ITMPCT(ITM) ;STORE JRST PKLOOP ; ; TEST FOR "OCCURS" ; PCKT09: CAMN T1,[SIXBIT /OCCURS/] ;"OCCURS"? JUMPE T2,OCCURS ;"OCCURS" IF BLANK PCKT10: CAMN T1,[SIXBIT /REDEFI/] ;"REDEFI"? CAME T2,[SIXBIT /NES/] ;"NES"? JRST PKLOOP ;UNDEFINED KEYWORD ; ; HERE ON REDEFINES ; REDEFI: JUMPN CHR,CPOPJ ;ERROR IF EOL PUSHJ P,COBSIX ;GET DATA POPJ P, ;ERROR PUSHJ P,FNDNAM ;FIND NAME JRST RDFERR ;REDEFINE ERROR MOVE T1,NAMITM(NAM) ;GET ITEM BLOCK HRRM T1,ITMRDF(ITM) ;STORE JRST PKLOOP RDFERR: TTCALL 3,[ASCIZ /?REDEFINES NON EXISTENT NAME /] POPJ P, ; ; HERE ON OCCURS ; OCCURS: JUMPN CHR,CPOPJ ;ERROR IF EOL PUSHJ P,COBSIX ;GET NUMBER POPJ P, ;ERROR PUSHJ P,MAKNUM ;MAKE NUMERIC POPJ P, ;ERROR HRLM T1,ITMRDF(ITM) ;STORE OCCURS JRST PKLOOP ; ; PCKT06 - STORE LEVEL 66 ; PCKT06: PUSHJ P,COBSIX ;GET NEXT POPJ P, ;ERROR MOVE T1,COBDAT(LOW) ;GET FIRST DATA WORD MOVE T2,COBDAT+1(LOW) ;GET SECOND DATA WORD CAMN T1,[SIXBIT /REDEFI/] ;"REDEFI" CAME T2,[SIXBIT /NES/] ;"NES"? POPJ P, ;ERROR JUMPN CHR,CPOPJ ;ALSO NOT EOL PUSHJ P,COBSIX ;GET FIRST ITEM POPJ P, ;ERROR JUMPN CHR,PCKT01 ;EOL PUSHJ P,FNDNAM JRST RDFERR ;REDEFINES ERROR MOVE T1,NAMITM(NAM) ;GET ITEM BLOCK HRLM T1,ITMRDF(ITM) ;STORE 1ST REDEFINES PUSHJ P,COBSIX ;GET THRU POPJ P, ;ERROR MOVE T1,COBDAT(LOW) ;GET DATA CAME T1,[SIXBIT /THRU/] ;"THRU"? POPJ P, ;ERROR JUMPN CHR,CPOPJ ;NOT EOL PUSHJ P,COBSIX ;GET SECOND POPJ P, ;ERROR PUSHJ P,FNDNAM JRST RDFERR MOVE T1,NAMITM(NAM) ;GET ITEM BLOCK HRRM T1,ITMRDF(ITM) ;STORE ITM BLOCK JUMPE CHR,CPOPJ ;MUST BE EOL JRST PCKT01 ;DONE ; ; ALCITM - ALLOCATE AN ITM TABLE ; ALCNAM - ALLOCATE A NAME TABLE ; CALL: PUSHJ P,ALCXXX ; (RETURN) WITH TABLE BASE IN T2 ; ALCITM: SKIPA T3,[ITMLEN] ;GET ITEM BLOCK SIZE ALCNAM: MOVEI T3,NAMLEN ;GET NAME BLOCK SIZE MOVE T2,.JBFF ;GET TABLE ADDRESS ADDB T3,.JBFF ;GET NEW CORE SIZE CAMG T3,.JBREL ;DO A CORE UUO? POPJ P, ;NO CORE T3, ;YES JRST [TTCALL 3,[ASCIZ /?CORE FAILURE /] JRST RESTRT] POPJ P, ;HAVE CORE ; ; MAKNUM - CONVERTS COBDAT INTO A NUMERIC ARGUMENT ; CALL: PUSHJ P,MAKNUM ; (ERROR RETURN - NON NUMERIC CHARACTER - CHARACTER IN CHR) ; (RETURN - NUMBER IN T1) ; MAKNUM: MOVEI T1,0 ;CLEAR NUMBER MOVE T2,[POINT 6,COBDAT(LOW) ] MAKNU1: ILDB T3,T2 ;GET ENTRY JUMPE T3,CPOPJ1 ;DONE - RETURN CAIL T3,"0"-" " CAILE T3,"9"-" " POPJ P, ;NON-NUMERIC IMULI T1,^D10 ;MOVE CURRENT ADDI T1,-<"0"-" ">(T3) JRST MAKNU1 ; ; FNDNAM - SEARCH NAME TABLE FOR A NAME ; CALL: PUSHJ P,FNDNAM ; (NO MATCH - LAST FP.NMB POINTED TO BY T2) ; (MATCH - MATCHED FP.NMB POINTED TO BY T2) ; FNDNAM: MOVEI NAM,FP.NMB(F) ;GET ADR FNDN04: HRRZ T3,0(NAM) ;WHERE DOES IT POINT JUMPE T3,CPOPJ ;ERROR RETURN MOVE NAM,T3 ;SET UP "CURRENT" NAME BLOCK ZZ==0 REPEAT COBSIZ,< MOVE T2,COBDAT+ZZ(LOW) ;GET DATA CAME T2,NAMNAM+ZZ(NAM) ;COMPARE WITH ENTRY JRST FNDN04 ;NO MATCH ZZ==ZZ+1 > PJRST CPOPJ1 ;HAVE A MATCH ; ; NXTLNE - ADVANCES FILE TO NEXT LINE ; CALL: PUSHJ P,NXTLNE ; (EOF RETURN) ; (RETURN) ; NXTLNE: JUMPN CHR,CPOPJ1 ;ALEARDY AT EOL? PUSHJ P,COBSIX ;NO - GET NEXT ITEM POPJ P, ;EOF - DONE JRST NXTLNE ;TEST AGAIN ; ; PCKERR - ROUTINE CALLED FROM MAIN PROGRAM ON PACKED ERROR ; CALL: PUSHJ P,PCKERR ; (RETURN - IF DESIRED) ; PCKERR: TTCALL 3,[ASCIZ /?PACKED Specification ERROR /] POPJ P, ;CONTINUE PROCESSING ; ; FDDUMP - DUMPS THS FD STORED IN CORE ; CALL: PUSHJ P,FDDUMP ; (RETURN) ; FDDUMP: SKIPA ITM,FP.ITM(F) ;LOCATE FIRST 01 LEVEL FDDUM1: HRRZ ITM,ITMLNK(ITM) ;GET NEXT JUMPE ITM,CPOPJ ;DONE - RETURN PUSHJ P,ITMDMP ;DUMP ITEM JRST FDDUM1 ; ; ITMDMP - DUMPS AN ITEM BLOCK ; CALL: MOVEI ITM,ITMBLK ; PUSHJ P,ITMDMP ; (RETURN) ; ; FLAGS ; FD.CMP==400000 ;COMP-3 ITEM FD.SGN==200000 ;SIGNED ITEM FD.NUM==100000 ;NUMERIC ITEM ; ITMDMP: HLRZ T2,ITMLVL(ITM) ;GET LEVEL # CAIN T2,^D66 ;LEVEL 66? JRST ITMDM7 ;YES MOVE T3,T2 ;COPY LEVEL ITMDM2: TTCALL 3,[ASCIZ / /] ;1 SPACE PER LEVEL SOJG T3,ITMDM2 ;1 SPACE PER LEVEL ITMDM1: IDIVI T2,^D10 ;TYPE TWO DIGITS ADDI T2,"0" ;TYPE 1ST DIGIT TTCALL 1,T2 ;TYPE 1ST DIGIT ADDI T3,"0" ;TYPE 2ND DIGIT TTCALL 1,T3 ;TYPE 2ND DIGIT TTCALL 3,[ASCIZ / /] ;TYPE A SPACE HRRZ NAM,ITMNAM(ITM) ;WHERE IS NAME BLOCK PUSHJ P,NAMPRT ;TYPE LEVEL NAME HRRZ T2,ITMRDF(ITM) ;TEST FOR REDEFINES JUMPE T2,ITMDM3 ;DOES NOT REDEFINE TTCALL 3,[ASCIZ / REDEFINES /] HRRZ NAM,ITMNAM(T2) ;GET NAME BLOCK PUSHJ P,NAMPRT ;TYPE NAME BLOCK ITMDM3: SKIPN T2,ITMPCT(ITM) ;PICTURE? JRST ITMDM4 ;NO TTCALL 3,[ASCIZ / PICTURE /] TLNE T2,FD.SGN ;SIGNED? TTCALL 3,[ASCIZ /S/] TLNE T2,FD.NUM ;NUMERIC SKIPA T3,["9"] ;YES MOVE T3,["X"] ;NO TTCALL 1,T3 ;TYPE 9 OR X HRRZ T2,T2 ;GET COUNT CAIN T2,1 ;NO () JRST ITMDM6 ;NO () TTCALL 1,["("] ;TYPE PAREN PUSHJ P,DECPRT ;TYPE DECIMAL TTCALL 1,[")"] ;FINISH ITMDM6: SKIPG ITMPCT(ITM) ;COMP-3? TTCALL 3,[ASCIZ / COMP-3/] ITMDM4: HLRZ T2,ITMOCR(ITM) ;OCCURS? JUMPE T2,ITMDM5 ;NO TTCALL 3,[ASCIZ / OCCURS /] PUSHJ P,DECPRT ;TYPE DECIMAL TTCALL 3,[ASCIZ / TIMES/] ITMDM5: TTCALL 3,[ASCIZ /. /] POPJ P, ;RETURN ITMDM7: TTCALL 3,[ASCIZ / 66 /] HRRZ NAM,NAMITM(ITM) ;GET NAME PUSHJ P,NAMPRT ;TYPE NAME TTCALL 3,[ASCIZ / REDEFINES /] HLRZ T2,ITMRDF(ITM) ;GET 1ST REDEFINES HRRZ NAM,ITMNAM(T2) ;GET NAME BLOCK PUSHJ P,NAMPRT ;PRINT NAME TTCALL 3,[ASCIZ / THRU /] HRRZ T2,ITMRDF(ITM) ;GET 2ND REDEFINES HRRZ NAM,ITMNAM(T2) ;GET NAME BLOCK PUSHJ P,NAMPRT ;PRINT NAME JRST ITMDM5 ;RETURN ; ; NAMPRT - TYPE NAMBLK ; CALL: MOVEI NAM,NAMBLK ; PUSHJ P,NAMPRT ; (RETURN) ; NAMPRT: MOVE T3,[POINT 6,NAMNAM(NAM) ] ;SET T3 NAMPR1: ILDB T4,T3 ;GET A BYTE JUMPE T4,CPOPJ ;RETURN IF NULL (NO SPACES) ADDI T4," " ;GO TO ASCII TTCALL 1,T4 ;TYPE JRST NAMPR1 ;RETURN ; ; DECPRT - TYPE A DECIMAL NUMBER ; CALL: MOVE T2,# ; PUSHJ P,DECPRT ; (RETURN) ; DECPRT: IDIVI T2,^D10 JUMPE T2,DECPR1 HRLM T3,0(P) PUSHJ P,DECPRT HLRZ T3,0(P) DECPR1: ADDI T3,"0" TTCALL 1,T3 POPJ P, PAGE SUBTTL RETURN COBOL ITEM IN "STANDARD" FORMAT ; ; COBSIX - RETURNS A COBOL LINE IN "STANDARDIZED FORM" ; AS SIXBIT ITEMS ; ; STANDARDIZED FORM IS AS FOLLOWS ; ; INPUT IS TRUNCATED AFTER 72 OR 106 CHARACTERS ; SEQUENCE NUMBERS ARE REMOVED ; COMMENT LINES (* IN COLUMN 1) ARE REMOVED ; LINE CAN BE ANY LENGTH ; LINE TERMINATED BY A PERIOD FOLLOWED BY A NON-NUMERIC CHARACTER ; CONTINUATIONS ARE EXPANDED ; LITERALS ARE TRUNCATED TO DOUBLE DOUBLE QUOTES OR DOUBLE SINGLE QUOTES ; ; ON FIRST CALL NXTCNT SHOULD BE ZERO ; ; CALL: PUSHJ P,COBSIX ; (EOF RETURN) ; (DATA RETURN - DATA IN COBDAT IN SIXBIT) ; ; ON RETURN CHR IS ZERO EXCEPT AT EOL ; ; COBSIX: MOVEI T1,6*COBSIZ ;SET SIZE MOVE T2,[POINT 6,COBDAT(LOW) ] ;SET POINTER MOVE T3,[XWD COBDAT,COBDAT+1] ;NB: ABOVE MUST BE CHANGED IF COBDAT OFFSET SETZM COBDAT(LOW) ;CLEAR COBDAT BLT T3,COBDAT+COBSIZ-1(LOW) PJRST 0(Q1) ;DISPATCH COBS01: TRO FLG,FR.BLK ;BLANK ON TRZ FLG,FR.DQT!FR.SQT ;LITERALS OFF COBS02: TRZ FLG,FR.AST!FR.CNT!FR.PER!FR.CMA ;TURN OFF COMMENT AND SUPPRESS COBS03: SOSG FP.CNT(F) ;CHARACTER IN BUFFER? JRST COBS10 ;NO - DO AN INPUT COBS04: ILDB CHR,FP.PNT(F) ;LOAD CHARACTER MOVE T4,NXTCNT(LOW) ;GET COUNT XCT CONTAB(CHR) ;PROCESS CHARACTER ADDI T4,1 ;COMPUTE NEXT COBS05: EXCH T4,NXTCNT(LOW) ;STORE NEXT TLNE F,FF.SEQ ;SEQUENCED JRST COBS06 ;TEST SEQUENCED CAIE CHR,CH.EOL ;ALWAYS RETURN BREAK CAIG T4,WD.CON ;RETURNABLE CHARACTER JRST COBS12 ;YES JRST COBS03 ;NO COBS06: SUBI T4,6 ;OFFSET JUMPL T4,COBS07 ;PAST SEQUENCE FIELD CAIE CHR,CH.EOL ;ALWAYS RETURN BREAK CAIG T4,WD.SEQ ;RETURNABLE JRST COBS12 ;RETURN CHARACTER JRST COBS03 ;NO COBS07: CAIN CHR,11 ;TAB IN SEQUENCE FIELD JRST COBS11 ;YES - SET PAST SEQUENCE CAIN CHR,CH.EOL ;BREAK IN SEQUENCE FIELD? TTCALL 3,[ASCIZ /%WARNING - SHORT LINE IN SEQUENCED FILE /] JRST COBS03 ;IGNORE CHARACTER GET ANOTHER ; ; COBS08 - COMPUTE TAB STOP ; COBS08: ANDCMI T4,7 ;CLEAR JUNK ADDI T4,10 ;OFFSET JRST COBS05 ;RETURN ; ; COBS09 - HANDLE EOL ; COBS09: MOVEI CHR,CH.EOL ;SET EOL MOVEI T4,0 ;SET NEXT IS 0 JRST COBS05 ; ; COBS10 - INPUT A BUFFER ; COBS10: IN CH.PCK, ;INPUT A BUFFER JRST COBS04 ;HAVE BUFFER STATO CH.PCK,740000 ;EOF? POPJ P, ;YES - EOF RETURN HALT COBS10 ;HARDWARE PROBLEMS ; ; HERE WITH CHARACTER ; COBS11: MOVEI T4,0 ;CLEAR CURRENT COBS12: TRZE FLG,FR.PER ;PERIOD SEEN JRST COBS28 ;YES TRZE FLG,FR.CMA ;COMMA SEEM JRST COBS32 ;YES COBS13: CAIE CHR,CH.EOL ;BREAK? TRNE FLG,FR.AST ;IN COMMENT LINE JRST COBS03 ;REMOVE COMMENT TRNE FLG,FR.CNT ;SUPPRESSING CONTINUATION? JRST COBS16 ;YES JUMPN T4,COBS17 ;FIRST CHARACTER? ; ; PROCESS FIRST CHARACTER ; COBS14: CAIE CHR,"*" ;COMMENT LINE? JRST COBS15 ;NO ; ; COMMENT LINE ; TRO FLG,FR.AST ;SET COMMENT LINE JRST COBS03 ;SKIP COMMENT LINE ; ; TEST CONTINUATION LINE ; COBS15: CAIE CHR,"-" ;CONTINUATION LINE? JRST COBS17 ;NO ; ; CONTINUATION LINE ; TRO FLG,FR.CNT ;SET CONTINUATION LINE JRST COBS03 ;GET NEXT ; ; SUPPRESS CONTINUATION ; COBS16: CAIE CHR,11 ;BLANK CAIN CHR," " ;BLANK JRST COBS03 ;YES - SUPPRESS TRNN FLG,FR.DQT!FR.SQT ;IN LITERAL JRST COBS19 ;NO - CONTINUE NON-LITERAL ;WITH THIS CHARACTER MOVEI T4,042 ;WHICH LITERAL TRNN FLG,FR.DQT ;DOUBLE OR SINGLE MOVEI T4,"'" ;MUST BE SINGLE CAMN CHR,T4 ;MATCHING LITERAL JRST COBS03 ;YES - SKIP AND CONTINUE TTCALL 3,[ASCIZ /?LITERAL CONTINUATION EXPECTED /] JRST RESTRT ;RESTART ; ; TEST FOR BLANK SUPPRESSION ; COBS17: CAIE CHR,11 ;TAB CAIN CHR," " ;SPACE JRST COBS18 ;YES JRST COBS19 ;NO COBS18: TRNN FLG,FR.DQT!FR.SQT ;IN LITERAL TRO FLG,FR.BLK ;NO JRST COBS03 ;SUPPRESS BLANK ; ; HERE WITH NON-BLANK CHARACTER ; COBS19: CAIN T1,6*COBSIZ ;AT BOL? JRST COBS21 ;YES - SUPPRESS LEADING TAB COBS20: TRZN FLG,FR.BLK ;HAVE WE SEEN A TAB? JRST COBS21 ;NO - DON'T OUTPUT ONE MOVEM CHR,SAVCHR ;SAVE CHARACTER MOVEI CHR,0 ;SET NON EOL RETURN JSP Q1,CPOPJ1 ;RETURN ITEM MOVE CHR,SAVCHR ;RESTORE CHARACTER COBS21: TRZ FLG,FR.BLK ;CLEAR BLANK CAIE CHR,042 ;LITERAL DOUBLE QUOTE JRST COBS22 ;NO TRNN FLG,FR.SQT ;SINGLE QUOTE ON TRC FLG,FR.DQT ;NO - COMPLEMENT JRST COBS24 ;GET ANOTHER COBS22: CAIE CHR,"'" ;SINGLE QUOTE LITERAL JRST COBS23 ;NO TRNN FLG,FR.DQT ;DOUBLE QUOTE ON TRC FLG,FR.SQT ;NO - COMPLEMENT JRST COBS24 ;OUTPUT QUOTE COBS23: TRNE FLG,FR.DQT!FR.SQT ;IN A LITERAL JRST COBS03 ;YES COBS24: CAIN CHR,"." ;PERIOD JRST COBS27 ;YES CAIN CHR,"," ;COMMA JRST COBS31 ;YES COBS25: SOJL T1,COBS26 ;ROOM IN ITEM MOVEI T3,-40(CHR) IDPB T3,T2 ;STORE ; ; PERIOD TEST ; COBS26: CAIE CHR,"," ;WAS CHARACTER A COMMA CAIN CHR,"." ;WAS CHARACTER A PERIOD JRST COBS29 ;YES JRST COBS03 ;GET NEXT ; ; INTERCEPT COMMA AND PERIOD ; COBS31: TROA FLG,FR.CMA ;SET COMMA SEEN COBS27: TRO FLG,FR.PER ;SET PERIOD SEEN JRST COBS03 ;GET NEXT ; ; HERE WHEN LAST WAS A PERIOD ; COBS28: CAIL CHR,"0" ;NUMERIC CAILE CHR,"9" ;NUMERIC JRST COBS30 ;NO MOVEM CHR,SAVCHR ;STORE MOVEI CHR,"." ;INSERT PERIOD JRST COBS25 ;INSERT COBS29: MOVE CHR,SAVCHR ;RESTORE JRST COBS13 ;CONTINUE WITH NUMERIC COBS30: MOVEM CHR,SAVCHR ;STORE CHARACTER MOVEI CHR,1 ;SET EOL JSP Q1,CPOPJ1 ;SKIP RETURN MOVE CHR,SAVCHR ;RESTORE CHARACTER JRST COBS13 ;CONTINUE WITH CHARACTER ; COBS32: CAIL CHR,"0" CAILE CHR,"9" JRST COBS13 ;IGNORE COMMA MOVEM CHR,SAVCHR MOVEI CHR,"," JRST COBS25 ; ; COBS00 - INITIALIZE FOR COBSIX ; SETS UP CONTAB AND ZEROES NXTCNT ; ; CALL: PUSHJ P,COBS00 ; (RETURN) ; COBS00: MOVEI Q1,COBS01 ;SET INITIAL ENTRY SETZM NXTCNT(LOW) ;CLEAR POSITION COUNTER MOVSI T3,(JFCL) ;NO-OP MOVEM T3,CONTAB+1 ;STORE FIRST NO-OP MOVE T4,[XWD CONTAB+1,CONTAB+2] ;SET ALL TO NO-OP BLT T4,CONTAB+174 ;175,176,177 SPECIAL MOVE T3,[JRST COBS03] ;INITIALIZE IGNORED CHARACTERS MOVEM T3,CONTAB ;IGNORE NULLS MOVEM T3,CONTAB+15 ;IGNORE CR MOVEM T3,CONTAB+177 ;IGNORE RUBOUT HRRI T3,COBS08 ;INITIALIZE TAB MOVEM T3,CONTAB+11 ;INITIALIZE TAB HRRI T3,COBS09 ;INITIALIZE BREAKS MOVEM T3,CONTAB+7 ;CONTROL G IS A BREAK MOVEM T3,CONTAB+12 ;LINEFEED IS A BREAK MOVEM T3,CONTAB+13 ;CONTROL K IS A BREAK MOVEM T3,CONTAB+14 ;FORMFEED IS A BREAK MOVEM T3,CONTAB+175 ;ALTMODE IS BREAK MOVEM T3,CONTAB+176 ;ALTMODE IS BREAK MOVSI T3,(POPJ P,) ;SET UP EOF MOVEM T3,CONTAB+3 ;CONTROL C IS EOF MOVEM T3,CONTAB+32 ;CONTROL Z IS EOF MOVE T3,[SUBI CHR,40] ;SET UP LOWER CASE MOVEM T3,CONTAB+140 ;SET UP LC A MOVE T4,[XWD CONTAB+140,CONTAB+141] BLT T4,CONTAB+"Z"+" " ;SET UP LOWER CASE POPJ P, ;DONE SUBTTL CODE TRANSLATION TABLES PAGE ; ; DISPATCH ROUTINES FOR VARIOUS CODES ; DEFINE CODDSP< CODTAB(PAD) ;PAD CHARACTER CODTAB(FLG) ;CODE FLAGS CODTAB(SIZ) ;# OF LEGAL CHARACTERS CODTAB(PNT) ;BYTE POINTER CODTAB(BYT) ;BYTES PER WORD CODTAB(IIB) ;ROUTINE TO INITIALIZE INPUT BLOCK CODTAB(IIR) ;ROUTINE TO INITIALIZE INPUT RECORD CODTAB(OIB) ;ROUTINE TO INITIALIZE OUTPUT BLOCK CODTAB(OIR) ;ROUTINE TO INITIALIZE INPUT RECORD CODTAB(IFB) ;ROUTINE TO FINISH INPUT BLOCK CODTAB(IFR) ;ROUTINE TO FINISH INPUT RECORD CODTAB(OFB) ;ROUTINE TO FINISH OUTPUT BLOCK CODTAB(OFR) ;ROUTINE TO FINISH OUTPUT RECORD > ; ; TABLE OF WHERE TO FIND TABLES ; FNDTAB: %ASCII ;DEFAULT CODE %ASCII ;FOR ASCII %SIXBI ;FOR SIXBIT %FEBCD ;FOR FIXED EBCDIC %VEBCD ;FOR VARIABLE EBCDIC ; ; DEFINE DISPATCH VIA MACRO ; DEFINE SPCDSP(A)< IF1, IF2, < IFE A, IFN A, >> ; ; ASCII ; %ASCII: 40 ;PAD CHARACTER FF.EOL!FF.ZER!FF.TAB ;FLAG XWD -^D128,0 ;LENGTH 0700 ;BYTE POINTER 5 ;BYTES PER WORD SPCDSP(0) ;INITIALIZE INPUT BLOCK SPCDSP(0) ;INITIALIZE INPUT RECORD SPCDSP(0) ;INITIALIZE OUTPUT BLOCK SPCDSP(0) ;INITIALIZE OUTPUT RECORD SPCDSP(0) ;FINISH INPUT BLOCK SPCDSP(AIFREC) ;FINISH INPUT RECORD SPCDSP(0) ;FINISH OUTPUT BLOCK SPCDSP(AOFREC) ;FINISH OUTPUT RECORD ; ; SIXBIT ; %SIXBI: 0 ;PAD CHARACTER FF.SYN!FF.RCC ;FLAG XWD -^D64,0 ;LENGTH 0600 ;BYTE POINTER 6 ;BYTES PER WORD SPCDSP(0) ;INITIALIZE INPUT BLOCK SPCDSP(SIIREC) ;INITIALIZE INPUT RECORD SPCDSP(0) ;INITIALIZE OUTPUT BLOCK SPCDSP(SOIREC) ;INITIALIZE OUTPUT RECORD SPCDSP(0) ;FINISH INPUT BLOCK SPCDSP(SIFREC) ;FINISH INPUT RECORD SPCDSP(0) ;FINISH OUTPUT BLOCK SPCDSP(SOFREC) ;FINISH OUTPUT RECORD ; ; FIXED EBCDIC ; HEX(C0) %FEBCD: XXX ;PAD CHARACTER FF.TAB ;FLAGS XWD -^D256,0 ;LENGTH 1000 ;BYTE POINTER 4 ;BYTES PER WORD SPCDSP(0) ;INITIALIZE INPUT BLOCK SPCDSP(0) ;INITIALIZE OUTPUT BLOCK SPCDSP(0) ;INITIALIZE INPUT RECORD SPCDSP(0) ;INITIALIZE OUTPUT RECORD SPCDSP(0) ;FINISH INPUT BLOCK SPCDSP(0) ;FINISH INPUT RECORD SPCDSP(0) ;FINISH OUTPUT BLOCK SPCDSP(0) ;FINISH OUTPUT RECORD ; ; VARIABLE EBCDIC ; HEX(C0) %VEBCD: XXX ;PAD CHARACTER FF.BLC!FF.RCC!FF.ZER!FF.TAB ;FLAGS XWD -^D256,0 ;LENGTH 1000 ;BYTE POINTER 4 ;BYTES PER WORD SPCDSP(VIIBLK) ;INITIALIZE INPUT BLOCK SPCDSP(VIIREC) ;INITIALIZE INPUT RECORD SPCDSP(VOIBLK) ;INITIALIZE OUTPUT BLOCK SPCDSP(VOIREC) ;INITIALIZE OUTPUT RECORD SPCDSP(0) ;FINISH INPUT BLOCK SPCDSP(0) ;FINISH INPUT RECORD SPCDSP(0) ;FINISH OUTPUT BLOCK SPCDSP(0) ;FINISH OUTPUT RECORD ; ; DEFAULT ROUTINES FOR BUFFER AND RECORD COUNT INITIALIZATION ; AND TERMINATION ; ; .IIBLK - INITIALIZE A BLOCK ; CALL: JSP ADR,.IIBLK ; (RETURN) ; .IIBLK: MOVE T1,F.BLSZ(IN) ;GET RECORDS PER BLOCK MOVEM T1,F.RECC(IN) ;STORE IN COUNTER HLRZ T1,F.CBUF(IN) ;GET BUFFERS PER BLOCK MOVEM T1,F.BUFC(IN) ;STORE IN COUNTER XCT FC.IIB(IN) ;SPECIAL ROUTINE? ; ; .OIBLK - INITIALIZE AN OUTPUT BLOCK ; CALL: JSP ADR,.OIBLK ; (RETURN) ; .OIBLK: MOVE T1,F.BLSZ(AUT) ;GET BLOCK SIZE MOVEM T1,F.RECC(AUT) ;STORE IN COUNTER HLRZ T1,F.CBUF(AUT) ;GET BUFFERS PER BLOCK MOVEM T1,F.BUFC(AUT) ;STORE IN COUNTER XCT FC.OIB(AUT) ;SPECIAL ROUTINE? ; ; .IIREC - INITIALIZE INPUT RECORD ; CALL: JSP ADR,.IIREC ; (BLOCK EXPIRED) ; (RETURN) ; .IIREC: SKIPE F.BLSZ(IN) ;BLOCK 0 SOSL F.RECC(IN) ;NO - RECORD IN THIS BLOCK AOSA ADR ;SKIP RETURN JRST 0(ADR) ;BLOCK EXPIRED XCT FC.IIR(IN) ;SPECIAL INITIALIZATION ; ; .OIREC - INITIALIZE AN OUTPUT RECORD ; CALL: JSP ADR,.OIREC ; (BLOCK EXPIRED) ; (RETURN) ; .OIREC: SKIPE F.BLSZ(AUT) ;BLOCK 0 SOSL F.RECC(AUT) ;NO - RECORD IN THIS BLOCK AOSA ADR ;SKIP RETURN JRST 0(ADR) ;BLOCK EXPIRED XCT FC.OIR(AUT) ;SPECIAL INITIALIZATION ; ; .IFBLK - FINISH AN INPUT BLOCK ; CALL: JSP ADR,.IFBLK ; (RETURN) ; .IFBLK: TLNE IN,FF.SPN ;SPANNING JRST .IFBL2 ;YES - JUST RETURN .IFBL1: JSP Q1,IN.BUF ;GRAB A BUFFER SKIPLE F.BUFC(IN) ;COUNT EXPIRED JRST .IFBL1 ;NO AOS F.CNT(IN) ;YES - FIX BYTE COUNT .IFBL2: XCT FC.IFB(AUT) ;SPECIAL INITIALIZATION ; ; .OFBLK - FINISH AN OUTPUT BLOCK ; CALL: JSP ADR,.OFBLK ; (RETURN) ; .OFBLK: TLNE AUT,FF.SPN ;SPANNING? JRST .OFBL2 ;YES - JUST RETURN .OFBL1: JSP Q1,OU.BUF ;OUTPUT A BUFFER SKIPLE F.BUFC(AUT) ;ANY LEFT JRST .OFBL1 ;YES AOS F.CNT(AUT) ;FIX BYTE COUNT .OFBL2: XCT FC.OFB(AUT) ;SPECIAL INITIALIZATION ; ; AOFREC - FINISH ASCII OUTPUT RECORD ; CALL: JSP ADR,AOFREC OUTPUT CR/LF ; (RETURN) ; AOFREC: MOVEI CHR,15 ;FINISH RECORD WITH CRLF SOSG F.CNT(AUT) ;ROOM IN BUFFER JSP Q1,OU.BUF ;GET BUFFER IDPB CHR,F.PNT(AUT) ;OUTPUT CHARACTER MOVEI CHR,12 ;INSERT LF SOSG F.CNT(AUT) ;ROOM IN BUFFER JSP Q1,OU.BUF ;OUTPUT BUFFER IDPB CHR,F.PNT(AUT) ;OUTPUT LF JRST 0(ADR) ;RETURN ; ; AIFREC - FINISH ASCII INPUT RECORD ; SPACES TO CR ; GRABS NEXT CHARACTER ; AIFREC: LDB CHR,F.PNT(IN) ;GET CHARACTER AIFRE1: CAIN CHR,15 ;CR JRST AIFRE2 SOSG F.CNT(IN) JSP Q1,IN.BUF ILDB CHR,F.PNT(IN) JRST AIFRE1 AIFRE2: SOSG F.CNT(IN) JSP Q1,IN.BUF IBP F.PNT(IN) JRST 0(ADR) ; ; SIIREC - INITIALIZE SIXBIT INPUT RECORD ; CALL: JSP ADR,SIIREC STORE RECORD COUNT ; (RETURN) ; SIIREC: INBYTE ;IGNORE 4 BYTES INBYTE INBYTE INBYTE INBYTE ;GET FIRST 6 DIGITS MOVE T1,CHR INBYTE ;GET LAST SIX DIGITS LSH T1,6 ADD T1,CHR JUMPE T1,SIIREC ;IGNORE EMPTY CONTROL WORDS MOVEM T1,F.CREC(IN) ;STORE JRST 0(ADR) ;RETURN ; ; SOIREC - INITIALIZE SIXBIT OUTPUT RECORD ; CALL: JSP ADR,SOIREC SYNCHRONIZE WORDS ; (RETURN) ; SOIREC: MOVEI CHR,0 ;OUTPUT COUNT OUTBYT ;4 NULL BYTES OUTBYT OUTBYT OUTBYT MOVE CHR,P2 ROT CHR,-6 OUTBYT ROT CHR,6 OUTBYT JRST 0(ADR) ;RETURN ; ; SIFREC - FINISH SIXBIT INPUT RECORD ; CALL: JSP ADR,SIFREC SYNCHRONIZE ; (RETURN) ; SIFREC: MOVE T1,F.PNT(IN) ;GET BYTE COUNTER TLNN T1,770000 ;EMPTY JRST 0(ADR) ;YES INBYTE ;GET A BYTE JRST SIFREC ;GO FOR EOW ; ; SOFREC - FINISH SIXBIT OUTPUT RECORD ; CALL: JSP ADR,SOFREC SYNCHRONIZE ; (RETURN) ; SOFREC: MOVE CHR,FC.PAD(AUT) ;GET PAD CHARACTER SOFRE1: MOVE T1,F.PNT(AUT) ;TEST POINTER TLNN T1,770000 ;EOW JRST 0(ADR) ;YES OUTBYT ;NO - OUTPUT A BYTE JRST SOFRE1 ;CONTINUE UNTIL EOW ; ; VIIBLK - INITIALIZE VARIABLE INPUT RECORD ; CALL: JSP ADR,VIIBLK STORE BLOCK COUNT ; (RETURN) ; VIIBLK: INBYTE ;GET A BYTE MOVE T1,CHR ;STORE BYTE INBYTE ;GET ANOTHER LSH T1,^D8 ;SHIFT FIRST BYTE ADD T1,CHR ;COMPUTE BLOCK SIZE INBYTE ;GET ANOTHER INBYTE ;GET ANOTHER JUMPE T1,VIIBLK ;IGNORE ZERO BLOCK WORDS SUBI T1,4 ;COMPUTE BLOCK SIZE MOVNM T1,F.EBC(IN) ;STORE IN EBC COUNTER MOVEM T1,F.CBLK(IN) ;STORE BLOCK SIZE JRST 0(ADR) ;RETURN ; ; VIIREC - INITIALIZE VARAIBLE INPUT RECORD ; CALL: JSP ADR,VIIREC STORE RECORD COUNT ; (RETURN) ; VIIREC: SKIPL F.EBC(IN) ;BLOCK EXPIRED JRST -1(ADR) ;GIVE EXPIRED RETURN INBYTE ;GET A BYTE MOVE T1,CHR ;STORE BYTE INBYTE ;GET ANOTHER LSH T1,^D8 ;SHIFT FIRST BYTE ADD T1,CHR ;COMPUTE RECORD SIZE INBYTE ;GET ANOTHER INBYTE ;GET ANOTHER ADDM T1,F.EBC(IN) ;COUNT RECORD SUBI T1,4 ;REDUCE BY RECORD COUNT MOVEM T1,F.CREC(IN) ;STORE RECORD SIZE JRST 0(ADR) ;RETURN ; ; VOIBLK - INITIALIZE OUTPUT BLOCK ; VOIREC - INITIALIZE OUTPUT RECORD ; CALL: JSP ADR,VOI??? INITIALIZE OUTPUT BLOCK OR COUNT ; (RETURN) ; VOIBLK: MOVE CHR,F.EBC(AUT) ;GET BLOCK SIZE TLNE FLG,FL.RWR ;REWRITING ADD CHR,FC.BYT(AUT) JRST VOIR01 ;STORE COUNT VOIREC: MOVE CHR,P2 ;GET BLOCK OR RECORD SIZE TLNE FLG,FL.RWR ;REWRITING ADD CHR,FC.BYT(AUT) ;INCREASE BY COUNT SIZE ADDM CHR,F.EBC(AUT) ;ADD TO SCORE VOIR01: ROT CHR,-^D8 ;GET FIRST BYTE OUTBYT ;OUTPUT BYTE ROT CHR,^D8 ;GET LAST BYTE OUTBYT ;STORE LAST BYTE MOVE CHR,FC.PAD(AUT) ;GET PAD OUTBYT ;PAD TWO BYTES OUTBYT ;PAD TWO BYTES JRST 0(ADR) ;RETURN PAGE SUBTTL INITIALIZE FILES ; ; INITFL - INITIALIZES FILE ; CALL: MOVEI F,FILTAB ADDRESS OF FILETABLE ; PUSHJ P,INITFL INITIALIZE ; (RETURN) ; INITFL: MOVEI T1,0 ;SET MODE 0 HRRZ T2,F.CODE(F) ;GET CODE CAIN T2,%ASCII ;ASCII CODE? JRST INITF1 ;YES - USE MODE 0 MOVEI T1,14 ;SET BINARY TLNN F,FF.OUT ;OUTPUT FILE? JRST INITF1 ;NO - USE MODE 14 TLNE FLG,FL.SPC ;SPECIAL SIXBIT/EBCDIC MOVEI T1,17 ;YES INITF1: MOVEM T1,F.MOD(F) ;STORE MODE MOVEI T1,F.ADR(F) ;ASSUME INPUT TLNE F,FF.OUT ;OUTPUT FILE MOVSI T1,F.ADR(F) ;MAKE OUTPUT MOVEM T1,F.BUF(F) ;STORE BUFFER WORD TLNE F,FF.OUT ;OUTPUT FILE SKIPA T2,[OPEN CH.OUT,F.MOD(F)] MOVE T2,[OPEN CH.IN,F.MOD(F)] XCT T2 JRST [TTCALL 3,[ASCIZ /?CAN'T OPEN DEVICE /] JRST RESTRT] TLNE F,FF.OUT ;OUTPUT FILE SKIPA T2,[ENTER CH.OUT,F.NAM(F)] MOVE T2,[LOOKUP CH.IN,F.NAM(F)] XCT T2 JRST [TTCALL 3,[ASCIZ /?CAN'T LOOKUP OR ENTER FILE /] JRST RESTRT] PUSHJ P,CMPBUF ;COMPUTE BUFFERS PUSHJ P,SETBUF ;CREATE BUFFERS ; ; PERFORM TAPE OPERATIONS ; TLNN F,FF.TAP ;IS DEVICE A MAGTAPE ? POPJ P, ;NO - RETURN MOVSI T2,(MTAPE CH.IN,) ;SET FOR INPUT CHANNEL TLNE F,FF.OUT ;OUTPUT FILE MOVSI T2,(MTAPE CH.OUT,) ;SET FOR OUTPUT CHANNEL TLNN F,FF.IND ;INDUSTRY MODE JRST INITF2 ;NO HRRI T2,101 ;MAKE MTAPE 101 XCT T2 ;SET INDUSTRY COMPATIBLE INITF2: TLNN F,FF.REW ;REWIND JRST INITF3 ;NO HRRI T2,1 ;MAKE MTAPE 1 XCT T2 ;REWIND PUSHJ P,TPSYCH ;WAIT INITF3: SKIPN T1,F.PSTN(F) ;ADVANCE OR BACKSPACE ? POPJ P, ;NO - DONE INITIALIZING JUMPL T1,INITF7 ;BACKSPACE INITF5: HRRI T2,16 ;MAKE MTAPE 16 XCT T2 ;ADVANCE ONE FILE PUSHJ P,TPSYCH ;WAIT SOJG T1,INITF5 ;DO ENOUGH POPJ P, ;DONE - RETURN INITF7: HRRI T2,17 ;MAKE MTAPE 17 XCT T2 ;BACKSPACE A FILE PUSHJ P,TPSYCH ;WAIT AOJL T1,INITF7 MOVE T3,[STATZ CH.IN,4000] ;AT BOT? TLNE F,FF.OUT ;OUTPUT FILE ? MOVE T3,[STATZ CH.OUT,4000] ;AT BOT? XCT T3 ;AT BOT? POPJ P, ;YES - RETURN HRRI T2,16 ;NO - ADVANCE PAST EOF XCT T2 ;ADVANCE FILE TPSYCH: ANDCMI T2,-1 ;MAKE MTAPE 0 XCT T2 ;WAIT POPJ P, ;RETURN ; ; CMPBUF - COMPUTE BUFFER NUMBER AND SIZE ; ; ALGORITHM: ; --------- ; ; IF DEVICE IS MTA CREATE TWO LONG BUFFERS LARGE ENOUGH ; TO HOLD A LOGICAL BLOCK ; ; IF DEVICE IS NOT MTA CREATE A BUFFER RING OF N + 1 ; BUFFERS WHERE N BUFFERS WILL HOLD ; A LOGICAL BLOCK ; ; BLOCK IS SIZED IS DETERMINED ; ; A) FROM BUFFERSIZE IF PROVIDED ; B) FROM RECORDSIZE AND BLOCKSIZE IF BUFFERSIZE NOT PROVIDED ; C) FROM DEVSIZ UUO IF NEITHER RECORD NOR BUFFER SIZE PROVIDED ; CMPBUF: MOVE T1,F.RCSZ(F) ;COPY RECORD SIZE MOVEM T1,F.CREC(F) ;TO COMPUTED MOVE T1,F.BLSZ(F) ;COPY BLOCKSIZE MOVEM T1,F.CBLK(F) ;TO COMPUTED SKIPN T1,F.RCSZ(F) ;RECORD SIZE PROVIDIED JRST CMPBU1 ;NO - DON'T COMPUTE F.CBUF TLNE F,FF.BLC ;BLOCK COUNT ADD T1,FC.BYT(F) ;YES - ADD BLOCK COUNT BYTES TLNN F,FF.SYN ;SYNCHRONIZE JRST CMPBU3 ;NO SUBI T1,1 ;YES IDIV T1,FC.BYT(F) CAIE T2,0 ADDI T1,1 IMUL T1,FC.BYT(F) ADD T1,FC.BYT(F) CMPBU3: TLNE F,FF.EOL ;EOL CHARACTER? ADDI T1,2 ;INCLUDE EOL CHARACTER SKIPE T2,F.BLSZ(F) ;ZERO BLOCKSIZE? IMUL T1,T2 ;NO - MULTIPLY BY BLOCKSIZE TLNE F,FF.BLC ;BLOCK COUNT ADD T1,FC.BYT(F) ;ADD BLOCK COUNT MOVEM T1,F.EBC(F) ;STORE AS EBC BLOCK SIZE SUBI T1,1 ;COMPUTE # OF WORDS IDIV T1,FC.BYT(F) ;DIVIDE BY BYTES / WORD CAIE T2,0 ;EXTRA ADDI T1,1 ;YES HRRM T1,F.CBUF(F) ;STORE RECORD SIZE IN BUFFERS HRRZ T2,F.SIZ(F) ;GET DEFAULT SIZE SUBI T1,1 IDIVI T1,-3(T2) CAIE T2,0 ADDI T1,1 TLNE F,FF.TAP MOVEI T1,1 HRLM T1,F.CBUF(F) CMPBU1: SKIPN T1,F.BFSZ(F) ;BUFFER SIZE PROVIDIED HRRZ T1,F.CBUF(F) ;BUFFER SIZE COMPUTED PJUMPE T1,CPOPJ ;NO - USE DEVSIZ DEFAULT TLNN F,FF.TAP ;MAGTAPE JRST CMPBU5 ;NO ADDI T1,3 ;ADD 3 FOR HEADER HRRM T1,F.SIZ(F) ;STORE IN F.SIZ POPJ P, ;DONE CMPBU5: SUBI T1,1 ;COMPUTE NUMBER OF BUFFERS HRRZ T2,F.SIZ(F) ;GET DEFAULT IDIVI T1,-3(T2) ;GET NUMBER OF BUFFERS CAIE T2,0 ;EXTRA ADDI T1,1 ;YES ADDI T1,1 ;ADD ONE FOR LUCK HRLM T1,F.SIZ(F) ;STORE BUFFERS IN RING POPJ P, ;RETURN ; ; SETBUF - CREATE BUFFERS ; WORKS OFF F.SIZ ; SETBUF: HRRZ T1,F.SIZ(F) ;GET BUFFER SIZE MOVE T2,T1 ;SAME IN T2 HLRZ T3,F.SIZ(F) ;GET NUMBER IN T3 IMUL T2,T3 ;COMPUTE NEEDED CORE MOVE T4,.JBFF ;STORE CURRENT .JBFF ADDB T2,.JBFF ;COMPUTE NEW CORE CAMG T2,.JBREL ;DO A CORE UUO JRST SETBU1 ;NO CORE T2, ;YES - DO A CORE UUO JRST [TTCALL 3,[ASCIZ /?CAN'T OBTAIN CORE /] JRST RESTRT] SETBU1: MOVSI T2,-2(T1) ;GET SIZE + 1 IN T1 ADDI T4,1 ;SET FIRST LOCATION HRR T2,T4 ;MOVE START TO T2 SETBU2: MOVEM T2,0(T2) ;SET TO POINT TO SELF ADDM T1,0(T2) ;SET TO POINT TO NEXT ADD T2,T1 ;INCREMENT SOJG T3,SETBU2 ;CONTINUE FOR ALL BUFFERS SUB T2,T1 ;CORRECT LAST BUFFER HRRM T4,0(T2) ;CORRECT LAST BUFFER HRLI T4,400000 ;SET BUFFER VIRGIN MOVS T3,FC.PNT(F) ;GET BYTE POINTER MOVEM T3,F.PNT(F) ;SET BYTE POINTER MOVEM T4,F.ADR(F) ;SET BUFFER VIRGIN POPJ P, ;RETURN PAGE SUBTTL GENERATE CODE TABLE ; ; CODGEN - GENERATES CODE TABLE ; CODGEN: HRRZ T1,F.CODE(IN) ;GET INPUT CODE HRRZ T2,F.CODE(AUT) ;GET OUTPUT CODE CAMN T1,T2 ;SAME CODE JRST CODGE1 ;YES CAIE T1,%FEBCD ;INPUT FIXED OR CAIN T1,%VEBCD ;VARIABLE EBCDIC JRST CODGE4 ;YES CAIE T2,%FEBCD ;OUTPUT FIXED OR CAIN T2,%VEBCD ;VARIABLE EBCDIC JRST CODGE7 ;YES ; ; ASCII TO SIXBIT OR VICA VERSA ; MOVE T1,FC.SIZ(IN) ;GET TABLE LENGTH CODGE9: HRRZ T4,T1 ;GET CHARACTER CAIN T2,%SIXBI ;SIXBIT OUTPUT JSP Q1,CODGE6 ;CONVERT TO SIXBIT CAIE T2,%SIXBI ;SIXBIT OUTPUT ADDI T4," " ;CONVERT TO ASCII MOVEM T4,CODTAB(T1) ;STORE CONVERSION AOBJN T1,CODGE9 ;DO ALL CHARACTERS POPJ P, ;RETURN ; ; EBCDIC OUTPUT ; CODGE7: HRL T3,FC.PNT(AUT) ;SET UP POINTER HRRI T3,AS%%EB-1 ;ASCII INPUT CAIE T1,%ASCII ;TEST HRRI T3,SI%%EB-1 ;NO SIXBIT INPUT MOVE T1,FC.SIZ(IN) ;GET TABLE LENGTH CODGE8: ILDB T4,T3 ;GET CONVERSION MOVEM T4,CODTAB(T1) ;STORE CONVERSION AOBJN T1,CODGE8 ;CONTINUE FOR ALL CHARACTERS POPJ P, ;RETURN ; ; EBCDIC INPUT ; CODGE4: MOVE T1,FC.SIZ(IN) ;GET CODE LENGTH MOVE T3,[POINT 7,EB%%AS ] ;GET TABLE POINTER CODGE5: ILDB T4,T3 ;GET CODE CAIN T4,134 ;FILL ORCMI T4,-1 ;SET BAD CHARACTER CAIE T2,%ASCII ;ASCII OUTPUT JSP Q1,CODGE6 ;NO - CONVERT TO SIXBIT MOVEM T4,CODTAB(T1) ;STORE CODE AOBJN T1,CODGE5 ;DO ALL 256 CHARACTERS POPJ P, ;RETURN ; ; SAME CODE ; CODGE1: MOVE T1,FC.SIZ(IN) ;GET TABLE LENGTH CODGE3: HRRM T1,CODTAB(T1) ;STORE CODE AOBJN T1,CODGE3 ;DO ALL CHARACTERS POPJ P, ;RETURN ; ; CODGE6 - CONVERT ASCII TO SIXBIT ; CODGE6: CAIL T4," " ;IN RANGE CAILE T4," "+77 ;IN RANGE SKIPA T4,[XWD -1,74] ;SUPPLY BAD RESULT SUBI T4," " ;CONVERT JRST 0(Q1) ;RETURN PAGE SUBTTL LOW CORE ALLOCATION RELOC PATCH: BLOCK PATSIZ ;PATCH AREA FIRST: PLIST: BLOCK PSIZE ;PUSHDOWN AREA ; ; DEFINE A PROTOTYPE FILE TABLE ; DEFINE FILTAB(A,N)< A==ZZ ZZ==ZZ+N> ZZ==0 ; DEFINE FILBLK< FILDAT(STA) ;LH STATUS (SEE FLAGS BELOW) ;RH FILBLK OFFSET ;OPEN BLOCK FILDAT(MOD) ;MODE FILDAT(DEV) ;DEVICE FILDAT(BUF) ;BUFFER WORD ;LOOKUP/ENTER BLOCK FILDAT(NAM) ;FILENAME FILDAT(EXT) ;EXTENSION FILDAT(PRT) ;PROTECTION FILDAT(PPN) ;PPN FILDAT(TYP) ;DEVCHR WORD FILDAT(SIZ) ;DEVSIZ WORD ;BUFFER RING HEADER FILDAT(ADR) ;CURRENT BUFFER ADDRESS FILDAT(PNT) ;CURRENT BUFFER POINTER FILDAT(CNT) ;CURRENT BUFFER COUNT > DEFINE FILDAT(A)< FILTAB(F.'A,1) > ; ; INCLUDE BASIC FILE BLOCK ; FILBLK ; FILTAB(F.PSTN,1) ;FILES TO ADVANCE OR BACKSPACE ; ; PACKED FILE SUB BLOCK ; DEFINE FILDAT(A)< FILTAB(FP.'A,1) > ; FILBLK ; FILTAB(FP.ITM,1) ;LINK TO ITEM BLOCKS FILTAB(FP.NMB,1) ;LINK TO NAME BLOCKS ; FILTAB(FP.CUR,1) ;CURRENT ITEM FILTAB(FP.PCT,1) ;CURRENT PICTURE FILTAB(FP.PSZ,1) ;PICTURE SIZE FILTAB(FP.TMP,1) ;BYTE IN CORE ; ; END OF PACKED SUB BLOCK ; FILTAB(F.RCSZ,1) ;RECORD SIZE PARAMETER FILTAB(F.BLSZ,1) ;BLOCKSIZE PARAMETER FILTAB(F.BFSZ,1) ;BUFFERSIZE PARAMETER FILTAB(F.CREC,1) FILTAB(F.CBLK,1) FILTAB(F.CBUF,1) ;COMPUTED RECORD LENGTH IN BUFFERS FILTAB(F.BUFC,1) ;COUNTS BUFFERS USED IN RECORD FILTAB(F.RECC,1) ;COUNTS RECORDS USED IN BLOCK FILTAB(F.BUFN,1) ;COUNTS BUFFERS INPUT OR OUTPUT FILTAB(F.EBC,1) ;HOLDS EBCDIC BLOCK SIZE FILTAB(F.CODE,1) ;HOLDS CODE TYPE DEFINE CODTAB(A)< ZZZ==ZZZ+1 FILTAB(FC.'A,1)> ZZZ==0 CODDSP CODDSP==ZZZ FILTAB==ZZ ;LENGTH OF TABLE ; ; F.STA - FILE FLAGS ; BITS DEFINED VIA FF.BIT MACRO ; DEFINE FF.BIT(A)< FF.'A==ZZ ZZ== > ZZ==400000 ; FF.BIT(VAR) ;VARIABLE MODE FF.BIT(SEQ) ;PACKED FILE IN SEQUENCED FORMAT FF.BIT(TAP) ;FILE IS A MAGTAPE FF.BIT(LIN) ;DEVICE IS LINE-BLOCKED FF.BIT(IND) ;DEVICE IN INDUSTRY COMPATIBLE MODE FF.BIT(UNL) ;UNLOAD DEVICE WHEN DONE FF.BIT(REW) ;REWIND DEVICE BEFORE PROCESSING FF.BIT(SPN) ;LOGICAL BLOCKS SPAN PHYSICAL RECORDS FF.BIT(OUT) ;FILE IS OUTPUT FILE FF.BIT(BLC) ;CODE HAS A BLOCK COUNT FF.BIT(RCC) ;CODE HAS A RECORD COUNT FF.BIT(SYN) ;CODE IS SYNCHRONIZED FF.BIT(TAB) ;CODE HAS TABS FF.BIT(EOL) ;CODE HAS EOL CHARACTER FF.BIT(ZER) ;CODE "ALLOWS" ZERO LENGTH RECORDS FF.BIT(NLS) ;DON'T LIST PACKED FD'S. ; ; DEFINE TABLES FOR THE INPUT AND OUTPUT FILES ; INFILE: BLOCK FILTAB ;INPUT FILE BLOCK OUTFIL: BLOCK FILTAB ;OUTPUT FILE BLOCK ; ; DEFINE A BUFFER FOR THE HELP TEXT AND CHARACTER CONVERSION ; TABLE ; HLPBUF: ;BLOCK FOR HELP I/O CONTAB: BLOCK ^D256 ;LARGE ENOUGH FOR EBCDIC ; ; DEFINE CODE CONVERSION TABLE ; CODTAB: BLOCK ^D256 ;LARGE ENOUGH FOR EBCDIC ; ; DEFINE COMMAND SCANNER DATA BASE ; MASK1: BLOCK 1 ;FIRST TWO WORD MASK MASK2: BLOCK 1 ;SECOND TWO WORD MASK SAVCHR: BLOCK 1 ;SAVE CHARACTER SCNPNT: BLOCK 1 ;SIXBIT POINTER SCNCNT: BLOCK 1 ;SIXBIT BYTE COUNTER SCNDAT: BLOCK SCNSIZ ;LARGEST SIXBIT ITEM SWHDAT: BLOCK SWHSIZ ;LARGEST SWITCH ; ; DEFINE NEEDED DATA AREAS ; PCKFD: BLOCK FDSIZE ;BLOCK FOR FD NAME COBDAT: BLOCK COBSIZ ;BLOCK FOR COBOL ITEM ZERO: BLOCK 1 ;ZERO WORD AFTER COBDAT NXTCNT: BLOCK 1 ;COUNTER NRECS: BLOCK 1 ;COUNTS RECORDS CONVERTED NCHRS: BLOCK 1 ;COUNTS CHARACTERS CONVERTED BCHRS: BLOCK 1 ;COUNTS BAD CHARACTERS NREC: BLOCK 3 ;NUMBER OF RECORDS IN ASCIZ NCHR: BLOCK 3 ;NUMBER OF CHARACTERS IN ASCIZ NBCHR: BLOCK 3 ;NUMBER OGF BAD CHARACTERS ; ; DEFINE DATA AREA FOR DUMP ; D.LIN1: BLOCK LINSIZ ;HOLDS ORIGINAL LINE D.LIN2: BLOCK LINSIZ ;HOLDS TRANSLATED LINE D.LIN3: BLOCK LINSIZ ;HOLDS PACKED CONVERSION D.PTR1: BLOCK 1 ;POINTER TO D.LIN1 D.PTR2: BLOCK 1 ;POINTER TO D.LIN2 D.PTR3: BLOCK 1 ;POINTER TO D.LIN3 ; ; DATA AREA FOR SPECIAL BUFFERS ; EXOUT: BLOCK 1 ;WORD EXECUTED AT OU.BUF TMPADR: BLOCK 1 ;USED FOR MULTIPLE JSP ADR, ACTADR: BLOCK 1 ACTPTR: BLOCK 1 ACTCNT: BLOCK 1 RECADR: BLOCK 1 RECPTR: BLOCK 1 RECCNT: BLOCK 1 BLKADR: BLOCK 1 BLKPTR: BLOCK 1 BLKCNT: BLOCK 1 ; ; ; DATA FOR OUTPUT TRAP ; TOIBLK: BLOCK 1 ;NORMAL BLOCK INITIALIZATION TOIREC: BLOCK 1 ;NORMAL RECORD INITIALIZATION TOFBLK: BLOCK 1 ;NORMAL BLOCK FINISH TOFREC: BLOCK 1 ;NORMAL RECORD FINISH ; LAST: RELOC PAGE SUBTTL INTEGER DIVISION AND PUSHDOWN ROUTINES ; ; T1DT23 - COMPUTE F((T1)/(T2-3)) ; T1DT2 - COMPUTE F((T1)/(T2)) ; ; WHERE F = INT(A/B) + 1 IF REM NOT = 0 ; = INT(A/B) IF REM = 0 ; WHERE INT IS INTEGER DIVISION RESULT ; REM IS INTEGER DIVISION REMAINDER ; ; CALL: MOVE T1,# ; MOVE T2,# ; PUSHJ P,ROUTINE ; (RETURN) ; T1DT23: SUBI T2,3 ;REDUCE T2 BY 3 T1DT2: IDIV T1,T2 ;DIVIDE JUMPE T2,CPOPJ ;NO REMAINDER ADDI T1,1 ;REMAINDER POPJ P, ;RETURN ; TPOPJ1: POP P,T1 ;RESTORE T1 CPOPJ1: AOSA 0(P) ;ADVANCE PUSHDWON TPOPJ: POP P,T1 ;RESTORE T1 CPOPJ: POPJ P, ;RETURN PAGE SUBTTL "HELP" - TYPE HELP TEXT ; ; SUBROUTINE HELPER ; CALL IS A PUSHJ P,HELPER ; INITIALIZE HELP FILE IF NOT INITIALIZED ; OTHERWISE - JUST TYPES THE HELP TEXT ; ; REQUIRES A 202(8) WORD AREA CALLED HLPBUF IN LOW CORE ; HELPER: MOVSI T2,(SIXBIT /SYS/) ;HLPTXT ON DEVICE SYS MOVEI T1,17 ;READ IN DUMP MODE MOVEI T3,0 ;DON'T NEED BUFFER HEADERS OPEN CH.HLP,T1 ;GET THE DEVICE PJRST HELPE4 ;TYPE SORRY MESSAGE MOVE T1,HLPBUF(LOW) ;GET CUSP NAME TO BE HELPED MOVSI T2,(SIXBIT /HLP/) ;READ CUSP.HLP SETZB T3,T4 ;SET UP LOOKUP BLOCK LOOKUP CH.HLP,T1 ;LOOKUP HELP FILE PJRST HELPE4 ;TYPE SORRY MESSAGE PUSH P,HLPBUF+201(LOW) ;STORE WORD AFTER BLOCK SETZM HLPBUF+201(LOW) ;MAKE SURE ASCIZ MOVSI T1,-200 ;SET UP IOWD HRRI T1,HLPBUF-1(LOW) ;SET UP IOWD MOVEI T2,0 ;CLEAR IOWD + 1 HELPE2: INPUT CH.HLP,T1 ;READ A BLOCK STATZ CH.HLP,740000 ;EVERYTHING OK JRST HELPE3 ;NO STATZ CH.HLP,20000 ;EOF? JRST HELPE1 ;YES TTCALL 3,HLPBUF(LOW) ;TYPE THE BUFFER JRST HELPE2 ;GET ANOTHER HELPE3: TTCALL 3,[ASCIZ /?HARDWARE READ ERROR/] HELPE1: POP P,HLPBUF+201(LOW) ;RESTORE WORD ; ; TABGEN - GENERATES SCANNER CONVERSION TABLE ; TABGEN: MOVSI T1,-200 ;200(8) ASCII CHARACTERS MOVE T2,[POINT 4,DESTAB ] ;SET UP POINTER TABGE1: ILDB T3,T2 ;GET ADDRESS ADDI T3,DS%ONE ;OFFSET MOVEM T3,CONTAB(T1) ;STORE CONVERSION AOBJN T1,TABGE1 ;DO 200(8) CHARACTERS ; POPJ P, ;RETURN HELPE4: TTCALL 3,[ASCIZ /%SORRY - I CAN'T HELP YOU/] POPJ P, ;RETURN PAGE SUBTTL COMMAND SCANNER ; ; SUBROUTINE SCANER ; GET A FILE SPECIFICATION FROM THE INPUT LINE ; ; CALL IS MOVEI F,FILSPC WHERE FILSPC ADDRESSES A FILE TABLE ; PUSHJ P,SCANER ; ERROR RETURN OR HELP TEXT TYPED OR BLANK LINE ; RETURN WITH THE LAST CHARACTER IN CHAR ; ; A FILESPEC IF OF THE FORM ; ; DEVICE:NAME.EXT[P,PN,SFD,...,SFD]/SWITCH/.../SWITCH ; TERMINATED BY A PLUS, COMMA, OR BREAK CHARACTER ; ; WHERE DEVICE IS A LOGICAL OR PHYSICAL DEVICE ; NAME.EXT IS STANDARD FILENAME.EXTENSION ; P,PN IS THE PPN (MAY APPEAR ANYWHERE IN THE SPEC) ; ; AND: ; ; ; SWITCHES SPECIFIED AS FOLLOWS: ; ; TWO TABLES: ; ; TABLE 2 ; ; FOR EACH SWITCH ; ; RH ADDRESS OF ROUTINE TO PROCESS SWITCH VALUE ; ; TABLE 1 ; ; SWITCH NAMES IN SIXBIT (UP TO 6*SWHSIZ CHARACTERS) ; ; S POINTS TO SWITCH TABLES ; LH TO TABLE 1 RH TO TABLE 2 ; ; START COMMAND SCANNER ; SCANER: TLO F,FF.VAR ;DEFAULT IS VARIABLE CODE TRZ FLG,FR.CLN!FR.PER!FR.BLK MOVSI T1,(SIXBIT /DSK/) MOVEM T1,F.DEV(F) SCANE1: PUSHJ P,SETSIX ;GET A SIXBIT ITEM POPJ P, ;ILLEGAL CHARACTER SCANE2: HRRZ ADR,0(ADR) ;GET SCANNER DISPATCH CAIN ADR,SC%BRK ;BREAK PJRST SC%BRK ;YES TRO FLG,FR.BLK ;SET NON-BLANK AND JRST 0(ADR) ;DISPATCH ; ; CONTROL CHARACTERS AND THEIR MEANING ; ; : COLON - ENDS DEVICE SPECIFICATION ; [ LEFT BRACKET - START PPN ; # POUND SIGN - START OCTAL NUMBER ; , COMMA - ENDS SCAN ; + PLUS - ENDS SCAN ; LF BREAK - ENDS SCAN ; . PERIOD - ENDS FILENEAME ; ; WHEN TRANSLATING PPN ; ; [ LEFT BRACKET - START PPN ; ] RIGHT BRACKET - END PPN ; , SEPERATE ELEMENTS OF PPN ; ; LINE CONTROL ; ; - WHEN FOLLOWED BY A BREAK - CONTINUATION ; ; SEMI-COLON COMMENT FOLLOWS ; ; ; SWITCH - A SWITCH FOLLOWS ; SEE ABOVE FOR SPECIFICATIONS ; SC%SWH: PJUMPE S,SC%ERR ;MAKE SURE SWITCHES EXPECTED MOVEM T1,SCNPNT(LOW) ;STORE POINTER MOVEM T2,SCNCNT(LOW) ;STORE COUNT MOVEI T1,SWHDAT ;GET SPACE FOR SWITCH MOVEI T2,SWHSIZ ;SET LENGTH PUSHJ P,GETSIX ;GET THE SWITCH POPJ P, ;INVALID ; ; TRY FOR MATCH ; MOVSI T1,SWHDAT ;GET DATA WORD HLR T1,S ;GET TABLE ADDRESS PUSHJ P,MATCH ;MATCH? PJRST SC%ERR ;NO ADDI T1,-1(S) ;GET DISPATCH HRRZ T1,0(T1) ;GET ADDRESS PUSHJ P,0(T1) ;DISPATCH SWITCH POPJ P, ;SWITCH ERROR MOVE T1,SCNPNT(LOW) ;RESTORE POINTER MOVE T2,SCNCNT(LOW) ;RESTORE COUNTER JRST SCANE2 ;DISPATCH ; ; MATCH - MATCHES TWO WORD ITEM IN LH OF T1 ; TO TABLE IN RH OF T1 ; ; FIRST GENERATE TWO WORD MASK ; MATCH: MOVS T3,T1 ;REVERSE POINTER WORD MOVEI T2,^D12 ;TWELVE SHIFTS REQUIRED MOVE T4,1(T3) ;GET SECOND WORD MOVE T3,0(T3) ;GET FIRST WORD MATCH1: ROTC T3,6 ;SHIFT TLNE T3,770000 ;ANY SET TLO T3,770000 ;SET THEM ALL SOJG T2,MATCH1 ;DO THEM ALL MOVEM T3,MASK1 ;STORE MASK MOVEM T4,MASK2 ;STORE MASK ; ; NOW FIND A MATCH IF ANY ; MOVS T3,T1 ;REVERSE TABLE MOVS T3,T1 ;GET ITEM ADDRESS ANDI T1,777777 ;CLEAR LH OF T1 MATCH2: SKIPN T2,0(T1) ;MORE ON LIST JRST MATCH3 ;END OF LIST MOVE T4,0(T2) ;GET FIRST ITEM AND T4,MASK1 ;MASK OUT FIRST WORD CAME T4,0(T3) ;MATCH AOJA T1,MATCH2 ;NO - COUNT AND BUMP MOVE T4,1(T2) ;GET SECOND WORD AND T4,MASK2 ;MASK CAME T4,1(T3) ;MATCH AOJA T1,MATCH2 ;COUNT TLNE T1,-1 ;TWO MATCHES POPJ P, ;YES HRL T1,T1 ;NO - COPY INDEX AOJA T1,MATCH2 ;BUMP AND COUNT MATCH3: HLRZ T1,T1 ;GET INDEX PJUMPE T1,CPOPJ ;NO MATCH HLRZ T3,T3 ;FIND TABLE BASE SUBI T1,-1(T3) ;COMPUTE OFFSET PJRST CPOPJ1 ;GO BACK ; ; POUND - OCTAL NUMBER FOLLOWS ; SC%PND: SKIPE SCNDAT(LOW) ;DATA MUST BE EMPTY PJRST SC%ERR ;SCANNER ERROR PUSHJ P,GETOCT ;GET OCTAL NUMBER POPJ P, ;INVALID MOVEM T1,SCNDAT(LOW) ;STORE AS DATA JRST 0(ADR) ;DISPATCH ; ; COLON - ENDS DEVICE ; SC%CLN: TRON FLG,FR.CLN ;PREVIOUS COLON SKIPN T1,SCNDAT(LOW) ;DATA NOT EMPTY PJRST SC%ERR ;IT IS ERROR MOVEM T1,F.DEV(F) ;STORE DEVICE JRST SCANE1 ;CONTINUE ; ; PERIOD - ENDS FILENAME ; SC%PER: TRON FLG,FR.PER ;PREVIOUS PERIOD SKIPN T1,SCNDAT(LOW) ;DATA NOT EMPTY PJRST SC%ERR ;IT IS MOVEM T1,F.NAM(F) ;STORE NAME JRST SCANE1 ;CONTINUE ; ; LEFT BRACKET - STARTS PPN ; SC%LFT: MOVEM T1,SCNPNT(LOW) ;STORE CURRENT POINTER PUSHJ P,GETOCT ;GET OCTAL NUMBER POPJ P, ;INVALID CAIE CHR,"," ;MUST BE COMMA PJRST SC%ERR HRLM T1,F.PPN(F) PUSHJ P,GETOCT ;GET PN POPJ P, ;INVALID HRRM T1,F.PPN(F) MOVE T1,SCNPNT(LOW) ;RESTORE POINTER CAIN ADR,SC%BRK ;DONE PJRST SC%BRK ;FINISH SPEC CAIE CHR,"]" ;RIGHT BRACKET PJRST SC%ERR ;NO PUSHJ P,GETSI1 ;CONTINUE ITEM POPJ P, JRST SCANE2 ;NORMAL DISPATCH ; ; SCANNER ERROR ; SC%ERR: TRO FLG,FR.BLK ;SET NON-BLANK MOVE T4,T5 ;SAVE COUNTER PUSHJ P,GETBRK ;CLEAR LINE SUBI T4,2 ;UPDATE CHARACTER COUNT TTCALL 1,[EXP " "] ;PRINT BLANK SOJGE T4,.-1 ;ANY MORE TTCALL 1,[EXP "^"] ;POINTER TTCALL 3,[ASCIZ / ?SCANNER ERROR/] POPJ P, ;GIVE ERROR RETURN ; ; HERE TO FINISH FILE-SPEC ; IF NAME NON BLANK STORE IT DEPENDING ON ; WHICH CHARACTERS SEEN ; SC%BRK: SKIPE T1,SCNDAT(LOW) ;SKIP IF NON-EMPTY TRO FLG,FR.BLK ;SET NON-BLANK TRNN FLG,FR.BLK ;BLANK LINE POPJ P, ;YES ; ; DO DEVCHR AND DEVSIZ UUO'S ; MOVEI T2,F.MOD(F) ;GET ADDRESS OF OPEN BLOCK DEVSIZ T2, ;GET DEFAULT SIZE HALT . ;NO DEVSIZ UUO MOVEM T2,F.SIZ(F) ;STORE SIZE MOVE T2,F.DEV(F) ;GET DEVICE NAME DEVCHR T2, ;GET DEVICE CHARACTERISTICS TLNE T2,(DV.MTA) ;MAGTAPE TLO F,FF.TAP ;SET MAGTAPE TLNE T2,(DV.TTY!DV.DIS!DV.PTP!DV.LPT!DV.CDR) TLO F,FF.LIN ;SET LINE BLOCK MOVEM T2,F.TYP(F) ;STORE DEVICE CHARACTERISTICS MOVEM F,F.STA(F) ;STORE STATUS AND OFFSET TRNE FLG,FR.PER ;PERIOD SEEN PJRST SCANE3 ;YES MOVEM T1,F.NAM(F) ;STORE NAME PJRST CPOPJ1 SCANE3: HLLM T1,F.EXT(F) ;STORE EXTENSION PJRST CPOPJ1 ;RETURN PAGE ; ; SUBROUTINE GETCHR ; RETURNS EQUIVALENCED CHARACTER ; GETCHR: TRZE FLG,FR.MIN ;TURN OFF MINUS FLAG JRST GETCH2 ;MINUS WAS SET - RETURN STORED GETCH4: TTCALL 4,CHR ;USE TTCALL MOVE ADR,CONTAB(CHR) ;GET DISPATCH CAIN ADR,DS%IGN ;IGNORE CHARACTER JRST GETCH4 ;YES AOS T5 ;INCREMENT CHARACTER COUNT CAIN CHR,"-" ;MINUS JRST GETCH1 ;HOLD IT CAIN CHR,";" ;SEMI - COLON PJRST GETBRK ;CLEAR LINE CAIN ADR,DS%SLW ;GIVE CR-LF TTCALL 3,[ASCIZ / /] POPJ P, ;YES ; ; HERE ON A MINUS ; GETCH1: TROE FLG,FR.MIN ;SET MINUS SEEN POPJ P, ;PREVENT LOOPING PUSHJ P,GETCH4 ;GET NEXT CHARACTER CAIE ADR,DS%BRK ;IS NEXT A BREAK JRST GETCH3 ;NO STORE FOR NEXT AROUND SETZ T5, ;ZERO COUNTER TRZ FLG,FR.MIN ;TURN OFF MINUS FLAG JRST GETCHR ;GET NEXT CHARACTER GETCH3: MOVEM CHR,SAVCHR(LOW) ;STORE CHARACTER MOVEI CHR,"-" ;RESTORE MINUS MOVE ADR,CONTAB(CHR) ;GET DISPATCH POPJ P, ;RETURN MINUS ; GETCH2: MOVE CHR,SAVCHR(LOW) ;GET SAVED CHARACTER MOVE ADR,CONTAB(CHR) ;GET DISPATCH POPJ P, ;RETURN SAVED CHARACTER ; ; SUBROUTINE GETBRK ; ; INPUTS FROM TTY UNTIL A BREAK ENCOUNTERED ; GETBRK: CAIE ADR,DS%BRK ;BREAK CAIN ADR,SC%BRK ;BREAK POPJ P, ;YES PUSHJ P,GETCHR ;GET EQUIVALENCED CHARACTER JRST GETBRK ;TEST IT ; ; GETSIX ; ; CALL: MOVEI T1,WHERE ; MOVEI T2,LENGTH ; PUSHJ P,GETSIX ; ERROR RETURN ; DATA RETURN - TERMINATOR IN CHR ; SETSIX: MOVEI T1,SCNDAT(LOW) ;SET UP T1 MOVEI T2,SCNSIZ ;SET UP T2 GETSIX: PUSHJ P,ZERCOR ;ZERO THE AREA HRLI T1,(POINT 6,0 ) ;MAKE T1 A POINTER IMULI T2,6 ;CONVERT TO SIXBIT BYTES GETSI1: PUSHJ P,GETCHR ;GET EQUIVALENCED CHARACTER CAIN ADR,DS%INV ;VALID CHARACTER? PJRST SC%ERR ;NO - GIVE ERROR MESSAGE CAIE ADR,DS%APH ;ALPHA PJRST CPOPJ1 ;NO - END OF ITEM SOJL T2,GETSI1 ;TRUNCATE CAILE CHR,"Z" ;NO - LOWER CASE? SUBI CHR," " ;YES - CONVERT TO UPPER SUBI CHR," " ;CONVERT TO SIXBIT IDPB CHR,T1 ;STORE JRST GETSI1 ;GET ANOTHER ; ; GETOCT - RETURN OCTAL NUMBER ; GETOCT: MOVEI T1,0 GETOC1: PUSHJ P,GETCHR ;GET EQUIVALENCEC CHARACTER CAIN ADR,DS%INV PJRST SC%ERR ;GIVE ERROR MESSAGE CAIL CHR,"0" CAILE CHR,"7" PJRST CPOPJ1 LSH T1,3 ADDI T1,-"0"(CHR) JRST GETOC1 ; ; GETDEC ; GETDEC: MOVEI T1,0 GETDE1: PUSHJ P,GETCHR ;GET EQUIVALENCED CHARACTER CAIN ADR,DS%INV PJRST SC%ERR ;GIVE ERROR MESSAGE CAIL CHR,"0" CAILE CHR,"9" PJRST CPOPJ1 IMULI T1,^D10 ADDI T1,-"0"(CHR) JRST GETDE1 ; ; ZERCOR - ZERO CORE ; ; CALL: MOVEI T1,WHERE ; MOVEI T2,LENGTH ; PUSHJ P,ZERCOR ; RETURN ; ZERCOR: SETZM 0(T1) ;CLEAR FIRST WORD CAIN T2,1 ;1 WORD POPJ P, ;YES MOVE T4,T1 ;WHERE IS LAST ADDI T4,-1(T2) ;AT T1 + T2 -1 MOVS T3,T1 ;WHERE TO START HRRI T3,1(T1) ;MAKE BLT POINTER BLT T3,0(T4) ;CLEAR POPJ P, ;RETURN PAGE SUBTTL DEFINE LINKAGE INTO ALLPR4 ; ; DEFINE LINKAGE INTO ALLPR4 ; INTERN SCANE1,SC%BRK,SC%ERR,SC%PND,SC%PER,SC%SWH INTERN SC%LFT,SC%CLN EXTERN DS%ONE,DS%IGN,DS%INV,DS%BRK,DS%SLW,DS%APH EXTERN DS%PND,DS%FIN,DS%MIN,DS%RHT,DS%PER,DS%SWH EXTERN DS%LFT,DS%CLN EXTERN DESTAB EXTERN EB%%AS,AS%%EB,SI%%EB PAGE SUBTTL SWITCH TABLES ; ; TABLES AS FOLLOWS: ; ; INSW1 INPUT FILE SWITCHES ; INSW2 ; OUTSW1 OUTPUT FILE SWITCHES ; OUTSW2 ; PCKSW1 PACKED FILE SWITCHES ; PCKSW2 ; ; SWITCH TABLES ARE BUILT VIA MACROS ; DEFINE TAPSWH< SWHMAC(SIXBIT/SPAN/,0,0,.SPAN) SWHMAC(SIXBIT/INDUST/,SIXBIT/RY/,0,.INDST) SWHMAC(SIXBIT/REWIND/,0,0,.REW) SWHMAC(SIXBIT/UNLOAD/,0,0,.UNL) SWHMAC(SIXBIT/ADVANC/,SIXBIT/E/,0,.ADV) SWHMAC(SIXBIT/BACKSP/,SIXBIT/ACE/,0,.BACK) > DEFINE INPSWH,< TAPSWH ;INCLUDE TAPE SWITCHES SWHMAC(SIXBIT/HELP/,0,0,.HELP) SWHMAC(SIXBIT/CODE/,0,1,.CODE) SWHMAC(SIXBIT/RECORD/,SIXBIT/SIZE/,1,.SIZE) SWHMAC(SIXBIT/BLOCKS/,SIXBIT/IZE/,1,.BLOCK) SWHMAC(SIXBIT/MODE/,0,1,.MODE) SWHMAC(SIXBIT/BUFFER/,SIXBIT/SIZE/,1,.BFSIZ) > DEFINE OUTSWH,< INPSWH SWHMAC(SIXBIT/DUMP/,0,0,.DUMP) > DEFINE PCKSWH,< SWHMAC(SIXBIT/HELP/,0,0,.HELP) SWHMAC(SIXBIT/FORMAT/,0,1,.FORMT) SWHMAC(SIXBIT/FD/,0,1,.FD) SWHMAC(SIXBIT/NOLIST/,0,0,.NLST) > DEFINE SWHMAC(A,B,C,D)< [A B] > ; ; DEFINE NAME TABLES ; INSW1: INPSWH Z OUTSW1: OUTSWH Z PCKSW1: PCKSWH Z ; DEFINE SWHMAC(A,B,C,D)< IFE C, IFN C, XWD LH,D > ; ; DEFINE PROCESS TABLES ; INSW2: INPSWH OUTSW2: OUTSWH PCKSW2: PCKSWH ; ; SIXBIT SWITCH VALUES FOR ALPHA SWITCHES ; DEFINE MODSWH< SWHMAC(SIXBIT/FIXED/,0) SWHMAC(SIXBIT/VARIAB/,SIXBIT/LE/) > ; DEFINE CODSWH< SWHMAC(SIXBIT/ASCII/,0) SWHMAC(SIXBIT/SIXBIT/,0) SWHMAC(SIXBIT/FIXEDE/,SIXBIT/BCDIC/) SWHMAC(SIXBIT/VARIAB/,SIXBIT/LEEBCD/) > DEFINE FRMSWH< SWHMAC(SIXBIT/CONVEN/,SIXBIT/TIONAL/) SWHMAC(SIXBIT/STANDA/,SIXBIT/RD/) > DEFINE SWHMAC(A,B)< [A B] > ; MODSW1: MODSWH Z CODSW1: CODSWH Z FRMSW1: FRMSWH Z ; ; PROCESS ROUTINES FOR SWITCHES ; ; ; SPAN ; .SPAN: CAIN CHR,":" ;ARGUMENT PJRST SC%ERR ;NONE ALLOWED TLO F,FF.SPN ;SET SPAN PJRST CPOPJ1 ;GET NEXT ; ; INDUSTRY COMPATIBLE - INDUSTRY COMPATIBLE MODE ; .INDST: CAIN CHR,":" ;ARGUMENT PJRST SC%ERR ;NONE ALLOWED TLO F,FF.IND ;SET INDUSTRY COMPATIBLE PJRST CPOPJ1 ;RETURN ; ; REWIND - SET REWIND FIRST ; .REW: CAIN CHR,":" ;ARGUMENT PJRST SC%ERR ;NONE ALLOWED TLO F,FF.REW ;SET REWIND PJRST CPOPJ1 ;RETURN ; ; UNLOAD - SET UNLOAD AFTER ; .UNL: CAIN CHR,":" ;ARGUMENT PJRST SC%ERR ;NONE ALLOWED TLO F,FF.UNL ;SET UNLOAD PJRST CPOPJ1 ; ; ADVANCE ; .ADV: MOVEI T1,1 ;ASSUME 1 FILE CAIE CHR,":" ;ARGUMENT JRST .ADV1 ;NO ARGUMENT PUSHJ P,GETDEC ;GET HOW MANY PJRST SC%ERR ;ERROR .ADV1: MOVEM T1,F.PSTN(F) ;STORE COUNT PJRST CPOPJ1 ;RETURN ; ; BACKSPACE ; .BACK: MOVEI T1,1 ;ASSUME 1 FILE CAIE CHR,":" ;ARGUMENT JRST .BACK1 ;NO - ASSUME 1 PUSHJ P,GETDEC ;GET ARGUMENT PJRST SC%ERR ;ERROR .BACK1: MOVNM T1,F.PSTN(F) ;STORE NEGATIVE PJRST CPOPJ1 ;GET NEXT ; ; DUMP - NO ARGUMENTS ; .DUMP: CAIN CHR,":" ;ARGUMENT PJRST SC%ERR ;NONE ALLOWED TLO FLG,FL.DMP ;REQUEST A DUMP PJRST CPOPJ1 ;RETURN ; ; MODE - SET FLAG IN LH OF F.STA ; ; .MODE: CAIE CHR,":" ;ARGUMENT PJRST SC%ERR ;NO MOVEI T1,SWHDAT ;USE SWHDAT MOVEI T2,SWHSIZ ;SAME PUSHJ P,GETSIX ;GET ARGUMENT PJRST SC%ERR ;ERROR MOVE T1,[XWD SWHDAT,MODSW1] PUSHJ P,MATCH ;FIND MATCH PJRST SC%ERR ;ERROR CAIE T1,1 ;FIXED TLOA F,FF.VAR ;TURN ON VARIABLE TLZ F,FF.VAR ;TURN OFF VARIABLE PJRST CPOPJ1 ;RETURN ; ; CODE - SET CODE KEY IN RH OF F.STA ; .CODE: CAIE CHR,":" ;ARGUMENT PJRST SC%ERR ;NO - SCANNER ERROR MOVEI T1,SWHDAT ;USE SWHDAT MOVEI T2,SWHSIZ ;USE DEFAULT SIZE PUSHJ P,GETSIX ;GET SWITCH PJRST SC%ERR ;ERROR MOVE T1,[XWD SWHDAT,CODSW1] PUSHJ P,MATCH ;LOOK FOR MATCH PJRST SC%ERR ;NOPE MOVEM T1,F.CODE(F) ;STORE MATCH VALUE AS CODE PJRST CPOPJ1 ;RETURN ; ; BLOCKSIZE - GET BLOCKSIZE AND STORE ; .BLOCK: CAIE CHR,":" ;ARGUMENT PJRST SC%ERR ;NO PUSHJ P,GETDEC ;GET DECIMAL ARGUMENT PJRST SC%ERR ;ERROR MOVEM T1,F.BLSZ(F) ;STORE BLOCK SIZE PJRST CPOPJ1 ;RETURN ; ; FORMAT - SET SWITCH IN F.STA ; .FORMT: CAIE CHR,":" ;ARGUMENT PJRST SC%ERR ;NO MOVEI T1,SWHDAT ;USE SWHDAT MOVEI T2,SWHSIZ ;USE DEFAULT SIZE PUSHJ P,GETSIX ;GET SWITCH PJRST SC%ERR ;ERROR MOVE T1,[XWD SWHDAT,FRMSW1] PUSHJ P,MATCH ;MATCH PJRST SC%ERR ;NO CAIE T1,1 ;CONVENTONAL TLOA F,FF.SEQ ;TURN ON STANDARD TLZ F,FF.SEQ ;TURN OFF STANDARD PJRST CPOPJ1 ;RETURN ; ; SIZE - SET RECORD SIZE ; .SIZE: CAIE CHR,":" ;ARGUMENT PJRST SC%ERR ;NO - ERROR PUSHJ P,GETDEC ;GET DECIMAL PJRST SC%ERR ;ERROR MOVEM T1,F.RCSZ(F) ;STORE RECORD SIZE PJRST CPOPJ1 ;RETURN ; ; BFSIZ - STORE BUFFER SIZE ; .BFSIZ: CAIE CHR,":" ;ARGUEMNT PJRST SC%ERR ;NO PUSHJ P,GETDEC ;GET ARGUMENT PJRST SC%ERR ;BAD RESPONSE MOVEM T1,F.BFSZ(F) ;STORE PJRST CPOPJ1 ;RETURN ; ; FD - STORE FD NAME ; .FD: CAIE CHR,":" ;ARGUMENT PJRST SC%ERR ;NO - ERROR MOVEI T4,DS%APH ;SET MINUS ALPHABETIC EXCH T4,CONTAB+"-" ;SET AND STORE MOVEI T1,PCKFD ;STORE IN PCKFD MOVEI T2,FDSIZE ;GET DEFAULT SIZE PUSHJ P,GETSIX ;GET ITEM SOS 0(P) ;SET ERROR EXCH T4,CONTAB+"-" ;RESTORE MINUS PJRST CPOPJ1 ;RETURN (NB SOS) ; ; HELP - OUTPUT HELP TEXT (ALLPRT.HLP UNLESS ARGUMENT) ; .HELP: MOVE T1,[CUSP] ;ASSUME CUSP TO BE TYPED MOVEM T1,HLPBUF(LOW) ;STORE CUSP NAME CAIE CHR,":" ;ARGUMENT JRST .HELP1 ;NO MOVEI T1,HLPBUF ;STORE NAME IN HLPBUF MOVEI T2,1 ;ONLY 1 WORD PUSHJ P,GETSIX ;GET NAME POPJ P, ;ERROR .HELP1: PUSHJ P,GETBRK ;CLEAR INPUT LINE PJRST HELPER ;CALL HELPER ; ; NOLIST - DON'T LIST FD IF PACKED SPEC ; .NLST: CAIN CHR,":" ;ARGUMENT PJRST SC%ERR ;NONE ALLOWED TLO F,FF.NLS ;SET FLAG PJRST CPOPJ1 ;RETURN PAGE SUBTTL PRINT STATISTICS AT END OF RUN STATS: MOVE 7,APOINT ;SET UP POINTERS MOVSI 14,-3 ;SET UP COUNTER NXTPNT: PUSHJ P,GETPNT ;GET POINTERS PUSHJ P,DECOUT ADDI 7,2 AOBJN 14,NXTPNT TTCALL 3,[ASCIZ/ # OF RECORDS CONVERTED /] TTCALL 3,NREC TTCALL 3,[ASCIZ/ # OF CHARACTERS CONVERTED /] TTCALL 3,NCHR TTCALL 3,[ASCIZ/ # OF BAD CHARACTERS /] TTCALL 3,NBCHR POPJ P, ; ; GET POINTERS ; GETPNT: MOVE T3,0(7) ;SET UP POINTER TO ASCIZ RECORD MOVE T1,1(7) ;SET UP POINTER TO COUNT MOVE T1,0(T1) ;GET ACTUAL COUNT POPJ P, ; ; POINTERS ; PNTERS: POINT 7,NREC EXP NRECS POINT 7,NCHR EXP NCHRS POINT 7,NBCHR EXP BCHRS APOINT: EXP PNTERS ; ; DECOUT - OUTPUT OCTAL NUMBER IN DECIMAL ; DECOUT: IDIVI T1,12 ;DIVIDE BY 10 HRLM T2,0(P) ;SAVE ON STACK SKIPE T1 ;DONE YET PUSHJ P,DECOUT ;NEXT DIGIT HLRZ T1,0(P) ;GET DIGIT ADDI T1,60 ;MAKE ASCIZ IDPB T1,T3 ;STORE POPJ P, PAGE SUBTTL LITERALS LIT END ALLPRT