perm filename STRSER.OLD[S,AIL]1 blob
sn#056470 filedate 1973-07-26 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00018 PAGES VERSION 17-1(0)
RECORD PAGE DESCRIPTION
00001 00001
00003 00002 HISTORY
00005 00003 Discussion
00008 00004 COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV,USERERR>
00017 00005 COMPIL(PTC,<PUTCH>,<GOGTAB,STRNGC,INSET>,<PUTCH -- PUT 1 CHARACTER ROUT>)
00019 00006 COMPIL(PNT,<POINT,BBPP.>,<GOGTAB,X22,X44>,<POINT, BBPP.>)
00020 00007 COMPIL(CVF,<CVF,CVG,CVE>
00024 00008
00027 00009
00029 00010
00031 00011
00033 00012 COMPIL(SUB,<SUBST,SUBSR>,<SAVE,RESTR,X22,.SKIP.,GOGTAB>,<SUBSTRING ROUTINES>)
00038 00013 COMPIL(EQU,<EQU>,<X44>,<EQU>)
00040 00014 COMPIL(CVD,<CVD,CVO>,<SAVE,RESTR,X11,X22>,<CVD AND CVO ROUTINES>)
00042 00015 COMPIL(CVS,<GETFORMAT,SETFORMAT,CVS,CVOS>
00047 00016 COMPIL(SCN,<SCAN>,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK>,<SCAN ROUTINE>)
00051 00017 COMPIL(CVC,<CVSIX,CVASC,CVSTR,CVXSTR>,<SAVE,RESTR,X11,X22,INSET,STRNGC,FLSCAN>
00054 00018 COMPIL(CVL,<CVFIL>,<SAVE,RESTR,X22,X33,FILNAM,.SKIP.>,<CVFIL>)
00056 ENDMK
⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021 102100000000 ⊗;
COMMENT ⊗
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(13) 3-18-73 BY RHT PROTECT RPH FROM USERERR
VERSION 16-2(12) 5-11-72 BY DCS BUG #GY# BE SURE ALIGNED IF SGLIGN & ALREDY CATED
VERSION 15-2(6-11) 5-11-72
VERSION 15-2(5) 2-8-72 BY DCS BUG #GL# -- CANCEL SAME -- COULDN'T GET RIGHT
VERSION 15-2(4) 2-6-72 BY DCS BUG #GL# CVF, CVG, CVE DON'T PUT OUT EXTRA SPACE WHEN NON-NEGATIVE
VERSION 15-2(3) 2-5-72 BY DCS BUG #GI# OPTIMIZE CAT, REMOVE TOPSTR
VERSION 15-2(2) 12-21-71 BY DCS BUG #FS# REMOVE SAILRUN CONDITIONAL
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER
⊗;
SUBTTL Discussion
LSTON (STRSER)
DSCR BEGIN STRSER
⊗
IFN ALWAYS,<BEGIN STRSER>
DSCR STRSER DISCUSSION
⊗
Comment ⊗ These routines manipulate entities known to
SAIL/GOGOL users as STRINGS. A string is described by
a two-word string descriptor with the following format:
WD1: string no,,# of characters
WD2: byte pointer to string
String no. is incremented whenever a new string is created at
the top of string space. (SUBSTR does not increment it). An
ILDB on WD2 gets the first character of the string.
All parameters necessary for string operations are in the user's
parameter table (GOGTAB → at it):
TOPBYTE: byte pointer to next available character
REMCHR: negative count of free characters remaining
ST: addr of first string space word
STTOP: addr of last word.
STRNGC is the compacting string garbage collector, called when not
enough space remains. The number of characters desired by the
operation detecting the lack is in register A on entry.
Strings are concatenated by copying both operands to the top
of string space (or only the 2nd if the first is already
on top), and creating a descriptor for the new string.
SUBSTR operations simply create new descriptors.
GETCH and PUTCH handle numeric ↔ string conversions.
⊗
COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV,USERERR>
,<SAVE,RESTR,X22,X33,STRNGC,INSET,GOGTAB,CONFIG,PUTCH>
,<CAT, USERERR -- CONCATENATION ROUTINE>)
;;#GI# DCS 2-5-72 OPTIMIZE CAT SOME MORE, REMOVE TOPSTR
DSCR "STRING"←CAT("STR1","STR2");
CAL SAIL
DES CALL GENERATED BY COMPILER FOR & OPERATOR
⊗
DEFINE CANON (ADR,AC)<
LDB TEMP,[POINT 3,ADR,5] ;4,5,6,7,0,1 FROM POSITION
IMULI AC,5 ;ADDR IN CHARS
ADD AC,BPTBL(TEMP) ;0,1,2,3,4,5 EXTRA CHARS
>
;CAT'S MAP TABLE
BPTBL: 4↔5↔0↔0↔0↔1↔2↔3 ;MAP
HERE (CAT.RV)
POP SP,TEMP ;ARGUMENTS ARE IN REVERSE ORDER,
POP SP,LPSA ; PUT THEM RIGHT
PUSH SP,-1(SP)
PUSH SP,-1(SP)
MOVEM LPSA,-3(SP)
MOVEM TEMP,-2(SP)
HERE (CAT)
MOVE USER,GOGTAB
POP P,UUO1(USER) ;SAVE FOR STRNGC ERR MESSAGE
MOVEI TEMP,-1 ;FOR TESTING LENGTHS
TDNN TEMP,-3(SP) ;FIRST STRING NULL?
JRST RETSEC ;YES, RETURN SECOND STRING
TDNN TEMP,-1(SP) ;SECOND STRING NULL?
JRST RETFRS ;YES, RETURN FIRST STRING
CATGO: MOVEI TEMP,RACS(USER)
BLT TEMP,RACS+3(USER)
MOVEM RF,RACS+RF(USER) ;SAVE F-REGISTER
HRRZ B,-2(SP) ;ADDR WORD OF FIRST STRING
MOVE LPSA,B
CANON (<-2(SP)>,LPSA) ;COMPUTE CANONICAL FORM
HRRZ A,-3(SP) ;#CHARS IN FIRST
ADD LPSA,A ;+#CHARS IN FIRST
HRRZ C,(SP) ;2D ADDRESS
CAMGE C,B ;IS IT POSSIBLE THEY ARE ALREADY CAT?
JRST CAT3 ;NO
CANON (<(SP)>,C) ;GET CANONICAL FORM OF 2D
CAMN C,LPSA ;SAME?
JRST ADJRET ;YES, RETURN ADJUSTED POINTER
CAT3: HRRZ C,TOPBYTE(USER) ;TRY SAME TRICK WITH THIS GUY
CANON (<TOPBYTE(USER)>,C)
CAMN C,LPSA ;FIRST AT THE TOP?
JRST ONLY1 ;YES
; TWO STRINGS TO MOVE
MOVTWO: ADD A,-1(SP) ;#CHARS(2)
HRRZ A,A ;ALLOW ROOM FOR POSSIBLE INSET
ADDM A,REMCHR(USER) ;#CHARS(NEW) - REMAINING #CHARS
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, GO MAKE SOME
SKIPE SGLIGN(USER) ;IF ALIGNING,
PUSHJ P,INSET ; ALIGN
HRRZ B,-3(SP) ;GET 1ST # CHARS
HRROM A,-3(SP) ;COUNT RESULT
MOVE LPSA,TOPBYTE(USER);WILL BE NEW BYTE POINTER
MOVE A,LPSA ;WILL BE RESULT
EXCH A,-2(SP) ;TRADE WITH FIRST BYTE POINTER
ILDB C,A ;KNOWN NOT TO BE NULL STRING
IDPB C,LPSA ;MOVE THE STRING
SOJG B,.-2 ;RAPIDLY
HRRZ A,-1(SP) ;#CHARS(2)
JRST CATB
; ONLY ONE STRING TO MOVE
ONLY1: SKIPE SGLIGN(USER) ;CHECK ALIGNMENT?
;;#GY# SEE JUST BELOW
JSP C,CHKLGN ;YES, DON'T RETURN IF MISALIGNED
;;#GY#
HRRZ A,-1(SP) ;#CHARS(2)
ADDM A,REMCHR(USER) ; - REMAINING CHARS
SKIPLE REMCHR(USER) ;ROOM?
PUSHJ P,STRNGC ;NO
ADDM A,-3(SP) ;NEW #CHARS
MOVE LPSA,TOPBYTE(USER);EXTEND FROM HERE
; MOVE 2D
CATB: MOVE B,(SP) ;2D BYTE POINTER
ILDB C,B ;MOVE THIS STRING
IDPB C,LPSA ;AND MOVE IT
SOJG A,.-2 ; FAST
MOVEM LPSA,TOPBYTE(USER);PUT THIS AWAY, BY ALL MEANS
REST.4: MOVSI TEMP,RACS(USER)
BLT TEMP,C
RETFRS: SUB SP,X22 ;REMOVE NON-RESULT
JRST @UUO1(USER) ;RETURN
RETSEC: POP SP,-2(SP)
POP SP,-2(SP)
JRST @UUO1(USER) ;DIDN'T SAVE THEM
;;#GY# DCS 5-11-72 ASSURE FULL-WORD ALIGN IF SGLIGN AND ALREADY CATTED
ADJRET: SKIPE SGLIGN(USER) ;IF NEED ALIGNMENT, MUST CHECK IT
JSP C,CHKLGN ;DON'T RETURN IF NOT ALIGNED
OKLG: HRRZ TEMP,-1(SP) ;COUNT OF 2D
ADDM TEMP,-3(SP) ;INCREASE COUNT OF FIRST
JRST REST.4
CHKLGN: MOVE TEMP,-2(SP) ;Check the position field of first arg --
TLNN TEMP,300000 ;44, 01 are aligned, 35,27,17,10 not. Bits
JRST (C) ; 1 and 2 are both off only for 44 and 01.
JRST MOVTWO ;Not aligned, move both
;;#GY#
DSCR "STRING"←CHRCAT(CHAR,"STR")
⊗
HERE (CHRCAT)
HRRZ TEMP,-1(SP) ;CHECK OTHER STRING NULL
JUMPE TEMP,ITSNUL
PUSH SP,-1(SP) ;MAKE ROOM FOR ONE UNDERNEATH
PUSH SP,-1(SP)
MOVEI TEMP,-4(SP) ;NOW PUT SINGLE-CHAR STRING
PUSH TEMP,[ONECH: 1
POINT 7,RACS+5(USER),27] ;CONSTANT IN
PUSH TEMP,ONECH+1
JRST CATCGO ;GO DO SPECIAL CAT
DSCR "STRING"←CATCHR("STR",CHAR)
⊗
HERE (CATCHR)
HRRZ TEMP,-1(SP)
JUMPE TEMP,ITSNUL
PUSH SP,ONECH ;PUT ONE-CHAR DESCRIPTOR ON
PUSH SP,ONECH+1 ;TOP
CATCGO: MOVE USER,GOGTAB
POP P,UUO1(USER) ;RETURN ADDRESS
POP P,TEMP ;PUT IT SOMEWHERE SAFE
ADD TEMP,TEMP
MOVEM TEMP,RACS+5(USER)
JRST CATGO ;EVERYBODY'S NON-NULL
ITSNUL: SUB SP,X22
JRST PUTCH ;ZAP
DSCR "STRING"←CHRCHR(CHAR,CHAR)
⊗
HERE (CHRCHR)
MOVE USER,GOGTAB
MOVEM RF,RACS+RF(USER)
PUSH P,A
MOVEI A,2 ;NEED 2 CHARS
ADDM A,REMCHR(USER)
SKIPLE A,REMCHR(USER)
PUSHJ P,STRNGC ;THE USUAL
MOVE A,-3(P) ;CHAR 1
EXCH A,(P) ;GET BACK SAVED
PUSHJ P,PUTCH ;A STRING
AOS -1(SP) ;2 CHARACTER STRING
MOVE TEMP,-1(P) ;CHAR 2
IDPB TEMP,TOPBYTE(USER);A 2-CHAR STRING
SUB P,X33
JRST @3(P) ;QUICK AS A BUNNY
;;#GI#
DSCR USERERR(VALUE,CODE,"MSG");
CAL SAIL
⊗
Comment ⊗USERER
does ERR. CODE,"MSG" -- prints VALUE if CODE is 2
(using ERR. UUO facilities
⊗
HERE (USERERR)
MOVE USER,GOGTAB
PUSHJ P,INSET ;ALIGN STRING SPACE TO FW BOUNDARY
PUSH SP,[1] ;CONCATENATE A NULL FOR TTCALL
PUSH SP,[POINT 7,[0]]
PUSHJ P,CAT
SUB SP,[XWD 2,2] ;ADJUST STACK
POP P,UUO1(USER) ;USER GUARANTEED OK
SKIPG TEMP,(P) ;IS CODE 0?
ERR. @2(SP) ;YES, NO CONTINUATION POSSIBLE
CAIN TEMP,1 ;IS CODE 1?
ERR. 1,@2(SP) ;YES, JUST PRINT ERROR, ALLOW CONT
CAIGE TEMP,2 ;IS IT SOMETHING ELSE
JRST USERDUN ;NO
MOVE TEMP,-1(P) ;YES, SET UP SO ERR. GUY WILL PRINT VALUE
ERR. 7,@2(SP) ; AND DO IT
USERDUN:
SUB P,X22
JRST @UUO1(USER)
ENDCOM (CAT)
COMPIL(PTC,<PUTCH>,<GOGTAB,STRNGC,INSET>,<PUTCH -- PUT 1 CHARACTER ROUT>)
DSCR "1-CHR STRING"←PUTCH(INTEGER);
CAL SAIL
DES CALL GENERATED BY SAIL TO MAKE A 1 CHAR STRING FROM AN INTEGER
⊗
HERE(PUTCH)
MOVE USER,GOGTAB
MOVEM RF,RACS+RF(USER)
SKIPE SGLIGN(USER)
PUSHJ P,INSET ;START ON FW BDRY
POP P,UUO1(USER)
PUSH P,A ;SAVE A
MOVEI A,1 ;COUNT FOR STRNGC
AOSLE REMCHR(USER) ;DECREASE FREE CHARS
PUSHJ P,STRNGC ; NO
POP P,A ;RESTORE A
POP P,TEMP ;GET CHARACTER
PUSH SP,[XWD 40,1] ;#CHARS
PUSH SP,TOPBYTE(USER);HERE'S WHERE IT GOES
IDPB TEMP,TOPBYTE(USER) ;STORE CHAR, UPDATE TOPBYTE(USER)
JRST @UUO1(USER) ;RETURN
ENDCOM (PTC)
COMPIL(PNT,<POINT,BBPP.>,<GOGTAB,X22,X44>,<POINT, BBPP.>)
; GETCH AND LOP NOW DONE IN LINE, NO LONGER NEEDED
HERE (BBPP.)
HERE (POINT) MOVEI A,43 ;GET LOW BIT
SUB A,-1(P)
ROT A,-6 ;NOW IN HIGH BITS
MOVE TEMP,-3(P) ;BYTE SIZE
DPB TEMP,[POINT 6,A,11]
HRR A,-2(P) ;EFFECTIVE ADDRESS.
SUB P,X44
JRST @4(P)
ENDCOM(PNT)
COMPIL(CVF,<CVF,CVG,CVE>
,<SAVE,STRNGC,RESTR,X22,X11,X33,.MT.,.CH.,.TEN.>
,<CVF, CVG, CVE>)
DSCR "STRING"←CVF(REAL);
CAL SAIL
⊗
HERE (CVF) PUSHJ P,SAVE
PUSH P,[-1]
JRST SSCONV
DSCR "STRING"←CVG(REAL);
CAL SAIL
⊗
HERE (CVG) PUSHJ P,SAVE
PUSH P,[1]
JRST SSCONV
DSCR "STRING"←CVE(REAL);
CAL SAIL
⊗
HERE (CVE) PUSHJ P,SAVE
PUSH P,[0]
JRST SSCONV
BEGIN NUMOUT
↑SSCONV:MOVE LPSA,X33
PUSHJ P,BOUND
;BOUND RETURNS AN INTEGER IN B WHICH WILL CONVERT
;TO 8 DECIMAL DIGITS.
;AN EXPONENT OF TEN IN D AND THE SIGN OF THE NUMBER IN FF
MOVM X,DIGS(USER) ;NUMBER OF DECIMALS
SKIPGE (P) ;IF F FORMAT
ADD X,D ;ADD THE TEN EXPONENT
JUMPN B,E0
JUMPN X,E0
MOVEI A,2
SKIPL (P)
MOVEM A,(P)
E0: JUMPGE X,E1
MOVEI B,0 ;THIS FIXES A BUG
JRST E2
E1: CAIL X,10
JRST E2
MOVEI Y,10 ; 0 ≤ X LESS THAN 8
SUB Y,X ;Y IS THE EXPONENT OF DIVISOR
MOVE Z,.TEN.(Y) ;Z IS THE DIVISOR
IDIV B,Z
ASH Z,-1
CAML C,Z
AOJ B, ;ROUND
CAMGE B,.TEN.(X) ;CHECK IF ROUND CAUSED ANOTHER DIGIT
JRST E2
SKIPGE (P) ;IF F FORMAT
AOJA X,E2 ;INCREASE DIGIT COUNT
IDIVI B,=10 ;OTHERWISE REMOVE IT
AOJ D, ;AND INCREASE EXPONENT
E2: MOVM A,DIGS(USER)
CAMGE A,X
MOVE A,X ;A CONTAINS NUMBER OF DIGITS
ADDI A,2 ;SIGN AND DECIMAL POINT
SKIPL (P)
ADDI A,4 ;IF NOT F FORMAT @-DD
MOVE Z,A ;SAVE CHARACTER COUNT
MOVM Y,WDTH(USER) ;MINIMUN STRING LENGTH
CAMG A,Y
MOVE A,Y
; THE STRING GARBAGE COLLECTOR GOODIES
ADDM A,REMCHR(USER) ;CHECK THERE IS ROOM
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC ;NO ROOM
HRRO C,A ;NON-ZERO, WITH COUNT
PUSH SP,C
PUSH SP,TOPBYTE(USER)
; INSERT LEADING SIGNS, BLANKS, ZEROES
SUB A,Z ;NUMBER OF LEADING SPACES
;;#GL# DCS 2-6-72 (1-1) EXTRA CHAR ONLY IF NEG. AND NO PADDING POSSIBLE
;;#GL# CANCELLED 2-8-72 BECAUSE I COULDN'T FIGURE IT ALL OUT
MOVEI C," "
JUMPE A,E4 ;NO LEADING SPACES
SKIPL WDTH(USER) ;F FORMAT
JRST E3
;; #GL#
JUMPE FF,.+2 ;LEADING ZEROS - NO SIGN, GO DO ZEROES
MOVEI C,"-"
IDPB C,TOPBYTE(USER)
MOVEI C,"0"
E5: IDPB C,TOPBYTE(USER) ;FILL WITH ZEROS
SOJG A,E5
JRST C1
E3: IDPB C,TOPBYTE(USER) ;FILL WITH BLANKS
SOJG A,E3
;; #GL#
E4: JUMPE FF,.+2 ;NO SIGN, BLANKS ALL DONE
;;#GL#
MOVEI C,"-" ;THEN THE SIGN
IDPB C,TOPBYTE(USER)
C1: MOVEI Z,10
SKIPL (P)
JRST C6
MOVE Y,X ;CVF NUMBER OF DIGITS
MOVM A,DIGS(USER) ;NUMBER OF DECIMALS
SUB Y,A ;POS OF DECIMAL POINT
JUMPGE Y,C5 ;IF POSITIVE
SUB Z,Y
MOVM X,DIGS(USER)
SETZ Y, ;OTHERWISE ZERO
JRST C5
C6: SETZ Y,
SKIPG (P)
JRST C5
JUMPL D,C5 ;CVG IF NEG TAKE CVE
CAMLE D,X ;IF ENOUGH DIGITS
JRST C5
MOVE Y,D ;SHIFT DECIMAL POINT
MOVEI D,0 ;AND ADJUST EXPONENT
C5: PUSH P,[D1] ;RECURSIVE NUMBER PRINTER
C2: CAIE X,(Y) ;DECIMAL POINT NOW
JRST C3
SOJ Z,
MOVEI C,"." ;YES
SKIPE DIGS(USER) ;IF ZERO DIGITS
JRST C4
JUMPN B,C4
MOVEI C," "
SKIPL -1(P)
JRST C9
SOJA X,C3
C9: MOVE Y,-1(P)
CAIE Y,2
JRST C4
POP P,Y
MOVE Y,[ASCII/ 0 /]
JRST D8
C3: CAILE X,(Z) ;IF MORE THAN 8 DIGITS
JRST [MOVEI C,"0" ;PUSH A ZERO
JRST C4]
IDIVI B,=10
IORI C,"0"
C4: HRLM C,(P)
SOSL X
C8: PUSHJ P,C2
C7: HLRZ C,(P) ;PUSH NUMBER OUT
IDPB C,TOPBYTE(USER)
POPJ P,
D1: SKIPGE (P)
JRST D7
SKIPN DIGS(USER)
SOJA D,D2
JUMPE D, [MOVE Y,[ASCIZ / /] ;EXPONENT ZERO SO STORE
JRST D8] ;FOUR BLANKS
D2: SETZ Y, ;ACCUMULATE EXPONENT STRING
SETZ FF, ;EXPONENT SIGN
JUMPL D, [SETO FF, ;NEGATIVE
MOVN D,D ;MAKE POSITIVE
JRST D4]
HRLI Y," "⊗=11 ;NUMBER POS SO TRILING BLANK
D4: CAIGE D,=10
JRST [MOVEI X," "
LSHC X,-7
JRST D5]
D5: IDIVI D,=10
IORI X,"0"
LSHC X,-7 ;PUSH INTO Y
JUMPG D,D5
MOVEI X,"@" ;PUSH @
IDPB X,TOPBYTE(USER)
MOVEI X,"-" ;MINUS SIGN
SKIPE FF
D6: IDPB X,TOPBYTE(USER) ;AND EXPONENT
JUMPE Y,D7
D8: LSHC X,7
JRST D6
D7: JRST RESTR ; RETURN
BOUND: SETZB FF,D ;TENS EXPONENT
MOVE B,-3(P) ;INPUT NUMBER
JUMPE B,ZERO
JUMPG B,POS
SETO FF, ;NUM IS NEG
SETO A,
LSHC A,11 ;SEPERATE BIN EXPONENT
LSH B,-1
TLO B,400000
SETCA A, ;BIN EXPONENT + 200
MOVNS B
TLN B,400000 ;IS NUM LARGEST NEGATIVE
JRST OK
ASH B,-1 ;WE WILL HAVE TO SHIFT AGAIN
AOJA A,OK
POS: SETZ A,
LSHC A,11 ;SEPERATE BIN EXPONENT
LSH B,-1
OK: SUBI A,200 ;BIN EXP IN A, ABS (BIN FRACT) IN B,
;BINARY POINT LEFT OF BIT 1 SIGN OF NUMBER IN FF
CAIL A,34
JRST MULTI ;USE NEGATIVE POWERS OF TEN
CAIG A,27 ;N LESS THAN 34
JRST FRACT ;USE POSITIVE POWERS OF TEN
CAIL A,33 ;30.2≤N LESS THAN 34
JRST TOPQ
CAIG A,30 ;30.2≤N LESS THAN 33
JRST BOT
DONE: SUBI A,43 ;31.2≤N LESS THAN 33
ASHC B,(A)
TLNE C,200000 ;ROUND
AOJ B,
ADDI D,10
ZERO: POPJ P,
TOPQ: CAMLE B,MF ;33.2≤N LESS THAN 34
JRST MULTI ;33.276 LESS THAN N LESS THAN 34
JRST DONE ;33.2≤N≤33.276
BOT: CAMGE B,LF ;30.2≤N≤30
JRST FRACT ;30.2≤N LESS THAN 30.230
JRST DONE ;30.230≤N LESS THAN 30
MULTI: MOVEI X,13 ;33.276 LESS THAN N
M2: ASH D,1
ADD A,.CH.(X) ;NEGATIVE POWERS OF TEN
CAIG A,31
JRST M1 ;N LESS THAN 32
JSP Q,LFMP ;31.2 LESS THAN N
M6: IORI D,1 ;SET EXPONENT BIT
CAIL A,34
SOJA X,M2 ;35.2 LESS THAN N STILL TOO LARGE
CAIE A,33 ;31.2 LESS THAN N LESS THAN 34
JRST M3 ;31.2 LESS THAN N LESS THAN 33
CAMLE B,MF ;33.2 LESS THAN N LESS THAN 34
JRST M4 ;33.276 LESS THAN N LESS THAN 34
M3: ASH D,-6(X) ;33.2 LESS THAN N≤33.276
JRST DONE
M1: CAIL A,30 ;N LESS THAN 32
JRST M5 ;29.2 LESS THAN N LESS THAN 32
M8: SUB A,.CH.(X) ;N LESS THAN 30 NO GOOD
SOJA X,M2 ;TRY NEXT POWER
M4: CAIE X,6 ;33.276 LESS THAN N LESS THAN 34
SOJA X,M2
MOVE B,MF ;33.276=N
JRST DONE
M5: MOVE Y,B ;SAVE B AND A
MOVE Z,A
JSP Q,LFMP
CAIL A,31 ;29.2 LESS THAN N LESS THAN 32
JRST M6 ;31.2 LESS THAN N LESS THAN 32
CAIG A,27 ;29.2 LESS THAN N LESS THAN 31
JRST M7 ;29.2 LESS THAN N LESS THAN 30
CAML B,LF ;30.2 LESS THAN N LESS THAN 31
JRST M6 ;30.230 LESS THAN N LESS THAN 31
CAILE X,6 ;30.2 LESS THAN N LESS THAN 30.230
JRST M7 ;STILL SOME TO GO
MOVE B,LF ;B=30.230
JRST M6
M7: MOVE B,Y ;RESTORE
MOVE A,Z
JRST M8
FRACT: MOVEI X,5 ;N LESS THAN 30.230
L2: ASH D,1
ADD A,.CH.(X)
CAIL A,33
JRST L1 ;32.2≤N
JSP Q,LFMP ;N LESS THAN 33
L6: IORI D,1
CAIGE A,30
SOJA X,L2 ;N LESS THAN 30
CAIE A,30 ;30.2≤N LESS THAN 33
JRST L3 ;31.2≤N LESS THAN 33
CAMGE B,LF ;30.2≤N LESS THAN 31
JRST L4 ;30.2≤N LESS THAN 30.230
L3: ASH D,(X) ;30.2300≤N LESS THAN 31
L9: MOVNS D
JRST DONE
L1: CAIG A,34 ;32.2≤N
JRST L5 ;32.2≤N LESS THAN 35
L8: SUB A,.CH.(X) ;34.2≤N
SOJA X,L2
L4: SOJGE X,L2 ;30.230≤N LESS THAN 31
MOVE B,LF ;N30.230
JRST L9
L5: MOVE Y,B ;SAVE B AND A
MOVE Z,A
JSP Q,LFMP
CAIG A,32 ;32.2≤N LESS THAN 35
JRST L6 ;32.2≤N LESS THAN 33
CAIL A,34 ;33.2≤N LESS THAN 35
JRST L7 ;34.2≤N LESS THAN 35
CAMG B,MF ;33.2≤N LESS THAN 34
JRST L6 ;33.2≤N LESS THAN 34
JUMPG X,L7 ;33.276 LESS THAN N LESS THAN 34
MOVE B,MF ;N=33.276
JRST L6
L7: MOVE B,Y ;RESTORE
MOVE A,Z
JRST L8
LFMP: MUL B,.MT.(X)
TLNE B,200000
JRST (Q)
ASHC B,1
SOJA A,(Q)
LF: 230455000000
MF: 276570177400
BEND
ENDCOM(CVF)
COMPIL(SUB,<SUBST,SUBSR>,<SAVE,RESTR,X22,.SKIP.,GOGTAB>,<SUBSTRING ROUTINES>)
DSCR "STRING"←SUBST("STRING",END CHAR,STARTING CHAR);
CAL SAIL
DES CALL GENERATED BY SAIL FOR STR[X FOR Y] OPERATION
⊗
HERE (SUBST)
MOVE LPSA,-2(P) ;END LOC
JRST SBSTR ;GO FINISH UP
; SUBSI NO LONGER NEEDED, REMOVED
DSCR "STRING"←SUBSR("STRING",#CHARS, START CHAR #);
CAL SAIL
DES CALL GENERATED BY SAIL FOR STR[X TO Y] OPERATION
ALGORITHM IS AS FOLLOWS:
1) _SKIP_←FALSE; "NOSKIP" IF ALL OK
< 2) IF END LOC > LENGTH, REPLACE IT BY LENGTH, (RH(_SKIP_)←TRUE;
3) NOW IF START < 1 OR END-START < -1 (-1⊃ZERO LENGTH REQUEST),>>
LH(_SKIP_)←TRUE, SET START TO 1 OR LENGTH+1
4) ADJUST LENGTH AND BP IN DESCRIPTOR
NOTICE THAT STR[∞+1 TO ∞+1+(non-neg integer)] IS LEGAL, RETURNING NULL,
AND TURNING ON _SKIP_
⊗
HERE (SUBSR)
SOS LPSA,-2(P) ;#CHARS
ADD LPSA,-1(P) ;-1 + START = END
SBSTR: MOVE TEMP,GOGTAB ;FOR A MOMENT
POP P,UUO1(TEMP) ;SAVE RETURN -- NONSTANDARD!!
SETZM .SKIP. ;ASSUME ALL OK
MOVE USER,(P) ;START LOC
HRRZ TEMP,-1(SP) ;LENGTH OF STRING
JUMPL LPSA,[ TDZA LPSA,LPSA ;END LOC CANNOT BE NEGATIVE
NO4: MOVE LPSA,TEMP ;NOR GREATER THAN LENGTH
HLLOS .SKIP. ;TELL THE USER END WAS WRONG
JRST OKS1]
CAMLE LPSA,TEMP ;END LOC CANNOT BE GREATER THAN LENGTH
JRST NO4
OKS1: CAIL USER,1(LPSA) ;NEW STRING MUST HAVE NON-NEG LENGTH
JRST NO1 ;ADJUST TO 1(LPSA)
JUMPLE USER,[NO2: MOVEI USER,1 ;NON-POS, ADJUST TO 1
JRST NO3
NO1: MOVEI USER,1(LPSA) ;1 PAST END OF REQUEST
NO3: HRROS .SKIP. ;TELL USER START IS BAD
JRST OKS] ;NOW CAN DO SUBSTRING
OKS: SUBI LPSA,-1(USER) ;NEW STRING LENGTH
HRRM LPSA,-1(SP) ;GET RID OF IT, FORGET IT
MOVE LPSA,(SP) ;BP
LDB TEMP,[POINT 3,LPSA,5]
TRC TEMP,4 ;# CHARS FROM BEG OF CURRENT BP
ADDI TEMP,-1(USER) ;+ # ADDITIONAL CHARS DUE TO SUBSTR
CAILE TEMP,4 ;CAN WE AVOID DIV OR SUB?
JRST DIVSUB ;NO
GETPTF: HLL LPSA,PTBL(TEMP) ;GET POINTER AND SIZE FIELDS
PTWAY: MOVEM LPSA,(SP) ;RESULT BP
SUB P,X22 ;RID SELF OF ARGUMENTS
JRST @3(P) ;RETURN
DIVSUB: CAILE TEMP,9 ;CAN WE AVOID DIV?
JRST DIV ;NO
SUBI TEMP,5 ;PUT # IN RANGE 0 TO 4
ADDI LPSA,1 ;INCREMENT BP
JRST GETPTF ;FINISH UP
; N.B. -- LPSA=13, TEMP=14, USER=15 -- CHANGE THIS CODE IF YOU MODIFY THESE
; ASSIGNMENTS
DIV: IDIVI TEMP,5 ;# WORDS TO USER, # CHARS TO TEMP
ADD LPSA,TEMP ;INCREMENT BP ADR FIELD
HLL LPSA,PTBL(USER) ;GET POINTER AND SIZE FIELDS
JRST PTWAY ;FINISH UP
PTBL: POINT 7,0
POINT 7,0,6 ;POINTER AND SIZE FIELDS FOR 7-BIT BYTES
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27
POINT 7,0,35
ENDCOM (SUB)
COMPIL(EQU,<EQU>,<X44>,<EQU>)
DSCR BOOLEAN←EQU("STR1","STR2");
CAL SAIL
⊗
HERE (EQU)
; NOTE USER NOT SET UP BECAUSE CAN BE NO ERROR MESSAGES
PUSH P,B ;SAVE EXTRA AC
HRRZ A,-1(SP) ;LENGTH OF ONE STRING
HRRZ B,-3(SP) ;LENGTH OF THE OTHER
CAME A,B ;SAME?
JRST NOTEQ ; NO, NOT EQUAL STRINGS
MOVE LPSA,(SP) ;ONE BYTE POINTER
MOVE USER,-2(SP) ;THE OTHER
JRST CLUP1 ;ENTER THE LOOP AT ITS BASE
CLUP: ILDB TEMP,LPSA ;ONE CHAR
ILDB B,USER ;ANOTHER
CAMN TEMP,B ;QUIT IF NOT EQUAL
CLUP1: SOJGE A,CLUP ;CONTINUE UNTIL ALL PERUSED OR SOME NOT EQUAL
JUMPL A,.+2 ;IF -1, THEY'RE EQUAL, USE -1 TO BE TRUE
NOTEQ: MOVEI A,0 ;NOT EQUAL
POP P,B ;RESTORE AC
SUB SP,X44 ;GET RID OF ARGS
POPJ P, ;RETURN
ENDCOM (EQU)
COMPIL(CVD,<CVD,CVO>,<SAVE,RESTR,X11,X22>,<CVD AND CVO ROUTINES>)
DSCR INTEGER←CVD("STRING");
CAL SAIL
⊗
HERE (CVD)
PUSHJ P,SAVE
MOVEI A,=10
JRST CV
DSCR INTEGER←CVO("STRING");
CAL SAIL
⊗
HERE (CVO)
PUSHJ P,SAVE
JOV .+1 ;CLEAR ANY OVERFLOWS
MOVEI A,10
CV: SETZB B,Y ;COLLECT RESULT IN B, Y IS +/- FLAG
MOVE LPSA,X11
HRRZ C,-1(SP) ;STRING COUNT
MOVE D,(SP) ;BYTE POINTER
CVL: SOJL C,CVDUN
ILDB X,D ;GET A CHAR
CAIG X," " ;IGNORE LEADING " "s AND SUCH
JRST CVL
CAIN X,"-" ;NEGATIVE?
TLCA Y,10000 ;NEGATE PREVIOUS NOTION
CAIN X,"+" ;PLUS?
JRST CVL ; GO BACK FOR MORE LEADING "BLANKS"
; NOW IT IS A DIGIT OR THE END
CNV: CAIL X,"0" ;IN RANGE?
CAIL X,"0"(A) ;A IS RADIX
JRST CVDUN ;NOT IN RANGE, DONE
IMUL B,A ;NUM=NUM*10+NEWDIG
ADDI B,-"0"(X)
SOJL C,CVDUN ;DONE WHEN NEGATIVE
ILDB X,D
JRST CNV
CVDUN: JOV [CAIN A,10 ;CVO?
TLC B,400000 ;YES, THIS SPECIAL HACK ALLOWS TYPING AN
JRST .+1] ;UNSIGNED OCTAL NO. WITH BIT 0 ON
IOR Y,[MOVEM B,RACS+1(USER)] ;MOVEM OR MOVNM
XCT Y
SUB SP,X22
JRST RESTR
ENDCOM(CVD)
COMPIL(CVS,<GETFORMAT,SETFORMAT,CVS,CVOS>
,<GOGTAB,INSET,X33,SAVE,RESTR,X11,X22,STRNGC>
,<GETFORMAT, SETFORMAT, CVS, CVOS ROUTINES>)
DSCR "STR"←CVS(INTEGER);
CAL SAIL
⊗
HERE(CVS) PUSHJ P,SAVE
PUSHJ P,CVSET ;SET UP FOR CONVERSION
MOVEI D,=10 ;WILL DIVIDE DECIMAL
SKIPL B,-2(P) ;IF NUMBER IS NEGATIVE,
JRST FRNP ; PRINT A MINUS SIGN,
MOVMS B ;PRINT ABS VALUE
MOVEI Y,"-" ;Y IS NOT ZERO, SIGNALS BLKIN BELOW
MOVEI A,1 ;ACCOUNT FOR EXTRA CHARACTER
JRST FRNP ;GO PRINT
DSCR "STR"←CVOS(INTEGER);
CAL SAIL
⊗
HERE (CVOS) PUSHJ P,SAVE
PUSHJ P,CVSET
MOVEI D,10 ;OCTAL DIVIDE
MOVE B,-2(P) ;GET THE DATA
LSHC B,-3 ;MAKE SURE NUMBER BEING
LDB C,[POINT 3,C,2] ;DIVIDED IS + BY SIMULATING
JRST FRNX ; THE FIRST RESULT.
FRNP: IDIV B,D ;FAMOUS RECURSIVE NUMBER PRINTER
FRNX: IORI C,"0"
HRLM C,(P)
ADDI A,1
JUMPE B,BLKIN ;GO TEST FOR LEADING BLANKS
PUSHJ P,FRNP
POPOFF: HLRZ C,(P)
IDPB C,TOPBYTE(USER)
POPJ P,
BLKIN: MOVEI D," " ;GIVE LEADING BLANKS IF WDTH POS,
SKIPL WDTH(USER) ; LEADING 0'S IF NEG.
JRST LEDBLK ;BLANKS
MOVEI D,"0"
JUMPE Y,LEDBLK ;NEGATIVE?
IDPB Y,TOPBYTE(USER) ;YES, PUT IN SIGN
MOVEI Y,0 ;DON'T DO IT AGAIN!
LEDBLK: CAML A,X ;NEED MORE FILL?
JRST POPOF1 ; NO
IDPB D,TOPBYTE(USER) ; YES, DROP IN ONE MORE
AOJA A,LEDBLK ;AND CONTINUE
POPOF1: JUMPE Y,POPOFF ;NEGATIVE, WERE FILLING BLANKS
IDPB Y,TOPBYTE(USER) ; YES, PUT SIGN IN AFTER BLANKS
JRST POPOFF ;GO PUT OUT NUMBER
FRNPDN: HRROM A,-1(SP) ;CHAR COUNT, NON-CONST STRING
MOVEI TEMP,=15 ;GIVE BACK WHAT WASN'T USED
CAMGE TEMP,X ; (15 IF GT WDTH, ELSE WDTH
MOVE TEMP,X ; USED FOR CALCULATION)
SUB A,TEMP
ADDM A,REMCHR(USER) ;UPDATE REMCHR
JRST RESTR
CVSET:
SKIPE SGLIGN(USER) ;IF ALIGNING,
PUSHJ P,INSET ; ALIGN
MOVE LPSA,X22
MOVM X,WDTH(USER) ;TOTAL FIELD SIZE, UNLESS NUMBER IS BIGGER
MOVEI A,=15 ;CHECK THAT THERE WILL
CAMGE A,X ; BE ROOM FOR THE NUMBER
MOVE A,X ; (USE 15 OR WDTH, WHICHEVER IS BIGGER
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC ;NO ROOM
MOVEI A,0
MOVEI Y,0 ;NOT NEG AS OF YET
PUSH SP,A ;A IS COUNT, SAVE STRING NO WORD SPACE
PUSH SP,TOPBYTE(USER);AND RESULTANT BYTE POINTER
POP P,D ;RETURN ADDR
PUSH P,[FRNPDN] ;CALLED IN-LINE FIRST TIME
JRST (D)
HERE (SETFORMAT)
MOVE USER,GOGTAB
POP P,TEMP ;RETURN ADDRESS
POP P,DIGS(USER) ;#DIGS TO RIGHT OF .
POP P,WDTH(USER) ;TOTAL FIELD WIDTH
JRST (TEMP)
DSCR GETFORMAT(@WIDTH,@DIGS);
CAL SAIL
⊗
HERE(GETFORMAT)
MOVE USER,GOGTAB
MOVEW (<@-1(P)>,<DIGS(USER)>)
MOVEW (<@-2(P)>,<WDTH(USER)>) ;GIVE USER RESULTS
SUB P,X33
JRST @3(P) ;RETURN
ENDCOM(CVS)
COMPIL(SCN,<SCAN>,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK>,<SCAN ROUTINE>)
DSCR "STR"←SCAN(@"STRING",BRKTBL,@BRCHAR);
CAL SAIL
⊗
HERE (SCAN) PUSHJ P,SAVE
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVE LPSA,X44
SOS C,-3(P) ;→STRING TO BE SCANNED
HRRZ A,(C) ;#CHARS IN INPUT STRING
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER) ;THE "OUT OF SPACE DANCE"
PUSHJ P,STRNGC
PUSH SP,A
PUSH SP,TOPBYTE(USER) ;RESULT BYTE POINTER
SKIPN A
JRST NULSCN ;RETURN NULLS ALL AROUND
MOVE B,1(C) ;INPUT BYTE POINTER
MOVEI Z,0
SOSL CHNL,-2(P) ;TABLE #, CHECK IT
CAILE CHNL,=17 ;FOR IN RANGE
ERR <SCAN: THERE ARE ONLY 18 BREAK TABLES>,1,SCNNR
SCNNX: MOVE D,BRKMSK+1(CHNL) ;HAS BITS ON FOR THIS TABLE
ADDI CHNL,1(USER) ;RLC+ORIG CHNL #
SETZM @-1(P) ;BREAK CHAR WORD
HRRZ Y,USER
ADD Y,[XWD X,BRKTBL];RLC+BRKTBL(USER)
SCNLUP: SOJL A,SCNDUN ;STRING EXHAUSTED
ILDB X,B ;GET A CHAR
TDNE D,@Y ;TDNE D,BRKTBL+RLC(X)
JRST SCNSPC ;OMIT OR BREAK
IDPB X,TOPBYTE(USER)
AOJA Z,SCNLUP
SCNNR: MOVNI CHNL,1 ;USE TABLE 0;
JRST SCNNX
SCNSPC: HLLZ TEMP,@Y ;NOW SEE IF WE
TDNN TEMP,D ;OMIT OR BREAK
JRST SCNLUP ; OMIT
SCNBRK: MOVEM X,@-1(P) ;SET BREAK CHAR WORD
SCNDUN: SKIPN TEMP,DSPTBL(CHNL) ;WHAT DO WE DO WITH BRCHAR?
JRST ENDSCN ; NOTHING
JUMPL TEMP,SCNAPN ;APPEND TO END OF STRING
SCNRET: SOS B ;LEAVE FOR NEXT TIME
REPEAT 4,<IBP B
>
JUMPL A,ENDSCN ;STRING WAS EXHAUSTED
AOJA A,ENDSCN ;PUT ONE BACK
SCNAPN:
;;#FM# 11-15-71 DCS (1-1)
JUMPL A,ENDSCN ;SCANNED OFF END, NOTHING LEFT TO APPEND
;;#FM#
IDPB X,TOPBYTE(USER)
ADDI Z,1
;;#GI# DCS 2-5-72 REMOVE TOPSTR
ENDSCN: MOVE TEMP,Z ;#CHARS IN NEW STRING
SUB TEMP,-1(SP) ;NUMBER RESERVED BUT NOT USED
ADDM TEMP,REMCHR(USER);UNRESERVE THEM
HRROM Z,-1(SP) ;NOT A CONSTANT, NEW STRING SIZE
JUMPGE A,.+2 ;IF EXHAUSTED, USE 0
MOVEI A,0
HRRM A,(C) ;UPDATE OLD COUNT
;;#GI#
MOVEM B,1(C) ;UPDATED ORIGINAL BYTE POINTER
JRST RESTR ;POPJ P,
NULSCN: SETZM @-1(P) ;NO BREAKS
SETZM (SP) ;REAL NULL STRING RESULT
JRST RESTR
ENDCOM(SCN)
COMPIL(CVC,<CVSIX,CVASC,CVSTR,CVXSTR>,<SAVE,RESTR,X11,X22,INSET,STRNGC,FLSCAN>
,<CVSIX, CVASC, CVSTR, CVXSTR -- CHARACTER CONVERSION ROUTINES>)
DSCR SIXBIT INTEGER←CVSIX("STRING");
CAL SAIL
⊗
HERE (CVSIX)
PUSHJ P,SAVE
MOVEI X,FNAME(USER) ;WHERE TO PUT IT
SUB SP,X22 ;ADJUST STACK
PUSHJ P,FLSCAN ;GET SIXBIT FROM STRING
MOVEW RACS+1(USER),FNAME(USER)
MOVE LPSA,X11
JRST RESTR
DSCR ASCII INTEGER←CVASC("STRING");
CAL SAIL
⊗
HERE (CVASC)
PUSHJ P,SAVE
POP SP,X
POP SP,B
HRRZS B ;STRING ARG
MOVEI C,5
MOVE D,[POINT 7,A]
MOVEI A,0
LUP: SOJL B,DUNN
ILDB Y,X
IDPB Y,D
SOJG C,LUP ;COLLECT CHARS IN A
DUNN: MOVEM A,RACS+1(USER) ;RESULT
MOVE LPSA,X11
JRST RESTR
DSCR "STR"←CVSTR(ASCII INTEGER);
CAL SAIL
⊗
HERE (CVSTR)
PUSHJ P,SAVE
MOVEI A,5
ADDM A,REMCHR(USER)
SKIPLE REMCHR(USER)
PUSHJ P,STRNGC
PUSHJ P,INSET ;ALIGN TO FW BDRY
;;#GI# DCS 2-5-72 REMOVE TOPSTR
PUSH SP,[XWD 40,5] ;BEST NON-CONSTANT STRING REP
;;#GI#
PUSH SP,TOPBYTE(USER)
MOVEW @TOPBYTE(USER),-1(P)
AOS TOPBYTE(USER)
MOVE LPSA,X22
JRST RESTR
DSCR "STR"←CVXSTR(SIXBIT INTEGER);
CAL SAIL
⊗
HERE (CVXSTR)
PUSHJ P,SAVE
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVEI A,6
ADDM A,REMCHR(USER) ;UPDATE REMAINING CHAR COUNT
SKIPLE REMCHR(USER) ;IS THERE ROOM FOR THIS STRING?
PUSHJ P,STRNGC ;NO, TRY TO GET IT
;;#GI# DCS 2-5-72 REMOVE TOPSTR
PUSH SP,[XWD 40,6] ;NON-CONST,,COUNT FOR RESULT
;;#GI#
PUSH SP,TOPBYTE(USER) ;RESULT STARTS HERE
MOVEI A,6
MOVE B,[POINT 6,-1(P)] ;POINT AT INPUT SIXBIT
CVXLP: ILDB TEMP,B ;GET A SIXBIT CHAR
ADDI TEMP,40 ;CONVERT TO ASCII
IDPB TEMP,TOPBYTE(USER) ;PUT IN RESULT STRING, UPDATE TOPBYTE
SOJG A,CVXLP ;DO IT ALL
MOVE LPSA,X22 ;REMOVE ARG, RETURN ADDRESS
JRST RESTR ;AND RETURN
ENDCOM(CVC)
COMPIL(CVL,<CVFIL>,<SAVE,RESTR,X22,X33,FILNAM,.SKIP.>,<CVFIL>)
DSCR SIXBIT INTEGER←CVFIL("FILE STRING",@RESULT EXTENSION,@RESULT PPN);
CAL SAIL
⊗
HERE (CVFIL)
PUSHJ P,SAVE
SETZM .SKIP. ;ASSUME NO PROBLEMS
PUSHJ P,FILNAM ;GET FILENAME COMPONENTS FROM STRING ARG
SETOM .SKIP. ;NO GOOD SPEC, REPORT IF HE'S INTERESTED
MOVE TEMP,FNAME(USER)
MOVEM TEMP,RACS+1(USER) ;AMJOR RESULT (NAME) TO R1
MOVE TEMP,FNAME+1(USER)
MOVEM TEMP,@-2(P) ;EXTENSION TO REF ARG.
MOVE TEMP,FNAME+3(USER)
MOVEM TEMP,@-1(P) ;PPN TO REF ARG.
MOVE LPSA,X33
JRST RESTR
ENDCOM(CVL)
IFN ALWAYS,<
BEND STRSER>
SUBTTL IO SERVICE ROUTINES