perm filename SAISCN.FAI[S,AIL]3 blob
sn#128055 filedate 1974-11-02 generic text, type T, neo UTF8
COMPIL(SCN,<SCAN,BKTCHK>,<INSET,SAVE,RESTR,X44,STRNGC,BRKMSK,CORGET>,<SCAN ROUTINE>)
HERE (SCAN) PUSHJ P,SAVE
SKIPE SGLIGN(USER)
PUSHJ P,INSET
MOVE LPSA,X44
SOS C,-3(P) ;PTR TO STRING TO BE SCANNED
HRRZ A,(C) ;#CHARS IN INPUT STRING
JUMPE A,NULSCN ;IF NO CHARS TO SCAN
MOVE B,1(C) ;INPUT BYTE POINTER
MOVEI Z,0
MOVE X,-2(P) ;TABLE #
MOVEI TEMP,-1 ;ERROR IF BLOCK NOT THERE OR NOT INIT'ED
PUSHJ P,BKTCHK ;CHECK OUT TABLE #
JRST ENDSCN ;ERROR OF SOME SORT
SCNNX: MOVE D,BRKMSK(CHNL) ;HAS BITS ON FOR THIS TABLE
TRNE D,@BRKCVT(CDB) ;WANT CONVERSION?
TLOA C,400000 ; YES
TLZ C,400000 ; NO
SETZM @-1(P) ;BREAK CHAR WORD
MOVE Y,CDB
ADD Y,[XWD X,BRKTBL];RLC+BRKTBL(CDB)
ADD CHNL,CDB ;RELOCATE 1 TO 18
TRNN D,@BRKOMT(CDB) ;COPY IF OMIT CHARS
JUMPGE C,NOCPY ;OR IF DOING CONVERSION
ADDM A,REMCHR(USER) ;WE MUST COPY THE STRING
SKIPLE REMCHR(USER) ;THE "OUT OF SPACE DANCE"
PUSHJ P,STRNGC
PUSH SP,A
PUSH SP,TOPBYTE(USER) ;RESULT BYTE POINTER
MOVE B,1(C) ;GET BYTE POINTER BACK
SCNLUP: SOJL A,SCNDUN ;STRING EXHAUSTED
ILDB X,B ;GET A CHAR
JUMPGE C,NOCNVS ;ONLY CONVERT IF WANTED
CAIL X,"a"
CAILE X,"z"
JRST .+2
TRZ X,40 ;MAKE IT UPPER CASE
NOCNVS: TDNE D,@Y ;TDNE D,BRKTBL+RLC(X)
JRST SCNSPC ;OMIT OR BREAK
IDPB X,TOPBYTE(USER)
AOJA Z,SCNLUP
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:
JUMPL A,ENDSCN ;SCANNED OFF END, NOTHING LEFT TO APPEND
IDPB X,TOPBYTE(USER)
ADDI Z,1
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
MOVEM B,1(C) ;UPDATED ORIGINAL BYTE POINTER
JRST RESTR ;POPJ P,
NULSCN: SETZM @-1(P) ;NO BREAKS
PUSH SP,A ;NULL STRING RESULT
PUSH SP,A ;
JRST RESTR
NOCPY: PUSH SP,(C) ;COPY COUNT WRD FROM INPUT (WILL MUNCH)
PUSH SP,1(C) ;BYTE POINTER TO START
SCNLP2: SOJL A,ENDSC2 ;COUNT DOWN
ILDB X,B ;GET NEXT CHAR
TDNN D,@Y ;IS BREAK CHAR ON (KNOW NOT OMIT)
AOJA Z,SCNLP2 ;JUST REGULAR
MOVEM X,@-1(P) ;IT WAS THE BREAK CHAR
SCNDN2: SKIPN TEMP,DSPTBL(CHNL) ; FIGURE OUT WHAT TO DO WITH BRK CHR
JRST ENDSC2 ;NICHTS
JUMPL TEMP,SCNAP2 ;APPEND IT
ADD B,[070000,,0] ;BACK UP BYTE POINTER
JFCL .+1 ;SO OVERFL STAYS HAPPY
JUMPG B,.+3
SUB B,[430000,,1] ;BACK UP ONE WORD WHEN NECESSARY
JFCL .+1 ;SO OVERFL STAYS HAPPY
AOJA A,ENDSC2 ;& WE HAVE ONE MORE LEFT
SCNAP2: ADDI Z,1 ;APPEND ONE MORE CHAR TO RESULT
ENDSC2: HRRM Z,-1(SP) ;
CAIGE A,0 ;NEVER PUT NEG COUNT
MOVEI A,0 ;THERE YOU GO
HRRM A,(C) ;FIX INPUT BYTE CNT
MOVEM B,1(C) ;NEW INPUT BYTE PTR
JRST RESTR ;ALL DONE
HERE(BKTCHK)
JUMPE X,.BKCKZ
ADDI X,=17 ;TABLE # NOW IN RANGE 0 THROUGH 71
SKIPN BKTPRV(USER) ;PRIVILEGED?
CAIL X,=18 ;LOWEST FOR ORDINARY USERS
CAILE X,=71 ;MAX FOR EVERYBOCY
JRST [MOVE X,X
ERR <BKTCHK: Breaktable out of range: >,7
JRST CPOPJ]
IDIVI X,=18
MOVEI CHNL,1(Y) ;CHNL NOW IN RANGE 1 TO 18
MOVE Y,X ;SAVE FOR POSSIBLE ERROR MESSAGE
ADD X,USER ;RELOCATE GROUP NUMBER
SKIPN CDB,BKTPTR(X) ;POINTER TO COREGET BLOCK
JRST .BKCKN ;BLOCK NOT THERE
TRNN TEMP,-1 ;NEED INITIALIZATION?
JRST CPOPJ1 ;NO
HRRZ X,BKJFFO(CDB) ;INITIALIZATION BITS
TDNN X,BRKMSK(CHNL) ;WAS IT INIT'ED?
JRST [.BKCKE: IMULI Y,=18 ;RECONSTUCT THE NUMBER SO WE CAN DISPLAY IT
ADD Y,CHNL
SUBI Y,=18
ERR <BKTCHK: Uninitialized break table: >,7
JRST CPOPJ]
CPOPJ1: AOS (P) ;SUCCESS, SKIP RETURN
CPOPJ: POPJ P,
.BKCKN: JUMPGE TEMP,.BKCKE ;IF INIT REQ'D AND BLOCK NOT THERE, ERROR
PUSH P,CHNL ;SAVE 1 TO 18
PUSH P,X ;SAVE LOCATION FOR POINTER
MOVEI C,BRKDUM+1 ;AMOUNT TO GET
PUSHJ P,CORGET
ERR <BKTCHK: CORGET failed>
MOVE CDB,B ;ADDR OF BLOCK
SETZM (B) ;CLEAN IT OUT
HRLI B,(B) ;
HRRI B,1(B)
BLT B,BRKDUM(CDB) ;
POP P,X
POP P,CHNL
MOVEM CDB,BKTPTR(X) ;SAVE FOR FUTURE REFERENCE
JRST CPOPJ1 ;SUCCESS
.BKCKZ: SETZ CHNL, ;CHEAT ON "RANGE 1 TO 18"
MOVEI X,1(USER)
SKIPN CDB,BKTPTR(X) ;POINTER FOR CORGET BLOCK, TABLES 1 TO 18
JRST .BKCKN+1 ;CORGET BLOCK NOT THERE: FETCH, FIDO
JRST CPOPJ1 ;SUCCESS
ENDCOM(SCN)