.TITLE BCDIO
/
/COPYRIGHT (C) 1975
/DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
/
/THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY
/ON A SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH
/THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS
/SOFTWARE, OR ANY OTHER COPIES THEREOF, MAY NOT BE PRO-
/VIDED OR OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON
/EXCEPT FOR USE ON SUCH SYSTEM AND TO ONE WHO AGREES TO
/THESE LICENSE TERMS. TITLE TO AND OWNERSHIP OF THE
/SOFTWARE SHALL AT ALL TIMES REMAIN IN DEC.
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE
/WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COM-
/MITMENT BY DIGITAL EQUIPMENT CORPORATION.
/
/DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
/OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC.
.EJECT
/EDIT #048 14 FEB 73 TAM(46,47) *REF*(28):WAD:(29)*REF*(33):WAD:
/EDIT #049 05-MAY-75 R. K. BLACKETT REMOVE 'AND'S WHICH STRIP BITS 0-2
/ FROM T.V. ADDRESS. THIS IS FOR XVM SYSTEMS.
/ THIS CHANGE DOES NOT PRECLUDE ITS USE ON NON-XVM
/ SYSTEMS.
/EDIT #050 06-MAY-75 R. K. BLACKETT FIX THE 'LF' GLITCH (AS DOCUMENTED IN
/ SPRS 15-E951, 15-948, 15-960, ET. AL.)
/ ADD NEW CONDITIONAL PARMS MSCC, LFTOSP
/ MSCC (MASS STORAGE CARRIAGE CONTROL) IF DEFINED,
/ CONVERT 1ST CHAR TO INTERNAL CC CHAR CODE
/ LFTOSP (LINE FEED TO SPACE) IF DEFINED, CONVERT A LEADING
/ LINE FEED TO A SPACE.
/ REQUIRES USING FIOPS 036 OR LATER, AS FIOPS WAS
/ MODIFIED TO SET BIT 3 OF .STAB ENTRY TO INDICATE
/ A DIRECTORIED DEVICE.
/ ALSO NEED RBCDIO 008 OR LATER, AS IT WAS CHANGED
/ TO SET .MSDEV FOR ALL RANDOM ACCESS DEVICES, ON
/ OUTPUT. MODIFICATION WAS TO .RW SECTION OF RBCDIO.
/
/EDIT #051 23-JUL-75 R. K. BLACKETT INSERT A SPECIAL TRANSFER VECTOR CALLED
/ 'CC1' WHICH CONTAINS THE POINTER TO THE FIRST WORD
/ OF THE WORD PAIR WHICH CONTINS THE 'CURRENT CHARACTER'.
/ THE OLDER EDITS USED 'CC' FOR THIS PURPOSE, BUT 'CC'
/ ALSO CONTAINS THE CHARACTER WITHIN THE PAIR,
/ CODED IN BITS 0-2. THIS INTERFERES WITH XVM WIDE
/ ADDRESSING MODES. 'CC' IS STILL PRESENT AND USED FOR
/ ALL OF ITS PREVIOUS FUNCTIONS EXCEPT FOR FETCHING
/ AND STORING CHARACTERS THRU AS AN INDIRECT POINTER.
/ ALSO, REMOVE TWOS COMPLEMENT ROUTINE, SUBSITUTING
/ 'TCA' INTRUCTIONS.
/ ALSO, CHANGE THE GLOBAL ROUTINE '.READ' TO BE NAMED
/ 'READ.' SO AS NOT TO CONFLICT WITH I/O MACRO BY SAME
/ NAME. THIS WAS DONE WITH EDITORS 'CONVERT' COMMAND,
/ SO SOME COMMENTS MAY HAVE BEEN ALTERED. IN ADDITION,
/ THE MODIFIED LINES WERE NOT FLAGED WITH EDIT NUMBERS.
/ EDIT #052 20-AUG-75 M. HEBENSTREIT DISCLAIMER
/
/ EDIT #053 12-DEC-75 R. K. BLACKETT FIX BUG INTEGER OUTPUT WHICH
/ CAUSED A NEXM WHEN OUTPUTING
/ THE LAST WORD OF PHYSICAL MEMORY
/ UNDER AN 'I' CONVERSION.
/
/
/
/ASSEMBLY PARAMETERS
/ DEFINE %FPP FOR FLOATING POINT PROCESSOR
/ DEFINE %V5A FOR ADSS SYSTEM, ELSE, DOS15 ASSUMED
/DEFINE RSX FOR RSX SYSTEM.
/ DEFINE LFTOSP AND MSCC AS FOLLOWS:
/ NEITHER DEFINED = DOS XVM RSX XVM OR LATER SYSTEMS
/ LFTOSP=0 = **ILLOGICAL CASE**
/ LFTOSP=0,MSCC=0 = DOS V3A,V3B RSX PLUS III V1A, V1B
/ MSCC=0 = DOS V1A, V2A RSX PLUS ADSS V5B AND EARLIER
.IFUND MSCC /(RKB-050) CHECK FOR ILLEGAL COMB
.IFDEF LFTOSP /(RKB-050)
.END *****ILLEGAL ASSEMBLY PARAMETER COMBINATION***
.ENDC /(RKB-050)
.ENDC /(RKB-050)
.IFDEF RSX
%V5A=0
%V5A1=0
.ENDC
.IFUND %V5A
%V5A1=0
%DOS15=0
.ENDC
.IFDEF %DOS15
%V5A1=0
.ENDC
/BCD I/O OBJECT-TIME PACKAGE.
/ INTERNAL GLOBALS--
.GLOBL .FA3 /** TO ALLOW LDNG. OF .GD CALL
.GLOBL .FA4 /** ALLOW JMP INTO .FA FR. .GE
.GLOBL .FR /BCD READ
.GLOBL .FW /BCD WRITE
.GLOBL .FA /BCD ARRAY I/O
.GLOBL .RA /* R.A. BCD ARRAY I/O
.GLOBL .FE /BCD ELEMENT I/O
.GLOBL .RE /* R.A. BCD ELEMENT I/O
.GLOBL .FF /BCD I/O CLEANUP
.GLOBL .STEOR /* STORE 'EOR' (S.A.) OR 'REOR' (R.A.)
.GLOBL .BFLOC /* STORE '.FN' (S.A.) OR '.FNPTR' (R.A.)
.GLOBL .INILB /* INIT. L.B.
.GLOBL .INIFD /* INIT. FORMAT DECODER
.GLOBL .HILIM /* HIGH LIMIT
.GLOBL .RAENT /* R.A. ENTRY TO EOR
.GLOBL .D /** DEC. FIELD WIDTH
.GLOBL .W /** FIELD WIDTH
.GLOBL .S /** FORMAT TYPE CODE
.GLOBL .SF /** SCALE FACTOR
.GLOBL .PACK /** PACK CHAR. IN L.B.
.GLOBL READ. /** READ CHAR.
.GLOBL .CHAR /** ASCII CHAR. READ FROM BUFFER
.GLOBL .NMTST /** NUMBER TEST ROUTINE
.GLOBL .MPYTN /** MULT. BY TEN
.IFUND MSCC /(RKB-050)
.GLOBL .MSDEV /(RKB-050) MASS STORAGE SWITCH (USED IN RBCDIO)
.ENDC /(RKB-050)
.IFUND %FPP
.GLOBL .FAO /** DOUBLE LOAD
.GLOBL .FAP
.ENDC
.GLOBL .HIFLG /** HIGH FLAG
.GLOBL .SCC /** CHAR. CNTR.
.GLOBL .PBLKS /** PACK BLANKS
.GLOBL .LBADD /** L.B. ADDR.
.GLOBL .FSTFL /** FIRST CHR. FLG.: =-1 IF ENCODE
.GLOBL BCDIO
BCDIO=.
/ VIRTUAL GLOBALS--
.GLOBL .FH /READ/WRITE FLAG.
.GLOBL .FC /I/O DEVICE INITIALIZER.
.GLOBL .FQ /LINE BUFFER TRANSFER ROUTINE.
.GLOBL .FM /LINE BUFFER SIZE.
.GLOBL .FN /LINE BUFFER.
.GLOBL .ER /ERROR ROUTINE.
.GLOBL .INISA /INIT. FOR SEQ. ACC. ROUT.
.IFUND RSX
.GLOBL .FC6 /**L.B. SIZE (FIOPS)
.ENDC
.IFDEF %V5A1
.GLOBL .RN /R.A. FLAG. =400000 IF RA. OR ELSE =0
.GLOBL .STADD /PTR. TO CURRENT ST. TAB. ENTRY (FIOPS)
.ENDC
.IFUND %FPP
.GLOBL .AA /FLOATING AC--EXP
.GLOBL .AB /FLOATING AC--M.S.
.GLOBL .AC /FLOATING AC--L.S.
.GLOBL .AG /REAL LOAD
.GLOBL .AH /REAL STORE.
.GLOBL .CC /GENERAL FLOATING ADD.
.GLOBL .CD /NORMALIZE FLOATING AC.
.GLOBL .CE /ANSWER SIGN.
.GLOBL .CF /HOLD FLOATING AC.
.GLOBL .CH /ROUND AND INSERT SIGN.
.GLOBL .CI /GENERAL FLOATING DIVIDE.
.ENDC
.GLOBL .ER4 /REINIT. LOCATION (OTSER)
.IFDEF %DOS15
.GLOBL .DSK,.FLRA,.FLTB1,.FLZW0
.ENDC
/
/ CONDITIONALLY DEFINED MACROS
.IFUND %FPP
.DEFIN FLD%,A
JMS* A
.ENDM
.ENDC
.IFDEF %FPP
FLD=713050
.DEFIN FLD%
FLD
.ENDM
.ENDC
.IFUND %FPP
.DEFIN URFST%,A
JMS* A
.ENDM
.ENDC
.IFDEF %FPP
URFST=713650
.DEFIN URFST%
URFST
.ENDM
.ENDC
.IFDEF %FPP
/ DIRECT ASSIGNS. FOR FPP PROCESSOR
DLD=713150
DST=713750
UNDST=713770
DRD=712540
FNG=713272
FAB=713271
FZR=711200
BZA=716601
BPA=716604
UNDMP=711560
URDDV=712050
BNA=716610
UNDLD=713170
URDRD=712550
DAD=716140
FNM=713250
DRD=712540
.ENDC
/ CONSTANTS AND WORKING STORAGE--
C00003 .DSA 3 / *** DDS FEB69 ***
C00005 .DSA 5 / *** DDS FEB69 ***
C00006 .DSA 6
C00035 .DSA 43
K00002 .DSA -2 / *** DDS FEB69 ***
K00004 .DSA -4
K00006 .DSA -6
K00010 .DSA -12 / *** DDS FEB69 ***
S00001 .DSA 1
S00004 .DSA 4
S00007 .DSA 7
S00010 10
S00012 .DSA 12
S00015 .DSA 15
S00017 .DSA 17
S00032 .DSA 32
S00040 .DSA 40
S00042 42
S00044 44
S00047 47
S00037 37
S00050 .DSA 50
S00051 .DSA 51
S00053 .DSA 53
S00054 .DSA 54
S00055 .DSA 55
S00056 .DSA 56
S00057 .DSA 57
S00060 .DSA 60
S00061 .DSA 61
S00077 .DSA 77
S00101 .DSA 101
S00110 .DSA 110
S00111 .DSA 111
S00114 .DSA 114
S00117 117
S00120 .DSA 120
S00122 122
S00124 .DSA 124
S00130 .DSA 130
S00170 .DSA 170
S00175 .DSA 175
S00177 .DSA 177
S02000 .DSA 2000
S17777 .DSA 17777 / *** DDS FEB69 ***
S20100 .DSA 020100
S77776 .DSA 077776
/S77777 .DSA 77777 /(RKB-049) THIS LITERAL REMOVED, NO LONGER USED
T00000 .DSA 100000
T77777 .DSA 177777
U01004 .DSA 201004
V00002 .DSA 300002
V00000 300000
V40000 .DSA 340000
V77777 .DSA 377777
W00000 .DSA 400000
Z40000 .DSA 740000
Z77400 .DSA 777400
Z77600 .DSA 777600
Z77671 .DSA 777671
Z77706 .DSA 777706
Z77760 .DSA 777760
DBLONE .DSA 1
.DSA 200000
.DSA 0
CCNT .DSA 0
STCON 0 /STR. CONST.
OCHR 0 /**OCTAL CHR.
TBNM 0 /**TAB NUM.
CCPTR 0 /** CHAR. PTR
VRTYP 0 /** VAR. TYPE
TEMP7 0 /**
TEMP8 0 /**
OCTL 0 /** OCTAL FLG.: =-1,OCTAL; =0, DEC.
IGCNT 0 /** IGNORE CHAR. CNT.
CNT2 .DSA 0
CNT .DSA 0
DADD .DSA 0
DELTA .DSA 0
.HIFLG .DSA 0
.HILIM .DSA 0
.LBADD .DSA 0
LIMIT .DSA 0
.IFDEF %FPP
FP5 0 /TEMP FILLER FOR FPP --DON'T MOVE!!!
/ CLOBBERED BY LOADING MS AND LS
.ENDC
MS .DSA 0
LS .DSA 0
NUMFLG .DSA 0
.SCC .DSA 0
SIGN .DSA 0
SLOT .DSA 0
SMS .DSA 0
SLS .DSA 0
.FSTFL .DSA 0
CRAMFL 0 /CR-ALTMODE FLAG RDEXT
.IFDEF %FPP
FP1 0 /TEM.
FP2 0 /WORKING REGISTERS FOR FPP
FP3 0 /AC
FP4 0 /
FPH2 0 /HELD REGIS. FOR FPP
FPH3 0
FPH4 0
.ENDC
LDEOR .DSA EOR /*
.STEOR XX /*
.BFLOC XX /*
.IFUND MSCC /(RKB-050)
.MSDEV XX /(RKB-050) MASS STORAGE DEVICE SWITCH.
/(RKB-050) SET FOR WRITING ONLY:
/(RKB-050) SKP = NON-MASS STORAGE
/(RKB-050) NOP = MASS STORAGE
.ENDC /(RKB-050)
BCNT=CCNT
TEMP6=IGCNT /**
DIG1=TVCC
DIG2 .DSA 0
DIG=.INIFD
DPOS=TVCC
FADDR=INCCC
FRFLG=CCA
NRZ=FNBCHR
OVFFLG=FMTFCH
POT=CCN
SDFLG=CC2
SEXP=.INIFD
SFFLG=CC2
SHCT=DSHR
TAC=INCP
TEMP1=NUMCHK
TEMP2=INCP
TEMP3=DECP
TMPFAC=SPLIT
TLS=DECP
TMS=GETCC
WD1=CCN
WD5=CCA
PKBLK2=NUMTS2
CHCT=BCNT
C00001=DBLONE / *** DDS FEB69 ***
.TITLE .FR - - BCD READ
/BCD READ
/CALLING SEQUENCE -- JMS .FR
/ .DSA ADDRESS OF SLOT NUMBER.
/ .DSA ADDRESS OF FORMAT STATEMENT OR ARRAY.
.FR CAL 0
JMS .INISA /* INIT. FOR SEQ. ACC.
DZM* .FH /SET READ/WRITE FLAG TO READ.
LAC* .FR /INITIALIZE INPUT DEVICE.
JMS* .FC
DAC SLOT /SAVE SLOT NUMBER.
.IFDEF %DOS15
DAC FR3 /SET UP .SEEK
JMS* .DSK /A DISK?
SNA
JMP FR2 /NO
LAC SLOT
JMS* .FLRA /FILE OPEN FOR RAND. ACC.?
JMP FR2 /YES.
FR7A LAC SLOT /NO. .SEEK IF NO FILE ACTIVE
JMS* .FLTB1
JMP FR6 /RETURNS HERE IF FILE ACTIVE-ADDR. OF DIR. BUFFER
DAC FR4 /HERE IF NO FILE ACTIVE-ADDRESS OF DIR. BUFFER
/ (RKB-050) DELETE THE FOLLOWING 5 LINES
/ (RKB-050) LAC* .STADD /ZERO SO .INIT WILL GO THRO IN .FC
/ (RKB-050) DAC FW5 /FOR LEVEL OF INDIR.
/ (RKB-050) DZM* FW5
/ (RKB-050) LAC* .FR /DAT SLOT
/ (RKB-050) JMS* .FC /INIT FOR INPUT
FR3 0 /DIR. ENTRY BUFFER INTO FR4
3 /.SEEK
FR4 0 /BUFF ADDRESS
.ENDC
FR2 ISZ .FR
LAC* .FR /GET FORMAT ADDRESS. IF A TRANSFER VECTOR,
DAC CC / GO ONE MORE LEVEL OF INDIRECT.
SPA
LAC* CC
JMS .INIFD /INITIALIZE FORMAT DECODER.
JMS EOR /READ FIRST RECORD.
ISZ .FR /EXIT.
JMP* .FR
.IFDEF %DOS15
FR6 SPA /IF AC POS., FILE ACTIVE FOR OUTPUT
/CLOSE OUTPUT FILE AND REOPEN IT FOR INPUT THRU FR7A
JMP FR2 /OK, FILE ACTIVE FOR INPUT (JUST CONT.)
LAC SLOT /.DAT SLOT INTO AC
DAC FR7 /SET .CLOSE CAL
JMS* .FLZW0 /ZERO FILE ACTIVE WORD OF DIR. ENTRY
FR7 0 /.CLOSE
6
JMP FR7A /GO REOPEN FILE FOR INPUT
.ENDC
.TITLE .FW - - BCD WRITE
/BCD WRITE
/ CALLING SEQUENCE -- JMS .FW
/ .DSA ADDRESS OF SLOT NUMBER.
/ .DSA ADDRESS OF FORMAT STATEMENT OR ARRAY
.FW CAL 0
JMS .INISA /* INIT. FOR SEQ. ACC.
LAC C00001 /SET READ/WRITE FLAG TO WRITE.
DAC* .FH
LAC* .FW /INITIALIZE OUTPUT DEVICE.
JMS* .FC
DAC SLOT /SAVE SLOT NUMBER.
.IFUND MSCC /(RKB-050)
LAC* .STADD /(RKB-050) TEST DEVICE FOR MASS STORAGE
DAC .MSDEV /(RKB-050) RESOLVE ONE MORE LEVEL OF INDIRECTION
LAC* .MSDEV /(RKB-050) TO GET TO CURRENT .STAB ENTRY
AND (40000) /(RKB-050) BY CHECKING FOR 'DIRECTORIED' BIT
SNA!CLA /(RKB-050) SET UP BY FIOPS
LAC (1000) /(RKB-050) MAKE SWITCH A SKIP IF NON-MS
TAD (740000) /(RKB-050) OR A NOP IF IT IS MASS STORAGE
DAC .MSDEV /(RKB-050)
LAC SLOT /(RKB-050) RESTORE AC
.ENDC /(RKB-050)
.IFDEF %DOS15
DAC FW3 /SET UP .ENTER
JMS* .DSK /A DISK?
SNA
JMP FW2 /NO
LAC SLOT /YES
JMS* .FLRA /FILE OPEN FOR RAND. ACC.?
JMP FW2 /YES
LAC SLOT /NO-OPEN DEFAULT FILE IF NO FILE ACTIVE
JMS* .FLTB1
JMP FW6 /FILE ACTIVE-CHECK I/O DIRECTION
DAC FW4 /NO FILE ACTIVE-ADDRESS OF DIR. ENTRY BUFF
/ (RKB-050) DELETE THE FOLLOWING 5 LINES:
/ (RKB-050) LAC* .STADD /ZERO SO .INIT WILL GO THRO IN .FC
/ (RKB-050) DAC FW5
/ (RKB-050) DZM* FW5
/ (RKB-050) LAC* .FW /DAT SLOT
/ (RKB-050) JMS* .FC /INIT FOR OUTPUT
FW3 0 /INTO FW4----.ENTER
4
FW4 0 /BUFFER ADDRESS
.ENDC
FW2 ISZ .FW
LAC* .FW /GET FORMAT ADDRESS. IF A TRANSFER VECTOR,
DAC CC / GO ONE MORE LEVEL OF INDIRECT.
SPA
LAC* CC
JMS .INIFD /INITIALIZE FORMAT DECODER.
JMS .INILB /INITIALIZE LINE BUFFER.
LAW -1 /SET UPPER LIMIT FOR CHARACTER PACKER AS A
TAD .FN / FUNCTION OF LINE BUFFER SIZE.
TAD* .FM
DAC .HILIM
ISZ .FW /EXIT.
JMP* .FW
.IFDEF %DOS15
FW5 0 /TEMP
FW6 SMA /IF AC NEG., FILE ACT. FOR INPUT - ERROR
JMP FW2 /FILE ACTIVE FOR OUTPUT - OK
JMS* .ER /OTS 51
51
.ENDC
.TITLE .FA (.RA) - - ARRAY I/O (RANDOM ACCESS - .RA)
/BCD ARRAY I/O
/ CALLING SEQUENCE -- JMS* .FA (.RA - FOR RAN. ACC.)
/ .DSA ADDRESS OF ADB WORD 5
.RA=. /* RAN. ACC. ENTRY
.FA CAL 0
LAC (.FE /** SET TO JMP TO FORMATTED ELEMENT
DAC .FA3 /** I/O
.FA4 LAC* .FA
DAC WD5 /ADDRESS OF WORD 5 OF ADB
SPA /1 MORE LEVEL?
LAC* WD5 /YES
DAC WD5 /RESTORE
TAD K00004
DAC WD1 /ADDRESS OF WORD 1 OF ADB ( NDIM-1, MODE)
LAC* WD1 /GET ADDRESS INCREMENT - DELTA = NUMBER OF WORDS
AND C00003 /PER DATA ITEM. MASK OUT THE MODE BITS
CMA /CREATE A LAW 1'S COMPLEMENT OF MODE BITS
DAC FA1 /WHICH IS EXECUTED JUST BEFORE CALLING ELEMENT I/O
CMA /ROUTINE. RESTORE MODE BITS.
SAD C00003 /ELEMENT SIZE IS MODE+1, EXCEPT IS 2 IF MODE
LAC C00001 /IS 3
TAD C00001 /MODE 3 IS DOUBLE INTEGER
DAC DELTA
LAC* WD5 /PLACE ADDRESS OF BEGINNING OF ARRAY INTO
DAC FA2 /BCD ELEMENT I/O CALL
ISZ WD1 /BUMP TO POINT TO SIZE WORD
TAD* WD1 /ADD ARRAY SIZE TO GET HIGH ADDRESS LIMIT
DAC LIMIT
FA1 LAW /(LAW -MODE, 1'S COMPLEMENT PUT HERE)
JMS* .FA3 /** CALL BCD EL. I/O ROUTINE
FA2 .DSA 0 / ARGUMENT=ADDRESS OF DATA ITEM.
LAC FA2 /INCREMENT DATA ITEM ADDRESS.
TAD DELTA
DAC FA2
CMA /COMPARE DATA ADDRESS WITH HIGH LIMIT.
TAD LIMIT / IF FA2.LT.LIMIT, GO AGAIN.
SMA / IF FA2.GE.LIMIT, EXIT.
JMP FA1
ISZ .FA
JMP* .FA
.FA3 XX /** HOLDS .FE (FORM.); .DSA .GD (DDIO)
.TITLE .FE (.RE) - - ELEMENT I/O (.RE - RANDOM ACCESS)
/BCD ELEMENT I/O CONTROL
/ CALLING SEQUENCE -- .GLOBL .FE, .RE
/ LAW -MODE 1'S COMPLEMENT
/ JMS* .FE (.RE - FOR RAN. ACC.)
/ CAL ELEMENT ADDRESS (T.V. IF BIT 0 = 1)
/ LAW -MODE, 1'S COMPLEMENT, RETURNED IN AC
/
.RE=. /* RANDOM ACCESS ENTRY
.FE CAL 0
DAC ACSAVE /MODE BITS ARE SAVED
CMA
DAC VRTYP
LAC* .FE /GET STARTING ADDRESS OF DATA ELEMENT
DAC DADD
SPA /IF T.V., ONE MORE LEVEL OF INDIRECT
LAC* DADD / ADDRESSING.
/ AND S77777 /SQUASHES MODE BITS
/ /(RKB-049) ABOVE LINE REMOVED.
DAC DADD
LAC CC /** IF D-D I/O,
SZA /** DON'T USE FORM. DECODER
JMS .FD /GET FORMAT SPECIFICATION
DZM OCTL /CLEAR OCTAL FLAG
LAC .S /CONVERSION CODE TIMES TWO (PLUS ONE FOR
RCL / WRITE)=INDEX VALUE FOR JUMP TABLE.
TAD* .FH
AND S00037 /** MASK 5 BITS
TAD JTABLE
DAC TEMP1
JMP* TEMP1
JTABLE .DSA FE1
FE1 JMP FE50 /I-READ
JMP FE2 /I-WRITE
JMP FE55 /L-READ
JMP FE7 /L-WRITE
FE66AT JMP FE60 /A-READ
JMP FE8 /A-WRITE
JMP FE50O /O-READ
JMP FE2O /O-WRITE
JMP FE51 /D-READ
JMP FE11 /D-WRITE
JMP FE51 /E-READ
JMP FE11 /E-WRITE
JMP FE51 /F-READ
JMP FE23 /F-WRITE
JMP FE51 /G-READ
JMP FE32 /G-WRITE
JMP FE60R /** R-READ
FE8RT JMP FE8R /** R-WRITE
FE99 ISZ .FE
ACSAVE LAW /LAW -MODE PUT HERE, RETURNED IN AC
JMP* .FE
.TITLE BCDIO
/** O-CONVERSION -- WRITE PROCESSOR
FE2O DZM MS
LAC VRTYP
SNA /SKIP IF DOUBLE INTEGER
JMP .+4 /SINGLE INTEGER
LAC* DADD
DAC MS /GET HIGH ORDER
ISZ DADD
LAC* DADD
DAC LS /GET LOW ORDER
LAC .W
TCA /(RKB-051)
DAC POT /SAVE NEGATIVE OF FIELD WIDTH
LAW -15
TAD .W
SPA /SKP IF LDNG. BLANKS NECESSARY
JMP FE2O9
TAD (1
JMS .PBLKS /PACK LDNG. BLANKS
LAW -14
DAC POT /RESET FIELD CNT.
CLC /SET AC=-1
FE2O9 DAC TEMP6 /CHAR. SKP CNT.
JMP FE2O7
FE2O8 LAC OCHR /BIN. VAL. OF OCTAL CHAR.
SZA
JMP FOVFL2 /IF NOT=0, OVER-FLOW
FE2O7 JMS GOCHR /GET OCTAL CHAR.
ISZ TEMP6
JMP FE2O8 /CHK. FOR OVFLO
FE2O6 JMS GETOD /GET OCTAL DIGIT
JMS .PACK
ISZ POT
JMP FE2O6 /GET NXT DIGIT
JMP FE99 /DONE - RTN.
/**
.EJECT
/** I-CONVERSION -- WRITE PROCESSOR
FE2 LAC* DADD
DAC MS
LAC VRTYP /(RKB-053) DON'T FETCH SECOND WORD FOR
SNA /(RKB-053) SINGLE INTEGER OUTPUT
JMP FE2A /(RKB-053) SINCE WE MIGHT RUN OFF THE END
/(RKB-053) NOT A PROBLEM ON PDP-15, SINCE
/(RKB-053) BOOTSTRAP, NOT DATA, WAS AT
/(RKB-053) THE TOP OF PHYSICAL MEMORY.
/(RKB-053) NOT TRUE OF XVM!!
ISZ DADD
LAC* DADD
DAC LS /LD. MS+LS W/ DATA
/(RKB-053)
/(RKB-053) FOLLOWING TWO LINES DELETED:
/ LAC VRTYP
/ SZA /SKP IF S.P. INT.
JMP FE3 /J
FE2A LAC MS /(RKB-053) CONTINUE WITH SINGLE INTEGER
DAC LS
SPA!CLA
CMA
DAC MS
FE3 DZM SIGN /SET TO POS.
LAC MS
SMA
JMP FE4
JMS COMJ /COMPL. D.P. INT.
ISZ SIGN /SET TO MINUS
FE4 LAC (DIGTS
DAC TEMP6 /HOLDS ADDR. OF 1ST DIG.
DZM POT /DIGIT CNTR.
/--DIVIDE BY 10(10) TO GET DEC. DIGITS
FEIL LAC MS
CLL
IDIV
12 /INT. DIV. BY 12(8)
DAC TEMP8
LACQ
DAC MS
LAC LS
LMQ /INTO MQ
LAC TEMP8 /PREVIOUS QUOTIENT
CLL
DIV
12 /FULL DIV. BY 12(8)
DAC* TEMP6 /DEPOSIT IN PROPER DIGIT
ISZ TEMP6
ISZ POT /INCR. DIGIT CNTR.
LACQ
DAC LS
LAC MS
OMQ /INCL. OR AC AND MQ TO CHK. IF BOTH 0
SZA /SKP IF DONE
JMP FEIL /NOT DONE - GO AGAIN
/--CHK. FOR FLD. OVFLO, PK. SIGN AND LEADING BLKS. AND DIGITS
JMS PLBSN /PK. LDNG. BLKS. & SIGN IF NEC.
FEDL CLC
TAD TEMP6
DAC TEMP6 /PTS. TP PROPER DIGIT
LAW 60
TAD* TEMP6 /ASCII FOR DIGIT
JMS .PACK /PK. DIGIT
LAC TEMP6
SAD (DIGTS
JMP FE99 /ALL DIGITS DONE - EXIT
JMP FEDL /NOT DONE - CONTIN.
DIGTS .BLOCK 13
/**
.EJECT
/L-CONVERSION -- WRITE PROCESSOR
FE7 CLC
TAD .W
SPA
JMP FE99 /EXIT IF FIELD WIDTH ZERO OR NEGATIVE.
JMS .PBLKS /PACK (WI1) BLANKS.
LAC* DADD
SNA!CLA
LAW -16 /F CHARACTER TO AC.
TAD S00124 /T CHARACTER TO AC.
JMS .PACK /PACK TO OR F CHARACTER IN BUFFER
JMP FE99 /EXIT
.EJECT
/** R-CONVERSION--WRITE PROCESSOR
FE8R LAW -5
TAD .W
DAC IGCNT /NUM OF LDNG. CHRS. TO BE SKPD.
SKP
/**
/A-CONVERSION -- WRITE PROCESSOR
FE8 DZM IGCNT /** SET TO INDIC. A-CONV.
CLA /CHECK FOR INTEGER TYPE. IF SO,
SAD VRTYP /WILL HAVE TO FAKE BLANKS.
JMP FE8I
LAC* DADD /FIRST DATA TO MS
DAC MS
ISZ DADD
LAC* DADD /SECOND DATA WORD TO LS
FE8IX DAC LS
LAC .W /IF W=0, EXIT
SNA!SPA
JMP FE99
TCA /(RKB-051) NEGATE W FOR A CHARACTER COUNT
DAC POT
LAW -5
TAD .W
SPA!SNA
JMP FE10R /**
JMS .PBLKS /PACK (W-5) BLANKS IF W.GT.5
LAW -5
DAC POT
FE10R LAC IGCNT /** IGCNT MINUS INDIC. R-CONV. W/
SMA /** W .LT. 5
JMP FE9 /** IF NO CHRS. TO BE SKPD., PACK
FE9R JMS DSH7 /** SKP FIRST (5-W) CHRS.
ISZ IGCNT /**
JMP FE9R /**
FE9 JMS DSH7 /ROTATE MS/LS 7 LEFT AND PACK LOW BITS OF
LAC LS / LS. CONTINUE UNTIL CHARACTER COUNT
JMS .PACK / IS ZERO.
ISZ POT
JMP FE9
JMP FE99 /EXIT
FE8I LAC U01004 /FOR EITHER R OR A CONVERSION OF INTEGER, START
DAC MS /WITH BLANKS,AS A CONV. IS A FAKE R CONV.
LAC* TEMP1 /NOW CHECK FOR CONVERSION TYPE.
SAD FE8RT
JMP FE8IR /MATCH, WAS R CONVERSION FOR INTEGER
LAW -5 /FOR A CONVERSION, RIGHT JUSTIFY ONE (IF A1) OR
TAD .W /TWO CHARACTERS IN MS,LS, THEN TREAT AS IF R-
DAC IGCNT /CONVERSION.
LAW -1 /CHECK FOR A1 FORMAT
TAD .W /ADD FIELD WIDTH, IS ZERO OF A1
SNA!CLA!CLL /DEFINE AN EAE LRS TO PUT ONE OR TWO CHARACTERS
LAC S00007 /IN RIGHT OF LS
TAD LRS3 /LRS 3+7 IF A1; LRS 3 OTHERWISE
DAC .+2
LAC* DADD /GET CHARACTER(S)
LRS /RIGHT ADJUST
SKP
FE8IR LAC* DADD /FOR R-CONVERSION, SIMPLY COMPLETE MS,LS PAIR
AND S77776 /AND IMPOSE BLANK REMNANT AT BEGIN OF WORD
JMP FE8IX
LRS3 LRS 3
.EJECT
/D- AND E-CONVERSION -- WRITE PROCESSOR.
FE11 LAC .W /IF W.LT.7, DEFAULT.
TAD K00006
SPA!SNA
JMP FOVFL1 /** FLD. OVFLO
LAW -1 /**
TAD .SF /** CNT INCL. .SF-1
SPA /** IF POS.
CLA /** ELSE, SET TO 0
TAD .D /**
TAD C00002 /**
DAC CNT /** NUM. OF DIGITS (& .) TO BE PRTED.
TAD C00005 /** FOR SIGN AND 'E+00'
TCA /(RKB-051) **
TAD .W /**
SPA /** SKP IF DATA FITS
JMP FOVFL1 /** ELSE, FLD. OVFLO
JMS .PBLKS /IF (W-D).GE.7, PACK (W-D-7) BLANKS
JMS GETPS
JMS PKSGN
LAC CNT /**
TCA /(RKB-051) ** COMPLEMENT FOR COUNTER
DAC CNT /
LAC .D /CALCULATE FRACTION FLAG = -D -1
CMA
DAC FRFLG
LAC .SF /**
SMA!SZA /**
TAD C00001 /** SIGNIF. DIGS. =.D+.SF+1 (.SF .GT. 0)
TAD .D /** =.D+.SF (.SF .LE. 0)
DAC SDFLG /** SIG. DIG. FLG.
FE15 LAC CNT /MANTISSA OUTPUT LOOP. IF CNT=FRFLAG,
SAD FRFLG / PRINT DECIMAL POINT.
JMP FE17
TAD SDFLG /IF /CNT/.GT.SDFLG, PRINT LEADING ZERO
SMA
JMP FE16 /IF /CNT/.LE.SDFLG, PRINT NEXT SIGNIFICANT
LAW 60 / DIGIT.
JMP FE18
FE16 JMS GETDD
JMP FE18
FE17 LAW 56
FE18 JMS .PACK
ISZ CNT /BUMP DIGIT COUNT
JMP FE15
LAW 53 /SET EXPONENT SIGN TO PLUS CHARACTER.
DAC SIGN
DZM DIG1 /ZERO EXPONENT DIGIT 1, AND PLACE ENTIRE
LAC .SF / *** DDS JAN69 ***
TCA /(RKB-051)
TAD POT / *** DDS JAN69 ***
DAC DIG2
SMA /IF EXPONENT IS NEGATIVE, COMPLEMENT IT
JMP FE19 / AND SET EXPONENT SIGN TO MINUS.
TCA /(RKB-051)
DAC DIG2
ISZ SIGN
ISZ SIGN
FE19 TAD K00010 /INTEGER DIVIDE DIG2 BY 10.0 -- QUOTIENT
SPA / TO DIG1, REMAINDER TO DIG2.
JMP FE20
DAC DIG2
ISZ DIG1
JMP FE19
FE20 LAC .S
SAD S00007 /SKP IF NOT G
LAC C00005 /IF G, MAKE E
TAD (100 /MAKE ASCII CHR.
JMS .PACK /PACK E OR D CHR.
LAC SIGN /PACK EXPONENT SIGN.
JMS .PACK
LAW 60 /PACK DIG1 OF EXPONENT.
TAD DIG1
JMS .PACK
LAW 60 /PACK DIG2 OF EXPONENT.
TAD DIG2
JMS .PACK
JMP FE99 /EXIT.
.EJECT
/F-CONVERSION -- WRITE PROCESSOR
FE23 JMS GETPS /SCALE AND ROUND DATA.
LAC POT /SINCE SCALE FACTOR ACTS AS AN ADDITIONAL
TAD .SF /POWER OF TEN FOR F-CONVERSIONS, INCOR-
DAC POT /PORATE SF INTO POT.
SPA!SNA /DETERMINE THE LENGTH OF THE NUMERIC FIELD
LAC C00001 /INCLUDING DECIMAL POINT --
TAD C00001 /POT+D+1 IF DATA.GE.(1.0)
TAD .D /D+2 IF DATA.LT.(1.0)
TCA /(RKB-051) NEGATE FOR USE AS A LOOP COUNTER (DIG2)
DAC DIG2
LAC SIGN /**
SZA /** SKP IF PLUS
LAW -1 /**
TAD DIG2
TAD .W /IF LENGTH OF NUMERIC FIELD EXCEEDS THE
SPA /** .W, GO TO FIELD OVFLO ROUTINE
JMP FOVFL3 /** FIELD OVERFLO
JMS .PBLKS
LAC SIGN /**
SZA /** IF PLUS, DON'T PACK
JMS PKSGN /**
LAC .D /SET FLG. (DPOS) TO INDIC. WHERE THE
CMA /DECIMAL POINT SHOULD BE OUTPUT
DAC DPOS
FE28 LAC DIG2 /NUMERIC OUTPUT LOOP -- IF LOOP COUNTER IS
SAD DPOS /SAME AS DECIMAL POINT FLAG (DIG2=DPOS),
JMP FE29 /OUTPUT DECIMAL POINT.
LAC POT /EXAMINE SCALE FACTOR. IF NEGATIVE OR
ISZ POT /ZERO, DATA.LT.(1.0) AND A LEADING ZERO
SPA!SNA /IS PRINTED. SCALE FACTOR IS INCREMENTED
JMP FE30 /ONE FOR NEXT PASS THROUGH LOOP.
JMS GETDD /GET NEXT DECIMAL DIGIT FROM FLOATING AC.
JMP FE31
FE29 LAW 56 /ASCII-7 DECIMAL POINT.
JMP FE31
FE30 LAW 60 /ASCII-7 ZERO
FE31 JMS .PACK /PACK CHARACTER IN OUTPUT BUFFER AND TEST
ISZ DIG2 /FOR END OF LOOP.
JMP FE28
LAC S2 /EXAMINE CONVERSION TYPE TO DETERMINE
TAD K00006 /EXIT LOCATION.
SMA!SZA
JMP FE33 /REENTER G-CONVERSION
JMP FE99 /EXIT TO CALLING PROGRAM.
.EJECT
/G CONVERSION -- WRITE PROCESSOR
FE32 JMS GETPS /GET POWER OF TEN AND SIGN
LAC POT /IF POT.LT.0, GO TO E-CONVERSION.
SPA
JMP FE11 / *** DDS JAN69 ***
TCA /(RKB-051) IF POT .GT. D, GO TO E-CONVERSION
TAD .D
DAC DIG1
SPA
JMP FE11 / *** DDS JAN69 ***
LAC .SF /IF 0.LE.POT.LE.D, SAVE SF, W, AND D. GO
DAC TEMP1 / TO F-CONVERSION WITH SF=0, W=(W-4),
LAC .W / AND D=(D-POT).
DAC TEMP2
LAC .D
DAC TEMP3
DZM .SF
LAW -4
TAD .W
DAC .W
LAC DIG1
DAC .D
LAC C00006
DAC .S
JMP FE23
FE33 LAW 4 /ON RETURN FROM F-CONVERSION PROCESSOR,
JMS .PBLKS / OUTPUT 4 BLANKS AND RESTORE SF, W, AND
LAC TEMP1 / D TO THEIR ORIGINAL VALUES.
DAC .SF
LAC TEMP2
DAC .W
LAC TEMP3
DAC .D
ISZ .S
JMP FE99 /EXIT
.EJECT
/ROUND AND SCALE DECIMAL DATA
/ CALLING SEQUENCE -- JMS GETPS
GETPS CAL 0
DZM OVFFLG
DZM SIGN /SET SIGN POSITIVE.
DZM POT /SET POWER-OF-TEN TO ZERO.
.IFDEF %FPP
FZR
0
.ENDC
.IFUND %FPP
DZM* .AA /CLEAR FLOATING ACCUMULATOR
DZM* .AB
DZM* .AC
.ENDC
LAW -6 /TEST CONVERSION-TYPE. SET NRZ=0 IF
TAD .S /F, ELSE SET NRZ=1. .S IS 6 IF F TYPE
SZA /REMAIN ZERO IF F TYPE
LAC C00001
DAC NRZ
LAC VRTYP /LOAD VARIABLE ON BASIS OF MODE TYPE
SAD C00002 /NOT ON BASIS OF CONVERSION
JMP GET03 /GO DO D.P. LOAD
FLD% .AG /SINGLE PRECISION LOAD
.DSA DADD+400000
JMP GET06
.IFDEF %FPP
GET03 DLD /DOUBLE PRECISION LOAD
.ENDC
.IFUND %FPP
GET03 JMS .FAO /D.P. LOAD INTO FLOATING ACCUMULATOR
.ENDC
.DSA DADD+400000
/COMMON ROUTINE
.IFDEF %FPP
GET06 BZA /BR IF FPP AC=0
GET17 /ZERO EXIT IMMED
BPA /BR IF POS.
GET07
ISZ SIGN /IF NEG. SET FLAG
FAB /MAKE FPP POS.
0
GET07 DST /STORE FPP AC IN WORKING
FP2 /REGISTERS FOR SCALING MANIPULATION
LAC FP2
SPA!SNA
JMP GET10 /DATA IN FPP AC MUST BE SCALED
DAC TMPFAC /SO THAT 0.100000 .LE.
DST /FPP AC .LE. 0.999999
FPH2 /(WHICH IS -3/31463146 .LE.
DLD /FPP AC .LE. +0/3777777....
DBLONE /IN FLT. PT. NOTATION) SO THAT
DST /MULT. BY TEN YIELDS FIRST
FP2 /DIGIT. IN ORDER TO AVOID MANY
GET08 LAC TMPFAC /DIVS. BY 10, THE FPP AC IS
CMA /SAVED IN FPH2 AND FPP AC IS USED
TAD FP2 /TO BUILD A SING. DIVISOR (POW. OF 10)
SMA /AFTER SCALING, POT CONTAINS POWER OF
JMP GET09 /TEN USED IN DIVISION
ISZ POT
JMS .MPYTN /MULT. FPP AC BY 10
DST /REST. TEMP FPP AC FOR EXP. TST
FP2
JMP GET08
GET09 URDRD /DIV. SAVED FPP AC BY FPP AC (NOW
FPH2 /APPROPRIATE POWER OF TEN)
GET10 DST /RESULT IS NOT ROUNDED. LD. FPP AC
FP2 /INTO TEMPS FOR MANIP.
LAC C00003 /AFTER SCALING, IF EXPON. OF DATA
TAD FP2 /IS NEG., FPP AC IS CHKD. FOR
SPA /.LT. 0.1 (-3/31463146..) IF SO
JMP GET11 /FPP AC IS MULT BY TEN AND POT
SZA /IS DECREM. BY ONE. IF NOT,
JMP GET12 /SCALING IS COMPLETE AND DATA CAN
LAC FP3 /BE ROUNDED OFF.
TAD TESTB
SPA
JMP GET11
SZA
JMP GET12
LAC FP4
TAD TESTC
SMA!SZA
JMP GET12
.ENDC
.IFUND %FPP
GET06 LAC* .AB /CHECK FOR NEGATIVE NUMBER.
SNA
JMP GET17 /Y ZERO, EXIT IMMEDIATELY
SMA
JMP GET07
AND V77777 /IF MANTISSA IS NEGATIVE, EXTRACT OFF THE
DAC* .AB / SIGN BIT AND SET SIGN TO MINUS.
SNA /EXIT WITH 0.0 IN CASE OF -0.0
JMP GET17
ISZ SIGN
GET07 LAC* .AA /THE DATA NOW IN FAC MUST BE SCALED SO
SPA!SNA / THAT 0.100000.3E.FAC.3E0.999999 (WHICH
JMP GET10 / IN FLOATING POINT POTATION IS
DAC TMPFAC / -3/31463146...LE.FAC.LE.+0/3777777...)
JMS* .CF / SO THAT MULTIPLYING BY 10 YIELDS FIRST
JMS .FAO / DIGIT. IN ORDER TO AVOID INNUMERABLE
.DSA DBLONE / DIVISIONS BY TEN IN THE CASE WHERE THE
GET08 LAC TMPFAC / EXPONENT IS LARGER AND POSITIVE, THE
CMA / FAC IS SAVED IN TMPFAC AND THE FAC IS
TAD* .AA / USED TO BUILD A SINGLE DIVISOR WHICH
SMA / IS A POWER OF TEN. AFTER SCALING POT
JMP GET09 / CONTAINS THE POWER OF TEN THAT WAS
ISZ POT / USED IN THE DIVISION.
JMS .MPYTN
JMP GET08
GET09 JMS* .CI /FAC=HAC/FAC
.DSA -44
.DSA 1 / *** DDS FEB69 ******WAD MAY 69 ***
JMS* .CH /ROUND AND SIGN
.DSA 0 / *** DDS FEB69 ***
.DSA -1 / *** DDS FEB69 ***
GET10 LAC C00003 /AFTER SCALING POSITIVE EXPONENTS BY DIVI-
TAD* .AA / SION OR IF THE EXPONENT OF THE DATA IS
SPA / NEGATIVE, THE FAC IS CHECKED IF IT IS
JMP GET11 / LESS THAN 0.1 (-3/31463146....).
SZA / IF SO, FAC IS MULTIPLIED BY 10 AND POT
JMP GET12 / DECREMENTED BY ONE. IF NOT, SCALING
LAC* .AB / IS COMPLETE AND THE DATA IS READY TO
TAD TESTB / BE ROUNDED OFF.
SPA
JMP GET11
SZA
JMP GET12
LAC* .AC
TAD TESTC
SMA!SZA
JMP GET12
.ENDC
GET11 CLC
TAD POT
DAC POT
JMS .MPYTN
JMP GET10
TESTB .DSA 463147
TESTC .DSA 314632
/ROUND-OFF ROUTINE
GET12 LAC NRZ /AT THIS TIME NRZ IS A FLAG USED TO DETER-
SPA / MINE WHICH FORMULA IS TO BE USED TO
JMP GET17 / CALCULATE WHICH ROUNDING VALUE IS TO
SNA / BE ADDED TO FAC.
JMP GET14
LAC .SF /D, E, OR G-CONVERSION. NRZ=D+1 IF SF.GT.0
SMA!SZA / NRZ=D+SF IF SF.LE.0
LAC C00001
TAD .D
JMP GET15
GET14 LAC .SF /F-CONVERSION. NRZ=D+POT+SF
TAD POT
TAD .D
GET15 SPA!CMA / *** DDS FEB69 ***
JMP GET17 / DECIMAL DIGITS (MINUS ONE) THAT ARE TO
DAC GET30 / *** DDS JAN69 ***
.IFDEF %FPP
DST /TEMP. STORE FO SCALED FPP AC
GET31
DLD
C00002
GET32 ISZ GET30
SKP
JMP GET33
JMS .MPYTN
JMP GET32
GET33 FNM /NORM. FPP AC BECAUSE MPYTEN DOESN'T
0
DRD /DIV. 1 BY (2*TEN**APPROP. POWER)
DBLONE /WHICH IS IN FPP AC
DAD /ADD SCALED DATA TO APPRO. POWER
GET31 /OF TEN TIMES .5 FOR ROUNDING
DST /TEST EXPON. FOR OVFLO ONLY
FP2 /OVFLO THAT CAN OCCUR THAT MAKE FPP
LAC FP2 /TOO
SPA!SNA
.ENDC
.IFUND %FPP
JMS .FAP / *** DDS JAN69 ***
.DSA GET31 / *** DDS JAN69 ***
JMS .FAO / *** DDS JAN69 ***
.DSA C00002 / *** DDS JAN69 ***
GET32 ISZ GET30 / *** DDS JAN69 ***
SKP / *** DDS JAN69 ***
JMP GET33 / *** DDS JAN69 ***
JMS .MPYTN / *** DDS JAN69 ***
JMP GET32 / *** DDS JAN69 ***
GET33 JMS .FAP / *** DDS JAN69 ***
.DSA GET34 / *** DDS JAN69 ***
JMS .FAO / *** DDS JAN69 ***
.DSA DBLONE / *** DDS JAN69 ***
JMS* .CF / *** DDS JAN69 ***
JMS .FAO / *** DDS JAN69 ***
.DSA GET34 / *** DDS JAN69 ***
JMS* .CI / *** DDS JAN69 ***
.DSA -44 / *** DDS JAN69 ***
.DSA 1 / *** WAD SEPT69 ***
JMS* .CH / *** DDS JAN69 ***
.DSA 0 / *** DDS FEB69 ***
.DSA -1 / *** DDS FEB69 ***
JMS FAQ / *** DDS JAN69 ***
.DSA GET31 / *** DDS JAN69 ***
LAC* .AA /CHECK FAC FOR OVERFLOW. THE ONLY OVER-
SPA!SNA / FLOW THAT CAN OCCUR THAT MAKE FAC TOO
.ENDC
JMP GET17 / BIG (.GT. 0.9999...) IS BY ONE BIT.
LAC C00001 / IN THIS CASE, A FLAG(OVFFLG) IS SET
DAC OVFFLG / FOR THE GETDD ROUTINE INDICATING THAT
ISZ POT / THE FIRST DECIMAL DIGIT IS A ONE. THE
NOP
GET17 JMP* GETPS / REFLECT THE EXTRA DIGIT.
GET31 .DSA 0 / *** DDS JAN69 ***
.DSA 0 / *** DDS JAN69 ***
.DSA 0 / *** DDS JAN69 ***
GET30 .DSA 0 / *** DDS JAN69 ***
C00002 .DSA 2 / *** DDS JAN69 ***
.DSA 200000 / *** DDS JAN69 ***
.DSA 0 / *** DDS JAN69 ***
.IFUND %FPP
GET34 .DSA 0 / *** DDS JAN69 ***
.DSA 0 / *** DDS JAN69 ***
.DSA 0 / *** DDS JAN69 ***
.ENDC
.EJECT
/** PACK LEADING BLANKS AND SIGN
/CALLING SEQUENCE--
/ JMS PLBSN
PLBSN 0
LAC .W /FLD. WIDTH
CMA
TAD POT
TAD SIGN /=0, + (NOT OUTPUT); =1, -
SMA /AC= -(.W+1)+POT+SIGN
JMP FOVFL2 /FIELD OVFLO
CMA
JMS .PBLKS /PACK BLKS.
LAC SIGN
SZA /SKP IF PLUS
JMS PKSGN /PK. SIGN
JMP* PLBSN
/**
.EJECT
/GET DECIMAL DIGIT
/ CALLING SEQUENCE -- JMS GETDD
GETDD CAL 0
LAC OVFFLG /CHECK OVERFLOW FLAG SET IN GETPS ROUTINE.
SNA / IF SET, FIRST DIGIT IS A ONE AND
JMP GET20 / FLOATING ONE IS SUBTRACTED FROM FAC.
DAC DIG
DZM OVFFLG
JMP GET23
GET20 JMS .MPYTN /MULTIPLY FAC BY 10 TO EXTRACT THE NEXT
DZM DIG / DECIMAL DIGIT.
.IFDEF %FPP
LAC FP5
.ENDC
.IFUND %FPP
LAC* .AA
.ENDC
SPA!SNA
JMP GET22 /IF FAC EXPONENT.LE.ZERO, DIGIT IS A ZERO.
TCA /(RKB-051) IF FAC EXPONENT .GT. 0, THE EXPONENT
DAC BCNT / IS COMPLEMENTED TO USE AS A SHIFT
JMS DSHL / COUNTER TO SHIFT THE INTEGER BITS OF
GET21 JMS DSHL / MS/LS INTO DIG
LAC DIG
RAL
DAC DIG
ISZ BCNT
JMP GET21
JMS DSHR
GET22 JMS TRMSLS
.IFDEF %FPP
UNDST /UNNORM. STORE
FP2
DZM FP2
UNDLD
FP2
.ENDC
.IFUND %FPP
DZM* .AA
.ENDC
LAW 60 /EXIT IS TAKEN WITH THE ASCII-7 CODE OF
XOR DIG / THE DECIMAL DIGIT IN THE AC.
JMP* GETDD
.IFDEF %FPP
GET23 UNDST
FP2
LAC FP3
AND T77777
DAC MS
LAC FP4
DAC LS
.ENDC
.IFUND %FPP
GET23 LAC* .AB /MS/LS=FAC-1.0
AND T77777
DAC MS
LAC* .AC
DAC LS
.ENDC
JMS DSHL
JMP GET22
.EJECT
/** GET OCTAL CHAR.
/CALLING SEQUENCE--
/ JMS GOCHR
GOCHR 0
LAW -3
DAC OCTL /CNTR.
DZM OCHR
GCH1 JMS DSHL /SHIFT MS+LS 1 LEFT
LAC OCHR
RAL /ROTATE BIT INTO AC
DAC OCHR
ISZ OCTL
JMP GCH1
JMP* GOCHR /IN OCHR AND AC
/**
.EJECT
/**GET OCTAL DIGIT
/CALLING SEQUENCE--
/ JMS GETOD
GETOD 0
LAC OCHR
XOR S00060
DAC TEMP6
JMS GOCHR
LAC TEMP6
JMP* GETOD
/**
.EJECT
/** O-CONVERSION -- READ PROCESSOR
FE50O LAW -1 /** SET TO INDIC. OCTAL
DAC OCTL
JMS RDEXTO /RD. EXT. FLD. AS OCTAL
JMP FE501
/**
/I-CONVERSION -- READ PROCESSOR.
FE50 JMS RDEXT /READ CONTENTS OF EXTERNAL FIELD. IF
DZM OCTL /** CLR. OCTAL FLG.
FE501 LAC SFFLG /SFFLG AND DPOS ARE NOT BOTH ZERO
TAD DPOS /AN ILLEGAL CHARACTER IS IN THE INPUT
SNA /**
JMP FE502 /** EXT.FLD. OK
BDTA DZM LS /** ILL. - SET TO 0
DZM MS /**
FE502 LAC SIGN /** IF NUM. NEG., CMPL.
RAR /**
LAC VRTYP /**
SAD C00003 /** SKP IF NOT J (ASSUME I)
JMP FE503 /**
LAC LS
SZL
TCA /(RKB-051)
DAC* DADD /STORE INTEGER IN MEMORY.
JMP FE99 /EXIT.
FE503 SZL /** J MODE - SKP IF POS. NUM.
JMS COMJ /** NEG. NUM., COMPLEMENT
LAC MS /**
DAC* DADD /** DEPOSIT NUM.
ISZ DADD /**
LAC LS /**
DAC* DADD
JMP FE99 /**
.EJECT
/** COMPLEMENT D.P. INT. (IN MS+LS)
COMJ 0
LAC LS
CMA!CLL
TAD C00001
DAC LS
LAC MS
CMA!SZL /SKP IF NO LS OVFLO
TAD C00001
DAC MS
JMP* COMJ
.EJECT
/**
/D- E- F- AND G-CONVERSIONS -- READ PROCESSOR
FE51 JMS RDEXT /READ EXTERNAL INPUT FIELD
LAC SFFLG /IF THERE WAS NO DECIMAL SCALE FACTOR,
SZA / TRANSFER MS+LS INTO FAC AND SET SCALE
JMP FE515 / FACTOR (LS) TO ZERO.
JMS TRMSLS
DZM LS
.IFDEF %FPP
FE515 UNDST
FP1
LAC C00035
DAC FP1
DLD
FP1
.ENDC
.IFUND %FPP
FE515 LAC C00035 /CONVERT RAW INTEGER MANTISSA TO FLOATING
DAC* .AA / POINT.
JMS* .CD
.ENDC
LAC FRFLG /CALCULATE MULTIPLIER POWER OF TEN = DECI-
TCA /(RKB-051) MAL SCALE FACTOR (LS) MINUS NUMBER OF
TAD LS / DIGITS AFTER DECIMAL POINT (SFFLG)=POT.
DAC POT
SNA
JMP FE54 /IF POT=0, FAC OK AS-IS.
SMA
JMP FE52 /IF POT.GT.0, MULT. FAC BY TEN (POT) TIMES.
.IFDEF %FPP
UNDST
FPH2
DLD
DBLONE
.ENDC
.IFUND %FPP
JMS* .CF /IF POT.LT.0, SAVE FAC IN HAC AND LOAD 1.0
JMS .FAO / INTO FAC --THEN MULTIPLY FAC BY TEN
.DSA DBLONE / (-POT) TIMES TO OBTAIN DIVISOR.
.ENDC
LAC POT
SKP
FE52 TCA /(RKB-051)
DAC CNT
FE53 JMS .MPYTN
.IFDEF %FPP
FNM
0 /UNUSED
.ENDC
ISZ CNT
JMP FE53
LAC POT /IF POT.GT.0, CONVERSION IS NOW COMPLETE.
SMA /IF POT.LT.0, CONVERSION IS COMPLETED BY
JMP FE54 / DIVIDING HAC BY FAC.
.IFDEF %FPP
DRD
FPH2
.ENDC
.IFUND %FPP
JMS* .CI
.DSA -44
.DSA 1 / *** WAD SEPT69 ***
.ENDC
FE54 LAC SIGN /SET ,CE = SIGN OF CONVERTED NUMBER.
SZA / BIT 0 = 0 PLUS
.IFDEF %FPP
FNG /NEGATE
NOP
.ENDC
.IFUND %FPP
LAC W00000 / BIT 0 = 1 MINUS
DAC* .CE
JMS* .CH /ROUND OFF FAC LOW BIT AND INSERT SIGN.
.DSA 0 / *** DDS FEB69 ***
.DSA -1 / *** DDS FEB69 ***
.ENDC
LAC VRTYP /STORING IS BASED ON MODE TYPE, NOT
SAD C00002 /CONVERSION TYPE
JMP FE545 /GO DO D.P. STORE
URFST% .AH
.DSA DADD+400000
JMP FE99
.IFDEF %FPP
FE545 UNDST
.ENDC
.IFUND %FPP
FE545 JMS .FAP /STORE DOUBLE
.ENDC
.DSA DADD+400000
JMP FE99
.EJECT
/L-CONVERSION -- READ PROCESSOR
FE55 LAC .W /SET COUNTER TO (W+1)
CMA
DAC CNT
DZM SIGN /SET INITIAL CONDITION TO FALSE.
FE56 ISZ CNT
SKP
JMP FE58
JMS READ. /READ EXTERNAL CHARACTERS UNTIL THE FIRST
SAD S00040 / NON-BLANK CHARACTER.
JMP FE56
SAD S00124
ISZ SIGN /IF FIRST NON-BLANK CHARACTER IS A (T),
FE57 ISZ CNT / SET CONDITION TRUE.
SKP
JMP FE58
JMS READ. /READ AND IGNORE ALL REMAINING CHARACTERS
JMP FE57 / IN THE EXTERNAL FIELD.
FE58 LAC SIGN /IF INPUT IS TRUE, STORE 777777 IN MEMORY.
SZA /IF INPUT IS FALSE, STORE ZERO IN MEMORY.
CLC
DAC* DADD
JMP FE99 /EXIT.
.EJECT
/** R-CONVERSION -- READ PROCESSOR
FE60R LAC .W
TCA /(RKB-051)
DAC IGCNT
TAD C00005
SPA!SNA
/**
/A-CONVERSION -- READ PROCESSOR
FE60 DZM IGCNT /** INDIC. A-CON. OR W .GE. 5
LAC JMP0 /** INIT. JMP INSTRUC. AND CHAR.
DAC FE65 / COUNTER.
DZM CHCT
LAC .W /IF FIELD WIDTH.LE.0, EXIT IMMEDIATELY.
SPA!SNA
JMP FE99
TCA /(RKB-051)
DAC CNT
FE63 JMS READ. /FETCH EXTERNAL 7-BIT CHARACTER, ROTATE
FE64 JMS DSH7 / MS+LS 7 LEFT, AND MERGE CHARACTER INTO
AND Z77600
XOR .CHAR / LS.
DAC LS
ISZ CHCT
ISZ CNT /CONTINUE UNTIL ALL CHARACTERS HAVE BEEN
FE65 JMP 0 / READ AND PACKED.
LAW -5 /CHECK CHARACTER COUNT AND IF LESS THAN
TAD CHCT / FIVE CHARACTERS HAVE BEEN PACKED, PACK
SMA / BLANKS UNTIL MS+LS IS FULL.
JMP FE66R /** CHK. IGCNT
DAC CNT
ISZ FE65
LAC S00040
DAC .CHAR
JMP FE64
FE66R LAC IGCNT /** IGCNT = 0 IF A-CONV. OR IF
SNA /** W .GE. 5
JMP FE66 /** NO SKPNG. - GET FIRST CHAR. IN PR.
JMS DSHL /**SHIFT EXTRA BIT OFF
FE67R JMS DSH7 /** SHIFT LEFT ONE CHAR.
LAC LS
AND S00177
RCL
DAC TEMP8
LAC LS
AND Z77400
XOR TEMP8
DAC LS
ISZ IGCNT /** UNTIL BLKS. ON LEFT
JMP FE67R /**
SKP
FE66 JMS DSHL /LEFT JUSTIFY TO 5/7 ASCII FORMAT
LAC VRTYP /IF THE VARIABLE IS AN INTEGER, WILL
SZA /TAKE SPECIAL TREATMENT
JMP FE66T /NOT AN INTEGER
LAC* TEMP1 /R CONVERSION?
SAD FE66AT
JMP FE66A /NO, A CONV.
LAC LS /FOR R CONVERSION OF INTEGER,ONLY THE
AND S77776 /LAST TWO CHARACTERS ARE TAKEN, RIGHT
JMP FE66S /JUSTIFIED, WITH BLANK REMNANT IN BITS 0-3
FE66A LAW -3 /FOR A-CONVERSION, GET RIGHTMOST 1 OR 2 CHARCTERS
TAD .W /AND SHIFT LEFT
SPA /FIELD WIDTH: 1 2 3 4 5 6 7 . . .
JMP FE66A1 /SHIFT LEFT: 0 0 1 2 3 3 3 . . .
TAD K00003 /WHEN .W IS 3 OR GREATER, NUMBER OF SHIFTS
SMA /IS LIMITED TO THREE.
CLC
TAD C00003 / RECOVER 0, 1, 0R 2, OR FORCE 2
CMA /EFFECTIVE 2'S COMPLEMENT OF NUMBER OF SHIFTS
DAC CNT
JMS DSH7 /SHIFT LEFT REQUIRED NUMBER OF TIMES
ISZ CNT /THUS PUT RIGHTMOST OF FIELD OF WIDTH 3 OR
JMP .-2 /LARGER INTO MS,LS LEFT JUSTIFIED.
FE66A1 LAC MS /ONLY THE
AND Z77760 /FIRST TWO CHARACTERS ARE TAKEN, WITH
XOR S00004 /BLANK REMNANT IN LAST 4 BITS.
JMP FE66S
FE66T LAC MS /STORE BCD WORD PAIR IN OBJECT MEMORY.
DAC* DADD
ISZ DADD
LAC LS
FE66S DAC* DADD
JMP FE99 /EXIT
JMP0 JMP FE63
.EJECT
/** READ EXTERNAL FIELD AS OCTAL
/CALLING SEQUENCE--
/ JMS RDEXTO
RDEXTO 0
LAC RDEXTO /** LD. RDEXT SUB. FOR RTN.
DAC RDEXT
LAC (JMS OMPTN /** LD. JMP TO OCTAL MULT.
DAC RDEX25
JMP RDXO /** JMP INTO RDEXT ROUTINE
/**
/READ EXTERNAL FIELD
/ CALLING SEQUENCE -- JMS RDEXT
RDEXT CAL 0 /THIS SUBROUTINE INPUTS AN EXTERNAL LINE
LAC (JMS IMPTEN /** LD. JMP TO DEC. MULT.
DAC RDEX25 /**
RDXO DZM SIGN /BUFF. FLD. OF LNGTH. W. AT EXIT
DZM SEXP / THE FOLLOWING ITEMS HAVE BEEN DETER-
DZM MS / MINED--
DZM LS / (1) SFFLG=0 IF THE FIELD WAS A RIGHT-
DZM POT / JUSTIFIED NUMBER WITH OR WITHOUT
DZM DPOS / A DECIMAL POINT AND THE INTEGER
DZM SFFLG / VALUE OF THE DIGITS IS IN MS+LS.
DZM CRAMFL
LAC .W / (2) SFFLG.NE.0 FOR ALL OTHER CASES
CMA / AND THE INTEGER VALUE IS IN THE
DAC BCNT / FLOATING ACCUMULATOR (UNNORMAL-
/ / IZED) AND LS CONTAINS THE DECI-
/ / MAL SCALE FACTOR.
/ / (3) FRFLG = POWER OF TEN THAT MUST
/ / BE DIVIDED INTO THE INTEGER TO
/ / REDUCE THE INTEGER VALUE OF THE
/ / NUMBER TO THE CORRECT FLOATING
/ / VALUE.
/ / (4) DPOS = 0 WHEN NO DECIMAL POINT
/ / HAS BEEN ENCOUNTERED IN THE
/ / EXTERNAL FIELD.
/ / (5) SIGN = 0, NUMBER IS POSITIVE.
/ / SIGN.NE.0, NUMBER IS NEGATIVE.
RDEX1 JMS BREAD /FETCH LINE BUFFER CHARACTER.
SAD S00053
JMP RDEX1 /IF CHARACTER IS PLUS SIGN.
SAD S00055
JMP RDEX4 /IF CHARACTER IS MINUS SIGN.
SAD S00056
JMP RDEX35 /IF CHARACTER IS DECIMAL POINT.
JMS .NMTST /TEST FOR FIRST NUMBER.
JMP RDEX1 / NO, FETCH NEXT CHARACTER.
SNA /IS IT A LEADING 0
JMP RDEX1 /YES. IGNORE
DAC LS / YES, COMPLETE NUMERIC CONVERSION.
AND S00010 /** =0 IF LEGAL OCTAL NUM.
AND OCTL /** =0, DEC.; =-1, OCTAL
SZA /** SKP IF OK
JMP BDTA /** O NM., NON-0 MD.:SET NM. TO 0
RDEX2 JMS BREAD
JMS .NMTST /IS CHARACTER A NUMBER.
JMP RDEX3 / NO, TEST FOR DECIMAL POINT.
RDEX25 JMS IMPTEN / YES, 10*LS+NUMBER TO LS.
JMP RDEX2
RDEX14 LAC CRAMFL /CR OR ALTMODE?
SZA
JMP RDEX15 /YES. DON'T STORE TRAILING 0'S
/BUMP DPOS ANYWAY
JMP RDEX25 /NO. CONTINUE
RDEX3 SAD S00056
JMP RDEX35 /BLANKS TREATED AS ZEROS
SAD S00040
SKP!CLA
JMP RDEX5
JMP RDEX14 /NOT DECIMAL POINT -- END OF CONVERSION.
/MAY HAVE HIT A CR OR ALT. CHECK ABOVE IN RDEX14
RDEX35 LAC BCNT /IF DECIMAL POINT, SAVE ITS POSITION AND
DAC DPOS / CONTINUE WITH NUMERIC CONVERSION.
JMP RDEX2
RDEX4 ISZ SIGN
JMP RDEX1
RDEX5 LAC BCNT /SAVE POSITION OF CHARACTER TERMINATING
DAC SFFLG / MANTISSA FIELD AND TRANSFER INTEGER
JMS TRMSLS / VALUE OF MANTISSA TO THE FLOATING AC.
/EXPONENT FIELD
DZM LS
DZM .SF /IGNORE P-FORMAT SPEC WHEN EXP. IN EXT. FIELD
LAC .CHAR
RDEX6 SAD S00053 /IF CHAR=PLUS, IGNORE IT.
JMP RDEX8
SAD S00055 /IF CHAR=MINUS, SET SIGN OF EXPONENT.NE.0.
JMP RDEX7
JMS .NMTST /IS CHAR A NUMBER.
JMP RDEX8 / NO, CONTINUE.
JMP RDEX9 / YES, COMPLETE NUMERIC CONVERSION.
RDEX7 ISZ SEXP
RDEX8 JMS BREAD
JMP RDEX6
RDEX9 DZM MS
DAC LS
RDEX10 JMS BREAD /GET NEXT CHARACTER
JMS .NMTST /IS CHAR A NUMBER.
JMP RDEX11 / NO, END OF CONVERSION.
JMS IMPTEN / YES, LS=10*LS+NUMBER
JMP RDEX10
RDEX11 JMS BREAD /READ CHARACTERS UNTIL BREAD EXITS.
JMP RDEX11
RDEX12 LAC DPOS
SNA!CMA /DECIMAL PT HIT?
JMP RDEX13 /NO ADJUST FRFLG
TAD SFFLG /YES OVERRIDE FMAT. SPEC
JMP RDEX16
RDEX13 LAC .D /NO. OF DECIMAL DIGITS SPEC.
TAD CRAMFL /BCNT AT CR OR ALT. OCCURANCE
RDEX16 TAD .SF /ALLOW FOR EXPLICIT P-FORMAT SPEC
DAC FRFLG /POWER OF 10 RAW MANTISSA IS TO BE DIVIDED BY
LAC SEXP /COMPL. IF SIGN OF EXPONENT IS NEG.
SNA
JMP RDEX17
LAC LS
TCA /(RKB-051)
DAC LS
JMP RDEX17 /EXIT
RDEX15 LAC DPOS /BUMP DPOS IN CASE CR OR ALT
SZA /DPOS=0 IF NI DECIMAL PT IN EXTER. FIELD
ISZ DPOS /DECIMAL PT FOUND
RDEX20 NOP /FALL THROUGH - (USED AS CONSTANT IN .FF)
JMP RDEX2 /DON'T STORE TRAILING 0'S ANYWAY
/SINCE CR OR ALT HIT
RDEX17 LAC SFFLG
SZA
JMP RDEX18
LAC MS
SZA /WAD ADD.
JMP RDEX19 /WAD ADD.
TAD LS
JMP RDEX19
.IFDEF %FPP
RDEX18 BNA
RDEX19
CLA
RDEX19 SNA /RDEX19 FROM RDEX17+5 & RDEX17+7
DAC SIGN /ZERO SIGN IN CASE 0.0
JMP* RDEXT
.ENDC
.IFUND %FPP
RDEX18 LAC* .AB
SZA / WAD ADD. TO 016 FOR DOS-15 TAF
JMP RDEX19 / WAD ADD. TO 016 FOR DOS-15 TAF
TAD* .AC
RDEX19 SNA
DAC SIGN
JMP* RDEXT /EXIT
.ENDC
.EJECT
/BUMP BCNT, TEST FOR ZERO, AND FETCH CHARACTER.
/ CALLING SEQUENCE -- JMS BREAD
BREAD CAL 0
ISZ BCNT
SKP /FIELD WIDTH NOT EXHAUSTED
JMP RDEX12
JMS READ. /FETCH LINE BUFFER CHAR
JMP* BREAD
.EJECT
/TRANSFER MS/LS TO .AB/.AC
/ CALLING SEQUENCE -- JMS TRMSLS
TRMSLS CAL 0
.IFDEF %FPP
UNDST
FP6
LAC MS
AND V77777
DAC FP7
LAC LS
DAC FP8
UNDLD
FP6
.ENDC
.IFUND %FPP
LAC MS
AND V77777
DAC* .AB
LAC LS
DAC* .AC
.ENDC
JMP* TRMSLS
.IFDEF %FPP
FP6 0
FP7 0
FP8 0
.ENDC
.EJECT
/MULTIPLY FLOATING ACCUMULATOR BY TEN. 74 OR 89 USEC.
/ CALLING SEQUENCE -- JMS .MPYTN (77.0 USEC AVG)
.IFDEF %FPP
.MPYTN 0
UNDMP /UNNORM., MULT.
MPY1
UNDST /LD. MS,LS
FP5
JMP* .MPYTN
MPY1 000004 /FLT. 10
240000
0
.ENDC
.IFUND %FPP
.MPYTN CAL 0
LAC* .AB /GET MS AND LS
DAC MS
LAC* .AC
DAC LS
JMS DSHR /SHIFT MS/LS 2 RIGHT AND ADD ORIGINAL
JMS DSHR / CONTENTS.
GLK
TAD* .AC
TAD LS
DAC LS
GLK
TAD* .AB
TAD MS
DAC MS
SMA!CLA /IF OVERFLOW, SHIFT ANSWER 1 RIGHT.
JMP MPY1
JMS DSHR
LAC C00001
MPY1 TAD C00003 /ADD 3 OR 4 TO EXPONENT DEPENDING ON
TAD* .AA / WHETHER OR NOT FAC OVERFLOWED.
DAC* .AA
JMS TRMSLS
JMP* .MPYTN
.ENDC
.EJECT
/** OCTAL MULT. (BY 8)
/CALLING SEQUENCE--
/ JMS OMPTN
OMPTN 0
DAC TAC /** SAVE NUM. TO BE ADDED
AND S00010
SZA /** SKP IF LEGAL OCTAL NUM.
JMP BDTA /** NOT OCTAL - RTN.
LAC OMPTN /** SAVE RTN. ADDR.
DAC IMPTEN
DZM TLS /** ZERO TEMP. REGS. FOR MULT. BY 8
DZM TMS
JMS DSHL /** MULT BY 2
JMP IMP2 /** JMP INTO IMPTEN ROUT.
/**
/MULTIPLY MS+LS BY 10 AND ADD (AC) 71-73 USEC.
/ CALLING SEQUENCE -- LAC BINARY NUMBER
/ JMS IMPTEN
IMPTEN CAL 0
DAC TAC /SAVE NUMBER TO BE ADDED.
JMS DSHL /MULTIPLY MS+LS BY 2 AND SAVE IN TMS+TLS.
LAC LS
DAC TLS
LAC MS
DAC TMS
IMP2 JMS DSHL /** MULT. MS+LS BY 8 (ENTRY FR. OMPTN)
JMS DSHL
CLL /ADD LS, TLS, AND ENTRY VALUE OF (AC).
LAC LS
TAD TLS
SZL!CLL
ISZ TMS /BUMP TMS IF OVERFLOW FROM LS+TLS
NOP
TAD TAC
DAC LS
GLK /GET CARRY BIT AND ADD MS AND TMS
TAD MS
TAD TMS
DAC MS
JMP* IMPTEN /EXIT
.EJECT
/SHIFT MS+LS RIGHT ONE OPEN 14 USEC
/ CALLING SEQUENCE -- JMS DSHR
DSHR CAL 0
LAC MS
RCR
DAC MS
LAC LS
RAR
DAC LS
JMP* DSHR
.EJECT
/SHIFT MS+LS LEFT ONE OPEN 14 USEC
/ CALLING SEQUENCE -- JMS DSHL
DSHL CAL 0
LAC LS
RCL
DAC LS
LAC MS
RAL
DAC MS
JMP* DSHL
.EJECT
/ROTATE MS+LS LEFT SEVEN 160 USEC.
/ CALLING SEQUENCE -- JMS DSH7
DSH7 CAL 0
LAW -7
DAC SHCT
DSH71 JMS DSHL
GLK
TAD LS
DAC LS
ISZ SHCT
JMP DSH71
JMP* DSH7
.EJECT
/DOUBLE LOAD
/ CALLING SEQUENCE -- JMS .FAO
/ .DSA ADDRESS (+400000 IF TRANSFER VECTOR)
.IFUND %FPP
.FAO CAL 0
LAC* .FAO /GET ARGUMENT AND SAVE.
DAC FADDR
SPA /IF T.V., GO ONE MORE LEVEL INDIRECT.
LAC* FADDR
DAC FADDR /FADDR NOW CONTAINS ADDRESS OF FIRST WORD.
LAC* FADDR
DAC* .AA /LOAD FIRST WORD.
ISZ FADDR
LAC* FADDR
DAC* .AB /LOAD SECOND WORD.
ISZ FADDR
LAC* FADDR
DAC* .AC /LOAD THIRD WORD.
ISZ .FAO
JMP* .FAO /EXIT
.ENDC
.EJECT
/DOUBLE STORE
/ CALLING SEQUENCE -- JMS .FAP
/ .DSA ADDRESS (+400000 IF TRANSFER VECTOR)
.IFUND %FPP
.FAP CAL 0
LAC* .FAP /GET ARGUMENT AND SAVE.
DAC FADDR
SPA /IF T.V., GO ONE MORE LEVEL INDIRECT.
LAC* FADDR
DAC FADDR /FADDR NOW CONTAINS ADDRESS OF FIRST WORD.
LAC* .AA
DAC* FADDR /STORE FIRST WORD.
ISZ FADDR
LAC* .AB
DAC* FADDR /STORE SECOND WORD.
ISZ FADDR
LAC* .AC
DAC* FADDR /STORE THIRD WORD.
ISZ .FAP
JMP* .FAP /EXIT
.ENDC
.EJECT
/DOUBLE FLOATING ADD
/ CALLING SEQUENCE -- JMS FAQ (AUGEND IN FAC)
/ .DSA ADDEND ADDRESS
.IFUND %FPP
FAQ CAL 0
JMS* .CF /TRANSFER AUGEND TO HAC.
LAC* FAQ /TRANSFER ARGUMENT TO DBL LOAD CALL.
DAC FAQ1
JMS .FAO /LOAD ADDEND INTO FAC.
FAQ1 .DSA 0
JMS* .CC /ADD HAC TO FAC.
.DSA 42
JMS* .CH /ROUND AND SIGN FAC.
.DSA 0 / *** DDS FEB69 ***
.DSA -1 / *** DDS FEB69 ***
ISZ FAQ /BUMP RETURN ADDRESS AND EXIT.
JMP* FAQ
.ENDC
.EJECT
/*
/INIT. BCDIO FOR SEQ. ACC.
/ TO CHANGE LOCATIONS THAT MIGHT HAVE BEEN ALTERRED BY
/ PREVIOUS R.A. OPERATIONS
/CALLING SEQUENCE --
/ JMS .INISA
.INISA 0 /*
LAC LDEOR /*
DAC .STEOR /*
LAC .FN /*
DAC .BFLOC /*
.IFDEF %V5A1
DZM* .RN /* CLR. R.A. FLG.
.ENDC
JMP* .INISA /*
.EJECT
/INITIALIZE FORMAT DECODER
/ CALLING SEQUENCE -- LAC STARTING ADDRESS OF FORMAT STATEMENT.
/ JMS .INIFD
.INIFD CAL 0
/ AND S77777 /** AND OFF MODE BITS
/ /(RKB-049) ABOVE LINE DELETED FOR XVM
DAC CC /CHARACTER POINTER
DZM .SF /ZERO TO SCALE FACTOR, SPECIFICATION
DZM R / REPEAT COUNT, AND PAREN COUNT.
DZM P
LAC KZ /SET GROUP REPEAT COUNT AND REENTRY LOCA-
DAC K / TION POINTERS TO THEIR INITIAL VALUES
ISZ K / AND SET RE(1) AND K(1) TO ZERO.
DZM* K
DAC K
LAC REZ
DAC RE
ISZ RE
DZM* RE
DAC RE
DAC NCF /SET NO-CONVERSION FLAG.
DZM CCN /CLEAR RE(P) INTERMEDIATE VALUE.
JMP* .INIFD
/FORMAT DECODER DEDICATED PARAMETERS --
KZ .DSA K
K .BLOCK 4
REZ .DSA RE
RE .BLOCK 4
REEN .DSA 0
CC .DSA 0
CCN .DSA 0
CCA .DSA 0
CC2 .DSA 0
CC1 .DSA 0 /(RKB-051) POINTER TO FIRST WORD OF CURRENT WORD PAIR
P .DSA 0
.SF .DSA 0
R .DSA 0
.S .DSA 0
S2 .DSA 0
.W .DSA 0
.D .DSA 0
NCF .DSA 0
.EJECT
/FORMAT STATEMENT DECODER
/ CALLING SEQUENCE -- JMS .FD
/THE FOLLOWING INFORMATION IS RETURNED--
/ (1) .S -- THE CONVERSION TYPE -- 0 I-CONVERSION
/ 1 L-CONVERSION
/ 2 A-CONVERSION
/ 3 O-CONVERSION
/ 4 D-CONVERSION
/ 5 E-CONVERSION
/ 6 F-CONVERSION
/ 7 G-CONVERSION
/ 10 R-CONVERSION
/ (2) .W -- THE EXTERNAL FIELD WIDTH
/ (3) .D -- THE FRACTION FIELD WIDTH
/ (4) .SF-- THE DECIMAL SCALE FACTOR
.FD CAL 0
DZM NUMFLG /INTIALIZE NUMERIC FLAG
K00001 LAW -1 /DECREMENT REPEAT COUNT. IF GREATER THAN
TAD R / ZERO, EXIT WITH ALL SPECIFICATIONS
DAC R / UNCHANGED.
SPA!SNA
JMP FD01
DZM NCF
JMP FD99
FD01 JMS GETCC /GET FIRST CHARACTER. IF A BLANK, FETCH
SAD S00040 / NON-BLANK CHARACTER.
FD02 JMS FNBCHR
SAD S00054
JMP FD20 /IF COMMA.
FD03 SAD S00057
JMP FD21 /IF SLASH
SAD S00051
JMP FD22 /IF RIGHT PAREN
SAD S00055
JMP FD25 /IF MINUS
FD05 SAD S00050
JMP FD26 /IF LEFT PAREN
JMS NUMCHK
JMP FD05 /IF A NUMBER.
SAD S00120
JMP FD31 /IF P
SAD S00044 /**
JMP FDSC /** IF $
SAD S00047 /**
JMP FDSC /** IF '
SAD S00042 /**
JMP FDSC /** IF "
SAD S00110
JMP FD32 /IF H
SAD S00130
JMP FD37 /IF X
SAD S00111
JMP FD39 /IF I
SAD S00114
JMP FD40 /IF L
SAD S00101
JMP FD41 /IF A
SAD S00122 /**
JMP FD45 /** IF R
SAD S00117 /**
JMP FD46 /** IF O
SAD S00124 /** IF T
JMP FD60 /**
FD06 JMS NUMCHK
JMP FD07 /IF A NUMBER.
FD07 TAD Z77671 /CHAR - (107)8
SMA!SZA
JMP FD08
TAD C00003 /CHAR - (104)8
SMA
JMP FD42 /IF D, E, F, OR G
FD08 LAC .CHAR
FD09 JMS NUMCHK
JMP FD10 /IF A NUMBER
FD86 JMS* .ER /END OF SKIP CHAIN -- ILLEGAL CHARACTER.
.DSA 12
LAC* CC1 /(RKB-051) POINT TO FIRST WORD (USED TO BE 'LAC* CC')
LAC* CC2
FD10 LAC LS /NUMBER IS FIELD WIDTH
DAC .W
DZM NUMFLG
LAC .CHAR /IF NEXT CHARACTER IS A PERIOD, FRACTION
SAD S00056 / FIELD WIDTH FOLLOWS. IF NOT, EXIT
JMP FD11 / WITH FRACTION FIELD WIDTH=0.
DZM .D
JMP FD99
FD11 JMS FNBCHR
JMS NUMCHK
SKP
JMP FD86 /IF PERIOD NOT FOLLOWED BY A NUMBER, BAD
LAC LS / FORMAT.
DAC .D
FD99 LAC .S
DAC S2
JMP* .FD
/COMMA
FD20 LAC P /CHECK PAREN COUNT FOR GREATER THAN ZERO.
SPA!SNA / IF NOT, BAD FORMAT.
JMP FD86 / IF SO, IGNORE COMMA.
JMS FNBCHR
JMP FD03
/SLASH
FD21 JMS* .STEOR /* START NEW RECORD AND THEN PROCESS LIKE
LAC P /CHECK PAREN CNT FOR >0
SPA!SNA /IF NOT BAD FORMAT
JMP FD86
JMP FD02 /CONTINUE
/RIGHT PAREN
FD22 JMS DECP /REDUCE PAREN COUNT. IF P=0, ITS THE END
LAC P / OF THE FORMAT STATEMENT. RESET CC TO
SZA / ITS REENTRY POSITION. IF P.NE.0, ITS
JMP FD24 / THE END OF A REPEATING GROUP. RESET
LAC REEN / CHARACTER COUNTER TO BEGINNING OF
DAC CC / GROUP.
JMS INCP /REENTRY POSITION IS THE START OF THE FOR-
LAC* RE / MAT STATEMENT IF NO GROUPING PARENS
SNA / ARE PRESENT (RE(1)=0). IF RE(1).NE.0,
JMS DECP / REENTER WITH P=1.
LAC NCF /IF END OF FORMAT STATEMENT HAS BEEN
SZA / REACHED WITHOUT NO-CONVERSION FLAG
JMP FD99 / BEING RESET, EXIT IMMEDIATELY.
JMS* .STEOR /* START NEW RECORD.
FD23 JMS GETCC /GET CHARACTER FOR NEW CC, AND REENTER
JMP FD03 / SKIP CHAIN.
FD24 CLC /DECREMENT THE GROUP REPEAT COUNT FOR THIS
TAD* K / GROUP. IF K(P).GT.ZERO, SET CC=RE(P),
DAC* K / THE SAVED GROUP REENTRY POINT AND
SNA!SPA / REPEAT THE GROUP AGAIN. IF K(P)=0,
JMP FD243 / DO NOT REPEAT AND GO ON TO NEXT CHAR-
LAC* RE / ACTER IN THE FORMAT STATEMENT.
DAC CC
JMP FD23
FD243 DZM* K
JMP FD02
/MINUS SIGN
FD25 JMS FNBCHR /FETCH FIRST CHAR AFTER MINUS SIGN.
JMS NUMCHK /IS IT A NUMBER.
SKP
JMP FD86 / NO, BAD FORMAT.
LAC LS /COMPLEMENT THE CONVERTED NUMBER AND STORE
TCA /(RKB-051) IT IN SF.
DAC .SF
LAC .CHAR /FIRST CHARACTER FOLLOWING MUST BE THE
SAD S00120 / LETTER P. IF NOT, BAD FORMAT.
SKP
JMP FD86
DZM NUMFLG /NO REPEAT COUNT
FD255 JMS FNBCHR /FETCH NEXT CHAR AND REENTER SKIP CHAIN.
JMP FD06
/LEFT PAREN
FD26 LAC P /IF P=0, THIS IS THE FIRST LEFT PAREN IN
SZA / THE FORMAT STATEMENT. SAVE CC IN REEN
JMP FD28 / FOR REENTRY, BUMP P BY 1, AND REENTER
LAC CC / SKIP CHAIN
DAC REEN
FD27 JMS INCP
JMS FNBCHR
JMP FD03
FD28 LAC* K /IF REPEAT COUNT NOT ZERO, THIS IS A CON-
SZA / TINUATION OF A GROUP REPEAT CYCLE --
JMP FD27 / BUMP P AND EXIT.
LAC NUMFLG /IF REPEAT COUNT = 0, THIS IS A NEW GROUP
SNA
JMP FD29 / NUMERIC FLAG. IF SET, RESET IT AND
/ / STORE CONVERTED NUMBER AS A REPEAT
LAC LS / COUNT. IF NOT SET, ASSUME A GROUP RE-
JMP FD30 / PEAT COUNT OF ONE. SAVE CC IN RE(P)
FD29 LAC C00001 / AS A GROUP REENTRY LOCATION.
FD30 DAC* K
LAC CC
DAC* RE
LAC P /IF THIS GROUP IS IN THE FIRST LEVEL OF
SAD C00001 / PAREN NESTING (P=1), CLOBBER REEN WITH
SKP / CCN OR RE(1) DEPENDING ON WHETHER THIS
JMP FD27 / GROUP HAD A REPEAT COUNT OR NOT.
LAC NUMFLG
SNA
JMP FD301
DZM NUMFLG
LAC CCN
JMP FD302
FD301 LAC* RE
FD302 DAC REEN
JMP FD27
/LETTER P
FD31 LAC NUMFLG /LETTER P MUST BE PRECEDED BY NUMBER. IF
SNA / NOT, BAD FORMAT. IF SO, NUMBER IS A
JMP FD86 / NEW SCALE FACTOR.
LAC LS
DAC .SF
DZM NUMFLG
JMP FD255 /REENTER SKIP CHAIN.
/**T-CONVERSION
FD60 JMS FNBCHR
JMS NUMCHK
SKP /YES - NUM. IN LS; NXT. CHAR. IN .CHAR
JMP FD86 /NOT NUM.: ERROR
DAC TEMP8
LAC LS
DAC TBNM /TAB NUM.
LAW -4
DAC TEMP7 /CNT. FOR MULT. BY 5
LAW -2
.IFUND RSX
TAD* .FC6 /L.B. SIZE - 2 FOR HDR.
.ENDC
.IFDEF RSX
AAC 376 /L.B. SIZE -2 FOR HDR.
.ENDC
RCR
DAC TEMP6
FD601 TAD TEMP6
ISZ TEMP7
JMP FD601 /ADD AGAIN
DAC TEMP7 /(L.B.-2) * (5/2) - 1
TCA /(RKB-051)
DAC TEMP6 /COMPL.
LAC TBNM
FD602 TAD TEMP6 /WRAP TBNM AROUND MAX. NM. OF CHRS.
SZA!SMA
JMP FD602
TAD TEMP7
DAC TBNM /FINAL TBNM
/--PROCESS FOR READ OR WRITE
LAC* .FH /=0, RD.; =1,WRT.
SNA
JMP FD603 /READ
LAW -2 /WRITE
TAD TBNM
SPA /TBNM MUST BE .GE. 2 FOR WRITE
JMP FD608 /ILLEGAL: EXIT
LAC CCPTR
TCA /(RKB-051)
TAD TBNM /TBNM-CCPTR
SPA /SKP IF OUTPT. ON SAME LINE
JMP FD604 /START NEW LINE
JMS .PBLKS /PACK TBNM-CCPTR BLANKS
JMP FD608 /FINISHED
/----WRITE NEW LINE
FD604 JMS* .STEOR /NEW RCD.
LAW 53 / '+' FOR NO ADVANCE
JMS .PACK
LAW -2
TAD TBNM
JMS .PBLKS /PACK TBNM-2 BLANKS IN NEW LINE
JMP FD608 /FINISHED
/----READ
FD603 LAC TBNM
SNA
JMP FD608 /ILLEGAL:TBNM MUST BE .GE. 1 FOR RD.
LAC CCPTR
TCA /(RKB-051)
TAD TBNM /TBNM-CCPTR
SNA
JMP FD608 /DIFFER. = 0: DO NOTHING, RTN.
SPA /SKP IF INPUT TO BE TAKEN FROM SAME LINE
JMP FD605 /GET NEW LINE
TCA /(RKB-051)
DAC TEMP6 /CNTR.
FD606 JMS READ. /DUMMY READ
ISZ TEMP6
JMP FD606 /READ AGAIN
JMP FD608 /FINISHED, RTN.
/----READ NEXT LINE
FD605 JMS* .STEOR /GET NEW RCD.
LAW -1
TAD TBNM
TCA /(RKB-051)
DAC TEMP6 /READ TBNM-1 DUMMY CHRS.
FD607 JMS READ. /DUMMY READ
ISZ TEMP6
JMP FD607 /READ AGAIN
/LD. NEXT CHR. AND GO BACK TO SKP CHAIN
FD608 DZM NUMFLG
LAC TEMP8
JMP FD02+1
/**
/** $, ' (STRING CONSTANT)-CONVERSION
FDSC DZM NUMFLG
DAC STCON
FDSC1 JMS FMTFCH /GET NEXT FORMAT CHR.
SAD STCON
JMP FDSC3 /SAME: CHK. IF STR. CHR. OR SEC. DELIM.
FDSC4 LAC* .FH /RD./WR. FLG.
SNA
JMP FDSC2 /RD.
LAC .CHAR /WR. - GET FRM. CHR.
JMS .PACK /PACK
JMP FDSC1 /RTN. TO GET AND CHK. NEXT CHR.
FDSC3 JMS FMTFCH /LK. AT NXT CHR.
SAD STCON
JMP FDSC4 /DOUBLE CHR.: PACK AS STR. CHR.
JMP FD01+1 /SINGLE CHR.: SEC. DELIM.
FDSC2 JMS RDINFS /RD. INTO FORMT. STMNT.
JMP FDSC1 /RTN. TO GET AND CHK. NEXT CHR.
/**
/H-CONVERSION
FD32 LAC NUMFLG /H CHARACTER MUST BE PRECEDED BY A NUMBER.
SNA / IF NOT, BAD FORMAT. IF SO, CONVERTED
JMP FD86 / NUMBER IS THE CHARACTER COUNT FOR
LAC LS / HOLLERITH I/O TRANSFERS.
DZM NUMFLG
TCA /(RKB-051)
DAC CCNT
SNA /IF NUMBER IS ZERO, BAD FORMAT.
JMP FD86
LAC* .FH /IS THIS A READ OR WRITE CALL.
SZA / READ
JMP FD36 / WRITE
FD33 JMS INCCC /UPDATE CC, CC2, CCA AND CLOBBER CHAR WITH
JMS SPLIT / INPUT FROM LINE BUFFER.
JMS RDINFS /**RD. INTO FRMT. STMNT.
ISZ CCNT /HAVE ALL CHARACTERS BEEN TRANSFERRED.
JMP FD33 / NO, PROCESS NEXT CHARACTER.
JMP FD02 / YES, REENTER SKIP CHAIN.
FD36 JMS FMTFCH /HOLLERITH OUTPUT -- READ AND PACK (CCNT)
JMS .PACK / CHARACTERS IN LINE BUFFER.
ISZ CCNT
JMP FD36
JMP FD02 /REENTER SKIP CHAIN.
/X-CONVERSION
FD37 LAC NUMFLG /X CHARACTER MUST BE PRECEDED BY A NUMBER.
SNA / IF NOT, BAD FORMAT. IF SO, COMPLEMENT
JMP FD86 / OF NUMBER IS THE CHARACTER COUNT FOR
LAC LS / I/O TRANSFER.
DZM NUMFLG
TCA /(RKB-051)
DAC CCNT
SNA /IF CHARACTER COUNT IS ZERO, BAD FORMAT.
JMP FD86
LAC* .FH /TEST FOR READ OR WRITE.
SZA / READ.
JMP FD385 / WRITE.
FD38 JMS READ. /READ--SKIP (CCNT) LINE BUFFER CHARACTERS.
ISZ CCNT
JMP FD38
JMP FD02 /REENTER SKIP CHAIN.
FD385 LAC LS /WRITE--PACK (LS) BLANKS IN LINE BUFFER.
JMS .PBLKS
JMP FD02 /REENTER SKIP CHAIN.
/I-CONVERSION
FD39 CLA /ZERO TO AC(15-17)
JMP FD43
/L-CONVERSION
FD40 LAW 1 /ONE TO AC(15-17)
JMP FD43
/A-CONVERSION
FD41 LAW 2 /TWO TO AC(15-17)
JMP FD43
/R-CONVERSION
FD45 LAW 10 /** EIGHT TO AC(14-17)
JMP FD43 /**
/**0-CONVERSION
FD46 LAW 3 /**
JMP FD43 /**
/D- E- F- AND G-CONVERSIONS /FOUR(D), FIVE(E), SIX(F), OR SEVEN(G)
FD42 LAC .CHAR / TO AC(15-17).
AND S00007 /GET RID OF AC BITS 0-14
FD43 AND S00017 /** GET RID OF AC BITS 0-13
DAC .S /STORE CONVERSION TYPE CODE.
DZM NCF /RESET NO-CONVERSION FLAG.
LAC NUMFLG /CHECK FOR REPEAT COUNT. IF THERE IS A
SNA / NUMBER, STORE IT IN R.
JMP FD44
DZM NUMFLG
LAC LS
DAC R
FD44 JMS FNBCHR /FETCH NEXT CHARACTER (=FIELD WIDTH) AND
JMP FD09 / REENTER SKIP CHAIN.
.EJECT
/** READ INTO FORMAT STATEMENT
/CALLING SEQUENCE--
/ JMS RDINFS
RDINFS 0
JMS READ. /GET L.B. CHAR.
LAC* CC1 /(RKB-051) MOVE FORMAT WORD PAIR INTO (WAS 'LAC* CC')
DAC MS /MS+LS FOR SHIFTING
LAC* CC2
DAC LS
LAW -5 /INIT. LOOP CNTRS. CNT AND CNT2
TAD CCA
DAC CNT2
LAC CCA
CMA
DAC CNT
FD34 JMS DSH7
ISZ CNT
JMP FD34 /UNTIL CUR. CHR. RT. JUST. IN LS
LAC LS
AND Z77600
XOR .CHAR /REPLACE OLD W/ NEW CHR.
DAC LS
SKP
FD35 JMS DSH7
ISZ CNT2
JMP FD35 /COMPLETE 36 BIT CIRCUL. SHIFT
JMS DSHL
LAC MS
DAC* CC1 /(RKB-051) (WAS 'DAC* CC')
LAC LS
DAC* CC2 /PUT WD. PR. IN FRMT. STMNT.
JMP* RDINFS
/**
.EJECT
/CHECK CHARACTER FOR NUMERIC -- COMPLETE CONVERSION IF YES.
/ CALLING SEQUENCE -- LAC CHARACTER (ASCII-7)
/ JMS NUMCHK
/ JMP YES (NEXT CHARACTER IN AC)
/ JMP NO (TESTED CHARACTER IN AC)
NUMCHK CAL 0
JMS .NMTST /IS CHARACTER A NUMBER.
JMP NUMCH3 / NO, BUMP RETURN ADDRESS AND EXIT.
DAC LS / YES, INITIALIZE MS AND LS.
DZM MS
LAC CC /SAVE LOCATION OF 1ST CHARACTER IN CASE
DAC CCN / THIS IS A GROUP REPEAT COUNT.
CLC /SET NUMBER FLAG.
DAC NUMFLG
JMP NUMCH2 /ENTER LOOP TO COMPLETE NUMERIC CONVERSION.
NUMCH1 JMS IMPTEN /MULTIPLY MS+LS BY 10 AND ADD (AC).
NUMCH2 JMS FNBCHR /FETCH NEXT CHARACTER AND TEST IT.
JMS .NMTST /IS IT A NUMBER.
JMP* NUMCHK / NO, EXIT WITH NEXT CHAR IN AC.
JMP NUMCH1 / YES, UPDATE TOTAL.
NUMCH3 ISZ NUMCHK /EXIT HERE IF 1ST CHAR NON-NUMERIC.
JMP* NUMCHK
.EJECT
/TEST FOR NUMERIC CHARACTER
/ CALLING SEQUENCE -- LAC CHARACTER (ASCII-7)
/ JMS .NMTST
/ JMP NO (TESTED CHARACTER IN AC)
/ JMP YES (BINARY VALUE OF CHARACTER IN AC)
.NMTST CAL 0
DAC NUMTS2 /SAVE CHARACTER.
TAD Z77706 /IS IT LESS THAN OR EQUAL TO NINE.
SMA / YES, TEST AGAIN.
JMP NUMTS1 / NO, EXIT.
TAD S00012 /IS IT GREATER THAN OR EQUAL TO ZERO.
SPA / YES, VALID NUMBER.
JMP NUMTS1 / NO, EXIT.
ISZ .NMTST /BUMP RETURN ADDRESS AND EXIT WITH BINARY
JMP* .NMTST / VALUE OF CHARACTER IN AC.
NUMTS1 LAC NUMTS2 /EXIT WITH ORIGINAL CHARACTER IN AC.
JMP* .NMTST
NUMTS2 .DSA 0 /TEMP STORAGE FOR (AC) AT ENTRY.
.EJECT
/INCREMENT PAREN COUNT
/ CALLING SEQUENCE -- JMS INCP
INCP CAL 0
K00003 LAW -3 /IF P.GE.3, BAD FORMAT
TAD P
SMA
JMP FD86
ISZ P / (P+1) TO (P)
NOP
ISZ K / (K+1) TO (K)
ISZ RE / (RE+1) TO (RE)
JMP* INCP
.EJECT
/DECREMENT PAREN COUNT
/ CALLING SEQUENCE -- JMS DECP
DECP CAL 0
CLC
TAD P /IF (P-1) NEGATIVE, BAD FORMAT.
SPA
JMP FD86
DAC P / (P-1) TO (P)
CLC
TAD K
DAC K / (K-1) TO (K)
CLC
TAD RE
DAC RE / (RE-1) TO (RE)
JMP* DECP
.EJECT
/GET CURRENT CHARACTER
/ CALLING SEQUENCE -- JMS GETCC
/ EXIT WITH CHARACTER IN AC AND IN CHAR.
GETCC CAL 0
JMS SPLIT /SPLIT CC INTO CCA AND CC2
TAD GETCC0 /FORM TRANSFER VECTOR TO ONE OF FIVE LOCA-
DAC TVCC / TIONS ACCORDING TO CHARACTER NUMBER.
JMP* TVCC
GETCC0 .DSA GETCC1
GETCC1 JMP GETCC6 /1ST CHARACTER
JMP GETCC5 /2ND CHARACTER
JMP GETCC4 /3RD CHARACTER
JMP GETCC3 /4TH CHARACTER
LAC* CC2 /5TH CHARACTER -- SHIFT WD 1 RIGHT
RAR
JMP GETCC7
GETCC3 LAC* CC2 /SHIFT WD2 8 RIGHT.
RTR; RTR; RTR; RTR
JMP GETCC7
GETCC4 LAC* CC2 /(RKB-051) 4 BITS IN WD1 + 3 BITS IN WD2.
LMQ /(RKB-051) THIS SECTION RECODED TO BE SLIGHTLY FASTER
LAC* CC1 /(RKB-051) COMBINE WITH WD1
LLS 3 /(RKB-051)
JMP GETCC7
GETCC5 LAC* CC1 /(RKB-051) SHIFT WD1 4 RIGHT.
RTR; RTR
JMP GETCC7
GETCC6 LAC* CC1 /(RKB-051) SHIFT WD1 8 LEFT
SWHA; RTR /(RKB-051) THIS LINE RECODED TO BE SLIGHTLY FASTER
GETCC7 AND S00177 /EXTRACT OFF UPPER 11 BITS.
DAC .CHAR
JMP* GETCC /EXIT.
TVCC .DSA 0
.CHAR .DSA 0
.EJECT
/SPLIT CC INTO CCA AND CC2
/ CALLING SEQUENCE -- JMS SPLIT
SPLIT CAL 0
LAC CC
AND (77777) /(RKB-051) STRIP CHARACTER COUNTER FROM [0:2]
DAC CC1 /(RKB-051) CC1 IS NOW USED AS POINTER, NOT CC
IAC /(RKB-051) POINT TO SECOND WORD OF PAIR
DAC CC2 /(RKB-051) SIMILAR CODE EXISTED HERE
LAC CC /(RKB-051) NOW EXTRACT THE CHARACTER COUNT
RTL; RTL
AND S00007
DAC CCA /CCA=3 HIGH BITS OF CC, RIGHT JUSTIFIED.
JMP* SPLIT /EXIT WITH CCA IN AC.
.EJECT
/FETCH FORMAT CHARACTER
/ CALLING SEQUENCE -- JMS FMTFCH
FMTFCH CAL 0
JMS INCCC /BUMP CHARACTRE COUNT +1.
JMS GETCC /GET CHARACTER.
JMP* FMTFCH
.EJECT
/INCREMENT CHARACTER COUNT
/ CALLING SEQUENCE -- JMS INCCC
INCCC CAL 0
LAC CC
SPA /IF LAST CHARACTER IN THE WORD PAIR, RESET
TAD V00002 / CHARACTER NUMBER TO ZERO, AND BUMP
TAD T00000 / WORD PAIR ADDRESS BY 2. IF NOT LAST
DAC CC / CHARACTER, BUMP CHARACTER NUMBER BY 1.
JMP* INCCC
.EJECT
/FETCH NON-BLANK FORMAT CHARACTER.
/ CALLING SEQUENCE -- JMS FNBCHR
FNBCHR CAL 0
FNB1 JMS FMTFCH
SAD S00040
JMP FNB1 /IF CHAR=BLANK, FETCH AGAIN.
JMP* FNBCHR
.EJECT
/BCD I/O CLEANUP
/ CALLING SEQUENCE -- JMS* .FF
.FF CAL 0
LAC CC /** =0 IF D-D
SNA /** SKP IF NOT D-D
JMP FF2 /** IF D-D, CALL TO .FD UNNEC.
LAW -1 /SET NO-CONVERSION FLAG TO STOP AT END OF
DAC NCF / FORMAT STATEMENT.
JMS .FD /CLEANUP ALL H AND X CONVERSIONS.
FF2=.
.IFDEF %V5A1
LAC* .RN /* R.A. FLG.
SZA /* SKP IF NOT R.A.
JMP* .FF /*
.ENDC
LAC* .FH /IF A WRITE, OUTPUT LAST LINE.
SZA
JMS* .STEOR /**
LAC RDEX20 /REINIT. .ER
DAC* .ER4
JMP* .FF /EXIT.
.EJECT
/INITIALIZE LINE BUFFER
/ CALLING SEQUENCE -- JMS .INILB
.INILB CAL 0
JMS EXCH /EXCHANGE MS+LS WITH SMS+SLS.
CLC /SET CHARACTER COUNT TO MINUS ONE FOR THE
DAC .SCC / BUMP ROUTINE
TAD .BFLOC /* RESET LINE BUFFER POINTER (LBADD) TO
DAC .LBADD / BEGINNING OF LINE BUFFER.
DZM .HIFLG /RESET FLAG TO 0 (POINTER OK).
LAC C00001 /**
DAC CCPTR /** INIT. CURR. CHR. PTR.
LAC* .FH
SZA
JMP INILB1
ISZ .LBADD / READ -- INCREMENT LINE BUFFER POINTER
ISZ .LBADD / PAST THE TWO HEADER WORDS.
JMP INILB2
INILB1 DZM MS / WRITE -- STORE ZERO IN WORD BUFFER
DZM LS / FOR HEADER WORDS.
INILB2 DZM .FSTFL /SET FIRST CHARACTER FLAG.
JMS BUMP /BUMP CHARACTER COUNTER (.SCC).
JMS EXCH /RESTORE MS+LS AND SMS+SLS.
JMP* .INILB /EXIT
.EJECT
/END OF RECORD PROCESSOR
/ CALLING SEQUENCE -- JMS EOR
EOR CAL 0
LAC* .FH /CHECK FOR READ OR WRITE.
SZA
JMP EOR1
LAC SLOT /READ--INPUT NEXT RECORD.
XOR S02000
JMS* .FQ
LAC* .FN /CHECK L.B. HEADER FOR IOPS-ALPHA MODE.
AND S00077 /VALIDITY AND MODE BITS
SAD C00002
JMP EOR3 /IF MODE OK, CONTINUE.
JMS* .ER /IF MODE NOT IOPS-ALPHA, TAKE ERROR EXIT.
.DSA 11
.RAENT 0 /* ENTRY FROM RBCDIO
EOR1 LAC .HIFLG /IF LINE BUFFER IS NOT FULL, FILL CURRENT
SZA / WORD PAIR WITH BLANKS.
JMP EOR2
LAW 15 /SET UP .PBLKS TO PACK CR'S AT END
DAC PKBLK1 /OF LINE, SO LP HANDLER WON'T OVERFLOW
LAC .SCC
TCA /(RKB-051)
JMS .PBLKS
LAW 40 /RESET .PBLKS TO PACK BLANKS
DAC PKBLK1
EOR2 LAC* .LBADD /CLOBBER LAST CHARACTER WITH A C/R.
AND Z77400 /REMOVE CURRENT CHARACTER.
XOR S00032 /INSERT C/R IN BITS 10 TO 16 (17=0).
DAC* .LBADD
.IFDEF %V5A1
LAC* .RN /* R.A. FLG.
SZA /* SKP IF NOT R.A.
JMP* .RAENT /* RTN. IF R.A.
.ENDC
LAC .FN /CALCULATE LINE BUFFER SIZE.
CMA!STL / (.F4) = 3BADD-.FN+1
TAD C00002
TAD .LBADD
RTL; RTL; RTL; RTL /CONSTRUCT HEADER WORD.
XOR C00002
DAC* .FN
LAC SLOT /WRITE CURRENT RECORD.
XOR S02000
JMS* .FQ
EOR3 JMS .INILB /INITIALIZE LINE BUFFER.
JMP* EOR /EXIT.
.EJECT
/PACK CHARACTER IN LINE BUFFER
/ CALLING SEQUENCE -- LAC CHARACTER (ASCII-7)
/ JMS PACK
.PACK CAL 0
AND S00177 /SAVE 7-BIT CHARACTER.
DAC .CHAR
ISZ CCPTR /** INCREM. CURR. CHR. PTR.
LAC .FSTFL /TEST FOR FIRST CHARACTER IN LINE. IF SO,
SPA /** SKP IF NOT ENCODE
JMP PACK3 /** ENCODE - CHK. IF D-D
SZA / CHANGE IT TO A CARRIAGE CONTROL CHAR-,
JMP PACK1 / ACTER.
LAC .CHAR
DAC .FSTFL /KILL FIRST-CHARACTER FLAG.
.IFUND MSCC /(RKB-050)
XCT .MSDEV /(RKB-050) SKP IF NOT MASS STORAGE
JMP PACK2 /(RKB-050) NOP IF MASS STORAGE, DON'T CONVERT 1ST CHAR
.ENDC /(RKB-050)
SAD S00061 /IF A BCD ONE, CHANGE TO 014.
LAW -14 / (EJECT PAGE)
SAD S00053 /IF A BCD PLUS, CHANGE TO 020.
LAW -20 / (NO LINE FEED)
SAD S00060 /IF A BCD ZERO, CHANGE TO 021.
LAW -21 / (DOUBLE SPACE)
SMA
LAW -12 /IF ANYTHING ELSE, MAKE
TCA /(RKB-051) IT 012 (LF)
DAC .CHAR
JMP PACK2
PACK1 LAC .HIFLG /IF LINE SIZE HAS BEEN EXCEEDED, EXIT
SZA / IMMEDIATELY.
JMP* .PACK
PACK2 JMS EXCH /OK TO PACK--EXCHANGE MS+LS AND SMS+SLS.
JMS DSH7 /ROTATE MS+LS LEFT 7, REMOVE CURRENT CON-
LAC LS / TENTS OF 7 LOW BITS, AND INSERT
AND Z77600 / CHARACTER.
XOR .CHAR
DAC LS
JMS BUMP /BUMP CHARACTER COUNT.
JMS EXCH /RESTORE MS+LS AND SMS+SLS.
JMP* .PACK /EXIT.
PACK3 LAC .CHAR /**
DAC .FSTFL /** SET TO INDIC. 1ST CHAR. REACHED
LAC CC /** =0 IF D-D I/O
SZA /**
JMP PACK2 /** FRMTD.: NO FORMS CONTROL CHR.
JMP* .PACK /** D-D: IGNORE 1ST CHAR.
.EJECT
/READ CHARACTER FROM LINE BUFFER
/ CALLING SEQUENCE -- JMS READ.
/ EXITS WITH ASCII-7 CHARACTER IN CHAR AND AC.
READ. CAL 0
LAC .HIFLG /IF LINE SIZE HAS BEEN EXCEEDED, SET CHAR-
SNA / ACTER TO A BLANK AND EXIT
JMP READ1
LAC S00040
DAC .CHAR
JMP* READ.
READ1 JMS EXCH /OK TO READ--EXCHANGE MS+LS AND SMS+SLS.
ISZ CCPTR /** INCREM. CURR. CHR. PTR.
JMS DSH7 /ROTATE MS+LS LEFT 7, AND EXTRACT OUT THE
LAC LS / 7 LOW BITS = FETCHED CHARACTER.
AND S00177
DAC .CHAR /**
SAD S00015 /IF CHAR=C/R OR ALT MODE, MAKE IT A BLANK
JMP READ3 / AND SET .HIFLG TO INDICATE END OF LINE.
SAD S00175
JMP READ3
READ2 JMS BUMP /BUMP CHR. CNT.
JMS EXCH /RESTORE MS+LS AND SMS+SLS.
LAC .CHAR /** TEST FOR CR
SAD S00015 /** DON'T IGN. CR (FOR D-D I/O)
JMP READ4 /**
.IFDEF LFTOSP /(RKB-050) CONVERT LF'S TO SPACES
LAC .FSTFL /IF THIS IS THE FIRST CHARACTER OF THE
SNA /LINE, CHECK IF IT IS A LINE FEED. IF SO,
LAC .CHAR /IT IS ASSUMED TO BE CARRIAGE CONTROL, AND
DAC .FSTFL /IS CHANGED TO A SPACE. RESET FIRST CHAR
LAC .CHAR
SAD S00012 /FLAG
LAC S00040
DAC .CHAR
.ENDC /(RKB-050)
LAW -40 /IGNORE ALL OTHER CHARACTERS LESS THAN 40(8)
TAD .CHAR / EXCEPT CARRIAGE RETURN.
SPA
JMP READ1
LAC .CHAR /EXIT WITH FETCHED CHARACTER IN AC.
READ4 JMP* READ. /**
READ3 LAC CC /** =0 IF D-D
SNA /** IF D-D OTPT., WANT CR, A.M.
JMP READ2 /**
LAC S00040 /BLANK
DAC .HIFLG /NON-ZERO TO HIFLG.
DAC .CHAR /**
LAC BCNT /STORE BCNT AND SET CR-ALT FLAG
DAC CRAMFL
JMP READ2
.EJECT
/EXCHANGE MS+LS WITH SMS+SLS 28 USEC.
/ CALLING SEQUENCE -- JMS EXCH
EXCH CAL 0
LAC LS /LS TO TEMP
DAC EXCH1
LAC SLS /SLS TO LS
DAC LS
LAC EXCH1 /TEMP TO SLS
DAC SLS
LAC MS /MS TO TEMP
DAC EXCH1
LAC SMS /SMS TO MS
DAC MS
LAC EXCH1 /TEMP TO SMS
DAC SMS
JMP* EXCH /EXIT
EXCH1 .DSA 0
.EJECT
/BUMP CHARACTER COUNT AND WORD PAIR
/ CALLING SEQUENCE -- JMS BUMP
BUMP CAL 0
ISZ .SCC /INCREMENT CHARACTER COUNT. IF LESS THAN
JMP* BUMP / 5 CHARACTERS HAVE BEEN READ (PACKED),
LAW -5 / EXIT IMMEDIATELY. IF NOT, RESET SCC
DAC .SCC / AND UPDATE 2 WORDS OF LINE BUFFER.
LAC* .FH /BRANCH PER READ OR WRITE.
SZA
JMP BUMP2
ISZ .LBADD /READ--LOAD NEXT 2 WORDS OF LINE BUFFER
LAC* .LBADD / INTO MS+LS AND INCREMENT L.B. POINTER
DAC MS / BY 2.
ISZ .LBADD
LAC* .LBADD
DAC LS
JMP* BUMP
BUMP2 JMS DSHL /WRITE--LEFT-JUSTIFY MS+LS, STORE MS+LS IN
ISZ .LBADD / NEXT TWO WORDS OF LINE BUFFER, AND
LAC MS / INCREMENT L.B. POINTER BY 2.
DAC* .LBADD
ISZ .LBADD
LAC LS
DAC* .LBADD
LAC .LBADD /IF L.B. POINTER HAS REACHED ITS HIGH
SAD .HILIM / LIMIT, SET HIFLG=NON-ZERO TO SUPPRESS
DAC .HIFLG / FURTHER L.B. ACCESS FOR THIS LINE.
JMP* BUMP /EXIT.
.EJECT
/PACK BLANKS
/ CALLING SEQUENCE -- LAC NUMBER OF BLANKS (127 MAX)
/ JMS .PBLKS
.PBLKS CAL 0
AND S00177 /COMPLEMENT NUMBER OF BLANKS TO GET LOOP
SNA / INDEX. IF ZERO, EXIT.
JMP* .PBLKS
TCA /(RKB-051)
DAC PKBLK2
PKBLK1 LAW 40 /PACK ONE BLANK.
JMS .PACK
ISZ PKBLK2
JMP PKBLK1 /LOOP UNTIL ALL BLANKS PACKED.
JMP* .PBLKS
.EJECT
/** OVER FLOW ROUTINE - PACK *'S (AND D.P., IF POSS.)
/E,D
FOVFL1 LAC .D
TAD C00005
TCA /(RKB-051)
TAD .W /.W-(D+5)
SPA
JMP FOVFL2 /CAN'T DO D.P.
JMS PKHSH /PACK .W-(.D+5) ASTERISKS
LAW 56 /'.'
JMS .PACK
LAC .D
TAD S00004
JMP PFIN /PACK .D+4 ASTERISKS
FOVFL2 LAC .W
JMP PFIN
/--F
FOVFL3 LAC .D
CMA
TAD .W /.W-(.D+1)
SPA
JMP FOVFL4 /CAN'T DO D.P.
JMS PKHSH /PACK .W-(.D+1) ASTERISKS
LAW 56 /D.P.
JMS .PACK
LAC .D
SKP
/CHK. FOR G-CONV.
FOVFL4 LAC .W
JMS PKHSH
LAC S2 /CONV. CODE
TAD K00006
SMA!SZA /SKP IF NOT G
SKP
JMP FE99 /G, SO, DONE
LAC S00004 /PACK 4 MORE ASTERISKS
PFIN JMS PKHSH
JMP FE99
/**
.EJECT
/**PACK ASTERISKS
/CALLING SEQUENCE--
/ LAC (NUM. OF ASTERISKS TO BE PKED.
/ JMS PKHSH
PKHSH 0
AND S00177
SNA
JMP* PKHSH /0 ASTERISKS: RTN. IMMED.
TCA /(RKB-051)
DAC TEMP6
PKHSH1 LAW 52 /'*'
JMS .PACK
ISZ TEMP6
JMP PKHSH1
JMP* PKHSH
/**
.EJECT
/PACK SIGN
/ CALLING SEQUENCE -- JMS PKSGN
PKSGN CAL 0
LAC SIGN /IF SIGN IS PLUS (SIGN=0) PACK A BLANK.
SZA!CLA /IF SIGN IS MINUS (SIGN.NE.0), PACK HYPHEN.
LAW 15
TAD S00040
JMS .PACK
JMP* PKSGN
.END