. 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