.         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