.TITLE STRING ; JEFFREY KODOSKY ARL AUG76 ; ; FSUBR ; ENTRY: 1 ARG ARGLIST ; EXIT: 1 ARG ; ERRORS: NONE ; CALLS: EVLIS ; CDR ; ATM2N ; RI ; PNBUFI ; STRBLD .GLOBL STRING,ZSTRING,QEVLIS,QCDR,QPNBUFI,QATM2N,QRI STRING: QEVLIS CLR R3 QPNBUFI ;RESET PNAME BUFFER POINTER STR01: MOV @R5,R2 ;GET NEXT ARG BEQ STR07 ;JUMP IF END OF ARGLIST QCDR MOV @R2,R0 ;GET CAR BIT #2,(R0)+ BNE STR05 ;JUMP IF NUMBER BIT #3,@R0 BEQ STR01 ;IGNORE NON-ATOMIC ARGS MOV -(R0),R2;LITATM OR STRING STR03: BIC #3,R2 BEQ STR01 ;JUMP IF END OF STRING MOVB 2(R2),R3 BEQ STR01 QPNBUFI MOVB 3(R2),R3 BEQ STR01 QPNBUFI MOV @R2,R2 BR STR03 STR05: MOV @R2,-(R5) QATM2N BCC .+4 QRI MOV (SP)+,R3 BIC #177600,R3 QPNBUFI BR STR01 STR07: TST (R5)+ CLR R3 QPNBUFI QSTRBLD ;RETURN NEW STRING .WORD 0 ZSTRING=.-STRING .PAGE ; SUBR: EXPLODE ; ENTRY: 1 ARG ; EXIT: ; ERRORS: NONE ; CALLS: ATM2ASCII ; I2ATM ; CONS .GLOBL EXPLODE,ZEXPLODE,QATM2ASCII,QI2ATM,QCONS EXPLODE:MOV @R5,R0 BIT #2,(R0)+ BNE EXP1 ;RETURN NIL IF NUMBER BIT #3,@R0 BNE EXP3 EXP1: CLR @R5 ;OR NON-ATOMIC ARG JMP @-(R4) EXP3: QATM2ASCII ;CONVERT TO ASCII BPL .+4 INC R3 ;BUMP PAST ' IF STRING CLR @R5 MOV R3,R2 ;FIND END OF STRING TSTB (R2)+ BNE .-2 DEC R2 ;POINT AFTER LAST BYTE EXP5: CMP R3,R2 BEQ EXP7 ;JUMP IF NO MORE CHARS MOVB -(R2),-(SP) BIC #177600,@SP QI2ATM ;MAKE AN INTEGER QCONS BR EXP5 EXP7: JMP @-(R4) ZEXPLODE=.-EXPLODE .PAGE ; SUBR VALUE ; ENTRY: 1 ARG ; EXIT: 1 ARG OR NIL IF ILLEGAL SYNTAX ; ERRORS: I4, HARD MATH ERROR (SUPPRESSED WITH Z SWITCH) ; CALLS: ATM2ASCII ; LEXICL ; I2ATM ; RCI ; OCI ; ICI ; R2ATM ; GET .GLOBL VALUE,ZVALUE,QATM2ASCII,QLEXICL,QI2ATM .GLOBL QRCI,QOCI,QICI,QR2ATM,APVAL,ZSW,QGET,QI4ERR VALUE: MOV @R5,R0 BIT #2,(R0)+ BNE VAL02 ;JUST RETURN IF ARG IS NUMBER! BIT #3,@R0 BNE VAL03 VAL01: CLR @R5 ;RETURN NIL IF NON-ATOMIC VAL02: JMP @-(R4) VAL03: QATM2ASCII ;STORE IN PNAME BUFFER BPL .+4 INC R3 ;BUMP OVER ' IF STRING MOV #400,NTYPE ;SIGN IS ALLOWED AT START MOV R3,R2 MOV R3,R1 ;SAVE BUFFER POINTER, SCAN STRING VAL04: MOVB (R2)+,R3 BEQ VAL17 ;JUMP IF END OF BUFFER QLEXICL CMP R0,#6 ;SIGN? BNE VAL07 ASRB NTYPE+1 ;YES: ALLOWED? BCS VAL04 ;YES: DON'T ALLOW ANOTHER BR VAL01 ;NO: ILLEGAL NUMBER SYNTAX VAL07: CMP R0,#13. ;DECIMAL POINT? BNE VAL09 TSTB NTYPE ;YES: ALLOWED? BMI VAL01 ;NO: ILLEGAL SYNTAX BIS #200,NTYPE ;YES: DON'T ALLOW ANOTHER BR VAL04 VAL09: CMP R0,#2 ;DIGIT? BNE VAL11 CMPB R3,#'8 ;YES: CHECK TYPE BLE 1$ INC NTYPE ;COUNT NON-OCTAL DIGITS 1$: BICB #177,NTYPE+1 ;NO SIGN ALLOWED NOW BR VAL04 VAL11: CMP R0,#4 ;E? BNE VAL13 ASRB NTYPE+1 ;YES: IF SIGN IS ALLOWED OR IF E BCS VAL01 ;ALREADY SEEN THEN BAD SYNTAX BMI VAL01 BIS #100600,NTYPE ;NO MORE E'S OR .'S BUT SIGN OK BR VAL04 VAL13: CMP R0,#5 ;Q? BNE VAL01 ;NO: ANYTHING ELSE IS BAD SYNTAX TST NTYPE ;IF SIGN IS STILL ALLOWED OR IF E OR . BNE VAL01 ;WAS SEEN OR IF NON-OCTAL DIGITS...ERROR TSTB (R2)+ ;Q MUST BE LAST CHAR BNE VAL01 MOV R1,R3 QOCI BCS VAL01 ;ERROR IF OVERFLOW VAL15: TST (R5)+ QI2ATM .WORD 0 VAL17: MOV R1,R3 ASLB NTYPE+1 ;ILLEGAL NUMBER IF SIGN STILL ALLOWED BNE VAL01 ;OR IF DIGITS DIDN'T FOLLOW SIGN BCS VAL19 ;JUMP IF FLOATING POINT TSTB NTYPE BMI VAL19 ;. SEEN QICI ;ELSE ATTEMPT INTEGER CONVERSION BCC VAL15 BR VAL21 ;JUMP IF TOO LARGE FOR INTEGER FORMAT VAL19: QRCI BIT #77777,@SP ;CHECK FOR INFINITY BNE VAL21 TST 2(SP) BEQ VAL21 MOV APVAL,-(R5) MOV ZSW,-(R5) ;YES: IS IT ALLOWED? QGET TST (R5)+ BNE VAL21 QI4ERR VAL21: TST (R5)+ ;RETURN A FLOATING POINT ATOM QR2ATM .WORD 0 NTYPE: .WORD 0 ZVALUE=.-VALUE .PAGE ; SUBR: STRLEN ; ENTRY: 1 ARG ; EXIT: 1 ARG ; ERRORS: NONE ; CALLS: I2ATM .GLOBL STRLEN,ZSTRLEN,QI2ATM STRLEN: MOV (R5)+,R0 BIT #2,(R0)+ BNE 1$ ;JUMP IF NUMBER BIT #3,@R0 BNE 2$ 1$: CLR @R5 ;RETURN NIL IF NUMBER OR NON-ATOMIC JMP @-(R4) 2$: MOV -2(R0),R0 CLR -(SP) 3$: BIC #3,R0 BEQ STRLN1 ;JUMP IF END OF STRING INC @SP TSTB 3(R0) BEQ STRLN1 INC @SP MOV @R0,R0 BR 3$ STRLN1: QI2ATM ;RETURN INTEGER .WORD 0 ZSTRLEN=.-STRLEN .PAGE ; SUBR: SEGMENT ; ENTRY: 3 ARGS ;; ; EXIT: 1 ARG ; ERRORS: NONE ; CALLS: STRBLD ; ATM2ASCII ; ATM2N ; RI .GLOBL SEGMENT,ZSEGMENT,QATM2ASCII,QATM2N,QRI,QSTRBLD SEGMENT:MOV @R5,R0 BIT #2,(R0)+ BNE 1$ BIT #3,@R0 BNE SEG01 1$: CMP (R5)+,(R5)+ ;RETURN NIL IF BAD 1ST ARG CLR @R5 JMP @-(R4) SEG01: QATM2ASCII BPL .+4 INC R3 ;BUMP PAST ' IF STRING MOV R3,-(SP);SAVE BUFFER POINTER QATM2N ;GET N1 BCC .+4 QRI QATM2N ;GET N2 BCC .+4 QRI MOV (SP)+,R2;LAST CHAR MOV (SP)+,R1;FIRST CHAR MOV (SP)+,R3;POINTER SUB R1,R2 ;RETURN NULL STRING IF N1>N2 BMI SEG05 1$: DEC R1 ;FIND N1-TH CHAR BLE SEG07 TSTB (R3)+ BNE 1$ SEG04: DEC R3 ;RAN OUT OF STRING: RETURN NULL STRING SEG05: CLRB @R3 SEG06: QSTRBLD .WORD 0 SEG07: MOV R3,R1 ;FIND N2-TH CHAR 1$: TSTB (R1)+ BEQ SEG06 ;JUMP IF OUT OF STRING DEC R2 BPL 1$ CLRB (R1)+ ;END OF NEW STRING BR SEG06 ZSEGMENT=.-SEGMENT .PAGE ; SUBR: POSITION ; ENTRY: 3 ARGS ;; ; EXIT: 1 ARG ; ERRORS: NONE ; CALLS: ATM2ASCII ; ATM2N ; RI ; I2ATM .GLOBL POSITION,ZPOSITION,QATM2ASCII,QATM2N,QRI,QI2ATM POSITION:MOV @R5,R0 BIT #2,(R0)+ BNE POS16 ;RETURN 0 IF BAD 1ST ARG BIT #3,@R0 BEQ POS16 QATM2ASCII BPL .+4 INC R3 ;BUMP PAST ' IF STRING MOV R3,-(SP);SAVE POINTER MOV 2(R5),-(R5) QATM2N BCC .+4 QRI MOV (SP)+,R2;R2=N MOV @SP,R3 ;POINTER CLR @SP ;POSITION COUNTER 1$: INC @SP DEC R2 BLE POS03 TSTB (R3)+ BEQ POS17 ;JUMP IF NO NTH CHAR! BR 1$ POS03: MOV (R5)+,R0;GET BIT #2,(R0)+ BNE POS18 ;RETURN 0 IF ILL FORMED ARG2 BIT #3,@R0 BEQ POS18 MOV -(R0),R2 BEQ POS18 ;NO MATCH IF IS NULL STRING POS10: MOV R3,R1 ;COMPARE WITH IN BUFFER MOV R2,R0 POS12: TSTB @R1 BEQ POS18 ;NO MATCH IF END OF REACHED CMPB 2(R0),(R1)+ BNE POS14 ;JUMP IF NO MATCH ON THIS POSITION TSTB 3(R0) BEQ POS19 ;IF ENDS THEN MATCH FOUND TSTB @R1 BEQ POS18 ;NO MATCH IF DNE OF REACHED CMPB 3(R0),(R1)+ BNE POS14 ;JUMP IF NO MATCH ON THIS POSITION MOV @R0,R0 BIC #3,R0 BEQ POS19 ;IF ENDS THEN MATCH FOUND BR POS12 ;CONTINUE CHECKING AT THIS POSITION POS14: INC @SP ;SHIFT ONE POSITION UP AND CHECK INC R3 BR POS10 POS16: CMP (R5)+,-(SP) POS17: TST (R5)+ POS18: CLR @SP POS19: TST (R5)+ ;POP LAST ARG QI2ATM ;RETURN INTEGER =POSITION .WORD 0 ZPOSITION=.-POSITION .END