. ADIT$ EDITING PACKAGE
. INTERNAL DEFINITIONS
DEF
.
. IF ALL OUTPUT IS TO BE GENERATED WITH EVEN PARITY, THE
. TAG 'PARGEN' SHOULD BE SET NONZERO. OTHERWISE, PARITY
. WILL NOT BE CHANGED, AND CANNED CHARACTERS WILL HAVE
. RANDOM PARITY.
.
PARGEN EQU 0 DISABLE PARITY GENERATION
.
. IF THE PARITY BIT IS TO BE STRIPPED OFF CHARACTERS PASSED
. TO ADIT$, THE TAG 'PARSTRIP' SHOULD BE SET NONZERO.
. OTHERWISE, CHARACTERS WILL BE STORED WITH WHATEVER PARITY
. BIT THEY WERE PASSED WITH. NOTE THAT IF PARGEN IS SET
. NONZERO, PARSTRIP MUST BE SET NONZERO ALSO UNLESS ALL
. CHARACTERS PASSED TO ADIT$ HAVE A ZERO PARITY BIT.
.
PARSTRIP EQU 0 DISABLE PARITY STRIPPING
.
. THE TAG 'SIXBIT' CONTROLS GENERATION OF THE LITTLE-USED SIXBIT
. ASCII SUBROUTINES IN ADIT$. IF SET TO ZERO, ALL CODE ASSOCIATED
. WITH THE SIXBIT ROUTINES WILL BE TURNED OFF, AND CALLS TO THEM
. WILL RESULT IN UNDEFINED SYMBOLS.
.
SIXBIT EQU 0 TURN OFF SIXBIT ASCII
.
.
PX EQU X1 PACKET POINTER
CX EQU X2 CHARACTER POINTER
WX EQU X3 WORD POINTER
PKT EQUF 0,PX PACKET LOCATION
CI EQUF 0,CX CHARACTER INDEX
WI EQUF 0,WX WORD INDEX
IL EQUF PKT,,Q2 IMAGE LENGTH
ILOC EQUF PKT,,H2 IMAGE LOCATION
CIX EQUF PKT+1,,Q2 SAVE AREA FOR CHARACTER INDEX
WIX EQUF PKT+1,,H2 SAVE AREA FOR WORD INDEX
EMSGC EQUF PKT+2,,Q1 AMSG$ SIGNAL CHARACTER
CIM EQUF PKT+2,,Q2 SAVE AREA FOR AMSG$ CHARACTER INDEX
WIM EQUF PKT+2,,H2 SAVE AREA FOR AMSG$ WORD INDEX
FPS EQUF PKT+3,,S1 SCALE FOR FLOATING POINT EDIT
FPR EQUF PKT+3,,S2 FLOATING POINT ROUNDING OPTION
RETURN EQUF PKT+3 RETURN POINT FOR VECTORS
RET EQUF PKT+4,,H1 SAVE AREA FOR RETURN POINT
SAVE1 EQUF PKT+4,,H2 SAVE AREA FOR PX
SAVE2 EQUF PKT+5 SAVE AREA FOR CX
SAVE3 EQUF PKT+6 SAVE AREA FOR WX
DPC EQUF PKT+7,,Q1 CHARACTER FOR DOUBLE PRECISION SCALE
SPC EQUF PKT+7,,Q2 CHARACTER FOR SINGLE PRECISION SCALE
NDP EQUF PKT+8,,S3 DIGITS BEFORE DECIMAL POINT
NDF EQUF PKT+8,,S4 DIGITS FOLLOWING DECIMAL POINT
SIGN EQUF PKT+8,,S5 SIGN INDICATOR
ZERO EQUF PKT+8,,S6 FLOATING POINT ZERO INDICATOR
FCOL EQUF PKT+9,,H1 FINAL COLUMN OR ZERO
SCALE EQUF PKT+9,,XH2 POWER OF TEN
VALUE EQUF PKT+10 SAVE AREA FOR DIGITS
A$DEF* PROC *0
$(1) LIT
P PROC *1
STORE** NAME
DO P(1)>0 , LA,P(0,1) A2,+(A$AD 1,1)
EX ADIT$T,*CX
END
P PROC 1,2*PARGEN
PARITY** NAME
ON PARGEN
DO P(1)=0 ,P(1,1) EQU A2
TEP,U P(1,1),1*/7-1
AA,U P(1,1),1*/7
OFF PARGEN
END
A$SCII
NULL* EQU NULL7
BLANK* EQU SPC7
BLANKS* EQU +(BLANK,BLANK,BLANK,BLANK)
MINUS* EQU DSH7
PLUS* EQU PLS7
ZER* EQU A07
COLON* EQU CLN7
COMMA* EQU CMA7
PERIOD* EQU PR7
SLASH* EQU SLSH7
ATSGN* EQU ATS7
LETTERA* EQU AA7
END
P PROC *0
A$TTDEF* NAME
TFQ* EQUF ADIT$TT,,Q1 FIELDATA TO QUARTER WORD ASCII
TSQ* EQUF ADIT$TT,,Q2 SIXTH WORD ASCII TO QUARTER WORD ASCII
TSF* EQUF ADIT$TT,,S4 SIXTH WORD ASCII TO FIELDATA
END
. CHARACTER SET DEFINITIONS
DEF
. 8-BIT ASCII WITH PARITY
AA8 EQU 0101 A
AB8 EQU 0102 B
AC8 EQU 0303 C
AD8 EQU 0104 D
AE8 EQU 0305 E
AF8 EQU 0306 F
AG8 EQU 0107 G
AH8 EQU 0110 H
AI8 EQU 0311 I
AJ8 EQU 0312 J
AK8 EQU 0113 K
AL8 EQU 0314 L
AM8 EQU 0115 M
AN8 EQU 0116 N
AO8 EQU 0317 O
AP8 EQU 0120 P
AQ8 EQU 0321 Q
AR8 EQU 0322 R
AS8 EQU 0123 S
AT8 EQU 0324 T
AU8 EQU 0125 U
AV8 EQU 0126 V
AW8 EQU 0327 W
AX8 EQU 0330 X
AY8 EQU 0131 Y
AZ8 EQU 0132 Z
A08 EQU 060 0
A18 EQU 0261 1
A28 EQU 0262 2
A38 EQU 063 3
A48 EQU 0264 4
A58 EQU 065 5
A68 EQU 066 6
A78 EQU 0267 7
A88 EQU 0270 8
A98 EQU 071 9
NULL8 EQU 0000 NULL
FIG8 EQU 0336 FIGS
SYN8 EQU 0226 SYNCHRONIZE
SPC8 EQU 040+0200*PARGEN SPACE
EX8 EQU 041 EXCLAMATION
QUTS8 EQU 042 QUOTES
NO8 EQU 0243 NUMBERS
DLL8 EQU 044 DOLLARS
PC8 EQU 0245 PERCENT
AMP8 EQU 0246 AMPERSAND
APT8 EQU 047 APOSTROPHE
LP8 EQU 050 LEFT PAREN
RP8 EQU 0251 RIGHT PAREN
AST8 EQU 0252 ASTERISK
PLS8 EQU 053 PLUS
CMA8 EQU 0254 COMMA
DSH8 EQU 055 HYPHEN
PR8 EQU 056 PERIOD
SLSH8 EQU 0257 SLASH
CLN8 EQU 072 COLON
SEMI8 EQU 0273 SEMI-COLON
LTN8 EQU 074 LESS THAN
EQ8 EQU 0275 EQUAL
GTN8 EQU 0276 GREATER THAN
QUST8 EQU 077 QUESTION
ATS8 EQU 0300 AT SIGN
LB8 EQU 0333 LEFT BRACKET
RS8 EQU 0134 RIGHT SLASH
RB8 EQU 0335 RIGHT BRACKET
CR8 EQU 0215 CARRIAGE RETURN
BELL8 EQU 0207 BELL
XON EQU 021 X-ON
LF8 EQU 012 LINE FEED
EOT8 EQU 0204 END OF TRANSMISSIO
SOM8 EQU 0201 START OF MESSAGE VER 1963
EOA8 EQU 0202 END OF ADDRESS VER 1963
EOM8 EQU 03 END OF MESSAGE VER 1963
WRU8 EQU 05 WHO ARE YOU VER 1963
RU8 EQU 06 ARE YOU" VER 1963
CIO8 EQU 0175 CIRCLED ONE VER 1963
ESC8 EQU 0176 ESCAPE VER 1963
DEL8 EQU 0377 DELETE VER 1963
SOH8 EQU 0201 START OF HEADER VER 1968
STX8 EQU 0202 START OF TEXT VER 1968
ETX8 EQU 03 END OF TEXT VER 1968
ENQ8 EQU 05 ENQUIRE VER 1968
LTR8 EQU 0377 LETTERS VER 1968
. 6-BIT ASCII
AA6 EQU 01 A
AB6 EQU 02 B
AC6 EQU 03 C
AD6 EQU 04 D
AE6 EQU 05 E
AF6 EQU 06 F
AG6 EQU 07 G
AH6 EQU 010 H
AI6 EQU 011 I
AJ6 EQU 012 J
AK6 EQU 013 K
AL6 EQU 014 L
AM6 EQU 015 M
AN6 EQU 016 N
AO6 EQU 017 O
AP6 EQU 020 P
AQ6 EQU 021 Q
AR6 EQU 022 R
AS6 EQU 023 S
AT6 EQU 024 T
AU6 EQU 025 U
AV6 EQU 026 V
AW6 EQU 027 W
AX6 EQU 030 X
AY6 EQU 031 Y
AZ6 EQU 032 Z
A06 EQU 060 0
A16 EQU 061 1
A26 EQU 062 2
A36 EQU 063 3
A46 EQU 064 4
A56 EQU 065 5
A66 EQU 066 6
A76 EQU 067 7
A86 EQU 070 8
A96 EQU 071 9
NULL6 EQU 0000 NULL
SPC6 EQU 040 SPACE
EX6 EQU 041 EXCLAMATION
QUTS6 EQU 042 QUOTES
NO6 EQU 043 NUMBERS
DLL6 EQU 044 DOLLARS
PC6 EQU 045 PERCENT
AMP6 EQU 046 AMPERSAND
APT6 EQU 047 APOSTROPHE
LP6 EQU 050 LEFT PAREN
RP6 EQU 051 RIGHT PAREN
AST6 EQU 052 ASTERISK
PLS6 EQU 053 PLUS
CMA6 EQU 054 COMMA
DSH6 EQU 055 HYPHEN
PR6 EQU 056 PERIOD
SLSH6 EQU 057 SLASH
CLN6 EQU 072 COLON
SEMI6 EQU 073 SEMI-COLON
LTN6 EQU 074 LESS THAN
EQ6 EQU 075 EQUAL
GTN6 EQU 076 GREATER THAN
QUST6 EQU 077 QUESTION
LB6 EQU 033 LEFT BRACKET
RS6 EQU 034 RIGHT SLASH
RB6 EQU 035 RIGHT BRACKET
. 7-BIT ASCII
AA7 EQU 0101 A
AB7 EQU 0102 B
AC7 EQU 0103 C
AD7 EQU 0104 D
AE7 EQU 0105 E
AF7 EQU 0106 F
AG7 EQU 0107 G
AH7 EQU 0110 H
AI7 EQU 0111 I
AJ7 EQU 0112 J
AK7 EQU 0113 K
AL7 EQU 0114 L
AM7 EQU 0115 M
AN7 EQU 0116 N
AO7 EQU 0117 O
AP7 EQU 0120 P
AQ7 EQU 0121 Q
AR7 EQU 0122 R
AS7 EQU 0123 S
AT7 EQU 0124 T
AU7 EQU 0125 U
AV7 EQU 0126 V
AW7 EQU 0127 W
AX7 EQU 0130 X
AY7 EQU 0131 Y
AZ7 EQU 0132 Z
A07 EQU 060 0
A17 EQU 0061 1
A27 EQU 0062 2
A37 EQU 0063 3
A47 EQU 0064 4
A57 EQU 0065 5
A67 EQU 0066 6
A77 EQU 0067 7
A87 EQU 0070 8
A97 EQU 0071 9
NULL7 EQU 0000 NULL
FIG7 EQU 026 FIGS SAME AS SYNC
SYN7 EQU 026 SYNCHRONIZE
SPC7 EQU 040 SPACE
EX7 EQU 041 EXCLAMATION
QUTS7 EQU 042 QUOTES
NO7 EQU 043 NUMBERS
DLL7 EQU 044 DOLLARS
PC7 EQU 045 PERCENT
AMP7 EQU 046 AMPERSAND
APT7 EQU 047 APOSTROPHE
LP7 EQU 050 LEFT PAREN
RP7 EQU 051 RIGHT PAREN
AST7 EQU 052 ASTERISK
PLS7 EQU 053 PLUS
CMA7 EQU 054 COMMA
DSH7 EQU 055 HYPHEN
PR7 EQU 056 PERIOD
SLSH7 EQU 057 SLASH
CLN7 EQU 072 COLON
SEMI7 EQU 073 SEMI-COLON
LTN7 EQU 074 LESS THAN
EQ7 EQU 075 EQUAL
GTN7 EQU 076 GREATER THAN
QUST7 EQU 077 QUESTION
ATS7 EQU 0100 AT SIGN
LB7 EQU 0133 LEFT BRACKET
RS7 EQU 0134 RIGHT SLASH
RB7 EQU 0135 RIGHT BRACKET
CR7 EQU 015 CARRIAGE RETURN
LF7 EQU 012 LINE FEED
EOT7 EQU 04 END OF TRANSMISSIO
SOM7 EQU 01 START OF MESSAGE VER 1963
EOA7 EQU 02 END OF ADDRESS VER 1963
EOM7 EQU 03 END OF MESSAGE VER 1963
WRU7 EQU 05 WHO ARE YOU VER 1963
RU EQU 06 ARE YOU VER 1963
CIO7 EQU 0175 CIRCLED ONE VER 1963
ESC7 EQU 0176 ESCAPE VER 1963
DEL7 EQU 0177 DELETE VER 1963
SOH7 EQU 01 START OF HEADER VER 1968
STX7 EQU 02 START OF TEXT VER 1968
ETX7 EQU 03 END OF TEXT VER 1968
ENQ7 EQU 05 ENQUIRE VER 1968
LTR7 EQU 0177 LETTERS VER 1968
. XS-3
XSA EQU 024 A
XSB EQU 025 B
XSC EQU 026 C
XSD EQU 027 D
XSE EQU 030 E
XSF EQU 031 F
XSG EQU 032 G
XSH EQU 033 H
XSI EQU 034 I
XSJ EQU 044 J
XSK EQU 045 K
XSL EQU 046 L
XSM EQU 047 M
XSN EQU 050 N
XSO EQU 051 O
XSP EQU 052 P
XSQ EQU 053 Q
XSR EQU 054 R
XSS EQU 065 S
XST EQU 066 T
XSU EQU 067 U
XSV EQU 070 V
XSW EQU 071 W
XSX EQU 072 X
XSY EQU 073 Y
XSZ EQU 074 Z
XS0 EQU 03 0
XS1 EQU 04 1
XS2 EQU 05 2
XS3 EQU 06 3
XS4 EQU 07 4
XS5 EQU 010 5
XS6 EQU 011 6
XS7 EQU 012 7
XS8 EQU 013 8
XS9 EQU 014 9
PRX EQU 075 PERIOD
CMAX EQU 056 COMMA
SEMIX EQU 023 SEMI-COLON
SLSHX EQU 064 SLASH
DSHX EQU 02 HYPHEN
QUTSX EQU 041 QUOTATIONS
QUSTX EQU 057 QUESTION
CLNX EQU 062 COLON
LPX EQU 0 LEFT PAREN
RPX EQU 0 RIGHT PAREN
APTX EQU 0 APOSTROPHE
DLLX EQU 0 DOLLAR
EXX EQU 0 EXCLAMATION
AMPX EQU 0 AMPERSAND
NOX EQU 0 NUMBER
SPCX EQU 0 SPACE
EQX EQU 0 EQUAL
ATX EQU 0 AT SIGN
PLSX EQU 0 PLUS
A$SCII** PROC 0,0
END
/
PROCEDURES FOR ADIT$
P PROC *1
A$DIT* NAME ADIT$ INITIAL ADIT$ ENTRY
A$DITR* NAME ADITR$ ADIT$ RE-ENTRY
A$DITZ* NAME ADITZ$ ADIT$ RE-ENTRY AND ZERO COLUMN POINTER
A$CHAR* NAME ACHAR$ EDIT A CHARACTER
A$QCHR* NAME AQCHR$ ASCII QUARTER CHARACTER
A$COL* NAME ACOL$ POSITION TO A COLUMN
A$SKIP* NAME ASKIP$ SKIP AN AREA
A$FCHR* NAME AFCHR$ FIELDATA CHARACTER
A$SCHR* NAME ASCHR$ ASCII SIXTH CHARACTER
A$MSGC* NAME *1 STORE NEW AMSG$ CHARACTER
DO P(1)>1 , LA,15*(P(1)<3)+P(1,3) 12,+(A$AD 1,1)
DO P(1)=1 , LA,15 12,P(1,1)
DO P(0,*0)=0 , LMJ 11,P(0,0) . CALL PROPER ROUTINE,
DO P(0,*0)=1 , SA,7 12,2,1 . OR STORE NEW MSG CHARACTER
END
P PROC *1
A$OCTV* NAME AOCTV$ VARIABLE LENGTH OCTAL
A$DECV* NAME ADECV$ VARIABLE LENGTH DECIMAL
A$FD1* NAME AFD1$ ONE WORD FIELDATA
A$FD3* NAME AFD3$ FIELDATA
A$FD5* NAME AFD5$ FIELDATA
A$FI* NAME AFI$ I$ FORM
A$FH* NAME AFH$ 18,18 FORM
A$SW1* NAME ASW1$ ASCII SIXTHS
A$SW3* NAME ASW3$ ASCII SIXTHS
A$QW1* NAME AQW1$ ASCII QUARTERS
A$QW3* NAME AQW3$ ASCII QUARTERS
A$HEXV* NAME AHEXV$ VARIABLE LENGTH HEXADECIMAL
DO P(1)>0 , LA,P(1,3) 12,+(A$AD 1,1)
LMJ 11,P(0,0)
END
P PROC 0,1
A$DITX* NAME ADITX$ EXIT FROM EDIT MODE
A$DTX* NAME ADITX$
A$COLN* NAME ACOLN$ COMPUTE COLUMN NUMBER
A$MSGR* NAME AMSGR$ RE-ENTER MESSAGE EDITOR
A$QMSR* NAME AQMSR$ RE-ENTER QUARTER WORD ASCII MESSAGE EDIT
A$FMSR* NAME AFMSR$ RE-ENTER FIELDATA MESSAGE EDITOR
A$LMSR* NAME ALMSR$ RE-ENTER MONOCASE MESSAGE EDITOR
A$CLEAR* NAME ACLEAR$ BLANK IMAGE AND RESET COLUMN POINTER
LMJ 11,P(0,0)
END
P PROC *1
A$FD2* NAME AFD2$ TWO WORD FIELDATA
A$FD4* NAME AFD4$ FIELDATA
A$FD6* NAME AFD6$ FIELDATA
A$SW2* NAME ASW2$ ASCII SIXTHS
A$SW4* NAME ASW4$ ASCII SIXTHS
A$QW2* NAME AQW2$ ASCII QUARTERS
A$QW4* NAME AQW4$ ASCII QUARTERS
DO P(1)>0 , DL 12,+(A$AD 1,1)
LMJ 11,P(0,0)
END
P PROC *1
A$MSG* NAME AMSG$ STRING EDIT
A$MSG1* NAME AMSG1$ STRING EDIT
A$QMSG* NAME AQMSG$ QUARTER WORD ASCII STRING EDIT
A$QMS1* NAME AQMS1$ QUARTER WORD ASCII STRING EDIT
A$FMSG* NAME AFMSG$ FIELDATA STRING EDIT
A$FMS1* NAME AFMS1$ FIELDATA STRING EDIT
A$LMSG* NAME ALMSG$ MONOCASE STRING EDIT
A$LMS1* NAME ALMS1$ MONOCASE STRING EDIT
DO P(1)>0 , LA,14*(P(1)<3)+P(1,3) 12,+(A$AD 1,1)
DO P(0)>1 , LXI,14*(P(0)<4)+P(0,3) 12,+(A$AD 0,1)
LMJ 11,P(0,0)
END
P PROC *1
A$COPY* NAME ACOPY$ STRING COPY ROUTINE
A$PACK* NAME APACK$ STRING COPY WITH PACKING
A$QCOP* NAME AQCOP$ QUARTER WORD ASCII STRING COPY
A$QPAC* NAME AQPAC$ QUARTER WORD ASCII STRING PACK
A$FCOP* NAME AFCOP$ FIELDATA STRING COPY
A$FPAC* NAME AFPAC$ FIELDATA STRING PACK
DO P(1)>1 , LA,14*(P(1)<4)+P(1,4) 12,+(A$AD 1,2)
DO P(0)>1 , LXI,14*(P(0)<4)+P(0,3) 12,+(A$AD 0,1)
DO P(1)>0 , LA,14 13,P(1,1)
LMJ 11,P(0,0)
END
P PROC *1
A$OCTF* NAME AOCTF$ FIXED LENGTH OCTAL EDITOR
A$DECF* NAME ADECF$ FIXED LENGTH DECIMAL EDITOR
A$DECZ* NAME ADECZ$ FIXED LENGTH LEADING ZERO DECIMAL
A$DCFZ* NAME ADCFZ$ FIXED LENGTH LEADING ZERO DECIMAL
A$HEXF* NAME AHEXF$ FIXED LENGTH HEXADECIMAL
DO P(1)>1 , LA,P(1,4) 12,+(A$AD 1,2)
DO P(1)>0 , LA,14 13,P(1,1)
LMJ 11,P(0,0)
END
P PROC *1
A$FORM* NAME 1 GENERAL FORM EDIT
DO P(1)>1 , LA,P(1,4) 12,+(A$AD 1,2)
DO P(1)>0 , LA 13,P(1,1)
LMJ 11,AFORM$
END
P PROC *1
A$FLS1* NAME AFLS1$ SINGLE PRECISION SCIENTIFIC
A$FLG1* NAME AFLG1$ SINGLE PRECISION GENERALIZED FORMAT
A$FLF1* NAME AFLF1$ SINGLE PRECISION FIXED FORMAT
A$FLN1* NAME AFLN1$ SINGLE NICE EDIT
P(2,1) EQU 1
A$FLS2* NAME AFLS2$ DOUBLE PRECISION SCIENTIFIC
A$FLG2* NAME AFLG2$ DOUBLE PRECISION GENERALIZED
A$FLF2* NAME AFLF2$ DOUBLE PRECISION FIXED
A$FLN2* NAME AFLN2$ DOUBLE NICE EDIT
DO P(2,1)**(P(1)>1) , LA 13,+(A$AD 1,2)
DO (1-P(2,1))**(P(1)>1) , DL 13,+(A$AD 1,2)
DO P(1)>0 , LA,14 12,P(1,1)
LMJ 11,P(0,0)
END
P PROC *1
A$TIM* NAME ATIME$ HH:MM:SS
A$TIME* NAME ATIME$ HH:MM:SS
A$DAY1* NAME ADAY1$ MM/DD/YY
A$DAY2* NAME ADAY2$ DD MMM YY
A$DAY3* NAME ADAY3$ MONTH DD, YEAR
A$DAY4* NAME ADAY4$ YYYYMMDD
A$DAY5* NAME ADAY5$ YYMMDD
A$DAYW* NAME ADAYW$ WEEKDAY
A$TIM1* NAME ATIM1$ HH:MM:SS XM
A$TIME1* NAME ATIME1$ HH:MM:SS XM
DO P(1)>0 , LA,P(1,3) 12,+(A$AD 1,1)
LMJ 11,P(0,0)
END
P PROC 0,2
A$TD* NAME ATIME$ HH:MM:SS
A$DAT1* NAME ADAY1$ MM/DD/YY
A$DAT2* NAME ADAY2$ DD MMM YY
A$DAT3* NAME ADAY3$ MONTH DD, YEAR
A$DAT4* NAME ADAY4$ YYYYMMDD
A$DAT5* NAME ADAY5$ YYMMDD
A$DATW* NAME ADAYW$ WEEKDAY
A$TD1* NAME ATIM1$ HH:MM:SS XM
TDATE$
LMJ 11,P(0,0)
END
A$AD* PROC 1,1 COMPUTE GENERALIZED ADDRESS
S EQU A$AD(1,1)
T EQU A$AD(1,2)
+(I$ 0,0,0,P(S,T+1),2*P(S,*T+1)+P(S,*T),P(S,T))
END
P PROC *10
A$PKT* NAME 1 GENERATE SMALL PACKET
A$PKTF* NAME 0 GENERATE BIG PACKET
A(0,1) EQU 'MSG'
A(1,1) EQU 046 '&'
A(0,2) EQU 'FPS'
A(1,2) EQU 1
A(0,3) EQU 'FPR'
A(1,3) EQU 1
A(0,4) EQU 'DPC'
A(1,4) EQU 0
A(0,5) EQU 'SPC'
A(1,5) EQU 0
DO P>2 ,I DO P-2 ,J DO A(1) , DO A(0,J)=P(I+1,1) ,A(1,J) EQU P(I+1,2)
Y FORM 9,9,18
Z FORM 6,6,6,18
Y 0,P(1,1),P(1,2)
Y 0,0,0
Y A(1,1),0,0
Z A(1,2),A(1,3),0,0
+ 0,0
+ 0
+ 0
DO P(0,0) , END
+ A(1,4),A(1,5),0,0
+ 0,0,0,0,0,0
+ 0,0
+ 0
+ 0
END
P PROC 1,1
A$FW* NAME 1 GENERATE FORM WORD
I DO P(1) ,F(1) EQU (F(1)*/P(1,I))++(1*/(P(1,I)-1))
+ F(1)
END
P PROC *1 EDIT USING COMMON PACKET
A$DT* NAME 1
A$DTR* NAME 2
A$DTZ* NAME 3
DO P(0,0)=1 , A$DIT AP$
DO P(0,0)=2 , A$DITR AP$
DO P(0,0)=3 , A$DITZ AP$
DO P(1)>0 , A$MSGC P(1,1)
END
P PROC *1
A$PRTX* NAME
A$DTX
A$PRT* NAME
APRINT$ AL$,ALL$,P(1,1)+(P(1)=0)
END
/.
. INTERNAL DEFINITIONS FOR ADIT$S AND ADIT$U
DEF
ISIGN EQUF PKT+2,,Q2 INTEGER SIGN (ZERO IF PLUS)
BIAS EQUF PKT+7,,XH2 SAVE AREA FOR POWERS
XPSIGN EQUF PKT+8,,S3 EXPONENT SIGN
EXP EQUF PKT+8,,S4 IF NONZERO, NO EXPONENT SCAN
AFTRDP EQUF PKT+8,,S5 AFTER THE DECIMAL POINT FLAG
VALNUM EQUF PKT+8,,S6 VALID NUMBER FOUND FLAG
MAN EQUF PKT+9 FIRST PART OF MANTISSA
C$DEF* PROC 0,0
LOAD* EQUF ADIT$U,*CX LOAD AND ADVANCE POINTER
LOOK* EQUF ADIT$K,CX LOAD WITHOUT ADVANCING
END .
. PROCEDURES FOR ADIT$S AND ADIT$U
P PROC 0,1
C$POS3* NAME CPOS3$ POSITION BEFORE NEXT NON-BLANK CHARACTER
C$POS4* NAME CPOS4$ POSITION AFTER NEXT NON-BLANK CHARACTER
C$CHAR* NAME CCHAR$ A0 = 1 CHARACTER
C$LOOK* NAME CLOOK$ LOOK AT NEXT CHAR, POINTER UNTOUCHED
C$I* NAME CI$ A0(A1) = INTEGER
C$DI* NAME CDI$ A0(A1) = DECIMAL INTEGER
C$OI* NAME COI$ A0(A1) = OCTAL INTEGER
C$HI* NAME CHI$ A0,A1 = HEXADECIMAL INTEGER
LMJ 11,P(0,0)
END
P PROC *1
C$POS1* NAME CPOS1$ POSITION BEFORE CHARACTER IN A0
C$POS2* NAME CPOS2$ POSITION AFTER CHARACTER IN A0
DO P(1)>0 , LA,14 12,P(1,1)-(P(0,*0)=1)
LMJ 11,P(0,0)
END
P PROC *0
C$FP* NAME CFP$ FLOATING POINT UNEDIT
C$FP2* NAME CFP2$ DOUBLE PRECISION ENTRY
C$N* NAME CN$ ANY TYPE WHATSOEVER
LMJ 11,P(0,0)
END