Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50343/allprt.mac
There is 1 other file named allprt.mac in the archive. Click here to see a list.
TITLE ALLPRT - INTERCONVERTS EBCDIC,ASCII AND SIXBIT
ENTRY ALLPRT
EXTERN .JBFF,.JBREL
;
; "STANDARD" MACROS
;
DEFINE HEX(X)
<XXX==0
IRPC X,<
IFLE "X"-"9",<XXX==^D16*XXX+"X"-"0">
IFG "X"-"9",<XXX==^D16*XXX+"X"-"A"+^D10>>>
;
; 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,<CH.HLP==0> ;HELP CHANNEL
IFNDEF CH.IN,<CH.IN==1> ;INPUT CHANNEL
IFNDEF CH.OUT,<CH.OUT==2> ;OUTPUT CHANNEL
IFNDEF CH.PCK,<CH.PCK==3> ;PACKED SPEC CHANNEL
IFNDEF PSIZE,<PSIZE==40> ;PUSHDOWN LIST LENGTH
IFNDEF PATSIZ,<PATSIZ==20> ;PATCH AREA LENGTH
IFNDEF SCNSIZ,<SCNSIZ==5> ;LARGEST SIXBIT ITEM SCANNED
IFNDEF SWHSIZ,<SWHSIZ==2> ;LONGEST SWITCH NAME
IFNDEF FDSIZE,<FDSIZE==5> ;LONGEST FD ALLOWED
IFNDEF COBSIZ,<COBSIZ==5> ;LARGEST COBOL ITEM ALLOWED
IFNDEF CH.EOL,<CH.EOL==33> ;PSEUDO COBOL EOL
IFNDEF LINSIZ,<LINSIZ==^D24> ;LENGTH OF DUMPED LINE
IFNDEF WD.CON,<WD.CON==^D106> ;WIDTH OF "CONVENTIONAL" COBOL LINE
IFNDEF WD.SEQ,<WD.SEQ==^D65> ;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,<XXX> ;PACKABLE
HEX(F9)
CAILE ADR,<XXX> ;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,<XXX> ;POSITIVE BYTE
HEX(C9)
CAILE ADR,<XXX> ;POSITIVE BYTE
JRST PCKO20 ;NO
JRST PCKO21 ;YES
HEX(D0)
PCKO20: CAIL ADR,<XXX> ;NEGATIVE BYTE
HEX(D9)
CAILE ADR,<XXX> ;NEGATIVE BYTE
JRST PCKO06 ;ERROR
TRO FLG,FR.SGN ;SET MINUS
HEX(F0)
PCKO21: IORI ADR,<XXX> ;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, <JRST 0(ADR)>
IF2, <
IFE A,<JRST 0(ADR) ;NO-OP>
IFN A,<JRST A ;SPECIAL PROCESSING>
>>
;
; 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/2>
>
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,<LH==0>
IFN C,<LH==FS.REQ>
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