/*** DELETE PROGRAM *** BY JOHN YOUNG ***\ /STARTED: 3-18-76 / *0000 CLA STL RAR KSB UND TAD RESTRT SRA TAD WHOBLK WHO JMP I .+1 INIT AUX0, 0 RESTRT, .+1 STA CLOS CRLF HLT *0020 PUTNUM= JMS I . NUMOUT GETNAM= JMS I . GET0 PRINT= JMS . PRINT0, 0 DCA AUX0 TAD I AUX0 AND P177 SNA JMP I PRINT0 TLS CLA JMP PRINT0+2 CRLF= JMS . CRLF0, 0 CLA TAD P15 TLS TAD N3 TLS CLA JMP I CRLF0 P77, 77 P177, 177 N240, -" P15, 15 N3, -3 P37, 37 P7600, 7600 SEGCNT, 0 DELFLS, 0 N215, -215 N270, -"7-1 EXITFG, 0 PRONUM, 0 NRBRAK, -"> CHAR, 0 N260, -"0 P7, 7 N10, -10 FLAG, 0 BADCON, SYNTAX NCOMMA, -", RBRACK, "] NBRACK, -"< NCR, "<-215 COUNT, 0 BUFF, END EXITPT, EXIT REDBLK, .+1 0 -1 FINBLK, OPNBLK, .+1 0 0 0 0 0 PRODAT, 0 SEGDAT, 0 WHOBLK, .+1 0 0 0 *0200 INIT, STA CLOS TAD EXITFG SZA CLA JMP I EXITPT GETNAM OPNBLK+2 JMP PROT0 TAD OPNBLK OPEN SZA CLA JMP I NOFIER TAD FINBLK FINF TAD REDBLK RED SZA CLA JMP I PROTER TAD SEGDAT TAD SEGCNT DCA SEGCNT ISZ DELFLS TAD BUFF PRINT CRLF JMP INIT PROT0, DCA PRONUM KSF JMP I SYNERR KRB DCA CHAR TAD CHAR TAD N260 SPA JMP I SYNERR AND P7 DCA AUX0 TAD CHAR TAD NRBRAK SNA CLA JMP PROT1 TAD CHAR TAD N270 SMA CLA JMP I SYNERR TAD PRONUM CLL RAL CLL RAL CLL RAL TAD AUX0 JMP PROT0 PROT1, KSF JMP I SYNERR KRB DCA CHAR TAD CHAR TAD NCOMMA SNA CLA JMP PROT2 TAD CHAR TAD N215 SNA CLA JMP PROT2-1 JMP PROT1 ISZ EXITFG PROT2, TAD OPNBLK OPEN SZA CLA JMP I NOFIER TAD FINBLK FINF TAD PRODAT AND P7600 DCA PRODAT TAD PRONUM AND P37 TAD PRODAT PROT TAD BUFF PRINT TAD REMSG PRINT TAD PRONUM AND P37 PUTNUM 2 TAD NRBRAK CIA TLS CRLF JMP INIT NOFIER, NOFILE PROTER, PROTVI SYNERR, SYNTAX REMSG, MSG7-1 *0400 SYNTAX, CLA KSF JMP SYNEXT KRB DCA CHAR TAD CHAR TAD N215 SNA CLA JMP SYNEXT TAD CHAR TAD NCOMMA SZA CLA JMP SYNTAX+1 SKP SYNEXT, ISZ EXITFG TAD SYNMES PRINT CRLF JMP I INITPT INITPT, INIT PROTVI, TAD PROMSG SKP NOFILE, TAD NOMSG PRI, DCA CHAR TAD BUFF PRINT TAD CHAR PRINT TAD WHOBLK+1 RTR RTR RTR AND P77 PUTNUM S 2 TAD NCOMMA CIA TLS CLA TAD WHOBLK+1 AND P77 PUTNUM S 2 TAD RBRACK TLS CRLF JMP I INITPT EXIT, CLA CLL TAD DELFLS SNA CLA JMP EXIT1 TAD DELMS1 PRINT /"DELETED " TAD SEGCNT PUTNUM S D 3 TAD DELMS2 PRINT /" BLOCKS IN " TAD DELFLS PUTNUM S D 3 TAD DELMS3 PRINT /" FILES" EXIT1, CRLF JMP RESTRT+1 DELMS1, MSG1-1 DELMS2, MSG2-1 DELMS3, MSG3-1 SYNMES, MSG4-1 PROMSG, MSG5-1 NOMSG, MSG6-1 *0600 GET0, 0 CLA KSF JMP I EXITPT TAD N10 /IF HE INPUTS 8 CHARS, IT'S A BAD ARG DCA COUNT TAD BUFF DCA 10 /SET UP BUFFER POINTER DCA FLAG GET1, ISZ COUNT SKP JMP I BADCON KRB DCA CHAR TAD CHAR TAD NBRACK SNA JMP GET2 /IF IT'S A "<", SET THE FLAG, AND GO DECODE TAD NCR SNA CLA JMP GET2-2 /IF IT'S A , GO DECODE TAD NCOMMA TAD CHAR SNA CLA JMP GET2-1 TAD CHAR DCA I 10 JMP GET1 ISZ EXITFG ISZ FLAG /PUT A "1" IN FLAG GET2, DCA I 10 /PUT ZEROS IN THE REST OF THE BUFFER ISZ COUNT JMP GET2 TAD BUFF DCA 10 /SET UP THE BUFFER POINTER, AGAIN TAD I GET0 /GET OUT DESTINATION -1 ISZ GET0 /INCREMENT PAST IT DCA 11 /SAVE IT CMA CLL RTL /AC= -3 DCA COUNT GET3, TAD I 10 /GET A CHAR SZA /DON'T TAKE 240 FROM 0 TAD N240 AND P77 /SHAVE OFF EXCESS CLL RTL RTL RTL /PUT IN LEFT BYTE (CHAR 1 IS NOW PACKED) DCA CHAR /SAVE (TEMP) TAD I 10 /GET NEXT CHAR SZA TAD N240 /DON'T TAKE 240 FROM 0 AND P77 /SAVE OFF GARBAGE TAD CHAR /GET CHAR1 DCA I 11 /STORE 2 PACKED CHARS ISZ COUNT /DO IT 3 TIMES JMP GET3 TAD FLAG /GET FLAG TAD GET0 /ADD TO RETURN ADDRESS DCA GET0 /SAVE IT JMP I GET0 /GO AWAY.... *1000 /COMBINATION OCTAL-DECIMAL OUTPUT ROUTINE /ENTER: TAD VALUE / JMS NUMOUT / S D 3 / RETURN / / /S MEANS TO SUPPRESS LEADING ZEROS /D MEANS TO OUTPUT IN DECIMAL /3 DIGITS TO OUTPUT, 1 TO 4 DIGITS / / S= 4000 D= 2000 NUMOUT, 0 DCA NUM TAD I NUMOUT CLL RAL /OCTAL OR DECIMAL OUTPUT? SPA CLA TAD DECOCT /DECIMAL TAD OCTPNT /OCTAL DCA STKPNT /PUT IT IN STACK POINTER TAD NUM260 DCA DATA+1 TAD NUM260 DCA DATA+2 TAD NUM260 DCA DATA+3 TAD DATPNT DCA DATA /SET DATA POINTER CMA CLL RTL DCA COUNT /SET UP ISZ LOOP TAD NUM /GETETH OUT NUMBER NUMLOP, CLL TAD I STKPNT /TAKE AWAY VALUE SNL JMP .+3 /IF NEG, CHANGE TO POWER-1 ISZ I DATA /TAKEN AWAY VAL, INCRE VALUE JMP NUMLOP /TAKE AWAY MORE DCA NUM /WE TOOK TOO MUCH TAD I STKPNT /ADD THAT VALUE BACK CIA TAD NUM ISZ DATA /INCRE DATA TO NEXT CHAR ISZ STKPNT /INCRE STKPNT TO NEXT VALUE ISZ COUNT /ARE WE DONE? JMP NUMLOP /NOPE, GOWAN BACK! TAD P4260 /THIS IS A ZERO, BUT IT IS DCA DATA+4 /NEGATIVE, INDICATES END OF STACK TAD I NUMOUT /ARE WE TO SUPPRESS SMA CLA /LEADING ZEROS? JMP NUMPUT /NO, GO OUTPUT TAD DATPNT DCA DATA CMA CLL RTL DCA COUNT NUMSUP, TAD NUM260 CIA TAD I DATA /IF THIS IS A ZERO SZA CLA /PUT A SPACE HERE JMP NUMPUT /IF NOT, DON'T SUPPRESS ANYMORE TAD NUM240 DCA I DATA ISZ DATA ISZ COUNT /IF THIS IS ALL ZERO NUMBER JMP NUMSUP /DON'T SUPPRESS THE LAST ONE NUMPUT, TAD I NUMOUT /FIGURE NUMBER AND NUM7 /OF CHARS TO OUTPUT CIA TAD OUTPNT DCA 17 TAD I 17 TLS SMA CLA JMP .-3 ISZ NUMOUT JMP I NUMOUT /HERE IS ALL THE DATA NEEDED FOR THE ROUTINE NUM260, "0 NUM240, " P4260, 4260 NUM7, 7 STKPNT, 0 NUM, 0 DECOCT, DECSTK-OCTSTK OCTPNT, OCTSTK DECIMA DECSTK, -1000 /-1000 DECIMAL -100 /-100 DECIMAL -10 /-10 DECIMAL OCTAL OCTSTK, -1000 /-1000 OCTAL -100 /-100 OCTAL -10 /-10 OCTAL DATPNT, .+2 DATA, .+1 0 /THOUSANDS 0 /HUNDREDS 0 /TENS 0 /ONES+4000 OUTPNT, .-1 MSG1, "D;"E;"L;"E;"T;"E;"D;" ;0 MSG2, " ;"B;"L;"O;"C;"K;"S;" ;"I;"N;" ;0 MSG3, " ;"F;"I;"L;"E;"S;0 MSG4, "?;"S;"Y;"N;"T;"A;"X;" ;"E;"R;"R;"O;"R;0 MSG5, " ;"I;"S;" ;"P;"R;"O;"T;"E;"C;"T;"E;"D;" ;"O;"N;" ;"D;"S;"K;":;"[;0 MSG6, " ;"N;"O;"T;" ;"F;"O;"U;"N;"D;" ;"O;"N;" ;"D;"S;"K;":;"[;0 MSG7, " ;"R;"E;"P;"R;"O;"T;"E;"C;"T;"E;"D;" ;"T;"O;" ;"<;0 END= . /FILENAME BUFFER $$$